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

interface
procedure init_cubwater;
procedure scene_cubwater;

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

const
cubic: array[0..23] of shortint =
(-1,-1,-1, -1,-1,1, -1,1,-1,-1,1,1, 1,-1,-1, 1,-1,1,1,1,-1, 1,1,1);
pindexc: array[0..23] of byte =
(0,3,1,2, 0,5,4,1, 0,6,2,4, 6,3,2,7, 3,5,1,7, 4,7,6,5);


var
 Aantal, T1: longint;

 cubeDc:array[0..23] of single;
 f:word;




procedure MakePolyEdge(x1,y1,x2,y2,x3,y3,x4,y4, col,numpoly:integer;frame, outp:word);
var
n:integer;
    procedure edge(ax,ay,bx,by:longint; c, numpoly:integer; frame_, output:word);
     var
     sy,x, delta, temp:longint;
     begin
     if ay=by then exit;
     if ay>by then begin temp:=ay; ay:=by; by:=temp; temp:=ax; ax:=bx; bx:=temp; end;

     delta := ((BX - AX) shl 8) div (BY - AY);
     X:=AX shl 8;

       {for SY:=AY to BY-1 do begin

              X := X+delta;
              mem[outp:frame+1+sy shl 1 +c + numpoly]:=byte(x shr 8);
        end;}
        asm
        mov es, output
        mov cx, word ptr BY

        mov di, word ptr AY
        sub cx, di; jz @exit

        shl di, 1
        add di, c
        add di, numpoly
        add di, frame_
        add di, 1

        db $66; mov ax, word ptr X
        db $66; mov dx, word ptr delta

        @l:{for SY:=AY to BY-1 do begin}
              db $66; add ax, dx {X := X+delta;}
              db $66; mov bx, ax {xx:=sar_(x,8);}
              db $66; sar bx, 8
              mov es:[di], bl {memw[outp:1+sy shl 2 +c + numpoly+frame_]:=x shr 8;}
              add di, 2
        dec cx
        jnz @l{end;}
        @exit:
        end;
     end;

    procedure Edges(num:byte);
    var
    c:byte;
    dx,x:integer;
    begin
      if num=0 then begin dx:=y1-y2; x:=x1; end;
      if num=1 then begin dx:=y2-y3; x:=x2; end;
      if num=2 then begin dx:=y3-y4; x:=x3; end;
      if num=3 then begin dx:=y4-y1; x:=x4; end;

      if x<x+dx then c:=1 else c:=0;

      if num=0 then Edge(x1,y1, x2,y2, c, numpoly, frame, outp);
      if num=1 then Edge(x2,y2, x3,y3, c, numpoly, frame, outp);
      if num=2 then Edge(x3,y3, x4,y4, c, numpoly, frame, outp);
      if num=3 then Edge(x4,y4, x1,y1, c, numpoly, frame, outp);
    end;

begin

      mem[outp:frame+numpoly]:=col;
      for n:=0 to 3 do Edges(n);
end;


procedure Clear_frame(frame, frame_size, where:word);
begin
{for n:=f*frame_size to (f+1)*frame_size do mem[vaddr3:n]:=0;}
frame:=frame*frame_size;
asm {fast clear frame-data}
mov es, where
mov di, frame
db $66; xor ax, ax
mov cx, frame_size
mov bx, cx
shr cx, 2
db $66; rep stosw
mov cx, bx
and cx, 3
rep stosb
end;
end;


procedure drawcubic(xx,yy:integer; zoom:single; frame,outp : word);
var
p4, p, numpoly, col:byte;
sy,x1,x2,x3,x4,y1,y2,y3,y4:integer;
dot_norm, pom, ax,ay,az,bx,by,bz,nx,ny,nz:single;

begin
numpoly:=0;
 for p:=0 to 5 do begin
  p4:=p shl 2;
  ax:=cubeDc[pindexc[p4+2]*3]  -cubeDc[pindexc[p4]*3];
  ay:=cubeDc[pindexc[p4+2]*3+1]-cubeDc[pindexc[p4]*3+1];
  az:=cubeDc[pindexc[p4+2]*3+2]-cubeDc[pindexc[p4]*3+2];
  bx:=cubeDc[pindexc[p4+1]*3]  -cubeDc[pindexc[p4]*3];
  by:=cubeDc[pindexc[p4+1]*3+1]-cubeDc[pindexc[p4]*3+1];
  bz:=cubeDc[pindexc[p4+1]*3+2]-cubeDc[pindexc[p4]*3+2];
  nx:=ay*bz-az*by;
  ny:=az*bx-ax*bz;
  nz:=ax*by-ay*bx;
  pom:=nz*-4+nx*ax+ny*ay+nz*az;

  if (pom>0) then begin {if the (cos)angle is lower than zero, don't show}

   x1:=round(zoom*cubeDc[pindexc[p4]*3])+xx;
   y1:=round(zoom*cubeDc[pindexc[p4]*3+1])+yy;
   x3:=round(zoom*cubeDc[pindexc[p4+1]*3])+xx;
   y3:=round(zoom*cubeDc[pindexc[p4+1]*3+1])+yy;
   x2:=round(zoom*cubeDc[pindexc[p4+2]*3])+xx;
   y2:=round(zoom*cubeDc[pindexc[p4+2]*3+1])+yy;
   x4:=round(zoom*cubeDc[pindexc[p4+3]*3])+xx;
   y4:=round(zoom*cubeDc[pindexc[p4+3]*3+1])+yy;
   dot_norm:=sqrt_(nx*nx+ny*ny+nz*nz);
   col:=round((nz*-4)/(dot_norm*4)*50)+56;{}
{   col:=p+1;}

   MakePolyEdge(x1,y1,x2,y2,x3,y3,x4,y4, col,numpoly*201,frame, outp);

   inc(numpoly);

   end;
 end;
end;

procedure rotateCubic(xr,yr,zr,scalec, per:single);
var
x,y,z,X1,Y1,Z1:single;
Cosxan,Sinxan,Cosyan,Sinyan,Coszan,Sinzan:single;
p, p3:byte;
begin
CosXan:=cos(Xr);SinXan:=sin(Xr);
CosYan:=cos(Yr);SinYan:=sin(Yr);
CosZan:=cos(Zr);SinZan:=sin(Zr);
p3:=0;
 for p:=0 to 7 do begin
  x:=cubic[p3];
  y:=cubic[p3+1];
  z:=cubic[p3+2];
  x1:=cosyan*x-sinyan*z;
  z1:=sinyan*x+cosyan*z;
  x:=coszan*x1+sinzan*y;
  y1:=coszan*y-sinzan*x1;
  z:=cosxan*z1-sinxan*y1;
  y:=sinxan*z1+cosxan*y1;
  CubeDc[p3]:=(x*per/(z-per)*scalec);
  CubeDc[p3+1]:=(y*per/(z-per)*scalec);
  CubeDc[p3+2]:=(z*scalec);
  p3:=p3+3;
end;
end;

procedure rubber_cube(x_cube,y_cube:integer; q_:word);
var deep_col, x1,x2, col, p,y,n,y_cut,y_data_cut:integer;
p201, yy, ff, offset_:word;
begin
q_:=q_ * 6;
ff:=f*(201*3);
y_cut:=0; y_data_cut:=0;
if y_cube<0 then begin y_cut:=abs(y_cube); y_cube:=0; y_data_cut:=y_cut shl 1; end;
if y_cube>100 then y_cut:=abs(y_cube-100);

deep_col:=80-y_cube shr 1;

for p:=0 to 2 do begin
p201:=p*201;
asm
   mov es, vaddr
   mov ax, vaddr2
   db $8E,$E0 {mov fs, ax}
   mov ax, vaddr3
   db $8E,$E8 {mov gs, ax}

   mov cx, 100
   sub cx, y_cut
   jz @close; js @close

   mov di, y_cube
   add di, cx
   dec di
   imul di, di, 320
   add di, x_cube


@y: {for y:=0 to 99-y_cut do begin}
   push cx
   {yy:=memw[vaddr3:(q + y shl 1) and 1023   shl 1];}
   mov bx, cx
   shl bx, 1
   add bx, q_
   and bx, 1023
   shl bx, 1
   db $65; mov dx, [bx]

   mov bx, ff
   mov si, bx
   sub si, dx {ff-yy}
   {if (ff<yy) then yy:=60300+(ff-yy) else yy:=ff-yy;}
   cmp bx, dx
   jae @yy0
      add si, 60300
   @yy0:
   {offset_:=word(yy + p*201);}
   add si, p201
   {col:=mem[vaddr2:offset_] + (deep_col - y shr 1);}
   mov dx, deep_col
   mov bx, cx
   shr bx, 1
   sub dx, bx
   db $64; add dl, byte ptr [si]

   {inc(offset_);}
   inc si
   {offset_:=offset_ + y_data_cut;}
   add si, y_data_cut

   {x1:=mem[vaddr2:offset_ +y shl 1  ];}
   {x2:=mem[vaddr2:offset_ +y shl 1+1];}
   mov bx, cx
   add bx, bx
   add si, bx
   xor cx, cx
   db $64; mov bx, [si]
   xchg cl, bh


   {if (x2>0) and (x1>0) then
   for n:=x1 to x2-1 do}
    mov si, di
    add di, bx
    sub cx, bx; js @exit; jz @exit;
    shr bl, 2
    add bl, dl
    mov bh, bl
    mov dx, cx
    shr cx, 2; jz @less_four
     @l:
         add es:[di], bx
         add es:[di+2], bx
         add bx, 0101h
         add di, 4
         dec cx
     jnz @l
     @less_four:

     and dx, 3; jz @exit
     @l2:
         add es:[di], bl
         inc di
         inc bl
         dec dx
     jnz @l2

     @exit:
     mov di, si
     sub di, 320
   pop cx
   dec cx
   jnz @y
   @close:
   end;
end;
end;

procedure DrawWater(wave_y_seg, where:word);
const middlepart_height=4;
begin
 asm
 push ds
 push bp
 mov es, where
 mov ds, wave_y_seg
 xor bp, bp
 mov si, 319*2

  @x:
  mov di, si
  shr di, 1

    mov cx, ds:[si]

    mov ax, di
    inc ax
    test ax, 3
    jnz @skip_max {take min height of 4 columns}
         mov bp, cx
         cmp bp, ds:[si-2]; jbe @sort1; mov bp, ds:[si-2]
         @sort1:
         cmp bp, ds:[si-4]; jbe @sort2; mov bp, ds:[si-4]
         @sort2:
         cmp bp, ds:[si-6]; jbe @sort3; mov bp, ds:[si-6]
         @sort3:

         {fill top part with dword}
         test bp, bp
         jz @skip0
         push di
         mov ax, bp
            @y0:
               db $66; mov word ptr es:[di-3], 0808h; db $08,$08;{}
               add di, 320
               dec ax
            jnz @y0
            pop di
         @skip0:
         imul dx, bp, 320
    @skip_max:

    add di, dx

    {---------------------top part----------------------}
    sub cx, bp
    mov al, 8
    and cx, 3; jz @skip
    @y1:
        mov es:[di], al
        add di, 320
    dec cx
    jnz @y1

    {---------------------middle part-------------------}
    @skip:
    mov bl, 200
    mov cx, bp
    sub cx, ds:[si]
    add cx, middlepart_height
    test cx, cx; jz @skip_m
    @y3:
        mov al, bl
        shr al, 2
        mov byte ptr es:[di], al
        add di, 320
        dec bl
        dec cx
    jnz @y3
    @skip_m:

    test di, 3
    jnz @skip3

       {fill bottom part with dword}
        mov cx, 200-middlepart_height
        sub cx, bp
        {add di, 320{}
          @y4:
              db $66; mov ax, bx
              db $66; and ax, 0fcfch; db $fc,$fc;
              db $66; shr ax, 2
              db $66; mov word ptr es:[di], ax{}
              db $66; sub bx, 0101h; db $01,$01;
              add di, 320
          dec cx
          jnz @y4

  @skip3:
  db $66; shl bx, 8  {put color-dword}
  sub si, 2
  jns @x
  pop bp
  pop ds
  end;{}
end;

procedure DrawParticles(col:byte; start_dots, count_dots, elapsed_time, wave_y_seg_, coord_seg, vect_seg:word);
begin
asm
   push ds
   push bp
   mov es, vaddr
   mov ax, coord_seg
   db $8E,$E0 {mov fs, ax}
   mov ax, vect_seg
   db $8E,$E8 {mov gs, ax}

   mov al, col
   mov cs:[offset @color+1], al
   jmp @clear_prefetch; @clear_prefetch:

   mov ax, wave_y_seg_
   mov si, start_dots
   shl si, 2

   mov cx, count_dots
   mov bp, elapsed_time
   mov ds, ax

   @l: {for n:=0 to active_dots-1 do begin}

       {vect_x:=integer(memw[vect_seg:n shl 2]);}
       {vect_y:=integer(memw[vect_seg:n shl 2 +2]);}
       db $65; mov bx, [si]
       db $65; mov dx, [si+2]

       {memw[coord_seg:n shl 2]  :=memw[coord_seg:n shl 2]     + vect_x * elapsed_time;}
       {memw[coord_seg:n shl 2+2]:=memw[coord_seg:n shl 2+2]   + vect_y * elapsed_time;}
       db $0f,$af,$dd {imul bx, elapsed_time}
       db $0f,$af,$d5 {imul dx, elapsed_time}
       db $64; mov ax, [si]
       db $64; mov di, [si+2]
       add ax, bx
       add di, dx
       db $64; mov [si], ax
       db $64; mov [si+2], di

       {x:=memw[coord_seg:n shl 2] shr 7;}
       {y:=memw[coord_seg:n shl 2+2] shr 7;}
       {if (x<0) or (x>319) then begin
       memw[coord_seg:n shl 2]:=n shl 4+96 shl 7;
       memw[coord_seg:n shl 2+2]:=integer(180 shl 7); end;}

       sar ax, 6
       jns @skip_x0
           mov bx, si
           add bx, (192 shl 6)
           db $64; mov [si], bx
           db $64; mov word ptr [si+2], (190 shl 6)
           add si, 4
           dec cx
           jnz @l; jmp @exit

       @skip_x0:
       cmp ax, 319
       jl @skip_x320
           mov bx, si
           add bx, (64 shl 6)
           db $64; mov [si], bx
           db $64; mov word ptr [si+2], (190 shl 6)
           add si, 4
           dec cx
           jnz @l; jmp @exit

       @skip_x320:

       sar di, 6
       {if (y<1) then memw[coord_seg:n shl 2+2]:=integer(170 shl 7);}
       jns @skip_y
           db $64; mov word ptr [si+2], (200 shl 6)
           add si, 4
           dec cx
           jnz @l; jmp @exit

       @skip_y:

       {y:=y+ mem[wave_y_seg:x shl 1];{}
       mov bx, ax
       add bx, bx
       add di, ds:[bx]

       {if (x>0) and (x<319) and (y<199) and (y>0) then mem[vaddr:x+y*320]:=0;}
       cmp di, 200; jb @skip_y199
           add si, 4
           dec cx
           jnz @l; jmp @exit
       @skip_y199:
       mov bx, di
       shl bx, 6
       shl di, 8
       add di, bx
       add di, ax

       mov al, cl
       and al, 1
       @color: add al, 51
       mov byte ptr es:[di], al

       add si, 4
       dec cx
       jnz @l {end;}
   @exit:
   pop bp
   pop ds
end;
end;


var
start_time, old_time:longint;
elapsed_time:word;

stage, drop_cubic: byte;
col, g,r,d, b, x,y:integer;
amp_ball, y_ball, qq, speed, min_bulk, max_bulk, bulk,amp, ph, x1,x2,y1,y2:single;
xr,yr,zr, pi320, y_amp:single;
history_size, small_waves, height_water:integer;
sq:word;
xp, q:integer;
speed_pal, m,n,qc:word;
tsin:single;
tsin_seg, wave_y_seg2, wave_y_seg, num_dots, coord_seg,vect_seg:word;
active_dots, vect_x,vect_y:integer;
stroka:string;

procedure init_cubwater;
begin
amp_ball:=160;
pi320:=pi/320;

History_size:=99;
f:=0;
qc:=0;
drop_cubic:=0;

height_water:=70;
bulk:=65; max_bulk:=50; min_bulk:=20;
stage:=0;
speed:=20;
q:=round(-3.14159*speed/2);
y_ball:=-110;

active_dots:=1;
num_dots:=2048;

Wave_y_seg:=vaddr3 + (1024*2 div 16);
Wave_y_seg2:=Wave_y_seg + (320*2 div 16) + 2;

tsin_seg:=Wave_y_seg2 + (320*2 div 16) + 2;

vect_seg :=vaddr3+2048;
coord_seg:=vect_seg+(num_dots*4 div 16);


for n:=0 to 1024 do begin
  tsin:=sin(6.283185307/1024 *n);
  meml[tsin_seg: n shl 2]:=longint(tsin);
end;

for n:=0 to 1023 do
memw[vaddr3:n shl 1]:=round(sin(6.283185307/1024 *n)*49+49) * (201*3);


for n:=0 to num_dots-1 do begin
   memw[coord_seg:n shl 2]  :=random(160)*20+135 * 64;
   memw[coord_seg:n shl 2+2]:=(n div 8+random(16)) * 64;

   memw[vect_seg:n shl 2]:=  random(90 div 2)-45 div 2;
   memw[vect_seg:n shl 2+2]:=random(64 div 2)-80 div 2;
end;

for n:=0 to History_size do begin
Xr:=rad(n);Yr:=rad(n)*2;Zr:=rad(n)*3;
rotateCubic(-xr,yr,0, 33, -5);
drawcubic(60,50, 0.8, n*(201*3),vaddr2);
end;

if useXMS=1 then begin
    LoadBufferToXMS('cubwater2', 65536, vaddr2);
    LoadBufferToXMS('cubwater3', 65536, vaddr3);
end;

end;




procedure scene_cubwater;
begin
Clear(0, 65535, vaddr);
Clear(0, 65535, vaddr2);
Clear(0, 65535, vaddr3);
{Clear(0, 64000, vga);}

if useXMS=1 then begin
   LoadBufferFromXMS('cubwater2', vaddr2, 0);
   LoadBufferFromXMS('cubwater3', vaddr3, 0);
end else init_cubwater;


clear_palette2memW(palette1, seg_palitra, ofs_palitra);
clear_palette2memW(palette2, seg_palitra, ofs_palitra);
setpalette_from_memW(palette1,seg_palitra,ofs_palitra);


for n:=1 to 63 do begin
b:=round(n)+16;
g:=round(10);
if g>63 then g:=63;
if b>63 then b:=63;
setonecolor2memw(n, 4, g,b, palette2, seg_palitra, ofs_palitra);
end;
g:=8;
for n:=0 to 191 do begin
if n>80 then g:=g+1;
b:=round(n*0.25)+18;
if b>63 then b:=63;
setonecolor2memw(n+64, 4, g div 3+10, b, palette2, seg_palitra,ofs_palitra);
end;

setonecolor2memw(52,0,12,57,  palette2, seg_palitra, ofs_palitra);
setonecolor2memw(53,0,8,54,   palette2, seg_palitra, ofs_palitra);

setonecolor2memw(54,8,14,58,  palette2, seg_palitra, ofs_palitra);
setonecolor2memw(55,12,18,63, palette2, seg_palitra, ofs_palitra);

init_pal2pal(seg_palitra,ofs_palitra);
palette_process[0]:=1;
speed_pal:=2;

wait_music_pos(10,0);

old_time:=mtimer;
start_time:=mtimer;

Aantal:=0; T1:=mTimer;

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



if (elapsed_time>0) or (aantal=0) then begin
{---------------------------------------------------------------}
MP^.GetInformation(@info); {midas get info);}

if stage=0 then if music_pos(10, 25) then drop_cubic:=1;

if stage=3 then if music_pos(12,40) then begin
      for n:=1 to 255 do setonecolor2memw(n,37,37,37, palette2, seg_palitra, ofs_palitra);
      init_pal2pal(seg_palitra, ofs_palitra);
      palette_process[0]:=1;
      speed_pal:=5;
      stage:=4;
      end; {}

if stage>0 then begin
   q:=q+elapsed_time;
   if amp_ball>20 then amp_ball:=amp_ball-(elapsed_time*0.7);
   end;

if drop_cubic=1 then begin
   sq:=sq+elapsed_time;
   y_ball:=-cos(sq/20)*amp_ball+60;
   if stage=0 then if y_ball>=20 then stage:=1;{}
end;

qq:=q/speed;


if stage=4 then if height_water>30 then height_water:=height_water-elapsed_time;


if stage=1 then begin
   if bulk<max_bulk then bulk:=bulk+elapsed_time;
   if bulk>=max_bulk then stage:=2;
   end;
if stage=2 then begin
   if bulk>min_bulk then bulk:=bulk-(elapsed_time*0.1);
   if bulk<=min_bulk then begin stage:=3; end;
   end;

amp:=cos(qq)*bulk;
small_waves:=integer(round((mtimer/20+q/10) * 256)) ;

end; {-------------------------------------------------------------}


{calculate water wawes}
for x:=0 to 319 do begin

{    y_amp:=tsin[round(x*1.6)]*amp;}
    y_amp:=single(meml[tsin_seg: round(x*1.6) shl 2])*amp;

    ph:=6-abs(y_amp*0.25);

    {y1:=y_amp + sin(x/20+small_waves)*ph;{}
    {y1:=y1    + sin(x/40+small_waves)*ph;}

{    y1:=y_amp + tsin[word(x*8+small_waves shr 1)   and 1023] * ph;{}
    y1:=y_amp  + single(meml[tsin_seg:
                 (word(x*8+small_waves shr 1)   and 1023) shl 2]) * ph;

{    y1:=y1    + tsin[word(x*4+small_waves)         and 1023] * ph;}
    y1:=y1     + single(meml[tsin_seg:
                 (word(x*4+small_waves)   and 1023) shl 2]) * ph;

    y:=round(y1)+height_water;

    if y<0 then y:=0;

    memw[wave_y_seg:x shl 1]:=y;
    memw[wave_y_seg2:x shl 1]:=y shr 1+60;
end;


DrawWater(wave_y_seg, vaddr);


{Draw particles}
if stage>0 then begin
   if active_dots<num_dots then begin
        active_dots:=(q+33)*28;
        if active_dots>=num_dots then active_dots:=num_dots;{}
        end;
   if active_dots>0 then begin
        DrawParticles(54, 0,             (active_dots div 2-1), elapsed_time*2, wave_y_seg, coord_seg, vect_seg);{}
        DrawParticles(52, num_dots div 2,(active_dots div 2-1), elapsed_time, wave_y_seg2, coord_seg, vect_seg);{}
   end;
end;{}

{---------------------------rubber cube----------------------------------}
if (elapsed_time>0) then qc:=qc+1;

{for n:=f*(201*3) to (f+1)*(201*3) do mem[vaddr2:n]:=0;}
Clear_frame(f, 201*3, vaddr2);

Xr:=rad(qc);
Yr:=rad(qc)*2;
Zr:=rad(qc)*3;
rotateCubic(xr,yr,zr, 33, -5);
drawcubic(60,50, 0.8, f*(201*3),vaddr2);

rubber_cube( 100, round(y_ball), sq);{}

if elapsed_time>0 then
    begin
    inc(f);
    if f>history_size then f:=0;
    end;
{--------------------------------------------------------------------}




if Vsync_mode=1 then Midas_WaitVR;{}

if palette_process[0]=1 then Pal2Pal_asm(palette_process[0], 1, 255, elapsed_time*speed_pal, seg_palitra, ofs_palitra);

FlipScreen(vaddr,vga);


Inc(Aantal);

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

until (esc_test) or ((info^.pos>12) and (info^.row>0)){};


end;


end.