{
  * k”kk”-gouraud
  * sikanopee k”kk” z-buffer
  * melkein fixed point rotation :D
(  * 32 bittinen fixed point polygon rutiini )
}

uses routines,map,kuubi;

type polytype = array[1..3] of byte;
     pointtype = array[1..3] of integer;

const vidseg = $a000;

      xinc = 256;
      yinc = 256;
      zinc = 128;

      zf = 256;
      xc = 160;
      yc = 100;
      zc = 256;

      fpoints = 8;
      xrange = 200;
      yrange = 200;
      zrange = 100;

var obi,loop : word;
    ctab : array[0..255] of real;
    stab : array[0..255] of real;
    fpoint,ftrans,trans : array[1..points,1..3] of integer;
    xphi,yphi,zphi : word;
    flarescr,zbufscr,virscr : pointer;
    flareseg,zbuf,virseg : word;
    x,y,z : integer;
    p : word;

procedure gouraud_horiz_zbuf(zseg,segi,lx1,lx2,ly:word; lc1,lc2:byte); assembler;
asm
  mov ax,[segi]
  mov es,ax

  mov ax,[lx1] { if x1>x2 then vaihda x1&x2 ja c1&x2 }
  mov bx,[lx2]
  cmp ax,bx
  jb @xok
  mov [lx1],bx
  mov [lx2],ax
  mov al,[lc1]
  mov bl,[lc2]
  mov [lc1],bl
  mov [lc2],al
@xok:

  mov ax,[ly] { di = y*320 + x }
  shl ax,6
  mov di,ax
  shl ax,2
  add di,ax
  mov ax,[lx1]
  add di,ax

  mov cx,[lx2] { cx = x2-x1 }
  sub cx,[lx1]
  cmp cx,0
  jz @done

{ dc:=((c2-c1) shl 8) div (x2-x1); }
  xor ax,ax
  xor bx,bx
  xor dx,dx { 16bit div k„ytt„„ dx:„„ }
  mov al,[lc2]
  mov bl,[lc1]
  cmp ax,bx
  ja @jump1
  sub bx,ax { c1 - c2 }
  mov ax,bx
  jmp @jump2
@jump1:
  sub ax,bx { c2 - c1 }
@jump2:
  shl ax,8
  div cx
  mov dx,ax { dx = fixed point v„rin derivaatta (”™™”h :) }

  xor si,si
  xor ax,ax
  xor bx,bx
  mov bl,[lc1] { bx = c1 * 256 }
  mov al,[lc2]
  cmp bl,al
  jb @cOK
  inc si
@cOK:
  shl bx,8     { bx sis„lt„„ fixed point-v„rin }

@inner:
  mov ax,bx { lis„„ vain vesi ja 1x add ja shifti }
  shr ax,8
  mov ah,[es:di] { aika ovelaa vaikka ite kehunkin (kr”h”m) }
  cmp ah,al
  ja @jumpPixel
  mov [es:di],al
  mov es,[zseg]
  mov [es:di],al
  mov es,[segi]
@jumpPixel:
  inc di
  cmp si,0
  jnz @subbaa
  add bx,dx
  jmp @jump
@subbaa:
  sub bx,dx
@jump:
  dec cx
  jne @inner
@done:
end;

{ triangle gouraud poly }
procedure gouraud_poly_real(zbuf,segi,x1,y1,x2,y2,x3,y3:word; c1,c2,c3:byte);
var x,y,c:array[1..3] of word;
    deltax,deltay,deltac:array[1..3] of integer;
    d:array[1..3] of real;
    dc:array[1..3] of real;
    loop:word;
    offs,i,j,k,l:word;

begin
  x[1]:=x1; x[2]:=x2; x[3]:=x3;
  y[1]:=y1; y[2]:=y2; y[3]:=y3;
  c[1]:=c1; c[2]:=c2; c[3]:=c3;
  for i:=1 to 3 do
    for j:=1 to 2 do if y[i] < y[j] then begin
        k:=y[i];       l:=x[i];
        y[i]:=y[j];    x[i]:=x[j];
        y[j]:=k;       x[j]:=l;
        k:=c[i];
        c[i]:=c[j];
        c[j]:=k;
      end;

   deltay[1]:=y[2]-y[1];
   deltax[1]:=x[2]-x[1];
   deltay[2]:=y[3]-y[2];
   deltax[2]:=x[3]-x[2];
   deltay[3]:=y[3]-y[1];
   deltax[3]:=x[3]-x[1];

   deltac[1]:=c[2]-c[1];
   deltac[2]:=c[3]-c[2];
   deltac[3]:=c[3]-c[1];

   for loop:=1 to 3 do begin
     if deltay[loop] <> 0
     then begin
       d[loop]:=deltax[loop] / deltay[loop];
       dc[loop]:=deltac[loop] / deltay[loop];
     end else begin
       d[loop]:=0;
       dc[loop]:=0;
     end;
   end;

   for loop:=y[1] to y[2] do
     gouraud_horiz_zbuf(zbuf,segi,x[1]+round(d[1]*(loop-y[1])),
                        x[1]+round(d[3]*(loop-y[1])),loop,
                        c[1]+round(dc[1]*(loop-y[1])),
                        c[1]+round(dc[3]*(loop-y[1])));
   for loop:=y[2] to y[3] do
     gouraud_horiz_zbuf(zbuf,segi,x[2]+round(d[2]*(loop-y[2])),
                        x[1]+round(d[3]*(loop-y[1])),loop,
                        c[2]+round(dc[2]*(loop-y[2])),
                        c[1]+round(dc[3]*(loop-y[1])));
end;

procedure sprite(x,y:integer;col:word); assembler;
var sy,sx:integer;
asm
  push ds

  mov cx,[x] { ds:si = piste flaressa }
  mov dx,[y]
  sub cx,16
  sub dx,16 { flaren keskipiste = x,y }
  mov [sx],cx
  mov [sy],dx { es:di (sx,sy) = piste virsegiss„ }

  mov ax,[virseg]
  mov es,ax
  mov ax,[flareseg]
  mov ds,ax

  mov ax,dx { di = sy*320+sx }
  shl ax,6
  mov di,ax
  shl ax,2
  add di,ax
  add di,cx
  xor si,si { si = 0 }
  xor dx,dx { dx pit„„ kirjaa flare X:st„ }

@inner:
  cmp [sy],199 { inscreen check (sx,sy) }
  jg @noPixel
  cmp [sy],0
  jl @noPixel
  cmp [sx],319
  jg @noPixel
  cmp [sx],0
  jl @noPixel

  xor bx,bx      { ynn„t„„n ruutu, flareseg ja col }
  mov bl,[ds:si] { flareseg pixel }
  mov ax,[col]
  sub bx,ax
  cmp bx,0
  jg @positive
  xor bx,bx
@positive:
  mov al,[es:di] { virseg pixel }
  add ax,bx      { ax = v„ri }

  cmp ax,256     { v„rin byte-chekki }
  jl @skip1
  mov ax,255
@skip1:
  mov es,[zbuf]
  mov bl,[es:di]
  cmp bl,0
  jz @skip0
  sub al,32
  cmp al,0
  jg @skip0
  xor al,al
@skip0:
  mov [es:di],al { ...ja piirret„„n al }

@noPixel:
  inc si { p„ivitet„„n indexit sun muut muuttujat }
  inc di
  inc dx
  inc [sx]
  cmp dx,32
  jnz @skip3 { jos rivi ei lopu viel„, hypp„„ @skip3 }

  xor dx,dx { jos dx = 32 (rivin loppu) niin... }
  mov ax,[x] { sx = x-16 }
  sub ax,16
  mov [sx],ax
  inc [sy]
  add di,320-32 { di hypp„„ rivin alasp„in }

@skip3:
  cmp si,32*32 { jos flaren offsetti on 32*32, lopeta }
  jnz @inner

  pop ds
end;

{ rotate object [XYZ], fixed point sinit }
procedure rotate;

var x,y,z,
    fx,fy,fz : integer;
    sinix,kosix,
    siniy,kosiy,
    siniz,kosiz : real;

begin
  for loop:=1 to points do begin
    x := point[loop,1];
    y := point[loop,2];
    z := point[loop,3];
    fx := fpoint[loop,1];
    fy := fpoint[loop,2];
    fz := fpoint[loop,3];
    sinix := stab[xphi shr 8];
    kosix := ctab[xphi shr 8];
    siniy := stab[yphi shr 8];
    kosiy := ctab[yphi shr 8];
    siniz := stab[zphi shr 8];
    kosiz := ctab[zphi shr 8];
{
                   Ú                                      ¿
                   ³ cy*cz          cy*sz          -sy    ³
     [X]*[Y]*[Z] = ³ sx*sy*cz-cx*sz sx*sy*sz+cx*cz  sx*cy ³
                   ³ cx*sy*cz+sx*sz cx*sy*sz-sx*cz  cx*cy ³
                   À                                      Ù
}
    trans[loop,1]:=round((kosiy*kosiz*x)+((sinix*siniy*kosiz*y)-(kosix*siniz*y))+
                         ((kosix*siniy*kosiz*z)+(sinix*siniz*z)));
    trans[loop,2]:=round((kosiy*siniz*x)+((sinix*siniy*siniz*y)+(kosix*kosiz*y))+
                         ((kosix*siniy*siniz*z)-(sinix*kosiz*z)));
    trans[loop,3]:=round((-siniy*x)+(sinix*kosiy*y)+(kosix*kosiy*z));

    ftrans[loop,1]:=round((kosiy*kosiz*fx)+((sinix*siniy*kosiz*fy)-(kosix*siniz*fy))+
                         ((kosix*siniy*kosiz*fz)+(sinix*siniz*fz)));
    ftrans[loop,2]:=round((kosiy*siniz*fx)+((sinix*siniy*siniz*fy)+(kosix*kosiz*fy))+
                         ((kosix*siniy*siniz*fz)-(sinix*kosiz*fz)));
    ftrans[loop,3]:=round((-siniy*fx)+(sinix*kosiy*fy)+(kosix*kosiy*fz));
  end;
  if xphi shr 8<255 then xphi:=xphi+xinc else xphi:=0;
  if yphi shr 8<255 then yphi:=yphi+yinc else yphi:=0;
  if zphi shr 8<255 then zphi:=zphi+zinc else zphi:=0;
end;

procedure drawPallot;
var dx,dy,dz : integer;
    col : integer;
    sx,sy : integer;

begin
  for p:=1 to points do begin
    dx:=(x+ftrans[p,1]) * 256;
    dy:=(y+ftrans[p,2]) * 256;
    dz:=z-ftrans[p,3];
    sx:=round(dx / (zc+dz)) + xc;
    sy:=round(dy / (zc+dz)) + yc;
    if (sx>0)and(sx<320)and
       (sy>0)and(sy<200)then begin
      col:=dz;
      if col<0 then col:=0;
      sprite(sx,sy,col);
    end;
  end;
end;

procedure DrawObj(x,y,z:integer);
var f,p : word;
    dx,dy,dz : integer;
    sx,sy,c : array[1..3] of integer;

function inrange(value:integer):byte;
begin
  inrange:=value;
  if value<0 then inrange:=0;
  if value>255 then inrange:=255;
end;

begin
  { ei tartte sorttia }
  for f:=1 to faces do begin
    for p:=1 to 3 do begin
{      gx = x * 256 / z + 160 ; keskipiste = ruudun keskipiste
       gy = y * 256 / z + 100 ; (320x200-tila) }
      dx:=x+trans[face[f,p],1];
      dy:=y+trans[face[f,p],2];
      dz:=z-trans[face[f,p],3];
      sx[p]:=round(dx shl 8 / (zc+dz)) + xc;
      sy[p]:=round(dy shl 8 / (zc+dz)) + yc;
      c[p]:=inrange(trans[face[f,p],3]*2);
    end;
    if c[1]+c[2]+c[3]>0 then
    gouraud_poly_real(zbuf,virseg,sx[1],sy[1],
                             sx[2],sy[2],
                             sx[3],sy[3],
                             c[1],c[2],c[3]);
  end;
end;

procedure NullObject;
begin
  xphi:=0;
  yphi:=0;
  zphi:=0;
  x:=0; y:=0;
  z:=128;
end;

begin
  randomize;
  mode($13);
  getmem(virscr,64000);
  virseg:=seg(virscr^);
  cls(virseg);
  for loop:=0 to 255 do ctab[loop]:=cos(loop*pi/128);
  for loop:=0 to 255 do stab[loop]:=sin(loop*pi/128);
  nullobject;
  repeat
    rotate;
    cls(virseg);
    drawobj(x,y,z);
    if z>0 then dec(z,4);
    retrace;
    flip(virseg,vidseg);
  until keypressed; flushKB;
  freemem(virscr,64000);
  mode(3);
end.
