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

interface

procedure scene_shadbobs;

implementation

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

const
pattern: array[0..4*4-1] of byte =
(0,8,2,10, 12,4,14,6, 3,11,1,9, 15,7,13,5);


procedure DrawBox(X1,Y1,X2,Y2:integer; color:Byte;where:word);
var temp, height, b:integer;
BEGIN
if x1>x2 then begin temp:=x2; x2:=x1; x1:=temp; end;
if y1>y2 then begin temp:=y2; y2:=y1; y1:=temp; end;
if x1>319 then exit;
if y1>199 then exit;
if x2<0 then exit;
if y2<0 then exit;

if x1<0 then x1:=0;
if y1<0 then y1:=0;
if x2>319 then x2:=319;
if y2>199 then y2:=199;

b:=320-(x2-x1)-1;
height:=y2-y1+1;

     ASM
        mov  es, where
        mov  ax, y1
        mov  di, ax
        xchg ah, al     {y*256}
        shl  di, 6      {y*64}
        add  di, ax

        mov  cl, color  {set eax to color}
        mov  ch, cl
        mov  ax, cx
        db $66; shl ax, 16
        mov  ax, cx

        mov  bx, x1
        mov  dx, x2
        add  di, bx     {start offset}

        inc  dx
        sub  dx, bx   {length}

        mov  bx, height
        mov  si, b

@loop:
        mov  cx, dx
        and  cx, 65532
        jz @length_less_four
        shr  cx, 2
        db $66; rep stosw

     @length_less_four:
        mov  cx, dx
        and  cx, 3
        jz @end_draw_line
        shr  cx, 1
        rep stosw
        adc cx, cx
        rep stosb

     @end_draw_line:
     add di, si
  dec bx
  jnz @loop
  END;
END;


Procedure fblur_HV(d:integer; where:word);assembler;
asm
push ds
     mov bx, d
     mov ds, where
     mov si, 640   +64000/2
     mov cx, 320*200/4 /2
     @blur:
        db $66; mov ax, ds:[si]
        add al, [si-5      +bx]
        add al, [si-320-4]
        add al, [si+320-4]
        shr al, 2
        db $66; mov ds:[si-321], ax
        sub si, 4
     dec cx
     jns @blur

     neg bx
     mov si, -320 +32000-320*2
     mov cx, 320*200/4 /2
     @blur2:
        db $66; mov ax, ds:[si]
        add al, [si+5      +bx]
        add al, [si-320+4     ]
        add al, [si+320+4     ]
        shr al, 2
        db $66; mov ds:[si+321], ax
        add si, 4
     dec cx
     jns @blur2
pop ds
end;


Procedure Fblur3(where:word);assembler;
asm
push ds
     mov ds, where
     mov es, where
     mov bx, 1  {; smear's effect factor}
     xor si, si
     mov di, 1
     mov cx, 320*200/4
     @blur:
        db $66; lodsw
        add al, [si+bx]
        add al, [si-320]
        add al, [si+320]
        shr al, 2
        add al, -1
        sbb dl, dl
        and al, dl
        db $66; stosw
     loop @blur
pop ds
end;

Procedure Fblur4(where:word);assembler;
asm
    push ds
    mov es,where
    mov ds,where
    mov di,0
    xor si, si
    mov cx,320*200/4
@Loooooop:
    db $66; mov ax,[di-320]
    db $66; add ax,[di+320]
    db $66; add ax,[di-1]
    db $66; add ax,[di+1]
    db $66; and ax, 0fcfch; db $fc,$fc;
    db $66; shr ax, 2
    db $66; stosw
    dec cx
    jnz @Loooooop
    pop ds
end;

Procedure Fade(swing:byte; where:word);assembler;
asm
     mov es, where
     xor di, di
     mov bl, swing
     neg bl
     mov cx, 320*200/2
     @blur:
        mov ax, es:[di]
        add al, bl
        sbb dl, dl
        and al, dl

        add ah, bl
        sbb dl, dl
        and ah, dl

        mov es:[di], ax
        add di, 2
     loop @blur
end;



procedure Hscale(val, where:word); assembler;
  asm
   mov bx, val
   push ds
   mov es, where
   mov ds, where
   xor dx, dx
   mov ax, 199
 @y:
   mov di, dx
   mov si, di
   add si, bx
   mov cx, 160/4
   cld
   db $66; rep movsw

   mov di, dx
   add di, 320-4
   mov si, di
   sub si, bx
   mov cx, 160/4
   std
   db $66; rep movsw

   add dx, 320
   dec ax
   jns @y
   cld
   pop ds
  end;

procedure fill_dither_buffer(segs,offs,where:word); assembler;
{for y:=0 to 3 do for x:=0 to 319 do
mem[vaddr:x+y*320 +64000]:=pattern[(x and 3)+(y and 3)*4];{}
asm
 push ds
 mov es, segs
 mov si, offs

 mov di, 64000 + 8*4-1
 mov ds, where
 mov dx, 3
 @y:
   mov ax, dx
   and ax, 3
   shl ax, 2
   mov cx, 7
   @x:
      mov bx, cx
      add bx, 2
      and bx, 3
      add bx, ax
      mov bl, es:[bx+si]
      mov ds:[di], bl
      dec di
      dec cx
   jns @x
 dec dx
jns @y
pop ds
end;

procedure uplineclear;assembler;
asm
mov es, vaddr
mov bx, vaddr2
mov dx, vaddr3
db $66; xor ax, ax
xor di, di
mov cx, 80
db $66; rep stosw
mov es, bx
xor di, di
mov cl, 80
db $66; rep stosw
mov es, dx
xor di, di
mov cl, 80
db $66; rep stosw
end;

procedure DrawLineRand(x1,y1, x2,y2:integer; where:word);
var x,y, len, temp:integer;
r,d:byte;
begin
  if x1>x2 then begin temp:=x1; x1:=x2; x2:=temp; end;
  if y1>y2 then begin temp:=y1; y1:=y2; y2:=temp; end;

  if x1=x2 then begin
    len:=(y2-y1) shr 2;
    for y:=0 to len do
     begin
       r:=random(5)*10;
       d:=random(6)+1;
       FillCircle_add(x1, y shl 2+y1,  d,r, 48, where);
     end;
  end;

  if y1=y2 then begin
    len:=(x2-x1) shr 2;
    for x:=0 to len do
     begin
       r:=random(5)*10;
       d:=random(6)+1;
       FillCircle_add(x shl 2+x1, y1,   d,r, 48,where);
     end;
  end;
end;


procedure draw_window(xx,yy,s:integer; plan:byte);
var where:word;
x1,y1, x2,y2, x,y:integer;
begin
     if plan=0 then where:=vaddr;
     if plan=1 then where:=vaddr2;
     if plan=2 then where:=vaddr3;
     x1:=xx-s; y1:=yy-s;
     x2:=xx+s; y2:=yy+s;

     if s>10 then begin
     DrawBox(x1,y1,x2,y2, 0, vaddr);
     DrawBox(x1,y1,x2,y2, 0, vaddr2);
     DrawBox(x1,y1,x2,y2, 0, vaddr3);
     end;

     DrawLineRand(x1,y1, x2,y1, where);
     DrawLineRand(x2,y1, x2,y2, where);
     DrawLineRand(x2,y2, x1,y2, where);
     DrawLineRand(x1,y2, x1,y1, where);
end;

procedure Draw_strong_window(c:byte);
var where,plan:word;
begin
   for plan:=0 to 2 do begin
     if plan=0 then where:=vaddr;
     if plan=1 then where:=vaddr2;
     if plan=2 then where:=vaddr3;

     DrawLine(107,47, 212,47, c, where);
     DrawLine(212,47, 212,152, c, where);
     DrawLine(212,152, 107, 152, c, where);
     DrawLine(107,152, 107, 47, c, where);
   end;
end;


var
Aantal, T1, start_time, old_time, elapsed_time:word;
qsub, window_size, qq,q,xx,yy:single;
count_bobs, bobs_tip, smear_on, event, blur_tip, scale_on, stage, col,col1,col2,col3:byte;
dw, d,x4,y4, x3,y3, x1,x2,y1,y2:integer;
n :word;
s, x,y:integer;
window_q, offset_di, offset_dx, f, r,g,b:word;

procedure Blur(mode, swing:integer);
begin
  if mode=0 then begin
       if b=0 then fblur2_(vaddr);
       if b=1 then fblur2_(vaddr2);
       if b=2 then fblur2_(vaddr3);{}
  end else
  if mode=1 then begin
       if b=0 then fblur_HV(swing, vaddr);
       if b=1 then fblur_HV(swing, vaddr2);
       if b=2 then fblur_HV(swing, vaddr3);{}
  end;
  if mode=2 then begin
       if b=0 then fblur3(vaddr);
       if b=1 then fblur3(vaddr2);
       if b=2 then fblur3(vaddr3);{}
  end;
  if mode=3 then begin
       if b=0 then fblur4(vaddr);
       if b=1 then fblur4(vaddr2);
       if b=2 then fblur4(vaddr3);{}
  end;
  if mode=4 then begin
       if b=0 then fade(swing, vaddr);
       if b=1 then fade(swing, vaddr2);
       if b=2 then fade(swing, vaddr3);{}
  end;

end;

procedure Scale(val:word);
begin
       if b=0 then hscale(val,vaddr);
       if b=1 then hscale(val,vaddr2);
       if b=2 then hscale(val,vaddr3);{}
end;

procedure Scene_Shadbobs;
begin

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

uplineclear;

n:=0;
for r:=0 to 7 do
  for g:=0 to 7 do
    for b:=0 to 3 do
     begin
     setonecolor2memW(n, r*9,g*9,b*21, palette1, seg_palitra,ofs_palitra);
     inc(n);
end;
setpalette_from_memW(palette1,seg_palitra,ofs_palitra);

s:=0;
q:=0;
d:=35;
f:=0;
b:=0;
stage:=0;
event:=0;
blur_tip:=1;
scale_on:=1;
smear_on:=0;
bobs_tip:=255;
count_bobs:=0;

window_size:=60; window_q:=0;

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

repeat
elapsed_time:=(mtimer-old_time);
old_time:=mtimer;

q:=(mtimer-start_time)*0.2;
inc(b); if b>2 then b:=0;


if (elapsed_time>0) or (aantal=0) then begin

   MP^.GetInformation(@info);


   {-------------------------EVENTS-------------------------------------}
   case event of
    0: if music_pos(58,48) then begin inc(event); bobs_tip:=0; end;
    1: if music_pos(59,0)  then begin inc(event); bobs_tip:=1; scale_on:=0;
                                      Clear(0, 64000, vaddr);
                                      Clear(0, 64000, vaddr2);
                                      Clear(0, 64000, vaddr3);
                                      end;
    2: if music_pos(60,0)  then begin inc(event); scale_on:=0; blur_tip:=0; end;
    3: if music_pos(61,4)  then begin inc(event); scale_on:=0; blur_tip:=1; smear_on:=1; uplineclear; end;
    4: if music_pos(62,0)  then begin inc(event); scale_on:=1; blur_tip:=0; smear_on:=1; end;
    5: if music_pos(62,32) then begin inc(event); scale_on:=0; blur_tip:=1; uplineclear; end;
    6: if music_pos(62,60)  then begin inc(event); scale_on:=0;blur_tip:=0; bobs_tip:=0; end;

    7: if music_pos(63,0)  then begin inc(event); scale_on:=1; bobs_tip:=2; end;
    8: if music_pos(63,8)  then begin inc(event); scale_on:=0; end;
    9: if music_pos(63,16) then begin inc(event); scale_on:=1; end;
   10: if music_pos(63,24) then begin inc(event); scale_on:=0; smear_on:=0; end;
   11: if music_pos(63,32) then begin inc(event); scale_on:=1; smear_on:=1; bobs_tip:=1; end;
   12: if music_pos(63,48) then begin inc(event); scale_on:=0; smear_on:=0; uplineclear; end;
   13: if music_pos(64,18) then begin inc(event); scale_on:=1; blur_tip:=1; smear_on:=0; qsub:=q; stage:=11; end;
   14: if music_pos(65,0)  then begin inc(event); stage:=13; end;
   end;

   if (stage=11) and (q-qsub>25) then inc(stage);
{   if (stage=12) and (q-qsub>30) then inc(stage);}

   {------------------------ FIGURES DRAW SECTION ---------------------------------}

       qq:=q/2;

  if stage<12 then
  case bobs_tip of
   0: begin
         CircleRGB(160,100,   30,  0,0,1,  vaddr, vaddr2, vaddr3);
      end;
   1: begin
         xx:=sin_(pi*2 * (q/10) * 0.64543324)*100+160;
         yy:=cos_(pi*2 * (q/10) * 0.38457832)*55+100;

         x1:=round(cos_(qq)*d+xx);
         y1:=round(sin_(qq)*d+yy);
         x2:=round(cos_(qq+1.5)*d+xx);
         y2:=round(sin_(qq+1.5)*d+yy);
         x3:=round(cos_(qq+2.5)*d+xx);
         y3:=round(sin_(qq+2.5)*d+yy);
         x4:=round(cos_(qq+4.5)*d+xx);
         y4:=round(sin_(qq+4.5)*d+yy);

         d:=round(cos_(q/4)*8+20);
         col:=round(-cos_(q)*7+8);
         CircleRGB_add(x1,y1,   d,  col,0,0,   48, vaddr, vaddr2, vaddr3);
         CircleRGB_add(x2,y2,   d,  0,col,0,   48, vaddr, vaddr2, vaddr3);
         CircleRGB_add(x4,y3,   d,  0,0,col, 48, vaddr, vaddr2, vaddr3);{}

         d:=round(cos_(q/4+2)*8+20);
         col:=round(-cos_(q+2)*7+8);
         CircleRGB_add(x2,y3,   d shr 1,  col shl 2 , 0, col shl 2,      48, vaddr, vaddr2, vaddr3);{}
         CircleRGB_add(x3,y4,   d shr 1,  col shl 1 ,    col shl 2,  0,   48, vaddr, vaddr2, vaddr3);{}
      end;
   2: begin
         for n:=0 to count_bobs do begin
            xx:=sin_(pi * (q/5+n/10) * 0.64543324)*120+160;
            yy:=cos_(pi * (q/5+n/10) * 0.38457832)*60+100;
            d:=round(cos_(n/3+q)*8+16);
            x1:=round(xx);
            y1:=round(yy);
            col1:=round(cos_(q+n/2)*7+8);
            col2:=round(cos_(q+n/2+2)*7+8);
            col3:=round(cos_(q+n/2+4)*7+8);
            CircleRGB_add(x1,y1,   d,  col1,col2,col3,   48, vaddr, vaddr2, vaddr3);
         end;
         if count_bobs<7 then inc(count_bobs);
      end;
   end;




    if stage=11 then begin
       {open window for final of part}
             window_q:=window_q+elapsed_time;
             if (window_size>0) then window_size:=window_size-elapsed_time/1.7;
             if (window_size<0) then window_size:=0;
             dw:=48-round(cos(rad(window_q*10))*window_size);
             Draw_window(160,100, dw, b);{}
     end;


     {-----------------------------------------------------------------------}


       if smear_on=1 then s:=round(sin_(q)*8) else s:=0;

       if stage<12 then begin

       Blur(blur_tip, s);{}
       if scale_on=1 then Scale(8);{}
       end;

       if (stage>=12) then begin
          blur(4, 5);
          Draw_strong_window(40);
          end;

       fill_dither_buffer(seg(pattern),ofs(pattern), vaddr);


       inc(f);
       f:=f and 3;
       if f=0 then begin offset_di:=0;   offset_dx:=199; end;
       if f=1 then begin offset_di:=320; offset_dx:=198; end;
       if f=2 then begin offset_di:=1;   offset_dx:=199; end;
       if f=3 then begin offset_di:=321; offset_dx:=198; end;



       {if Vsync_mode=1 then Midas_WaitVR;{}



       {-------------------Draw frame -------------------------------}
       Draw_screen(f, offset_di, offset_dx, vaddr,vaddr2,vaddr3, vga);


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

end
else begin

Midas_WaitVR;{}

end;

until (esc_test) or (stage>12);
end;

end.