{ polygon routines (c) 1999 access / kilobite }
unit polygons;

interface
procedure gouraud_poly_real(segi:word; x1,y1,x2,y2,x3,y3:integer; c1,c2,c3:byte);
procedure gouraud_poly_zbuf(segi:word; x1,y1,x2,y2,x3,y3:integer; c1,c2,c3:byte);
procedure poly(segi,x1,y1,x2,y2,x3,y3:word; col:byte);
procedure sqpoly(segi,px1,py1,px2,py2,px3,py3,px4,py4:word; col:byte);

implementation

{ horizontal line }
procedure horiz(where:word;xb,xe,y:integer;col:byte); assembler;
asm
  mov ax,[xb]
  mov bx,[xe]
  cmp ax,0
  jb @SkipLine
  cmp bx,0
  jb @SkipLine
  cmp ax,319
  ja @SkipLine
  cmp bx,319
  ja @SkipLine
  mov ax,[y]
  cmp ax,0
  jb @SkipLine
  cmp ax,199
  ja @SkipLine
  mov es,[where]  { minne? vga=$a000 }
  mov ax,[xb]     { ax = x begin }
  mov bx,[xe]     { bx = x end }
  cmp ax,bx       { ax > bx ? }
  jb @EiVaihtoa
  mov [xb],bx     { vaihdetaan }
  mov [xe],ax     { x begin ja x end }
@EiVaihtoa:
  mov ax,[y]      { di = y * 320 + xb }
  shl ax,6
  mov di,ax
  shl ax,2
  add di,ax
  add di,[xb]
  mov cx,[xe]     { cx = xe - xb }
  sub cx,[xb]
  mov al,[col]    { v„ri }
  rep stosb       { ja piirret„„n se viiva }
@SkipLine:
end;

{ 8.8 decimal fixed point gouraud horizline }
procedure gouraud_horiz(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
  neg dx { jos c1<c2 ni negatoi:) derivaatta }
@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
  stosb
  add bx,dx
  dec cx
  jne @inner
@done:
end;

{ 8.8 decimal fixed point gouraud z-buffer (whuh :) horizline }
procedure gouraud_horiz_zbuf(segi:word; lx1,lx2,ly:integer; lc1,lc2:byte); assembler;
var x1,x2:word;
    c1,c2:byte;
asm
  mov ax,[segi]
  mov es,ax

  mov al,[lc1]
  mov [c1],al
  mov al,[lc2]
  mov [c2],al

  mov ax,[lx1] { if x1>x2 then vaihda x1&x2 ja c1&x2 }
  mov bx,[lx2]
  cmp ax,0    { clippaukset }
  jg @x1zero
  xor ax,ax
@x1zero:
  cmp ax,319
  jl @x1over
  mov ax,319
@x1over:
  cmp bx,0
  jg @x2zero
  xor bx,bx
@x2zero:
  cmp bx,319
  jl @x2over
  mov bx,319
@x2over:

  mov [x1],ax
  mov [x2],bx
  cmp ax,bx
  jb @xok
  mov [x1],bx
  mov [x2],ax
  mov al,[lc1]
  mov bl,[lc2]
  mov [c1],bl
  mov [c2],al
@xok:

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

  mov cx,[x2] { cx = x2-x1 }
  sub cx,[x1]
  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,[c2]
  mov bl,[c1]
  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 ax,ax
  xor bx,bx
  mov bl,[c1] { bx = c1 * 256 }
  mov al,[c2]
  cmp bl,al
  jb @cOK
  neg dx
@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,[segi]
@jumpPixel:
  inc di
  cmp si,0
  add bx,dx
  dec cx
  jne @inner
@done:
end;

{ triangle gouraud poly }
procedure gouraud_poly_real(segi:word; x1,y1,x2,y2,x3,y3:integer; c1,c2,c3:byte);
var x,y:array[1..3] of integer;
    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:integer;
    offs,i,j,k,l:integer;

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 begin
     if (loop>0)and(loop<199) then
     gouraud_horiz_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])));
   end;
   for loop:=y[2] to y[3] do begin
     if (loop>0)and(loop<199) then
     gouraud_horiz_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;
end;

{ triangle gouraud poly (z-buffer)
  polygoon gappi vaivaa
  0 kpl reaalimuuttujia tai roundeja }

procedure gouraud_poly_zbuf(segi:word; x1,y1,x2,y2,x3,y3:integer; c1,c2,c3:byte);
var x,y,c:array[1..3] of integer;
    deltax,deltay,deltac:array[1..3] of longint;
    d,dc:array[1..3] of longint;
    loop:integer;
    offs,i,j,k,l:word;
    xb,xe,cb,ce:integer;

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;
  { sorttaus y-arvojen mukaan (piirret„„n ylh„„lt„ alas) }
  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] shl 16) div deltay[loop];
       dc[loop]:=(deltac[loop] shl 16) div deltay[loop];
     end else begin
       d[loop]:=0;
       dc[loop]:=0;
     end;
   end;

   { voisin v„itt„„ ett„ t„m„ nopeuttaa hiukan ;) }
   xb:=x[1];
   xe:=x[1];
   cb:=c[1];
   ce:=c[1];
   offs:=0;
   { no, ainakin selvent„„ koodia }
   for loop:=y[1] to y[2] do begin
     if (loop>0)and(loop<200) then
     gouraud_horiz_zbuf(segi,xb+((offs*d[1]) shr 16),xe+((offs*d[3]) shr 16),loop,
                             cb+((offs*dc[1]) shr 16),ce+((offs*dc[3]) shr 16));
     inc(offs);
   end;
   xb:=x[2];
   cb:=c[2];
   i:=offs;
   offs:=0;
   for loop:=y[2] to y[3] do begin
     if (loop>0)and(loop<200) then
     gouraud_horiz_zbuf(segi,xb+((offs*d[2]) shr 16),xe+(((i+offs)*d[3]) shr 16),loop,
                             cb+((offs*dc[2]) shr 16),ce+(((i+offs)*dc[3]) shr 16));
     inc(offs);
  end;
end;

{ triangle polygon filler (flat) }
{ basic one color filler }
procedure poly(segi,x1,y1,x2,y2,x3,y3:word; col:byte);
var x,y:array[1..3] of word;
    deltax,deltay:array[1..3] of integer;
    d: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;
  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;

      end;

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

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

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

{ square polygon filler }
{ divides coordinates to 2 triangles and draws them }
{ fucking slow and useless shit }
procedure sqpoly(segi,px1,py1,px2,py2,px3,py3,px4,py4:word; col:byte);
var x,y:array[1..3] of word;
    px,py:array[1..4] of word;
    sx,sy:array[1..2,1..3] of word;
    deltax,deltay:array[1..3] of integer;
    d:array[1..3] of real;
    bloop,loop:word;
    offs,i,j,k,l:word;

begin
px[1]:=px1; py[1]:=py1;
px[2]:=px2; py[2]:=py2;
px[3]:=px3; py[3]:=py3;
px[4]:=px4; py[4]:=py4;
for i:=1 to 4 do
  for j:=1 to 3 do if py[i] < py[j] then begin
      k:=py[i];      l:=px[i];
      py[i]:=py[j];  px[i]:=px[j];
      py[j]:=k;      px[j]:=l;
    end;
{ 1st triangle }
sx[1,1]:=px[1]; sy[1,1]:=py[1]; { kaksi ylint„ }
sx[1,2]:=px[2]; sy[1,2]:=py[2];
if px[3] < px[4] then begin { vasem alempi }
  sx[1,3]:=px[3]; sy[1,3]:=py[3];
end else begin
  sx[1,3]:=px[4]; sy[1,3]:=py[4];
end;
{ 2nd triangle }
sx[2,1]:=px[3]; sy[2,1]:=py[3]; { kaksi alinta }
sx[2,2]:=px[4]; sy[2,2]:=py[4];
if px[1] > px[2] then begin { oikea ylempi }
  sx[2,3]:=px[1]; sy[2,3]:=py[1];
end else begin
  sx[2,3]:=px[2]; sy[2,3]:=py[2];
end;

for bloop:=1 to 2 do begin
  x[1]:=sx[bloop,1]; x[2]:=sx[bloop,2]; x[3]:=sx[bloop,3];
  y[1]:=sy[bloop,1]; y[2]:=sy[bloop,2]; y[3]:=sy[bloop,3];
  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;
      end;

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

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

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

end.