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

interface

procedure scene_balls2;

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 128*128-1 do mem[map:c]:=byte(255);}

for y:=0 to 127 do begin

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

   for x:=0 to 127 do begin

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

     if M < R*R then begin
        Z:=(256-M div (R div 4));

        {if z>1 then mem[map:n]:=0;
        if z>1 then mem[map:n]:=byte(round(z / 6));{}

        Z:=Z div 4;
        Z:=Z+R;

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

        memw[map:word(n*2+128*128)]:=C * 2;

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



Procedure Draw(xc,yc,r:integer; select_texture:byte; map, texture, buf:word; theta:single);
var
add_si, add_di,map2, offs, vsi, XY, YY,XX, m, 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 + (128*128) shr 4;

  x1:=xc-r;
  x2:=xc+r;
  y1:=yc-r;
  y2:=yc+r;

  XY:=word(xc+yc*(R shl 1)) shl 1 + 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(y1) shr 4;

  End_line:=7;
  if y2>199 then End_line:=7 - ((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:=word(l*(16*320));
lvsi:=l shl 11; {l*16*128}
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 7;
      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:=7;
  if x2>319 then End_column:=7 - ((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:=(128-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 {256-32}
        add di, add_di {320-16}

        {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);
begin
   intersection(xi, yi, xc[n],yc[n], xc[n], 199,   round(FloorX1), round(FloorY1), round(FloorX2), round(FloorY2));

   height:=(yc[n]+r)-yi;
   if (height>0) and (yi>0) and (yi<300) then begin
    {Line(xc[0],yc[0]+r, xi,yi, 1, vaddr);}
    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
e, qe, event, speed_pal, qsub, Aantal,T1,start_time, old_time,elapsed_time:word;

floor_angle_x, floor_angle_y, floor_angle_z:single;


procedure Scene_Balls2;
begin
clear(0, 65535, vaddr2);
clear(0, 65535, vaddr3);
clear(60, 64000, vga);


r:=64;
max_count:=2;
gravy:=0.1;
damping:=0.5;
count:=1;

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


{mapgen2(R, vaddr2);{}

LoadBin('blmap2.bin',  vaddr2,  0);
LoadBin('btex2_0.bin',  vaddr3,  0);
LoadBin('darkpal2.pal', seg_palitra,  ofs_palitra+palette2);
init_pal2pal(seg_palitra,ofs_palitra);
palette_process[0]:=1;
speed_pal:=4;

randseed:=0;
for m:=0 to max_count-1 do
begin
xc[m]:=r+m*r;
yc[m]:=-r;
xv[m]:=1;
yv[m]:=0;
end;

set_border_color(113);

event:=0;
qe:=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);


    if (event=0) and (music_pos(36,56)) then begin
          LoadBin('metal.pal', seg_palitra,  ofs_palitra+palette2);
          init_pal2pal(seg_palitra,ofs_palitra);
          palette_process[0]:=1;
          speed_pal:=12;
    inc(event);
    end;
    if (event=1) and (music_pos(37,0)) then begin
          LoadBin('darkpal2.pal', seg_palitra,  ofs_palitra+palette2);
          init_pal2pal(seg_palitra,ofs_palitra);
          palette_process[0]:=1;
          speed_pal:=8;
    inc(event);
    end;
    if (event=2) and (music_pos(37,58)) then begin
          for n:=0 to 255 do setonecolor2memw(n,55,55,50,  palette2, seg_palitra, ofs_palitra);
          init_pal2pal(seg_palitra,ofs_palitra);
          palette_process[0]:=1;
          speed_pal:=12;
    inc(event);
    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_x:=rad(-165);
       floor_angle_y:=rad(sin_(qe/40)*35);
       floor_angle_z:=rad(cos_(qe/60)*50);
       floor_collision_line( 160,180, floor_angle_x,floor_angle_y,floor_angle_z, 0.125, 400*f_scale);
       qe:=qe+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);
               Balls_Collision(400-r, n);
               Floor_Collision(n);

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


mesh_draw(160,180,  40,22,   floor_angle_x,floor_angle_y,floor_angle_z, 0.125, 400, vaddr2+4000, vaddr);



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




if Vsync_mode=1 then Midas_WaitVR;{}

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


FlipScreen(vaddr,VGA);


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

until (esc_test) or (info^.pos > 37);
end;

end.
