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

interface

const
max_ball_count=6;
f_scale=4;
f_width=64  *f_scale;
f_heigh=256 *f_scale;
f_count=14; {max 20, если мы храним меш внизу видеобуфера}
var
f_x1, f_y1, f_y2:integer;
x, y, z, p:integer;
q, max_count, count, r,m,n:word;
Xc,Yc, num_floor_jump : array[0..max_ball_count-1] of integer;
Xv,Yv : array[0..max_ball_count-1] of single;
colliz_line_coord : array[0..5] of integer;
gravy, damping:single;
FloorX1, FloorX2, FloorY1, FloorY2, height:single;
xi,yi:integer;

procedure FloorMeshGen(where:word);
procedure Balls_movement(m, elapsed_time:word);
procedure Balls_collision(max_zone_y:integer; n:word);
procedure floor_collision_line( xs,ys:integer; Xr,Yr,Zr, scale, per:single);
procedure mesh_draw( xs,ys:integer;col1,col2:byte; Xr,Yr,Zr, scale, per:single; mesh, where:word);
procedure Line_reflect(var xv,yv:single; x1,y1, x2,y2:single);
procedure Intersection(var xi,yi:integer; x1,y1,x2,y2, x3,y3,x4,y4:longint);


implementation

uses triangle, math2;

PROCEDURE GouraudHorline(xbeg,xend,y:integer; c1,c2:byte;where : word);
var delta : integer;
begin
 if (Xend=Xbeg) then begin
       if (xBeg>=0) and (xBeg<320) then
       asm
       mov es, Where
       mov ax, y
       shl ax, 6
       mov di, ax
       shl ax, 2
       add di, ax
       add di, xbeg
       mov al, c1
       shl al, 2
       mov es:[di], al
       end
end
else begin
delta := (((c2-c1) shl 8) div (Xend-Xbeg));
if xBeg<0 then begin c1:=byte(c1-(xBeg*delta) shr 8); xBeg:=0; end;
if xEnd>319 then xEnd:=319;
asm
  mov es, where
  mov bx, xbeg
  mov cx, Xend
  inc cx
  sub cx, bx
  mov ax, y
  shl ax, 6
  mov di, ax
  shl ax, 2
  add di, ax
  add di, bx

  xor dx, dx
  mov dh, c1

  mov bx, delta
  mov si, cx

  shr cx, 2; jz @less_four
 @l_dw:

  mov al, dh
  add dx, bx
  mov ah, dh
  add dx, bx
  db $66; shl ax, 16

  mov al, dh
  add dx, bx
  mov ah, dh
  add dx, bx

  db $66; rol ax, 16 +2
  db $66; and ax, 0fcfch; dw $fcfc;
  db $66; mov es:[di], ax
  add di, 4
  dec cx
 jnz @l_dw

 @less_four:
  test si, 2; jz @less_two
  mov al, dh
  add dx, bx
  mov ah, dh
  add dx, bx

  shl ax, 2
  and ax, 0fcfch
  mov es:[di], ax
  add di, 2
 @less_two:
 test si, 1; jz @exit
  shl dh, 2
  mov es:[di], dh
 @exit:

end;
end;
end;

procedure triangleGourant(ax,ay,az,bx,by,bz,cx,cy,cz:longint;where:word);
var
z1,z2:byte;
sy,x1,x2,temp:integer;
clockwise, Zit1,Zit2, zeta1, zeta2, zeta3, delta1, delta2, delta3, Xit1, Xit2:longint;
begin
 if (ax<0) and (bx<0) and (cx<0) then exit;
 if (ax>319) and (bx>319) and (cx>319) then exit;

 if (ay>by) then begin temp:=ay; ay:=by; by:=temp; temp:=ax; ax:=bx; bx:=temp;
                                                   temp:=az; az:=bz; bz:=temp; end;
 if (by>cy) then begin temp:=by; by:=cy; cy:=temp; temp:=bx; bx:=cx; cx:=temp;
                                                   temp:=bz; bz:=cz; cz:=temp; end;
 if (ay>by) then begin temp:=ay; ay:=by; by:=temp; temp:=ax; ax:=bx; bx:=temp;
                                                   temp:=az; az:=bz; bz:=temp; end;

 if (ay=cy) or (cy<0) or (ay>199) then exit;

 clockwise:=(BX - AX) * (CY-AY) - (BY-AY) * (CX - AX);

 Xit1:=AX shl 8;
 delta1 := ((CX - AX) shl 8) div (CY - AY);

 Zit1:=AZ shl 8;
 zeta1 :=  ((CZ - AZ) shl 8) div (CY - AY);

 if (BY<>AY) then
      begin
           delta2 := ((BX - AX) shl 8) div (BY - AY);  Xit2:=AX shl 8;
           zeta2  := ((BZ - AZ) shl 8) div (BY - AY);  Zit2:=AZ shl 8;
      end
 else begin
           delta2 := (CX - AX) shl 8; Xit2:=BX shl 8;
           zeta2  := (CZ - AZ) shl 8; Zit2:=BZ shl 8;
           end;

 if (CY<>BY) then begin
           delta3 := ((CX - BX) shl 8) div (CY - BY);
           zeta3  := ((CZ - BZ) shl 8) div (CY - BY);
           end;

 if AY<0 then begin Xit1:=Xit1+delta1*abs(ay); Xit2:=Xit2+delta2*abs(ay);
    if BY<0 then begin Xit2:=BX shl 8+delta3*abs(by); BY:=0; end;
    AY:=0;
 end;
 if CY>199 then CY:=199;

if clockwise<0 then

    for SY:=AY to CY do begin
        x2:=integer(Xit1 shr 8);
        x1:=integer(Xit2 shr 8);
        z2:=byte(Zit1 shr 8);
        z1:=byte(Zit2 shr 8);

        if (x2>=0) and (x1<320) then begin
             {if x1<0 then x1:=0; if x2>319 then x2:=319;}
             if (x2>=x1) then GouraudHorline(x1,x2,sy, z1,z2, where);
             end;
        Xit1:=Xit1+delta1;
        Zit1:=Zit1+zeta1;
        if SY < BY then begin
                        Xit2:=Xit2 + delta2;
                        Zit2:=Zit2 + zeta2;
                        end
                   else begin
                        Xit2:=Xit2 + delta3;
                        Zit2:=Zit2 + zeta3;
                        end;
    end else
        for SY:=AY to CY do begin
        x1:=integer(Xit1 shr 8);
        x2:=integer(Xit2 shr 8);
        z1:=byte(Zit1 shr 8);
        z2:=byte(Zit2 shr 8);

        if (x2>=0) and (x1<320) then begin
             {if x1<0 then x1:=0; if x2>319 then x2:=319;}
             if (x2>=x1) then GouraudHorline(x1,x2,sy, z1,z2, where);
             end;
        Xit1:=Xit1+delta1;
        Zit1:=Zit1+zeta1;
        if SY < BY then begin
                        Xit2:=Xit2 + delta2;
                        Zit2:=Zit2 + zeta2;
                        end
                   else begin
                        Xit2:=Xit2 + delta3;
                        Zit2:=Zit2 + zeta3;
                        end;
       end;
end;


procedure FloorMeshGen(where:word);
var n:word;
begin
{
f_x1:=-(f_count*f_width div 2);
f_y1:=-(f_heigh div 2);
f_y2:=  f_heigh div 2;
z:=0;
for n:=0 to f_count-1 do begin
p:=n*18 *2;
m:=f_width*n;
memw[where:0+p]:=word(f_x1 +m);           memw[where:1*2+p]:=word(f_y1);  memw[where:2*2+p]:=word(z);
memw[where:3*2+p]:=word(f_x1+f_width +m); memw[where:4*2+p]:=word(f_y1);  memw[where:5*2+p]:=word(z);
memw[where:6*2+p]:=word(f_x1+f_width +m); memw[where:7*2+p]:=word(f_y2);  memw[where:8*2+p]:=word(z);
memw[where:9*2+p]:=word(f_x1+f_width +m); memw[where:10*2+p]:=word(f_y2); memw[where:11*2+p]:=word(z);
memw[where:12*2+p]:=word(f_x1 +m);        memw[where:13*2+p]:=word(f_y2); memw[where:14*2+p]:=word(z);
memw[where:15*2+p]:=word(f_x1 +m);        memw[where:16*2+p]:=word(f_y1); memw[where:17*2+p]:=word(z);
end;
z:=-110 *f_scale;
for n:=f_count to f_count*2-1 do begin
p:=n*18 *2;
m:=f_width*(n-f_count);
memw[where:0+p]:=word(f_x1 +m);           memw[where:1*2+p]:=word(f_y2);  memw[where:2*2+p]:=0;
memw[where:3*2+p]:=word(f_x1+f_width +m); memw[where:4*2+p]:=word(f_y2);  memw[where:5*2+p]:=0;
memw[where:6*2+p]:=word(f_x1+f_width +m); memw[where:7*2+p]:=word(f_y2);  memw[where:8*2+p]:=word(z);
memw[where:9*2+p]:=word(f_x1+f_width +m); memw[where:10*2+p]:=word(f_y2); memw[where:11*2+p]:=word(z);
memw[where:12*2+p]:=word(f_x1 +m);        memw[where:13*2+p]:=word(f_y2); memw[where:14*2+p]:=word(z);
memw[where:15*2+p]:=word(f_x1 +m);        memw[where:16*2+p]:=word(f_y2); memw[where:17*2+p]:=0;
end;}

colliz_line_coord[0]:= -f_width*f_count div 2;
colliz_line_coord[1]:=  0; colliz_line_coord[2]:=  0;
colliz_line_coord[3]:=  f_width*f_count div 2;
colliz_line_coord[4]:=  0; colliz_line_coord[5]:=  0;
end;

procedure Line_reflect(var xv,yv:single; x1,y1, x2,y2:single);
var xn,yn, dot, lenght:single;
begin
xn:=-(y2-y1);
yn:=(x2-x1);

lenght:=1/sqrt_(xn*xn+yn*yn);
xn:=xn*lenght;
yn:=yn*lenght;

lenght:=sqrt_(xv*xv+yv*yv);
xv:=xv/lenght;
yv:=yv/lenght;

dot:=(xv*xn) + (yv*yn);
dot:=dot + dot; {dot*2}
xv:=xv - dot * xn;
yv:=yv - dot * yn;
xv:=xv*lenght;
yv:=yv*lenght;

end;


procedure Intersection(var xi,yi:integer; x1,y1,x2,y2, x3,y3,x4,y4:longint);
var
a1,b1,c1,a2,b2,c2:longint; x,y:integer;
det:longint;
begin
xi:=0; yi:=0;

    a1 := y1 - y2;
    b1 := x2 - x1;
    c1 := x1 * y2 - x2 * y1;
    a2 := y3 - y4;
    b2 := x4 - x3;
    c2 := x3 * y4 - x4 * y3;

    if a1*b2-a2*b1=0 then exit {writeln('Parallels!')}
    else
     begin
       det := a1 * b2 - a2 * b1;
       xi := (b1 * c2 - b2 * c1) div det;
       yi := (a2 * c1 - a1 * c2) div det;

       if ((xi<x1) and (xi<x2)) or ((xi>x1) and (xi>x2)) or ((xi<x3) and (xi<x4)) or ((xi>x3) and (xi>x4)) then exit;
       if ((yi<y1) and (yi<y2)) or ((yi>y1) and (yi>y2)) or ((yi<y3) and (yi<y4)) or ((yi>y3) and (yi>y4)) then exit;
     end;
end;



procedure Balls_movement(m, elapsed_time:word);
begin
    yv[m]:=yv[m]+gravy*elapsed_time;
    xc[m]:=round(xc[m]+xv[m]*elapsed_time);
    yc[m]:=round(yc[m]+yv[m]*elapsed_time);
end;


procedure Balls_collision(max_zone_y:integer; n:word);
var
Xvec,Yvec, length, Xvec_norm,Yvec_norm:single;
CenterVec_x,CenterVec_y:single;
temp, otrezok_x,otrezok_y:single;
m:word;
begin
   for m:=0 to count-1 do
   if (m<>n) and (yc[m]>-r) and (yc[m]<max_zone_y) then
   begin

   CenterVec_x:=xc[m]-xc[n];
   CenterVec_y:=yc[m]-yc[n];
   length:=sqrt_(CenterVec_x*CenterVec_x + CenterVec_y*CenterVec_y);

   if length<r+r then begin {если окружности пересекаются}
         CenterVec_x:=CenterVec_x/length;
         CenterVec_y:=CenterVec_y/length;
         {line( round(xc[0]+CenterVec_x*r), round(yc[0]+CenterVec_y*r),
               round(xc[1]-CenterVec_x*r), round(yc[1]-CenterVec_y*r), col, vaddr);{}

         {Отрезок между границами окружностей}
         otrezok_x:=(xc[n]+CenterVec_x*r)-(xc[m]-CenterVec_x*r);
         otrezok_y:=(yc[n]+CenterVec_y*r)-(yc[m]-CenterVec_y*r);

         {Возвращаем окружность в точку где она не пересекается со второй}
         xc[n]:=round(xc[n]-otrezok_x);
         yc[n]:=round(yc[n]-otrezok_y);

         {Обмениваемся векторами скорости}
         if xv[m]>0 then begin
         temp:=xv[n]; xv[n]:=xv[m]; xv[m]:=temp; end;
         if yv[m]>0 then begin
         temp:=yv[n]; yv[n]:=yv[m]; yv[m]:=temp; end;

      end;
  end;
end;



procedure mesh_draw( xs,ys:integer;col1,col2:byte; Xr,Yr,Zr, scale, per:single; mesh, where:word);
var
temp_sincos_seg,temp_vertex_seg, p,n,v:word;
x0,x1,x2,y0,y1,y2,z0,z1,z2,c1,c2,c3:integer;
col:byte;
begin
temp_vertex_seg:=mesh+(f_count*(3*3*2)*2*2 +16) shr 4;
temp_sincos_seg:=temp_vertex_seg+2;
meml[temp_sincos_seg:0] :=longint(round(cos_(Xr)*256)); {CosX}
meml[temp_sincos_seg:4] :=longint(round(sin_(Xr)*256)); {SinX}
meml[temp_sincos_seg:8] :=longint(round(cos_(Yr)*256)); {CosY}
meml[temp_sincos_seg:12]:=longint(round(sin_(Yr)*256)); {SinY}
meml[temp_sincos_seg:16]:=longint(round(cos_(Zr)*256)); {CosZ}
meml[temp_sincos_seg:20]:=longint(round(sin_(Zr)*256)); {SinZ}

for n:=0 to f_count*2*2-1 do begin
   p:=n* (9*2);
       asm
          mov es, mesh
          mov ax, temp_vertex_seg
          db $8E,$E8 {mov gs, ax}
          mov ax, temp_sincos_seg
          db $8E,$E0 {mov fs, ax}

          finit
          fld dword ptr scale

          mov si, p
          push bp
          xor bp, bp

          @v:  {for v:=0 to 2 do begin}
            {xx:=memw[mesh:p+v*6];
             yy:=memw[mesh:p+v*6+2];
             zz:=memw[mesh:p+v*6+4];}

            {x1:=sar_(cosy*x-siny*z, 8);}
            db $66,$26,$0f,$bf,$04     {movsx eax, word ptr es:[si]   {X}
            {db $66; add ax, word ptr xx}
            db $66,$26,$0f,$bf,$5c,$04 {movsx ebx, word ptr es:[si+4] {Z}
            {db $66; add bx, word ptr zz}
            db $66; mov dx, ax
            db $66; mov di, bx
            db $64,$66,$0f,$af,$1e,$0c,$00 {imul ebx, fs:[12] {siny}
            db $64,$66,$0f,$af,$06,$08,$00 {imul eax, fs:[8]  {cosy}
            db $66; sub ax, bx
            db $66; sar ax, 8

            {z1:=sar_(siny*x+cosy*z, 8);}
            db $64,$66,$0f,$af,$3e,$08,$00 {imul edi, fs:[8]  {cosy}
            db $64,$66,$0f,$af,$16,$0c,$00 {imul edx, fs:[12] {siny}
            db $66; add dx, di
            db $66; sar dx, 8
            db $66; push dx

            {x:=cosz*x1+sinz*y;}
            db $66; mov dx, ax  {edx=X1}
            db $66,$26,$0f,$bf,$5c,$02 {movsx ebx, word ptr es:[si+2] {Y}
            {db $66; add bx, word ptr yy}
            db $66; mov di, bx  {edi=y}
            db $64,$66,$0f,$af,$1e,$14,$00 {imul ebx, fs:[20] {sinz}
            db $64,$66,$0f,$af,$06,$10,$00 {imul eax, fs:[16] {cosz}
            db $66; add ax, bx
            db $66; mov cx, ax

            {y1:=sar_(cosz*y-sinz*x1, 8);}
            db $64,$66,$0f,$af,$16,$14,$00 {imul edx, fs:[20] {sinz}
            db $64,$66,$0f,$af,$3e,$10,$00 {imul edi, fs:[16] {cosz}
            db $66; sub di, dx
            db $66; sar di, 8

            {z:=cosx*z1-sinx*y1;}
            db $66; pop ax
            db $66; mov bx, ax {EBX=z1}
            db $66; mov dx, di {EDX=y1}
            db $64,$66,$0f,$af,$3e,$04,$00 {imul edi, fs:[4] {sinx}
            db $64,$66,$0f,$af,$06,$00,$00 {imul eax, fs:[0] {cosx}
            db $66; sub ax, di
            db $66; sar ax, 8
            db $65; mov word ptr [bp+4], ax {z}

            {y:=sinx*z1+cosx*y1;}
            db $64,$66,$0f,$af,$1e,$04,$00 {imul ebx, fs:[4] {sinx}
            db $64,$66,$0f,$af,$16,$00,$00 {imul edx, fs:[0] {cosx}
            db $66; add bx, dx

            {p:=(per shl 8) div (per-dots_coord[n].z)}
            db $66; mov di, 400*f_scale; dw $0;
            db $66; sub di, ax
            db $66,$b8,$00,$40,$06,$00; {mov eax, 400*4*256}
            db $66; cwd
            db $66; idiv di

            {memw[temp_vertex_seg:v*6]:=x * p shr 8;
            memw[temp_vertex_seg:v*6+2]:=y * p shr 8;
            memw[temp_vertex_seg:v*6+4]:=z;}

            db $66,$0f,$af,$d8 {imul ebx, eax}
            db $66; sar bx, 8+8
            db $65; mov word ptr [bp+2], bx {y}

            db $66,$0f,$af,$c8 {imul ecx, eax}
            db $66; sar cx, 8+8
            db $65; mov word ptr [bp], cx {x}

            {*scale}
            db $65,$df,$46,$00 {fild word ptr gs:[bp]}
            db $d8,$c9         {fmul st(0), st(1)}
            db $65,$df,$5e,$00 {fistp word ptr gs:[bp]}
            db $65,$df,$46,$02 {fild word ptr gs:[bp]}
            db $d8,$c9         {fmul st(0), st(1)}
            db $65,$df,$5e,$02 {fistp word ptr gs:[bp]}
            db $65,$df,$46,$04 {fild word ptr gs:[bp]}
            db $d8,$c9         {fmul st(0), st(1)}
            db $65,$df,$5e,$04 {fistp word ptr gs:[bp]}

            add si, 6
            add bp, 6

          cmp bp, 6*3
          jb @v
          pop bp
          fstp st
       end;

  x0:=integer(memw[temp_vertex_seg:0]);
  y0:=integer(memw[temp_vertex_seg:2]);
  z0:=integer(memw[temp_vertex_seg:4]);
  x1:=integer(memw[temp_vertex_seg:6]);
  y1:=integer(memw[temp_vertex_seg:8]);
  z1:=integer(memw[temp_vertex_seg:10]);
  x2:=integer(memw[temp_vertex_seg:12]);
  y2:=integer(memw[temp_vertex_seg:14]);
  z2:=integer(memw[temp_vertex_seg:16]);

  if (n and 2=0) then col:=col1 else col:=col2;
       if n<f_count*2 then begin
       c1:=(col+z0 div 2);
       c2:=(col+z1 div 2);
       c3:=(col+z2 div 2);
       if c1>63 then c1:=63; if c2>63 then c2:=63; if c3>63 then c3:=63;
       if c1<16 then c1:=16; if c2<16 then c2:=16; if c3<16 then c3:=16;

       triangleGourant((x0+xs),(y0+ys), c1,
                       (x1+xs),(y1+ys), c2,
                       (x2+xs),(y2+ys), c3,where)
       end
       else
       triangle_asm    (x0+xs,y0+ys, x1+xs,y1+ys, x2+xs,y2+ys, 128-byte(col and 3) shl 4 , where);{}
  end;
end;


procedure floor_collision_line( xs,ys:integer; Xr,Yr,Zr, scale, per:single);
var v:word;
x,y,z : array[0..1] of integer;
x1,y1,z1,xx,yy,zz, CosX, CosY, CosZ, SinX,SinY,SinZ:single;
begin
CosX:=cos_(Xr);SinX:=sin_(Xr);
CosY:=cos_(Yr);SinY:=sin_(Yr);
CosZ:=cos_(Zr);SinZ:=sin_(Zr);
for v:=0 to 1 do begin
   xx:=colliz_line_coord[v*3]; yy:=colliz_line_coord[v*3+1];
   zz:=colliz_line_coord[v*3+2];
   x1:=cosy*xx-siny*zz; z1:=siny*xx+cosy*zz;
   xx:=cosz*x1+sinz*yy; y1:=cosz*yy-sinz*x1;
   zz:=cosx*z1-sinx*y1; yy:=sinx*z1+cosx*y1;
   x[v]:=round(xx * per/(per-zz)*scale);
   y[v]:=round(yy * per/(per-zz)*scale);
   z[v]:=round(zz * scale);
   end;
FloorX1:=x[0]+xs; FloorX2:=x[1]+xs;
FloorY1:=y[0]+ys; FloorY2:=y[1]+ys;
{DrawLine((x[0]+xs),(y[0]+ys), (x[1]+xs),(y[1]+ys),2, vaddr);{}
end;


end.