{$N+,A+,G+,F+,D-,E-,L-,R-,S-,Q-,Y-}
unit penrose;

interface

procedure scene_penrose;

implementation

uses global, screen, resource, memory, palette, math2;

const
pattern64: array[0..8*8-1] of byte =
( 0,48,12,60, 3,51,15,63,
  32,16,44,28,35,19,47,31,
  8,56, 4,52,11,59, 7,55,
  40,24,36,20,43,27,39,23,
  2,50,14,62, 1,49,13,61,
  34,18,46,30,33,17,45,29,
  10,58, 6,54, 9,57, 5,53,
  42,26,38,22,41,25,37,21);

var gravy:integer;

procedure DrawParticles_1(count_dots, coord_seg, output:word);assembler;
   asm
   mov es, output
   mov cx, count_dots
   shr cx, 1
   mov si, 0
   push ds
   mov ds, coord_seg

   @l0:
       db $66; mov di, ds:[si]

       sar di, 5
       cmp di, 319; ja @skip_draw

       db $66; mov ax, di
       db $66; sar ax, 5 + 16
       cmp ax, 199; ja @skip_draw

           xchg ah, al
           add di, ax
           shr ax, 2
           add di, ax
           mov al, cl
           and al, 15
           mov es:[di], al

       @skip_draw:
       add si, 4+4
       dec cx
       jnz @l0
   pop ds
end;

procedure DrawParticles_2(count_dots, coord_seg, output:word);assembler;
   asm
   mov es, output
   mov cx, count_dots
   shr cx, 1
   mov si, 4
   push ds
   mov ds, coord_seg

   @l0:
       db $66; mov di, ds:[si]

       sar di, 5
       cmp di, 320; ja @skip_draw

       db $66; mov ax, di
       db $66; sar ax, 5 + 16
       cmp ax, 200; ja @skip_draw

           xchg ah, al
           add di, ax
           shr ax, 2
           add di, ax
           mov al, cl
           and al, 15
           mov ah, al
           mov es:[di], ax
           mov es:[di-1], al
           mov es:[di-320], al
           mov es:[di+320], al

       @skip_draw:
       add si, 4+4
       dec cx
       jnz @l0
   pop ds
end;

procedure MoveParticles(count_dots, elapsed_time, coord_seg, vect_seg:word);
var n,g, x,y,vect_x,vect_y:integer;
begin
{if elapsed_time=0 then exit;}
g:=gravy*elapsed_time;
   asm
   mov es, vect_seg
   mov bx, elapsed_time
   mov dx, g
   mov cx, count_dots
   push ds
   mov ds, coord_seg
   xor si, si

   cmp bx, 1; je @l1
   cmp bx, 2; je @l2
   cmp bx, 3; je @l3
   cmp bx, 4; je @l4
              ja @l5

   @l1: { if elapsed_time=1 }
       db $66; mov ax, es:[si]
               add es:[si+2], dx {vect_y+gravy}
       db $66; add ds:[si], ax   {coord+vect}
    add si, 4
    dec cx
    jnz @l1
    jmp @exit

   @l2: {if elapsed_time=2   vect+vect}
       db $66; mov ax, es:[si]
       db $66; add ax, ax
               add es:[si+2], dx
       db $66; add ds:[si], ax
    add si, 4
    dec cx
    jnz @l2
    jmp @exit

   @l3: {if elapsed_time=3   vect+vect+vect}
       db $66; mov ax, es:[si]
               db $66,$67,$8d,$04,$40 {lea eax, [eax*2+eax]}
               add es:[si+2], dx
       db $66; add ds:[si], ax
    add si, 4
    dec cx
    jnz @l3
    jmp @exit

   @l4: {if elapsed_time=4   vect shl 2 }
       db $66; mov ax, es:[si]
       db $66; shl ax, 2
               add es:[si+2], dx
       db $66; add ds:[si], ax
    add si, 4
    dec cx
    jnz @l4
    jmp @exit

   @l5: {if elapsed_time>4 (with imul)}
       mov di, es:[si]
       mov ax, es:[si+2]
       db $0f,$af,$fb {imul di, bx {elapsed_time}
       db $0f,$af,$c3 {imul ax, bx {elapsed_time}
       add es:[si+2], dx
       add ds:[si],   di
       add ds:[si+2], ax
    add si, 4
    dec cx
    jnz @l5

    @exit:
    pop ds
   end;
end;

procedure rand_switch_vect(q,num_dots, rand_table, segm:word);assembler;
asm
   mov es, segm
   mov cx, num_dots
   mov dx, q
   push ds
   mov ds, rand_table
   xor di, di
   xor bx, bx
   @l:
        mov si, cx
        add si, dx
        and si, 255
        mov bx, ds:[si]
        dec bl
        js @skip
           neg word ptr es:[di+bx]
        @skip:

        shr bx, 8
        dec bl
        js @skip2
           neg word ptr es:[di+bx+4]
        @skip2:

        add di, 8
        sub cx, 2
   jnz @l
   pop ds
end;


procedure Fade(q:word; col:byte; gradient, pattern, where:word);
var n,c,x,y,r,p:integer;
begin
n:=-255+q;
asm
mov es, where
mov ax, pattern
db $8e,$e0 {mov fs, ax}

mov al, col
mov ah, al

mov bx, n
xor si, si
push ds
mov ds, gradient

push bp
mov bp, bx

mov cl, 100
@y: {for y:=0 to 99 do for x:=0 to 159 do begin}

   mov ch, 160
   @x:
     db $0f,$b6,$14; {movzx dx, byte ptr ds:[si] {c:=mem[gradient:y*640+x*2];}
     add dx, bp {r:=c+n;}

     db $64; cmp [si], dx
     jl @skip0
            mov word ptr es:[si], ax
            mov word ptr es:[si+320], ax
     @skip0:

     add si, 2
   dec ch
   jnz @x
add si, 320
dec cl
jnz @y {end;}
pop bp
pop ds
end;
end;


var
Aantal, T1, start_time, old_time,elapsed_time:word;
n, y,yy,x,q:word;
pal_speed,red1,blue1,green1, red2,blue2,green2,stage:byte;
num_dots, rand_seg, coord_seg, vect_seg:word;
r,g,b:shortint;

procedure scene_penrose;
begin

num_dots:=9408;
vect_seg :=vaddr2;
coord_seg:=vaddr3;
rand_seg:=vaddr3+num_dots*4 div 16 +2;

red1:=8; green1:=12+5; blue1:=22+7; {present color screen}
red2:=10+4; green2:=6+3; blue2:=14+10; {exit color screen}


Midas_WaitVR;
for n:=1 to 180 do setonecolor(n, 14,8, 16);
setonecolor(255, 0,0,0);
Clear(1, 64000, vga);
set_border_color(255);


{fill dither pattern for full screen-buffer}
yy:=0;
for y:=0 to 99 do
   begin
   for x:=0 to 159 do memw[vaddr:x shl 1 + yy]:=pattern64[(x and 7)+(y and 7)*8];
   yy:=yy+640;
   end;

LoadBinUnpack('penrose.bin',  {load->}vaddr3,{-unpack->}vaddr2,  0);
FlipScreen(vaddr2, vga);

Wait_music_pos(27, 32); if ESC_PRESSED=1 then exit;


start_time:=mtimer;
repeat
q:=mtimer-start_time;
for n:=1 to 256 do if n<180 then begin
    r:=round(14 +  (sin_(n/80-q/10+2)*30-20)/1.8);
    g:=round(8  +  (sin_(n/80-q/10+2.5)*30-20)/1.8);
    b:=round(16 +  (sin_(n/80-q/10+2.7)*30-20)/1.8);
    if r<14 then r:=14;
    if g<8  then g:=8;
    if b<16 then b:=16;
    setonecolor(n, r,g,b);
end;
Midas_WaitVR;{}
until (port[$60]=1) or (q>55);


setonecolor(16,red1,green1,blue1);
Clear(1, 64000, vga);
Wait_music_pos(27, 46); if ESC_PRESSED=1 then exit;



Aantal:=0; T1:=mTimer;
start_time:=mtimer;
repeat
MP^.GetInformation(@info);

q:=mtimer-start_time;
if q<84 then Fade(320-q*3, 16, vaddr2, vaddr, vga);
Midas_WaitVR;{}

Inc(Aantal);
if FPS_Mode=1 then WriteFps(100, mtimer, T1, Aantal, vga);

until (esc_test) or (music_pos(28,15));
if ESC_PRESSED=1 then exit;

{-----------------------------PRESENT--------------------------------------}

stage:=0;
gravy:=0;
pal_speed:=1;

Clear(0, 65535, vaddr3);  {no remove!}
LoadBin('pres1.bin',  vaddr2,  0);
LoadBin('pres2.bin',  vaddr3,  0);


for n:=0 to 16 do setonecolor2memw(n,red1,green1,blue1, palette1, seg_palitra,ofs_palitra);
setonecolor2memw(255,0,0,0, palette1, seg_palitra,ofs_palitra);
Midas_WaitVR;
setpalette_from_memW(palette1,seg_palitra,ofs_palitra);

for n:=0 to 15 do begin
  r:=round(n*2+red1+8);
  g:=round(n*2.5+green1+8);
  b:=round(n*3+blue1);
  if r>63 then r:=63; if g>63 then g:=63; if b>63 then b:=63;
  setonecolor2Memw(n, r,g,b, palette2, seg_palitra,ofs_palitra);
  end;

setonecolor2memw(16,red1,green1,blue1, palette2, seg_palitra,ofs_palitra);
init_pal2pal(seg_palitra,ofs_palitra);
palette_process[0]:=1;


old_time:=mtimer;
start_time:=mtimer;
Aantal:=0; T1:=mTimer;

repeat
q:=mTimer-start_time;
elapsed_time:=(mtimer-old_time);
old_time:=mtimer;


Clear(16, 64000, vaddr);

if elapsed_time>0 then begin
   MP^.GetInformation(@info);
   if (stage=0) and (q>100) then stage:=1;{ blast}
   if (stage=3) and (q>160) then stage:=4;{ fade out}

   if stage=0 then for n:=0 to elapsed_time-1 do rand_switch_vect(q+n, num_dots, rand_seg, vect_seg);{}

   if stage=1 then begin  {blast}
        LoadBin('pres3.bin', vect_seg, 0);
        setonecolor2memw(16,red1+10,green1+10,blue1+10, palette2, seg_palitra,ofs_palitra);
        init_pal2pal(seg_palitra,ofs_palitra);
        palette_process[0]:=1;
        pal_speed:=16;
        stage:=2; gravy:=2;
        end;
   if (stage=2) and (q>110) then begin
        setonecolor2memw(16,red1,green1,blue1, palette2, seg_palitra,ofs_palitra);
        init_pal2pal(seg_palitra,ofs_palitra);
        palette_process[0]:=1;
        pal_speed:=2;
        stage:=3;
        end;
   if stage=4 then begin
        for n:=0 to 16 do setonecolor2memw(n,red2,green2,blue2, palette2, seg_palitra,ofs_palitra);
        init_pal2pal(seg_palitra,ofs_palitra);
        palette_process[0]:=1;
        pal_speed:=2;
        stage:=5;
        end;

   MoveParticles(num_dots, elapsed_time, coord_seg, vect_seg);{}
end;

DrawParticles_1(num_dots, coord_seg, vaddr);{}
DrawParticles_2(num_dots, coord_seg, vaddr);{}

if Vsync_mode=1 then Midas_WaitVR;{}
if palette_process[0]=1 then Pal2Pal_asm(palette_process[0], 0, 16, elapsed_time*pal_speed, seg_palitra,ofs_palitra);

FlipScreen(vaddr, vga);

Inc(Aantal);
if FPS_Mode=1 then WriteFps(100, mtimer, T1, Aantal, vga);

until (esc_test) or (music_pos(29,32));


end;

end.