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

interface

procedure scene_balls1;

implementation

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

(*
Procedure MapGen2(r:word; map :word);
var
n,c,rr:word;
xt,yt,z, m, dx, dy, x,y:integer;
begin
n:=0;
rr:=r*r;
for c:=0 to 64*64 do mem[map:c*2+1]:=byte(0);

for y:=0 to 63 do begin

   dy:=R-y;
   dy:=dy*dy;

   for x:=0 to 63 do begin

     dx:= R-x;
     M:=dx*dx;
     M:=M+dy;

     if M < R*R then begin
        Z:=byte(255-M div (R div 8));

{        mem[map:n*2]:=1;
        if z>59 then mem[map:n*2 +8-64*8-6]:=byte( round(z*0.8) and 252);{}

        Z:=Z div 8;
        Z:=Z+R;

        Xt:=(X-R)*(r*2) div (Z*2);
        Yt:=(Y-R)*(r*2) div (Z*2);
        C:= (Xt+r) + (Yt+r)*128;

        memw[map:word(x*2+y*256+64*64*2)]:=C * 4;

      end;
      inc(n)
   end;
   end;
end;
*)

Procedure Draw(xc,yc,r:integer; select_texture:byte; map, texture, buf:word; color2:byte; theta:single);
var
add_si, add_di, map2, m,offs, vsi, XY, XX,YY, lm:word;
l, n, y2,y1,x1,x2:integer;
cs,cc,cvsi, cm, sscale, cscale, xq,yq, xqq,yqq, ls, lc,lvsi:integer;
wsize, hsize, start_line, end_line, start_column, end_column:integer;
begin
  if (xc<-r) or (yc<-r) or (xc>319+r) or (yc>199+r) then exit;

  map2:=map + (64*64*2) shr 4;

  x1:=xc-r;
  x2:=xc+r;
  y1:=yc-r;
  y2:=yc+r;
  XY:=word(xc+yc*(R shl 1)) shl 2 + select_texture; {scroll texture}
  offs:=word(320*y1+x1);

  sscale := round(sin_(theta)*256);
  cscale := round(cos_(theta)*256);
  xqq:=  R shl 8 - (R * (cscale+sscale));
  yqq:=  R shl 8 - (R * (cscale-sscale));

  Start_line:=0;
  if y1<0 then Start_line:=abs(0-y1) shr 4;

  End_line:=3;
  if y2>199 then End_line:=3 - ((y2-199) shr 4);

if start_line<=end_line then
for l:=Start_line to End_line do
begin

ls:=l*(sscale shl 4);
lc:=l*(cscale shl 4);
lm:=l*(16*320);
lvsi:=l shl 10; {l*16*64}
hsize:=16;

if (y1<0) and (l=Start_line) then
    begin
      hsize:=16  - (abs(0-y1) and 15);
      lm:=lm+      (16-hsize)*320;
      lvsi:=lvsi + (16-hsize) shl 6;
      ls:=ls     + (16-hsize) * sscale;
      lc:=lc     + (16-hsize) * cscale;
    end;

if (y2>199) and (l=End_line)  then hsize:=16 - (y2-199) and 15 +1;

  Start_column:=0;
  if x1<0 then Start_column:=abs(x1) shr 4;

  End_column:=3;
  if x2>319 then End_column:=3 - ((x2-320) shr 4);


  for n:=start_column to end_column do begin
      cm:=0;
      cvsi:=0;
      cs:=0;
      cc:=0;
      wsize:=16;
      add_di:=(320-16);
      add_si:=(64-16);
      if (x2>319) and (n=End_column)  then
             begin
             wsize:= wsize  - (x2-320) and 15 ;
             add_di:=add_di + (16-wsize);
             add_si:=add_si + (16-wsize);
             end;
      if (x1<0) and (n=Start_column) then
             begin
             wsize:= wsize  - (abs(x1) and 15);
             add_di:=add_di + (16-wsize);
             add_si:=add_si + (16-wsize);
             cm:=  (16-wsize);
             cvsi:=(16-wsize);
             cs:=(16-wsize) * sscale;
             cc:=(16-wsize) * cscale;
             end;

      xq:=xqq+(cscale*(n shl 4)) + ls +cc;
      yq:=yqq-(sscale*(n shl 4)) + lc -cs;

      m:=word(offs  +n shl 4  +lm +cm);
      vsi:=n shl 4 {*16*2}  +lvsi +cvsi;

      YY:=hsize;
      XX:=wsize shr 1;
      if (YY>0) and (wsize>0) then
      asm
        mov     ax, map
        db      $8E,$E0 {mov fs, ax}

        mov     ax, texture
        db      $8e,$e8 {mov gs, ax}

        mov     es, buf

        push ds
        mov ds, map2

        {self-moding inneral loop}
        mov ax, CSCALE
        mov cs:[offset @cscale+1], ax
        mov cs:[offset @cscale2+1], ax
        mov cs:[offset @cscale3+1], ax

        mov ax, SSCALE
        mov cs:[offset @sscale+2], ax
        mov cs:[offset @sscale2+2], ax
        mov cs:[offset @sscale3+2], ax

        mov ax, XY
        mov cs:[offset @xy+3], ax
        mov cs:[offset @xy2+3], ax
        mov cs:[offset @xy3+3], ax

        jmp @clear_prefetch; @clear_prefetch:
        {------------------------}

        mov si, vsi {n:=0;}
        mov di, m

        @draw:  {for y:=0 to YY do begin}

        mov ax, xq   { xtemp:=xq;}
        mov cx, yq   { ytemp:=yq;}

        test byte ptr wsize, 1
        jz @skip_draw_pixel

        {draw one pixel of column width (wsize) not multiple of 2}
        db $64; mov dh, [si]
        cmp dh, 255; je @skip3
                mov bh, ch
                mov bl, ah
                add bl, bl
                mov bx, ds:[bx]
                @xy3: db $65; add dh, [bx+1111h]
                mov es:[di], dh
        @skip3:
        @cscale3: add ax, 1111h {CSCALE   {xtemp:=xtemp+cscale;}
        @sscale3: sub cx, 1111h {SSCALE   {ytemp:=ytemp-sscale;}
        add si, 1; add di, 1
        @skip_draw_pixel:

        cmp XX, 0  {if wsize/2 =0 then skip draw-line cycle}
        je @next

        push bp
        mov bp, XX   {width/2 of column}
        @drawline:  {for x:=0 to XX-1 do begin}

        db $64; mov dx, [si]  {mov dx, fs:[si] ; C_L:=memw[map:n shl 1];}

        cmp dl, 255
        je @skip
                mov bh, ch      { xtr:=byte(xtemp shr 8); }
                mov bl, ah      { ytr:=byte(ytemp shr 8); }
                add bl, bl
                mov bx, ds:[bx] { UV:=memw[map:xtr+ytr*r2 *2   +128*128*2]; }
                @xy: {T:=memw[texture:word((UV+XY) shl 1) and (R2*R2*2-1)];}
                db $65; add dl, [bx+1111h] {add dl, gs:[bx] ; texture}
                mov es:[di], dl
        @skip:
        @cscale: add ax, 1111h {CSCALE   {xtemp:=xtemp+cscale;}
        @sscale: sub cx, 1111h {SSCALE   {ytemp:=ytemp-sscale;}

        cmp dh, 255
        je @skip2
                mov bh, ch      { xtr:=byte(xtemp shr 8); }
                mov bl, ah      { ytr:=byte(ytemp shr 8); }
                add bl, bl
                mov bx, ds:[bx] { UV:=memw[map:xtr+ytr*r2 *2   +128*128*2]; }
                @xy2: {T:=memw[texture:word((UV+XY) shl 1) and (R2*R2*2-1)];}
                db $65; add dh, [bx+1111h] {add bl, gs:[bx] ; texture}
                mov es:[di+1], dh
        @skip2:
        @cscale2: add ax, 1111h {CSCALE   {xtemp:=xtemp+cscale;}
        @sscale2: sub cx, 1111h {SSCALE   {ytemp:=ytemp-sscale;}

        add si, 2
        add di, 2  {inc(m);}
        dec bp
        jnz @drawline
        pop bp

        @next:

        add si, add_si
        add di, add_di

        {xq:=xq+sscale;}
        mov ax, SSCALE
        add XQ, ax
        {yq:=yq+cscale;}
        mov ax, CSCALE
        add YQ, ax

        dec YY
        jnz @draw
        pop ds

      end;
end; end;
end;


procedure Floor_collision(n:integer);
var y_predel:integer;
begin
   intersection(xi, yi, xc[n],yc[n], xc[n], 199,   round(FloorX1), round(FloorY1), round(FloorX2), round(FloorY2));

   if num_floor_jump[m]<1 then y_predel:=400 else y_predel:=200;


   height:=(yc[n]+r)-yi;
   if (height>0) and (yi>0) and (yi<y_predel) then begin
    {Line(xc[0],yc[0]+r, xi,yi, 1, vaddr);}

    inc(num_floor_jump[n]);

    yc[n]:=round(yc[n]-height);
    Line_Reflect(xv[n], yv[n], FloorX1, FloorY1, FloorX2, FloorY2);
    if yv[n]<-damping then  yv[n]:=yv[n]*damping;
    end;
end;






var
start_pal, end_pal:byte;
qy, e, speed_pal, event, qsub, Aantal,T1,start_time, old_time,elapsed_time:word;
jump_on:array[0..3] of word;
floor_angle_y:single;

function jump1(var jump_this:word; d, speed:single):single;
var jump:single;
begin
  jump:= sin((q-jump_this)/speed)*d;
  if jump<0 then begin jump_this:=0; jump:=0;end;
  jump1:=jump;
end;

procedure go_event(e:word;name:string; param1:integer);
begin
  if (e=event) then begin

     if      name='jump1' then begin
                         jump_on[1]:=q;
             end
     else if name='jump2' then begin
                         jump_on[2]:=q;
             end
     else if name='palette1' then begin
             LoadBin('textgen3.pal', seg_palitra,  ofs_palitra+palette2);
             init_pal2pal(seg_palitra,ofs_palitra);
             palette_process[0]:=1;
             speed_pal:=param1;
             end
     else if name='palette2' then begin
             LoadBin('texture0.pal', seg_palitra,  ofs_palitra+palette2);
             init_pal2pal(seg_palitra,ofs_palitra);
             palette_process[0]:=1;
             speed_pal:=param1;
             end
     else if name='palette3' then begin
             for n:=0 to 255 do setonecolor2memw(n,50,55,60,  palette2, seg_palitra, ofs_palitra);
             init_pal2pal(seg_palitra,ofs_palitra);
             palette_process[0]:=1;
             speed_pal:=param1;
             start_pal:=0; end_pal:=255;
             end;

  inc(event);
  end;
end;



procedure Scene_balls1;
begin
clear(0, 65535, vaddr2);
clear(0, 65535, vaddr3);

r:=32;
max_count:=5;
gravy:=0.1;
damping:=0.5;
count:=1;

qy:=0;

LoadBin('ball64.bin',  vaddr2,  64*64*2);

floorMeshGen(vaddr2+4000);
LoadBin('flr_mesh.bin', vaddr2+4000, 0);


{mapgen2(R, vaddr2);{}


LoadBin('lighmap2.bin',  vaddr2,  0);
LoadBin('texture0.bin',  vaddr3,  0);
LoadBin('textgen3.pal', seg_palitra,  ofs_palitra+palette2);

for n:=1 to 255 do setonecolor2memw(n,20,18,23,  palette1, seg_palitra, ofs_palitra);
init_pal2pal(seg_palitra,ofs_palitra);
palette_process[0]:=1;
speed_pal:=1;
start_pal:=1; end_pal:=255;

set_border_color(0);


randseed:=0;
for m:=0 to max_count-1 do
begin
xc[m]:=r+m;
yc[m]:=-r;
xv[m]:=random(2)+1;
yv[m]:=0;
num_floor_jump[m]:=0;
end;

event:=0;
for n:=0 to 3 do jump_on[n]:=0;


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

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


if (elapsed_time>0) or (aantal=0) then begin
MP^.GetInformation(@info);

    case event of
         0: if music_pos(32,48) then go_event(0,'palette2',10);
         1: if music_pos(32,53) then go_event(1,'palette1',8);
         2: if music_pos(33,48) then go_event(2,'palette2',8);
         3: if music_pos(33,56) then go_event(3,'palette1',8);
         4: if music_pos(34,16) then go_event(4,'palette2',8);
         5: if music_pos(34,24) then go_event(5,'palette1',4);
         6: if music_pos(34,32) then go_event(6,'palette2',8);
         7: if music_pos(35,32) then go_event(7,'palette1',4);
         8: if music_pos(35,48) then go_event(8,'palette3',4);
    end;

end;


clear(60, 64000, vaddr); {Clear framebuffer}

if elapsed_time>0 then begin
   for e:=0 to elapsed_time-1 do begin

       floor_angle_y:=rad(sin_(qy/40)*35);
       floor_collision_line( 160,180, rad(-165),floor_angle_y,rad(-30), 0.125, 400*f_scale);
       qy:=qy+1;

       if (mtimer-qsub > 80) and (count<max_count) then
         begin
           qsub:=mtimer;
           inc(count);
         end;

       if count>0 then
           for n:=0 to count-1 do
             begin

                Balls_Movement(n, 1);

                if (yc[n]>-r*2) and (yc[n]<200-r) then begin
                   Balls_Collision(200-r, n);
                   Floor_Collision(n);
                end;

                if (yc[n]>-r) and (yc[n]<200) then begin
                    if (xc[n]<-100) then     begin xv[n]:=-xv[n]*damping;  xc[n]:=-100;     end;
                    if (xc[n]>419-r) then begin xv[n]:=-xv[n];  xc[n]:=419-r; end;
                end;

                if (yc[n]>200+r*2*(n+1)) then begin
                    xc[n]:=r*2+n*r;
                    yc[n]:=-r*2;
                    yv[n]:=0;
                    xv[n]:=random(2)+1;
                    num_floor_jump[n]:=0;
                end;{}

             end;

   end;
end;


mesh_draw(160,180,  40,22,   rad(-165), floor_angle_y, rad(-30), 0.125, 400, vaddr2+4000, vaddr);

{Line(round(FloorX1), round(FloorY1), round(FloorX2), round(FloorY2), 1, vaddr);{}


if count>0 then
for m:=0 to count-1 do
draw(xc[m],yc[m], R, m and 3   , vaddr2, vaddr3, vaddr, 0, rad(xc[m]*2));{}



if Vsync_mode=1 then Midas_WaitVR;

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

FlipScreen(vaddr, vga);{}


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

until (esc_test) or (info^.pos>35);

for n:=0 to 255 do setonecolor2memw(n,50,55,60,  palette1, seg_palitra, ofs_palitra);
setpalette_from_memW(palette1,seg_palitra,ofs_palitra);


end;

end.
