Unit GFX3;


INTERFACE

USES crt,fpack,dos ; {for loading pcx}
CONST VGA = $A000;

TYPE Virtual = Array [1..64000] of byte;  { The size of our Virtual Screen }
     VirtPtr = ^Virtual;                  { Pointer to the virtual screen }

VAR Virscr,virscr2 : VirtPtr;                     { Our first Virtual screen }
    Vaddr,vaddr2  : word;                        { The segment of our virtual screen}
    Scr_Ofs : Array[0..199] of Word;
    startclock,stopclock,time:real;
    h,m,s,s100:word;
    ticks:longint absolute $40:$6c;
    tim1,tim2,s1,s2:integer;
     poly,uvpoly:array[1..199,1..2] of integer;
             palar:array[1..255,1..3] of byte;

Const
  MinX = 0;
  MinY = 0;
  MaxX = 319;
  MaxY = 199;

Procedure SetMCGA;
   { This procedure gets you into 320x200x256 mode. }
Procedure SetText;
   { This procedure returns you to text mode.  }
Procedure Cls (Where:word;Col : Byte);
   { This clears the screen to the specified color }
Procedure SetUpVirtual;
   { This sets up the memory needed for the virtual screen }
Procedure ShutDown;
   { This frees the memory used by the virtual screen }
procedure flip(source,dest:Word);
   { This copies the entire screen at "source" to destination }
Procedure Pal(Col,R,G,B : Byte);
   { This sets the Red, Green and Blue values of a certain color }
Procedure GetPal(Col : Byte; Var R,G,B : Byte);
  { This gets the Red, Green and Blue values of a certain color }
procedure WaitRetrace;
   {  This waits for a vertical retrace to reduce snow on the screen }
Procedure Hline (x1,x2,y:word;col:byte;where:word);
   { This draws a horizontal line from x1 to x2 on line y in color col }
Procedure Line(a,b,c,d:integer;col:byte;where:word);
  { This draws a solid line from a,b to c,d in colour col }
Procedure DrawPoly(x1,y1,x2,y2,x3,y3,x4,y4:integer;color:byte;where:word);
   { This draw a polygon with 4 points at x1,y1 , x2,y2 , x3,y3 , x4,y4
     in color col }
Function rad (theta : real) : real;
   {  This calculates the degrees of an angle }
Procedure Putpixel (X,Y : Integer; Col : Byte; where:word);
   { This puts a pixel on the screen by writing directly to memory. }
Function Getpixel (X,Y : Integer; where:word) :Byte;
   { This gets the pixel on the screen by reading directly to memory. }
Procedure LoadCEL (FileName :  string; ScrPtr : pointer);
  { This loads the cel 'filename' into the pointer scrptr }
Procedure LoadPal (FileName : string);
  { This loads in an Autodesk Animator V1 pallette file }

{ƒ ¡œª £¦¬ }
procedure flip32(source,dest:Word);
Procedure Cls32(Where:word;Col : Byte);
procedure hline32(xb,xe,y:integer; c:byte; where:word);
procedure flines(w:word); {this fills screen with tv -black lines}

procedure FoDown;
procedure Clockon;
procedure clockoff;
Procedure ppixel (X,Y : Integer; Col : Byte);
procedure asmfade(wo:pointer);
Procedure Fadeup;
Procedure Fadedown;
procedure fillbox(x,y,xx,yy,c:integer;where:word);
procedure smear (x,y,xx,yy:integer;where:word);
procedure Lpcx(fn:string;where:word);
procedure showletter(x,y,co:integer;ch:char;w:word); {using the rom font}
procedure showmsg(x,y,co:integer;st:string;w:word); {shows a message}
procedure palplay;
procedure vlines(w:word); {this fills screen with tv-black lines}
procedure hlines(w:word); {this fills screen with tv -black lines}
procedure fcasm(x,y,r:word;c:byte;w:word); {filled circle}
procedure fadein(w:word);
Procedure GouraudCpPoly(x1, y1, x2, y2, x3, y3, C1, C2, C3:integer ;PgSeg : word);
Procedure NewTex(X1,Y1,U1,V1,X2,Y2,U2,V2,X3,Y3,U3,V3:Integer;Texture:Pointer;w:word);
procedure resett1;
function t1:integer;
procedure fedges(c,f,t:word);
Procedure Noise4(Where:Word);
Function IntSqrt(Const L : LongInt) : Word;
procedure savepal(s:string);
Procedure DP(x1,y1,x2,y2,x3,y3,x4,y4,
                   u1,v1,u2,v2,u3,v3,u4,v4:integer;
                   from,too:word);


IMPLEMENTATION

{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure SetMCGA;  { This procedure gets you into 320x200x256 mode. }
BEGIN
  asm
     mov        ax,0013h
     int        10h
  end;
END;

{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure SetText;  { This procedure returns you to text mode.  }
BEGIN
  asm
     mov        ax,0003h
     int        10h
  end;
END;

{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure Cls (Where:word;Col : Byte); assembler;
   { This clears the screen to the specified color }
asm
   push    es
   mov     cx, 32000;
   mov     es,[where]
   xor     di,di
   mov     al,[col]
   mov     ah,al
   rep     stosw
   pop     es
End;

{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure SetUpVirtual;
   { This sets up the memory needed for the virtual screen }
BEGIN
  GetMem (VirScr,64000);
  vaddr := seg (virscr^);
END;

{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure ShutDown;
   { This frees the memory used by the virtual screen }
BEGIN
  FreeMem (VirScr,64000);
END;

{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
procedure flip(source,dest:Word); assembler;
  { This copies the entire screen at "source" to destination }
asm
  push    ds
  mov     ax, [Dest]
  mov     es, ax
  mov     ax, [Source]
  mov     ds, ax
  xor     si, si
  xor     di, di
  mov     cx, 32000
  rep     movsw
  pop     ds
end;

{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure Pal(Col,R,G,B : Byte); assembler;
  { This sets the Red, Green and Blue values of a certain color }
asm
   mov    dx,3c8h
   mov    al,[col]
   out    dx,al
   inc    dx
   mov    al,[r]
   out    dx,al
   mov    al,[g]
   out    dx,al
   mov    al,[b]
   out    dx,al
end;

{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure GetPal(Col : Byte; Var R,G,B : Byte);
  { This gets the Red, Green and Blue values of a certain color }
Var
   rr,gg,bb : Byte;
Begin
   asm
      mov    dx,3c7h
      mov    al,col
      out    dx,al

      add    dx,2

      in     al,dx
      mov    [rr],al
      in     al,dx
      mov    [gg],al
      in     al,dx
      mov    [bb],al
   end;
   r := rr;
   g := gg;
   b := bb;
end;

{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
procedure WaitRetrace; assembler;
  {  This waits for a vertical retrace to reduce snow on the screen }
label
  l1, l2;
asm
    mov dx,3DAh
l1:
    in al,dx
    and al,08h
    jnz l1
l2:
    in al,dx
    and al,08h
    jz  l2
end;

{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure Hline (x1,x2,y:word;col:byte;where:word); assembler;
  { This draws a horizontal line from x1 to x2 on line y in color col }
asm
  mov   ax,where
  mov   es,ax
  mov   ax,y
  mov   di,ax
  shl   ax,8
  shl   di,6
  add   di,ax
  add   di,x1

  mov   al,col
  mov   ah,al
  mov   cx,x2
  sub   cx,x1
  shr   cx,1
  jnc   @start
  stosb
@Start :
  rep   stosw
end;

{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure Line(a,b,c,d:integer;col:byte;where:word);
  { This draws a solid line from a,b to c,d in colour col }
  function sgn(a:real):integer;
  begin
       if a>0 then sgn:=+1;
       if a<0 then sgn:=-1;
       if a=0 then sgn:=0;
  end;
var i,s,d1x,d1y,d2x,d2y,u,v,m,n:integer;
begin
     u:= c - a;
     v:= d - b;
     d1x:= SGN(u);
     d1y:= SGN(v);
     d2x:= SGN(u);
     d2y:= 0;
     m:= ABS(u);
     n := ABS(v);
     IF NOT (M>N) then
     BEGIN
          d2x := 0 ;
          d2y := SGN(v);
          m := ABS(v);
          n := ABS(u);
     END;
     s := m shr 1;
     FOR i := 0 TO m DO
     BEGIN
          putpixel(a,b,col,where);
          s := s + n;
          IF not (s<m) THEN
          BEGIN
               s := s - m;
               a:= a + d1x;
               b := b + d1y;
          END
          ELSE
          BEGIN
               a := a + d2x;
               b := b + d2y;
          END;
     end;
END;


{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure DrawPoly(x1,y1,x2,y2,x3,y3,x4,y4:integer;color:byte;where:word);
  { This draw a polygon with 4 points at x1,y1 , x2,y2 , x3,y3 , x4,y4
    in color col }
var
  x:integer;
  mny,mxy:integer;
  mnx,mxx,yc:integer;
  mul1,div1,
  mul2,div2,
  mul3,div3,
  mul4,div4:integer;

begin
  mny:=y1; mxy:=y1;
  if y2<mny then mny:=y2;
  if y2>mxy then mxy:=y2;
  if y3<mny then mny:=y3;
  if y3>mxy then mxy:=y3;    { Choose the min y mny and max y mxy }
  if y4<mny then mny:=y4;
  if y4>mxy then mxy:=y4;

  if mny<0 then mny:=0;
  if mxy>199 then mxy:=199;
  if mny>199 then exit;
  if mxy<0 then exit;        { Verticle range checking }

  mul1:=x1-x4; div1:=y1-y4;
  mul2:=x2-x1; div2:=y2-y1;
  mul3:=x3-x2; div3:=y3-y2;
  mul4:=x4-x3; div4:=y4-y3;  { Constansts needed for intersection calc }

  for yc:=mny to mxy do
    begin
      mnx:=320;
      mxx:=-1;
      if (y4>=yc) or (y1>=yc) then
        if (y4<=yc) or (y1<=yc) then   { Check that yc is between y1 and y4 }
          if not(y4=y1) then
            begin
              x:=(yc-y4)*mul1 div div1+x4; { Point of intersection on x axis }
              if x<mnx then
                mnx:=x;
              if x>mxx then
                mxx:=x;       { Set point as start or end of horiz line }
            end;
      if (y1>=yc) or (y2>=yc) then
        if (y1<=yc) or (y2<=yc) then   { Check that yc is between y1 and y2 }
          if not(y1=y2) then
            begin
              x:=(yc-y1)*mul2 div div2+x1; { Point of intersection on x axis }
              if x<mnx then
                mnx:=x;
              if x>mxx then
                mxx:=x;       { Set point as start or end of horiz line }
            end;
      if (y2>=yc) or (y3>=yc) then
        if (y2<=yc) or (y3<=yc) then   { Check that yc is between y2 and y3 }
          if not(y2=y3) then
            begin
              x:=(yc-y2)*mul3 div div3+x2; { Point of intersection on x axis }
              if x<mnx then
                mnx:=x;
              if x>mxx then
                mxx:=x;       { Set point as start or end of horiz line }
            end;
      if (y3>=yc) or (y4>=yc) then
        if (y3<=yc) or (y4<=yc) then   { Check that yc is between y3 and y4 }
          if not(y3=y4) then
            begin
              x:=(yc-y3)*mul4 div div4+x3; { Point of intersection on x axis }
              if x<mnx then
                mnx:=x;
              if x>mxx then
                mxx:=x;       { Set point as start or end of horiz line }
            end;
      if mnx<0 then
        mnx:=0;
      if mxx>319 then
        mxx:=319;          { Range checking on horizontal line }
      if mnx<=mxx then
        hline (mnx,mxx,yc,color,where);   { Draw the horizontal line }
    end;
  end;

{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Function rad (theta : real) : real;
  {  This calculates the degrees of an angle }
BEGIN
  rad := theta * pi / 180
END;

{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure Putpixel (X,Y : Integer; Col : Byte; where:word); assembler;
  { This puts a pixel on the screen by writing directly to memory. }
asm
   mov  ax,where
   mov  es,ax
   mov  bx,[y]
   shl  bx,1
   mov  di,word ptr [Scr_Ofs + bx]
   add  di,[x]
   mov  al,[col]
   mov  es:[di],al
end;


{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Function Getpixel (X,Y : Integer; where:word):byte; assembler;
  { This puts a pixel on the screen by writing directly to memory. }
asm
   mov  ax,where
   mov  es,ax
   mov  bx,[y]
   shl  bx,1
   mov  di,word ptr [Scr_Ofs + bx]
   add  di,[x]
   mov  al,es:[di]
end;

{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure LoadCEL (FileName :  string; ScrPtr : pointer);
  { This loads the cel 'filename' into the pointer scrptr }
var
  Fil : file;
  Buf : array [1..1024] of byte;
  BlocksRead, Count : word;
begin
  assign (Fil, FileName);
  reset (Fil, 1);
  BlockRead (Fil, Buf, 800);    { Read and ignore the 800 byte header }
  Count := 0;
  BlocksRead := $FFFF;
  while (not eof (Fil)) and (BlocksRead <> 0) do begin
    BlockRead (Fil, mem [seg (ScrPtr^): ofs (ScrPtr^) + Count], 1024, BlocksRead);
    Count := Count + 1024;
  end;
  close (Fil);
end;

Procedure ppixel (X,Y : Integer; Col : Byte);
BEGIN
  Mem [VGA:X+(Y*320)]:=Col;
END;


procedure asmfade(wo:pointer); assembler;
asm
  les di,wo
  xor cx,cx
 @yloop:
  mov ax,320
  mul cx
  mov bx,0
 @xloop:
  push ax
  add ax,bx
  mov di,ax
  mov si,ax
  xor ah,ah
  xor dx,dx
  mov al,es:[si]
  add dx,ax
  mov al,es:[si+318]
  add dx,ax
  mov al,es:[si+640]
  add dx,ax
  mov al,es:[si+321]
  add dx,ax
  shr dx,2
  jz @skip
  dec dl
 @skip:
  mov [es:di],dl
  pop ax
  inc bx
  cmp bx,320
  jne @xloop
  inc cx
  cmp cx,199
  jne @yloop
end;



procedure LoadPal (FileName : string);
var
  F:file;
  loop1:integer;
  pall:array[0..255,1..3] of byte;
begin
  assign (F, FileName);
  reset (F,1);
  blockread (F, pall,768);
  close (F);
  for loop1 := 0 to 255 do
    Pal(loop1,pall[loop1,1],pall[loop1,2],pall[loop1,3]);
end;

procedure fillbox(x,y,xx,yy,c:integer;where:word);
var l1:integer;
begin
  for l1:=y to yy do hline (x,xx,l1,c,where);
end;

procedure smear (x,y,xx,yy:integer;where:word);
var p1,p2,p3,p4,p5,p6,p7,p8,p:byte;
    l1,l2:integer;
begin
  for l1:=y to yy do
    for l2:=x to xx do begin
       p1:=getpixel(l2-1,l1-1,where);
       p2:=getpixel(l2,l1-1,where);
       p3:=getpixel(l2+1,l1-1,where);

       p4:=getpixel(l2-1,l1,where);
       p5:=getpixel(l2+1,l1,where);

       p6:=getpixel(l2-1,l1+1,where);
       p7:=getpixel(l2,l1+1,where);
       p8:=getpixel(l2+1,l1+1,where);
       p:=round((p1+p2+p3+p4+p5+p6+p7+p8) shr 3);
       putpixel(l2,l1,p,where);
     end;
end;

Procedure Fadeup;
  { This fades up the pallette to white }
VAR loop1,loop2:integer;
    Tmp : Array [1..3] of byte;
BEGIN
  For loop1:=1 to 64 do BEGIN
    WaitRetrace;
    For loop2:=0 to 255 do BEGIN
      Getpal (loop2,Tmp[1],Tmp[2],Tmp[3]);
      If Tmp[1]<63 then inc (Tmp[1]);
      If Tmp[2]<63 then inc (Tmp[2]);
      If Tmp[3]<63 then inc (Tmp[3]);
      Pal (loop2,Tmp[1],Tmp[2],Tmp[3]);
    END;
  END;
END;

Procedure Fadedown;
  { This fades up the pallette to white }
VAR loop1,loop2:integer;
    Tmp : Array [1..3] of byte;
BEGIN
  For loop1:=1 to 64 do BEGIN
    WaitRetrace;
    For loop2:=0 to 255 do BEGIN
      Getpal (loop2,Tmp[1],Tmp[2],Tmp[3]);
      If Tmp[1]>00 then dec (Tmp[1]);
      If Tmp[2]>00 then dec (Tmp[2]);
      If Tmp[3]>00 then dec (Tmp[3]);
      Pal (loop2,Tmp[1],Tmp[2],Tmp[3]);
    END;
  END;
END;


Procedure GouraudPoly(X1, Y1, X2, Y2, X3, Y3, C1, C2, C3:integer; PgSeg : word);

Var
  xTop, yTop : Integer;
  xBot, yBot : Integer;
  xMid, yMid : Integer;
  cTop, cBot, cMid : Integer;
  Count : Integer;
  xVal1, xStep1 : Integer;
  xVal2, xStep2 : Integer;
  cVal1, cStep1 : Integer;
  DColor : Integer;
  crMid : Integer;
  xrMid : Integer;
  hCount, cVal : Integer;

Begin
  Asm
    Mov  ax,Y1
    Mov  bx,X1
    Mov  cx,Y2
    Mov  dx,X2
    Mov  si,C1
    Mov  di,C2

    Mov  xTop,bx
    Mov  yTop,ax
    Mov  xBot,dx
    Mov  yBot,cx
    Mov  cTop,si
    Mov  cBot,di
    Cmp  ax,cx
    Jle @Skip2Top
      Mov  xTop,dx
      Mov  yTop,cx
      Mov  xBot,bx
      Mov  yBot,ax
      Mov  cTop,di
      Mov  cBot,si
   @Skip2Top:
    Mov  ax,Y3
    Mov  bx,X3
    Mov  cx,C3
    Cmp  ax,yTop
    Jge @CheckY3Bottom
      Mov  dx,yTop
      Mov  yMid,dx
      Mov  dx,xTop
      Mov  xMid,dx
      Mov  dx,cTop
      Mov  cMid,dx
      Mov  yTop,ax
      Mov  xTop,bx
      Mov  cTop,cx
      Jmp @Fini
   @CheckY3Bottom:
      Cmp ax,yBot
      Jle @Y3Mid
        Mov  dx,yBot
        Mov  yMid,dx
        Mov  dx,xBot
        Mov  xMid,dx
        Mov  dx,cBot
        Mov  cMid,dx
        Mov  yBot,ax
        Mov  xBot,bx
        Mov  cBot,cx
        Jmp @Fini
     @Y3Mid:
        Mov  yMid,ax
        Mov  xMid,bx
        Mov  cMid,cx
   @Fini:
  End;

  If (yBot-yTop) = 0
    Then Begin
      xrMid := xMid;
      crMid := cMid;
    End
    Else Begin
      xrMid := (yMid-yTop)*(xBot-xTop) Div (yBot-yTop) + xTop;
      crMid := (yMid-yTop)*(cBot-cTop) Div (yBot-yTop) + cTop;
    End;

  Asm
    Mov  es,PgSeg
  End;

  If xMid < XrMid
    Then Begin
      DColor := (crMid-cMid) Shl 8 Div (xrMid-xMid+1);

      cVal1 := cTop Shl 8;
      xVal1 := xTop Shl 6;
      xVal2 := xVal1;
      xStep1 := (xMid-xTop) Shl 6 Div (yMid-yTop+1);
      cStep1 := (cMid-cTop) Shl 8 Div (yMid-yTop+1);
      xStep2 := (xBot-xTop) Shl 6 Div (yBot-yTop+1);
      For Count := yTop to yMid do
        Begin
          Asm
            Mov  bx,Count
            Mov  dx,bx
            Shl  bx,6
            Add  bh,dl
            Mov  di,bx

            Mov  ax,Word Ptr [xVal1]
            Shr  ax,6
            Mov  cx,Word Ptr [xVal2]
            Shr  cx,6

            Add  di,ax

            Sub  cx,ax
            Inc  cx
            Js   @Exit
            Mov  bx,dColor
            Mov  ax,cVal1
            Shr  cx,1
            Jnc @SkipSingle
            Mov  es:[di],ah
            Add  ax,bx
            Inc  di
           @SkipSingle:
            Jcxz @Exit
           @Looper:
            Mov  dl,ah
            Add  ax,bx
            Mov  dh,ah
            Add  ax,bx
            Mov  es:[di],dx
            Add  di,2
            Dec  cx
            Jnz  @Looper
           @Exit:
          End;
          Inc(cVal1, cStep1);
          Inc(xVal1, xStep1);
          Inc(xVal2, xStep2);
        End;

      xVal2 := xVal2 - xStep2;

      cVal1 := cMid Shl 8;
      xVal1 := xMid Shl 6;
      xStep1 := (xBot-xMid) Shl 6 Div (yBot-yMid+1);
      cStep1 := (cBot-cMid) Shl 8 Div (yBot-yMid+1);
      For Count := yMid to yBot do
        Begin
          Asm
            Mov  bx,Count
            Mov  dx,bx
            Shl  bx,6
            Add  bh,dl
            Mov  di,bx

            Mov  ax,Word Ptr [xVal1]
            Shr  ax,6
            Mov  cx,Word Ptr [xVal2]
            Shr  cx,6
            Add  di,ax

            Sub  cx,ax
            Inc  cx
            Js   @Exit
            Jcxz @Exit
            Mov  bx,dColor
            Mov  ax,cVal1
            Shr  cx,1
            Jnc @SkipSingle
            Mov  es:[di],ah
            Add  ax,bx
            Inc  di
           @SkipSingle:
            Jcxz @Exit
           @Looper:
            Mov  dl,ah
            Add  ax,bx
            Mov  dh,ah
            Add  ax,bx
            Mov  es:[di],dx
            Add  di,2
            Dec  cx
            Jnz  @Looper
           @Exit:
          End;
          Inc(cVal1, cStep1);
          Inc(xVal1, xStep1);
          Inc(xVal2, xStep2);
        End;
    End
    Else Begin
      DColor := (cMid-crMid) Shl 8 Div (xMid-xrMid+1);

      cVal1 := cTop Shl 8;
      xVal1 := (xTop) Shl 6;
      xVal2 := xVal1;
      xStep1 := (xBot-xTop) Shl 6 Div (yBot-yTop+1);
      cStep1 := (cBot-cTop) Shl 8 Div (yBot-yTop+1);
      xStep2 := (xMid-xTop) Shl 6 Div (yMid-yTop+1);

      For Count := yTop to yMid do
        Begin
          Asm
            Mov  bx,Count
            Mov  dx,bx
            Shl  bx,6
            Add  bh,dl
            Mov  di,bx

            Mov  ax,Word Ptr [xVal1]
            Shr  ax,6
            Mov  cx,Word Ptr [xVal2]
            Shr  cx,6
            Add  di,ax

            Sub  cx,ax
            Inc  cx
            Js   @Exit
            Jcxz @Exit
            Mov  bx,dColor
            Mov  ax,cVal1
            Shr  cx,1
            Jnc @SkipSingle
            Mov  es:[di],ah
            Add  ax,bx
            Inc  di
           @SkipSingle:
            Jcxz @Exit
           @Looper:
            Mov  dl,ah
            Add  ax,bx
            Mov  dh,ah
            Add  ax,bx
            Mov  es:[di],dx
            Add  di,2
            Dec  cx
            Jnz  @Looper
           @Exit:
          End;
          Inc(cVal1, cStep1);
          Inc(xVal1, xStep1);
          Inc(xVal2, xStep2);
        End;

      xVal1 := xVal1 - xStep1;
      cVal1 := cVal1 - cStep1;
      xVal2 := (xMid) Shl 6;
      xStep2 := (xBot-xMid) Shl 6 Div (yBot-yMid+1);
      For Count := yMid to yBot do
        Begin
          Asm
            Mov  bx,Count
            Mov  dx,bx
            Shl  bx,6
            Add  bh,dl
            Mov  di,bx

            Mov  ax,Word Ptr [xVal1]
            Shr  ax,6
            Mov  cx,Word Ptr [xVal2]
            Shr  cx,6

            Add  di,ax

            Sub  cx,ax
            Inc  cx
            Js   @Exit
            Jcxz @Exit
            Mov  bx,dColor
            Mov  ax,cVal1
            Shr  cx,1
            Jnc @SkipSingle
            Mov  es:[di],ah
            Add  ax,bx
            Inc  di
           @SkipSingle:
            Jcxz @Exit
           @Looper:
            Mov  dl,ah
            Add  ax,bx
            Mov  dh,ah
            Add  ax,bx
            Mov  es:[di],dx
            Add  di,2
            Dec  cx
            Jnz  @Looper
           @Exit:
          End;
          Inc(cVal1, cStep1);
          Inc(xVal1, xStep1);
          Inc(xVal2, xStep2);
        End;
    End;

End;

Procedure GouraudCpPoly(x1, y1, x2, y2, x3, y3, C1, C2, C3:integer ;PgSeg : word);

Type
  tFlatClip = Record
    x, y, x1, y1 : Integer;
    c, c1 : Integer;
  End;

Var
  FlatList : Array[0..7] of tFlatClip;
  NumVert : Integer;
  Count : Integer;
  ClipVert : Integer;
  V1, V2 : Integer;

Begin
  If (((X1 >= MinX) and (X1 <= MaxX)) and ((Y1 >= MinY) and (Y1 <= MaxY)) and
      ((X2 >= MinX) and (X2 <= MaxX)) and ((Y2 >= MinY) and (Y2 <= MaxY))) and
      ((X3 >= MinX) and (X3 <= MaxX)) and ((Y3 >= MinY) and (Y3 <= MaxY))
      Then Begin
        GouraudPoly(X1, Y1, X2, Y2, X3, Y3, C1, C2, C3, PgSeg);
        Exit;
      End;
  FlatList[0].x := X1;
  FlatList[0].y := Y1;
  FlatList[0].c := C1;
  FlatList[1].x := X2;
  FlatList[1].y := Y2;
  FlatList[1].c := C2;
  FlatList[2].x := X3;
  FlatList[2].y := Y3;
  FlatList[2].c := C3;
  NumVert := 3;
  ClipVert := 0;
  { Clip against left side }
  V1 := NumVert - 1;
  For Count := 0 to (NumVert-1) do
    Begin
      If (FlatList[V1].x >= MinX) and (FlatList[Count].x >= MinX)
        Then Begin
          FlatList[ClipVert].x1 := FlatList[Count].x;
          FlatList[ClipVert].y1 := FlatList[Count].y;
          FlatList[ClipVert].c1 := FlatList[Count].c;
          ClipVert := ClipVert + 1;
        End;
      If (FlatList[V1].x >= MinX) and (FlatList[Count].x < MinX)
        Then Begin
          FlatList[ClipVert].x1 := MinX;
          FlatList[ClipVert].y1 := (FlatList[Count].y-FlatList[V1].y)*(MinX-FlatList[v1].x)
                                    Div (FlatList[Count].x-FlatList[V1].x) + FlatList[V1].y;
          FlatList[ClipVert].c1 := (FlatList[Count].c-FlatList[V1].c)*(MinX-FlatList[v1].x)
                                    Div (FlatList[Count].x-FlatList[V1].x) + FlatList[V1].c;
          ClipVert := ClipVert + 1;
        End;
      If (FlatList[V1].x < MinX) and (FlatList[Count].x >= MinX)
        Then Begin
          FlatList[ClipVert].x1 := MinX;
          FlatList[ClipVert].y1 := (FlatList[Count].y-FlatList[V1].y)*(MinX-FlatList[V1].x)
                                    Div (FlatList[Count].x-FlatList[V1].x) + FlatList[v1].y;
          FlatList[ClipVert].c1 := (FlatList[Count].c-FlatList[V1].c)*(MinX-FlatList[V1].x)
                                    Div (FlatList[Count].x-FlatList[V1].x) + FlatList[v1].c;
          ClipVert := ClipVert + 1;
          FlatList[ClipVert].x1 := FlatList[Count].x;
          FlatList[ClipVert].y1 := FlatList[Count].y;
          FlatList[ClipVert].c1 := FlatList[Count].c;
          ClipVert := ClipVert + 1;
        End;
      V1 := Count;
    End;
  NumVert := ClipVert;
  ClipVert := 0;
  { Clip against Right side }
  V1 := NumVert - 1;
  For Count := 0 to (NumVert-1) do
    Begin
      If (FlatList[v1].x1 <= MaxX) and (FlatList[Count].x1 <= MaxX)
        Then Begin
          FlatList[ClipVert].x := FlatList[Count].x1;
          FlatList[ClipVert].y := FlatList[Count].y1;
          FlatList[ClipVert].c := FlatList[Count].c1;
          ClipVert := ClipVert + 1;
        End;
      If (FlatList[V1].x1 <= MaxX) and (FlatList[Count].x1 > MaxX)
        Then Begin
          FlatList[ClipVert].x := MaxX;
          FlatList[ClipVert].y := (FlatList[Count].y1-FlatList[V1].y1)*(MaxX-FlatList[v1].x1)
                                   Div (FlatList[Count].x1-FlatList[v1].x1) + FlatList[v1].y1;
          FlatList[ClipVert].c := (FlatList[Count].c1-FlatList[V1].c1)*(MaxX-FlatList[v1].x1)
                                   Div (FlatList[Count].x1-FlatList[v1].x1) + FlatList[v1].c1;
          ClipVert := ClipVert + 1;
        End;
      If (FlatList[v1].x1 > MaxX) and (FlatList[Count].x1 <= MaxX)
        Then Begin
          FlatList[ClipVert].x := MaxX;
          FlatList[ClipVert].y := (FlatList[Count].y1-FlatList[V1].y1)*(MaxX-FlatList[v1].x1)
                                   Div (FlatList[Count].x1-FlatList[v1].x1) + FlatList[v1].y1;
          FlatList[ClipVert].c := (FlatList[Count].c1-FlatList[V1].c1)*(MaxX-FlatList[v1].x1)
                                   Div (FlatList[Count].x1-FlatList[v1].x1) + FlatList[v1].c1;
          ClipVert := ClipVert + 1;
          FlatList[ClipVert].x := FlatList[Count].x1;
          FlatList[ClipVert].y := FlatList[Count].y1;
          FlatList[ClipVert].c := FlatList[Count].c1;
          ClipVert := ClipVert + 1;
        End;
      v1 := Count;
    End;
  NumVert := ClipVert;
  ClipVert := 0;
  { Clip against top edge }
  V1 := NumVert - 1;
  For Count := 0 to (NumVert-1) do
    Begin
      If (FlatList[V1].y >= MinY) and (FlatList[Count].y >= MinY)
        Then Begin
          FlatList[ClipVert].x1 := FlatList[Count].x;
          FlatList[ClipVert].y1 := FlatList[Count].y;
          FlatList[ClipVert].c1 := FlatList[Count].c;
          ClipVert := ClipVert + 1;
        End;
      If (FlatList[V1].y >= MinY) and (FlatList[Count].y < MinY)
        Then Begin
          FlatList[ClipVert].x1 := (MinY-FlatList[V1].y)*(FlatList[Count].x-FlatList[V1].x)
                                           Div (FlatList[Count].y-FlatList[V1].y) + FlatList[V1].x;
          FlatList[ClipVert].c1 := (MinY-FlatList[V1].y)*(FlatList[Count].c-FlatList[V1].c)
                                           Div (FlatList[Count].y-FlatList[V1].y) + FlatList[V1].c;
          FlatList[ClipVert].y1 := MinY;
          ClipVert := ClipVert + 1;
        End;
      If (FlatList[V1].y < MinY) and (FlatList[Count].y >= MinY)
        Then Begin
          FlatList[ClipVert].x1 := (MinY-FlatList[V1].y)*(FlatList[Count].x-FlatList[V1].x)
                                    Div (FlatList[Count].y-FlatList[V1].y) + FlatList[V1].x;
          FlatList[ClipVert].c1 := (MinY-FlatList[V1].y)*(FlatList[Count].c-FlatList[V1].c)
                                    Div (FlatList[Count].y-FlatList[V1].y) + FlatList[V1].c;
          FlatList[ClipVert].y1 := MinY;
          ClipVert := ClipVert + 1;
          FlatList[ClipVert].x1 := FlatList[Count].x;
          FlatList[ClipVert].y1 := FlatList[Count].y;
          FlatList[ClipVert].c1 := FlatList[Count].c;
          ClipVert := ClipVert + 1;
        End;
      V1 := Count;
    End;
  NumVert := ClipVert;
  ClipVert := 0;
  V1 := NumVert - 1;
  For Count := 0 to (NumVert-1) do
    Begin
      If (FlatList[V1].y1 <= MaxY) and (FlatList[Count].y1 <= MaxY)
        Then Begin
          FlatList[ClipVert].x := FlatList[Count].x1;
          FlatList[ClipVert].y := FlatList[Count].y1;
          FlatList[ClipVert].c := FlatList[Count].c1;
          ClipVert := ClipVert + 1;
        End;
      If (FlatList[V1].y1 <= MaxY) and (FlatList[Count].y1 > MaxY)
        Then Begin
          FlatList[ClipVert].x := (MaxY-FlatList[V1].y1)*(FlatList[Count].x1-FlatList[V1].x1)
                                    Div (FlatList[Count].y1-FlatList[v1].y1) + FlatList[V1].x1;
          FlatList[ClipVert].c := (MaxY-FlatList[V1].y1)*(FlatList[Count].c1-FlatList[V1].c1)
                                    Div (FlatList[Count].y1-FlatList[v1].y1) + FlatList[V1].c1;
          FlatList[ClipVert].y := MaxY;
          ClipVert := ClipVert + 1;
        End;
      If (FlatList[V1].y1 > MaxY) and (FlatList[Count].y1 <= MaxY)
        Then Begin
          FlatList[ClipVert].x := (MaxY-FlatList[V1].y1)*(FlatList[Count].x1-FlatList[V1].x1)
                                    Div (FlatList[Count].y1-FlatList[v1].y1) + FlatList[V1].x1;
          FlatList[ClipVert].c := (MaxY-FlatList[V1].y1)*(FlatList[Count].c1-FlatList[V1].c1)
                                    Div (FlatList[Count].y1-FlatList[v1].y1) + FlatList[V1].c1;
          FlatList[ClipVert].y := MaxY;
          ClipVert := ClipVert + 1;
          FlatList[ClipVert].x := FlatList[Count].x1;
          FlatList[ClipVert].y := FlatList[Count].y1;
          FlatList[ClipVert].c := FlatList[Count].c1;
          ClipVert := ClipVert + 1;
        End;
      V1 := Count;
    End;
  NumVert := ClipVert;

  V1 := 1;
  V2 := 2;

  { Now draw the polygons }
  For Count := 0 to (NumVert - 3) do
    Begin
      GouraudPoly(FlatList[0].x, FlatList[0].y,
                  FlatList[V1].x, FlatList[V1].y,
                  FlatList[V2].x, FlatList[V2].y,
                  FlatList[0].c, FlatList[V1].c,
                  FlatList[V2].c, PgSeg);
      V1 := V2;
      V2 := V2 + 1;
    End;
End;






















procedure Lpcx(fn:string;where:word);
var bo:boolean;

begin
  total:=1;
  infodat[1]:=fn;
  bo:=loadpcx(1,where,true);
end;

Procedure Cls32 (Where:word;Col : Byte); assembler;
   { This clears the screen to the specified color }
   { Modified by Ness / Accelerated 100% on VLB card, 60% on ISA}
asm
   push    es
   mov     cx, 16000;
   mov     es,[where]
   xor     di,di
   mov     al,[col]
   mov     ah,al
   mov     dx, ax
   db      $66, $C1, $E0, $10         {shl eax, 16}
   mov     ax, dx
   db      $F3, $66, $AB              {rep stosd}
   pop     es
End;


procedure flip32(source,dest:Word); assembler;
  { This copies the entire screen at "source" to destination }
  { Modified by Ness / Accelerated 100% on a VLB card, 60% on ISA}

asm
  push    ds
  jmp     @doit
@cont:
  mov     ax, [Dest]
  mov     es, ax
  mov     ax, [Source]
  mov     ds, ax
  db      $F3, $66, $A5      {rep movsd}
  pop     ds
  jmp     @out
@doit:
  xor     di, di
  xor     si, si
  mov     cx, 16000
  jmp     @cont
@out:
end;



procedure showletter(x,y,co:integer;ch:char;w:word);
var l1,l2,c:integer;
    q:byte;
    ad:word;
begin
  c := ord(ch);            { Get the char }
  ad := $fa6e + (c * 8);              { Calc address of character image in ROM }
  for l1 := 0 to 7 do
  begin
    q := mem[$f000 : ad + l1];       { Get a byte of the image }
    for l2 := 7 downto 0 do
    begin
      if odd(q) then        { Is bit 0 set? }
      begin
        putpixel(l2+x,l1+y,co,w);
      end;
      q := q shr 1;           { Shift the byte one pos to the right }
    end;
  end;
end;

procedure showmsg(x,y,co:integer;st:string;w:word);
var l1:integer;
begin
  for l1:=1 to length(st) do begin
     showletter((l1-1)*8+x,y,co,st[l1],w);
  end;
end;



procedure hline32(xb,xe,y:integer; c:byte; where:word); assembler;
asm
  mov bx,[xb]
  cmp bx,0              { if zero don't draw }
  jz @out
  mov cx,[xe]
  jcxz @out
  cmp bx,cx             { see if x-end is smaller than x-begin }
  jb @skip
  xchg bx,cx            { yes: switch coords }
 @skip:
  dec bx                { atatch planes }
  inc cx
  sub cx,bx             { length of line in cx }
  mov es,[where]        { segment to draw in }
  mov ax,[y]            { heigth of line }
  shl ax,6
  mov di,ax
  shl ax,2
  add di,ax             { y*320 in di (offset) }
  add di,bx             { add x-begin }
  mov al,[c]            { get color }
{ Modified - Start }
            mov   ah, al
            mov   dx, ax
            db    $66, $C1, $E0, $10         {shl eax, 16}
            mov   ax, dx

            mov   si, di
            mov   bx, cx

            shr   cx, 2
            db    $F3, $66, $AB              {rep stosd}

            mov   cx, bx
            and   cx, 3
            rep   stosb
{ Modified - End }
 @out:
end;

procedure palplay;
type c=record
      r,g,b:byte;
     end;
var
l1:integer;
pa:array[1..255] of c;
temp:c;

begin
  {store pallete to pa}
  for l1:=1 to 255 do
    getpal(l1,pa[l1].r,pa[l1].g,pa[l1].b);
    {Move all pallete one forward}
  temp:=pa[1];
  for l1:=1 to 64 do begin
   pa[l1].r:=pa[l1+1].r;
   pa[l1].g:=pa[l1+1].g;
   pa[l1].b:=pa[l1+1].b;
  end;
  pa[64]:=temp;
  {now put it back to the pallete}
  for l1:=1 to 255 do
      pal(l1,pa[l1].r,pa[l1].g,pa[l1].b);
end;


procedure hlines(w:word); {this fills screen with tv -black lines}
var c,y,dx2:word;

begin
  asm
  xor dx,dx
@loop:
  inc dx
  push dx
  shl dx,1
  mov y,dx
  shr dx,1 {bring it back. faster that push-pop}

  push dx
   mov c,0
   @vloop:
     mov  ax,w
     mov  es,ax
     mov  bx,[y]
     shl  bx,1
     mov  di,word ptr [Scr_Ofs + bx]
     add  di,c
     mov  al,0
     mov  es:[di],al
     inc c
   cmp c,319
   js @vloop

   pop dx
   cmp dx,99
   js @loop
   end;
end;

procedure vlines(w:word); {this fills screen with tv -black lines}
var c,y,dx2:word;

begin
  asm
  xor dx,dx
@loop:
  inc dx
  push dx
  shl dx,1
  mov y,dx
  shr dx,1 {bring it back. faster that push-pop}

  push dx
    mov c,0
 @vloop:
   mov  ax,w
   mov  es,ax
   mov  bx,c
   shl  bx,1
   mov  di,word ptr [Scr_Ofs + bx]
   add  di,y
   mov  al,0
   mov  es:[di],al
   inc c
   cmp c,200
   js @vloop

   pop dx
   cmp dx,160
   js @loop
   end;
end;


procedure flines(w:word); {this fills screen with tv -black lines}
var c,y,dx2:word;

begin
  asm
  xor dx,dx
@loop:
  inc dx
  push dx
  shl dx,1
  mov y,dx
  shr dx,1 {bring it back. faster that push-pop}

  push dx
    mov c,0
 @vloop:
   mov  ax,w
   mov  es,ax
   mov  bx,c
   shl  bx,1
   mov  di,word ptr [Scr_Ofs + bx]
   add  di,y

   sub di,320
   mov  al,es:[di]
   add  al,128
   mov  es:[di],al
   add di,320


   inc c
   cmp c,200
   js @vloop

   pop dx
   cmp dx,160
   js @loop
   end;
end;

procedure fcasm(x,y,r:word;c:byte;w:word);
var a,d,r2:word;
   l1,l2:word;
begin
  asm
    mov  l1,0
    mov l2,0
    @loop1:
       mov l1,0
    @loop2:
      {d:=(l1-x)*(l1-x) +(l2-y)*(l2-y);}
      mov ax,l1
      sub ax,x
      mul ax
      mov a,ax

      mov ax,l2
      sub ax,y
      mul ax
      add ax,a
      mov d,ax

      mov ax,r
      mul ax
      mov r2,ax {r^2}

      mov ax,r2
      sub ax,r
      cmp ax,d
      js @no

      {     (r2-r<d)}

{      mov ax,r2
      add ax,r
      cmp ax,d
      js @no}
      {(d<r2+r)}
        mov  ax,w
        mov  es,ax
        mov  bx,[l2]
        shl  bx,1
        mov  di,word ptr [Scr_Ofs + bx]
        add  di,[l1]
        mov  al,[c]
        mov  es:[di],al
   @no: add l1,1
    cmp l1,320
    js @loop2
    add l2,1
    cmp l2,199
    js  @loop1
end;
end;


procedure FoDown;
var l1:integer;
    r,g,b:byte;

begin
  for l1:=1 to 255 do begin
     getpal(l1,r,g,b);
     if r>0 then r:=r-1;
     if g>0 then g:=g-1;
     if b>0 then b:=b-1;
     pal(l1,r,g,b);
  end;
end;


procedure fadein(w:word);
var l1,l2:word;
    c1,c2,c3,c4,co:byte;
begin
  asm
     mov l1,0
     @loop1:

      mov     ax,[w]
      mov     es,ax
      mov     di,[l1]

      inc di
      mov     al, es:[di]
      mov c1,al

      mov di,[l1]
      add di,319
      mov     al, es:[di]
      mov c2,al

      mov di,[l1]
      sub di,319
      mov     al, es:[di]
      mov c3,al

      mov di,[l1]
      dec di
      mov     al, es:[di]
      mov c4,al

     xor ax,ax
     mov al,c1

     xor bx,bx
     mov bl,c2
     add ax,bx

     xor bx,bx
     mov bl,c3
     add ax,bx

     xor bx,bx
     mov bl,c4
     add ax,bx

     shr ax,2

     mov co,al
{  co:=(c1+c2+c3+c4)shr 2;}

    mov     ax,w
    mov     es,ax
    mov     di,l1
    mov     al, [Co]
  stosb

  inc l1
  cmp l1,64000
 ja @out
 jmp @loop1
 @out:
end;
end;


Procedure NewTex(X1,Y1,U1,V1,X2,Y2,U2,V2,X3,Y3,U3,V3:Integer;Texture:Pointer;w:word);
{The actual texture-map routine. Only a little commented :-}
Var TexOfs                                       : Array [0..320] Of Word;
    SO,Long                                      : Word;
    XL,UL,VL,XR,UR,VR                            : Array [0..200] Of LongInt;
    DY21,DY31,DY32,DX21,DX31,DX32,DU21,DU31,DU32 : LongInt;
    DV21,DV31,DV32,U,V,I,J,K                     : LongInt;
Begin

  {Sort for increasing y-coordinates}
  For I:=1 To 2 Do Begin
    If Y3<Y2 Then Begin
      J:=Y3; Y3:=Y2; Y2:=J; J:=X3; X3:=X2; X2:=J;
      J:=U3; U3:=U2; U2:=J; J:=V3; V3:=V2; V2:=J; End;
    If Y2<Y1 Then Begin
      J:=Y1; Y1:=Y2; Y2:=J; J:=X1; X1:=X2; X2:=J;
      J:=U1; U1:=U2; U2:=J; J:=V1; V1:=V2; V2:=J; End;
    If Y3<Y1 Then Begin
      J:=Y1; Y1:=Y3; Y3:=J; J:=X1; X1:=X3; X3:=J;
      J:=U1; U1:=U3; U3:=J; J:=V1; V1:=V3; V3:=J End
  End;

  {Exception occurs when there are two top y-coords with the same value}
  If (Y1=Y2) And (X1>X2) Then Begin
    J:=X1; X1:=X2; X2:=J; J:=U1; U1:=U2; U2:=J; J:=V1; V1:=V2; V2:=J End;

  {Calculate X,U and V along the edges and store these}
DY21:=Y2-Y1; DY31:=Y3-Y1; DY32:=Y3-Y2; DX21:=X2-X1; DX31:=X3-X1; DX32:=X3-X2;
DU21:=U2-U1; DU31:=U3-U1; DU32:=U3-U2; DV21:=V2-V1; DV31:=V3-V1; DV32:=V3-V2;
  XL[0]:=X1; XL[0]:=XL[0]*256; UL[0]:=U1;
  UL[0]:=UL[0]*256; VL[0]:=V1; VL[0]:=VL[0]*256;
  If Y1=Y2 Then Begin
    XR[0]:=X2; XR[0]:=XR[0]*256; UR[0]:=U2; UR[0]:=UR[0]*256;
    VR[0]:=V2; VR[0]:=VR[0]*256 End Else Begin
    XR[0]:=XL[0]; UR[0]:=UL[0]; VR[0]:=VL[0]; End;
  For I:=Y1+1 To Y2 Do Begin
    XL[I-Y1]:=XL[I-Y1-1]+(DX31*256) Div DY31;
    XR[I-Y1]:=XR[I-Y1-1]+(DX21*256) Div DY21;
    UL[I-Y1]:=UL[I-Y1-1]+(DU31*256) Div DY31;
    UR[I-Y1]:=UR[I-Y1-1]+(DU21*256) Div DY21;
    VL[I-Y1]:=VL[I-Y1-1]+(DV31*256) Div DY31;
    VR[I-Y1]:=VR[I-Y1-1]+(DV21*256) Div DY21;
  End;
  For I:=Y2+1 To Y3 Do Begin
    XL[I-Y1]:=XL[I-Y1-1]+(DX31*256) Div DY31;
    XR[I-Y1]:=XR[I-Y1-1]+(DX32*256) Div DY32;
    UL[I-Y1]:=UL[I-Y1-1]+(DU31*256) Div DY31;
    UR[I-Y1]:=UR[I-Y1-1]+(DU32*256) Div DY32;
    VL[I-Y1]:=VL[I-Y1-1]+(DV31*256) Div DY31;
    VR[I-Y1]:=VR[I-Y1-1]+(DV32*256) Div DY32;
  End;

  {Calculate texture-offsets for longest horizontal line (at Y=Y2)}
  Long:=Y2-Y1;
  If XL[Long]<XR[Long] Then Begin
    U:=UL[Long]; V:=VL[Long]; SO:=256*(V Shr 8)+(U Shr 8);
    For I:=0 To XR[Long] Shr 8-XL[Long] Shr 8 Do Begin
      TexOfs[I]:=256*(V Shr 8)+(U Shr 8)-SO;
      U:=U+((UR[Long]-UL[Long])*256) Div (XR[Long]-XL[Long]+1);
      V:=V+((VR[Long]-VL[Long])*256) Div (XR[Long]-XL[Long]+1);
    End;
  End Else Begin
    U:=UR[Long]; V:=VR[Long]; SO:=256*(V Shr 8)+(U Shr 8);
    For I:=0 To XL[Long] Shr 8-XR[Long] Shr 8 Do Begin
      TexOfs[I]:=256*(V Shr 8)+(U Shr 8)-SO;
      U:=U+((UL[Long]-UR[Long])*256) Div (XL[Long]-XR[Long]+1);
      V:=V+((VL[Long]-VR[Long])*256) Div (XL[Long]-XR[Long]+1);
    End;
  End;

  {Fill polygon (=Read back X,U and V-coordinates from buffer) }
  If XL[Long]<XR[Long] Then
    For I:=0 To Y3-Y1 Do Begin
      SO:=256*(VL[I] Shr 8)+(UL[I] Shr 8);
      For J:=XL[I] Shr 8 To XR[I] Shr 8 Do
        Mem[w:320*(I+Y1)+J]:=Mem[Seg(Texture^):Ofs(Texture^)+SO+
                                      TexOfs[J-XL[I] Shr 8]]
    End
  Else
    For I:=0 To Y3-Y1 Do Begin
      SO:=256*(VR[I] Shr 8)+(UR[I] Shr 8);
      For J:=XR[I] Shr 8 To XL[I] Shr 8 Do
        Mem[w:320*(I+Y1)+J]:=Mem[Seg(Texture^):Ofs(Texture^)+SO+
                                      TexOfs[J-XR[I] Shr 8]]
    End;
End;{NewTex}

procedure fedges(c,f,t:word);
var l1:word;
    c1,c2,c3,c4,c5:byte;
    b1,b2:boolean; {Patenta}
begin
  b1:=false;
  b2:=false;

  for l1:=400 to 63600 do begin
    c1:=mem[f:l1+1];
    c2:=mem[f:l1-1];
    c3:=mem[f:l1+320];
    c4:=mem[f:l1-320];
      c1:=abs(c1-c2)+abs(c3-c4);
      if c1>c then begin
         mem[t:l1]:=255;
      end;

{      if b2=true then mem[vga:l1-2]:=255;}
    end;
 end;

Procedure Noise4(Where:Word);
Var o:word;
    Seq:integer;
    Fx:integer;
    c:byte;
    c1,curp:byte;
Begin
Fx:=0;
 For o:=0 to 15999 do
  Begin
   Inc(Fx);
   If Fx=319 Then Fx:=0;
   If Fx=0 Then Seq:=Random(5);     {<-----------}

   If (Random(Seq)=1) then
    Begin
     Mem[Where:o]:=Mem[Where:o]+10;
     Mem[Where:o+15999]:=Mem[Where:o+15999]+10;
     Mem[Where:o+31999]:=Mem[Where:o+31999]+10;
     Mem[Where:o+47999]:=Mem[Where:o+47999]+10
    End;
  End;
End;



(* This routine was "borrowed" from Demostu3.zip ;) *)
Function IntSqrt(Const L : LongInt) : Word;assembler;
Asm
	Db $66; mov ax,WORD PTR [l]
	Db $66; mov bx,ax
	Db $66; mov cx, $0000; DW $4000;
	Db $66; mov dx,cx
	Db $66; add dx,ax
	Db $66; shr ax,1
	Db $66; cmp dx,bx
	ja @over1
	Db $66; sub bx,dx
	Db $66; or ax,cx
@over1:	Db $66; shr cx,2
	Db $66; mov dx,cx
	Db $66; add dx,ax
	Db $66; shr ax,1
	Db $66; cmp dx,bx
	ja @over2
	Db $66; sub bx,dx
	Db $66; or ax,cx
@over2: Db $66; shr cx,2
	Db $66; mov dx,cx
	Db $66; add dx,ax
	Db $66; shr ax,1
	Db $66; cmp dx,bx
	ja @over3
	Db $66; sub bx,dx
	Db $66; or ax,cx
@over3:	Db $66; shr cx,2
	Db $66; mov dx,cx
	Db $66; add dx,ax
	Db $66; shr ax,1
	Db $66; cmp dx,bx
	ja @over4
	Db $66; sub bx,dx
	Db $66; or ax,cx
@over4:	Db $66; shr cx,2
	Db $66; mov dx,cx
	Db $66; add dx,ax
	Db $66; shr ax,1
	Db $66; cmp dx,bx
	ja @over5
	Db $66; sub bx,dx
	Db $66; or ax,cx
@over5:	Db $66; shr cx,2
	Db $66; mov dx,cx
	Db $66; add dx,ax
	Db $66; shr ax,1
	Db $66; cmp dx,bx
	ja @over6
	Db $66; sub bx,dx
	Db $66; or ax,cx
@over6:	Db $66; shr cx,2
	Db $66; mov dx,cx
	Db $66; add dx,ax
	Db $66; shr ax,1
	Db $66; cmp dx,bx
	ja @over7
	Db $66; sub bx,dx
	Db $66; or ax,cx
@over7:	Db $66; shr cx,2
	Db $66; mov dx,cx
	Db $66; add dx,ax
	Db $66; shr ax,1
	Db $66; cmp dx,bx
	ja @over8
	Db $66; sub bx,dx
	Db $66; or ax,cx
@over8:	Db $66; shr cx,2
	Db $66; mov dx,cx
	Db $66; add dx,ax
	Db $66; shr ax,1
	Db $66; cmp dx,bx
	ja @over9
	Db $66; sub bx,dx
	Db $66; or ax,cx
@over9:	Db $66; shr cx,2
	Db $66; mov dx,cx
	Db $66; add dx,ax
	Db $66; shr ax,1
	Db $66; cmp dx,bx
	ja @over10
	Db $66; sub bx,dx
	Db $66; or ax,cx
@over10:
	Db $66; shr cx,2
	Db $66; mov dx,cx
	Db $66; add dx,ax
	Db $66; shr ax,1
	Db $66; cmp dx,bx
	ja @over11
	Db $66; sub bx,dx
	Db $66; or ax,cx
@over11:
	Db $66; shr cx,2
	Db $66; mov dx,cx
	Db $66; add dx,ax
	Db $66; shr ax,1
	Db $66; cmp dx,bx
	ja @over12
	Db $66; sub bx,dx
	Db $66; or ax,cx
@over12:
	Db $66; shr cx,2
	Db $66; mov dx,cx
	Db $66; add dx,ax
	Db $66; shr ax,1
	Db $66; cmp dx,bx
	ja @over13
	Db $66; sub bx,dx
	Db $66; or ax,cx
@over13:
	Db $66; shr cx,2
	Db $66; mov dx,cx
	Db $66; add dx,ax
	Db $66; shr ax,1
	Db $66; cmp dx,bx
	ja @over14
	Db $66; sub bx,dx
	Db $66; or ax,cx
@over14:
	Db $66; shr cx,2
	Db $66; mov dx,cx
	Db $66; add dx,ax
	Db $66; shr ax,1
	Db $66; cmp dx,bx
	ja @over15
	Db $66; sub bx,dx
	Db $66; or ax,cx
@over15:
	Db $66; shr cx,2
	Db $66; mov dx,cx
	Db $66; add dx,ax
	Db $66; shr ax,1
	Db $66; cmp dx,bx
	ja @over16
	Db $66; sub bx,dx
	Db $66; or ax,cx
@over16:
End;

procedure savepal(s:string);
var f:text;
    l1,l2:integer;
    r,g,b:byte;

begin
  assign(f,s);
  rewrite(f);
  for l1:=1 to 255 do begin
    getpal(l1,r,g,b);
    writeln(f,'Pal(',l1,',',r,',',g,',',b,');');
  end;
  close(f);
end;


procedure tlineasm(minx,maxx,y,minu,maxu,v,from,too:word);
var l1,l2,len:integer;
    step,rx:word;
    x,vx:word;
    vc:byte;
begin
  len:=abs(maxx-minx);
  if len>0 then step:=((maxu-minu)shl 7) div len
  else exit;
  rx:=minu shl 7;
{  if step=0 then step:=1 shl 7; hahah this is not mathimatically correct}
  {but fuck it!}
{  for l1:=minx to maxx do begin}
  asm
   mov ax,minx
   mov l1,ax
  @loopl1:
   mov ax,rx
   add ax,step
   mov rx,ax
   shr ax,7
   mov x,ax

   mov  ax,from
   mov  es,ax
   mov  bx,[v]
   shl  bx,1
   mov  di,word ptr [Scr_Ofs + bx]
   add  di,[x]
   mov  al,es:[di]
   mov  vc,al

   mov  ax,too
   mov  es,ax
   mov  bx,[y]
   shl  bx,1
   mov  di,word ptr [Scr_Ofs + bx]
   add  di,[l1]
   mov  al,[vc]
   mov  es:[di],al
   inc l1
   mov ax,maxx
   cmp l1,ax
   js @loopl1

end;

{  end;}
end;







Procedure DP(x1,y1,x2,y2,x3,y3,x4,y4,
                   u1,v1,u2,v2,u3,v3,u4,v4:integer;
                   from,too:word);
  { This draw a polygon with 4 points at x1,y1 , x2,y2 , x3,y3 , x4,y4
    in color col }
var miny,maxy:integer;
    minv,maxv,v,vinc:integer;
    l1:integer;


Procedure doside (x1,y1,x2,y2:integer);
  { This scans the side of a polygon and updates the poly variable }
VAR temp:integer;
    x,xinc:integer;
    loop1:integer;
BEGIN
  if y1=y2 then exit;
  if y2<y1 then BEGIN
    temp:=y2;
    y2:=y1;
    y1:=temp;
    temp:=x2;
    x2:=x1;
    x1:=temp;
  END;
  xinc:=((x2-x1) shl 7) div (y2-y1);
  x:=x1 shl 7;
  for loop1:=y1 to y2 do BEGIN
    if (loop1>(1)) and (loop1<(199)) then BEGIN
      if (x shr 7<poly[loop1,1]) then poly[loop1,1]:=x shr 7;
      if (x shr 7>poly[loop1,2]) then poly[loop1,2]:=x shr 7;
    END;
    x:=x+xinc;
  END;
END;

Procedure dotside (x1,y1,x2,y2:integer);
  { This scans the side of a polygon and updates the poly variable }
VAR temp:integer;
    x,xinc:integer;

    loop1:integer;

BEGIN
  if y1=y2 then exit;
  if y2<y1 then BEGIN
    temp:=y2;
    y2:=y1;
    y1:=temp;
    temp:=x2;
    x2:=x1;
    x1:=temp;
  END;
  xinc:=((x2-x1) shl 7) div (y2-y1);
  x:=x1 shl 7;
  for loop1:=y1 to y2 do BEGIN
    if (loop1>(1)) and (loop1<(199)) then BEGIN
      if (x shr 7<uvpoly[loop1,1]) then uvpoly[loop1,1]:=x shr 7;
      if (x shr 7>uvpoly[loop1,2]) then uvpoly[loop1,2]:=x shr 7;
    END;
    x:=x+xinc;
  END;
END;


begin
{  asm
    mov   si,offset poly
    mov   cx,199
@Loop1:
    mov   ax,32766
    mov   ds:[si],ax
    inc   si
    inc   si
    mov   ax,-32767
    mov   ds:[si],ax
    inc   si
    inc   si
    loop  @loop1
  end;     { Setting the minx and maxx values to extremes }
  for l1:=1 to 199 do begin
    poly[l1,1]:=32766;
    poly[l1,2]:=-32767;
    uvpoly[l1,1]:=32766;
    uvpoly[l1,2]:=-32767;
  end;

  miny:=y1;
  maxy:=y1;

  minv:=v1;
  maxv:=v1;

  if y2<miny then miny:=y2;
  if y3<miny then miny:=y3;
  if y4<miny then miny:=y4;
  if y2>maxy then maxy:=y2;
  if y3>maxy then maxy:=y3;
  if y4>maxy then maxy:=y4;

  if v2<minv then minv:=v2;
  if v3<minv then minv:=v3;
  if v4<minv then minv:=v4;

  if v2>maxv then maxv:=v2;
  if v3>maxv then maxv:=v3;
  if v4>maxv then maxv:=v4;


  if miny<1 then miny:=1;
  if maxy>199 then maxy:=199;
  if (miny>199) or (maxy<0) then exit;

  Doside (x1,y1,x2,y2);
  Doside (x2,y2,x3,y3);
  Doside (x3,y3,x4,y4);
  Doside (x4,y4,x1,y1);

  Dotside (u1,v1,u2,v2);
  Dotside (u2,v2,u3,v3);
  Dotside (u3,v3,u4,v4);
  Dotside (u4,v4,u1,v1);

  vinc:=((maxv-minv) shl 7) div (maxy-miny);
  v:=minv shl 7;
  for l1:= miny to maxy do begin
    v:=v+vinc;

    tlineasm(poly[l1,1],poly[l1,2],l1,uvpoly[l1,1],uvpoly[l1,2],v shr 7,from,too);
    {this V has to change to do correct tmap}
{    hline32 (poly[l1,1],poly[l1,2],l1,color,where);}
  end;
end;


PROCEDURE CLOCKON;
BEGIN
  GETTIME(H,M,S,S100);
  STARTCLOCK:=(H*3600)+(M*60)+S +(S100/100);
END;

PROCEDURE CLOCKOFF;
BEGIN
  GETTIME(H,M,S,S100);
  STOPCLOCK:=(H*3600)+(M*60)+S +(S100/100);
  TIME:=STOPCLOCK-STARTCLOCK
END;

VAR Loop1:word;

procedure resett1;
begin
  s1:=ticks;
end;

function t1:integer;
begin
  t1:=ticks-s1;
end;

BEGIN
  For Loop1 := 0 to 199 do
    Scr_Ofs[Loop1] := word(Loop1 * 320);
END.
