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

interface

const
cubic: array[0..23+3] 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,    0,0,0);
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
q_cubes, f,history_size,cube_size, face_size, frame_size:word;
Small_cubeDc:array[0..23] of single;

procedure Small_drawcubic(mode:byte; xx, face_size, frame, outp : word);
procedure Small_rotateCubic(xr,yr,zr, per, scalec:single);
procedure Clear_frame(frame, frame_size, where:word);
procedure DrawCube_160(yy:word; x_cube, y_cube:integer; color:byte; from,where:word);


implementation

uses math2;



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 Small_drawcubic(mode:byte; xx, face_size, frame, outp : word);
var
p,p4,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:=Small_cubeDc[pindexc[p4+2]*3]-  Small_cubeDc[pindexc[p4]*3];
  ay:=Small_cubeDc[pindexc[p4+2]*3+1]-Small_cubeDc[pindexc[p4]*3+1];
  az:=Small_cubeDc[pindexc[p4+2]*3+2]-Small_cubeDc[pindexc[p4]*3+2];
  bx:=Small_cubeDc[pindexc[p4+1]*3]-  Small_cubeDc[pindexc[p4]*3];
  by:=Small_cubeDc[pindexc[p4+1]*3+1]-Small_cubeDc[pindexc[p4]*3+1];
  bz:=Small_cubeDc[pindexc[p4+1]*3+2]-Small_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(Small_cubeDc[pindexc[p4]*3])+xx;
   y1:=round(Small_cubeDc[pindexc[p4]*3+1])+xx;
   x3:=round(Small_cubeDc[pindexc[p4+1]*3])+xx;
   y3:=round(Small_cubeDc[pindexc[p4+1]*3+1])+xx;
   x2:=round(Small_cubeDc[pindexc[p4+2]*3])+xx;
   y2:=round(Small_cubeDc[pindexc[p4+2]*3+1])+xx;
   x4:=round(Small_cubeDc[pindexc[p4+3]*3])+xx;
   y4:=round(Small_cubeDc[pindexc[p4+3]*3+1])+xx;
   dot_norm:=sqrt_(nx*nx+ny*ny+nz*nz);
   if mode=0 then col:=round((nz*-4)/(dot_norm*4)*32)+64
   else if mode=1 then col:=p+1
   else if mode=2 then col:=p*3+1;

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

procedure Small_rotateCubic(xr,yr,zr, per, scalec:single);
var x,y,z,X1,Y1,Z1:single;
CosX, CosY, CosZ, SinX,SinY,SinZ:single;
p3,p:byte;
begin
CosX:=cos_(Xr);SinX:=sin_(Xr);
CosY:=cos_(Yr);SinY:=sin_(Yr);
CosZ:=cos_(Zr);SinZ:=sin_(Zr);
 p3:=0;
 for p:=0 to 7 do begin
  x:=cubic[p3];
  y:=cubic[p3+1];
  z:=cubic[p3+2];
  x1:=cosy*x-siny*z;
  z1:=siny*x+cosy*z;
  x:=cosz*x1+sinz*y;
  y1:=cosz*y-sinz*x1;
  z:=cosx*z1-sinx*y1;
  y:=sinx*z1+cosx*y1;
  Small_CubeDc[p3]:=(x*per/(z-per)*scalec);
  Small_CubeDc[p3+1]:=(y*per/(z-per)*scalec);
  Small_CubeDc[p3+2]:=(z*scalec);
  p3:=p3+3;
end;
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 DrawCube_160(yy:word; x_cube, y_cube:integer; color:byte; from,where:word);
var
cube_size_fix, y_fix, frame_offset, p:word;
col:byte;
begin

x_cube:=x_cube-cube_size shr 1;
y_cube:=y_cube-cube_size shr 1;

if (y_cube>99) or (y_cube+cube_size<1) then exit;
if (x_cube>159) or (x_cube<=-cube_size) then exit;

y_fix:=0;
cube_size_fix:=cube_size;
if y_cube+cube_size>99 then begin
    y_fix := (y_cube+cube_size-100);
    cube_size_fix:=cube_size-y_fix;
    y_fix := y_fix shl 1;
end;

if y_cube<0 then begin
    cube_size_fix:=cube_size+y_cube;
    y_cube:=0;
end;

if (f<yy) then yy:=history_size+(f-yy) else  yy:=f-yy;
yy:=yy*frame_size;

if (x_cube>0) and (x_cube<160-cube_size) then
asm
mov es, where
mov ax, y_cube
imul ax, ax, 160
add ax, x_cube
mov cs:[offset @y_cube+1], ax {db $8e,$e8 {mov gs, ax}

mov di, yy {frame_offset:=yy;}

mov cx, 2
@p: {for p:=0 to 2 do begin}
push cx
push di

    mov al, color

    mov si, cube_size_fix
    dec si
    shl si, 1

    push ds
    push bp
    mov ds, from

    mov bl, ds:[di] {col:=mem[vaddr3:frame_offset];}
    add bl, al   {individual color-group}
    mov bh, bl
    mov ax, bx
    db $66; shl ax, 16
    mov ax, bx

    inc di {inc(frame_offset);}

    add di, y_fix
    mov cs:[offset @frame_offset+2], di {db $8E,$E7 {mov fs, di} {frame_offset}
    jmp @clear_prefetch; @clear_prefetch:

    xor bx, bx
    xor bp, bp
    {for y:=0 to cube_size-1 do begin}
    @y:
       @frame_offset: mov dx, ds:[si+1234h]
       mov bl, dl
       sub dh, dl
       jz @exit
       js @exit

           @y_cube: mov di, 1234h {db $8c,$ef {mov di, gs}{y_cube}
           add di, bp

             {DrawLineH(x1, x2, y, c, where);}
             {-------------------------------------}
             add  di, bx
             mov  cl, dh

             and  cx, 252; jz @length_less_four
                 shr  cx, 2
                 db $66; rep stosw

             @length_less_four:
             test dh, 2; jz @length_less_two
                 mov es:[di], ax
                 add di, 2
             @length_less_two:
             test dh, 1; jz @exit
                 mov es:[di], al
             @exit:
            {---------------------}
    add bp, 160
    sub si, 2
    jns @y {end;}
    pop bp
    pop ds

pop di
add di, face_size {frame_offset:=frame_offset + face_size;}
pop cx
dec cx
jns @p
end
else  {with x-clipping}
asm
mov es, where
mov ax, y_cube
mov cx, x_cube
imul ax, ax, 160
add ax, cx
mov cs:[offset @y_cube+1], ax {db $8e,$e8 {mov gs, ax}
mov cs:[offset @x_cube+1], cx

mov di, yy {frame_offset:=yy;}

mov cx, 2
@p: {for p:=0 to 2 do begin}
push cx
push di

    mov al, color

    mov si, cube_size_fix
    dec si
    shl si, 1

    push ds
    push bp
    mov ds, from

    mov bl, ds:[di] {col:=mem[vaddr3:frame_offset];}
    add bl, al   {individual color-group}
    mov bh, bl
    mov ax, bx
    db $66; shl ax, 16
    mov ax, bx

    inc di {inc(frame_offset);}

    add di, y_fix
    mov cs:[offset @frame_offset+2], di {db $8E,$E7 {mov fs, di} {frame_offset}
    jmp @clear_prefetch; @clear_prefetch:

    xor bx, bx
    xor bp, bp
    {for y:=0 to cube_size-1 do begin}
    @y:
       @frame_offset: mov dx, ds:[si+1234h]
       mov bl, dl
       sub dh, dl
       jz @exit
       js @exit

           {left-right clipping}
          @x_cube: mov cx, 1234h {x_cube}
          test ch, 128; jz @skip_0_cut {if x_cube<0 then}
             add dl, cl; jns @skip_160_cut {if (x1+x_cube)<0 then}
             xor bx, bx
             sub bx, cx
             add dh, dl; js @exit; jmp @skip_160_cut
           @skip_0_cut:
             add cl, dh
             add cl, bl
             cmp cl, 160
             jbe @skip_160_cut; sub cl, 160; sub dh, cl; js @exit; @skip_160_cut:


           @y_cube: mov di, 1234h {db $8c,$ef {mov di, gs}{y_cube}
           add di, bp

             {DrawLineH(x1, x2, y, c, where);}
             {-------------------------------------}
             add  di, bx
             mov  cl, dh

             and  cx, 252; jz @length_less_four
                 shr  cx, 2
                 db $66; rep stosw

             @length_less_four:
             test dh, 2; jz @length_less_two
                 mov es:[di], ax
                 add di, 2
             @length_less_two:
             test dh, 1; jz @exit
                 mov es:[di], al
             @exit:
            {---------------------}
    add bp, 160
    sub si, 2
    jns @y {end;}
    pop bp
    pop ds

pop di
add di, face_size {frame_offset:=frame_offset + face_size;}
pop cx
dec cx
jns @p
   end;
end;


end.