Unit VgaUtil;

Interface

{$G+,R-}

Uses Crt;

{-$DEFINE CLIPADDPUT}

Const
  Long = $66;
  display1 : word = $0000;
  display2 : word = $4000;

  { Vga card 64k bank select }
  BankOfs : Array[0..3] of Word = (0, $4000, $8000, $A000);
  BankNum : Array[0..3] of Byte = (0, 1, 2, 3);

  Width = 80;
  Numsins = 255;
  HiNumsins = Numsins shl 6;
  Pi = 3.1415;
  MovPut = 0;
  AddPut = 1;
  SubPut = 2;
  AndPut = 3;
  OrPut  = 4;
  XorPut = 5;
  TPut = 6;

Type AnyString = String[127];
     RGB = Record
       r, g, b : Byte;
     End;
     PaletteType = Array[0..255] of RGB;
     P2dType = Record
                 x, y : Integer;
               End;
     P3dType = Record
                 x, y, z : Integer;
               End;
     P2dArray = Array[0..255] of P2dType;
     P3dArray = Array[0..255] of P3dType;

Var
  SinTable,CosTable: Array[0..Numsins] of integer;
  Sin2Table,Cos2Table: Array[0..Numsins] of integer;
  PageOffset : Word;
  OldScreenMode, CurPage : Byte;
  VLU : array[0..199] of word;
  OldExitProc : pointer;
  Pal : PaletteType;

{ For procedure comments you will have to hunt around, sorry... }

Procedure CalcSine;
Procedure CalcVLU;
Procedure SetGraphicsMode(Mode : Byte);
Procedure RefreshWait;
Procedure SetSingleColor(Var TPal : PaletteType; Col, R, G, B : Byte);
Procedure SetRGB(ColNum, R, G, B : Byte);
Procedure SetSPalette(Palette : PaletteType);
Procedure Fadepals(Startpal, Endpal : Palettetype; Steps : Integer);
Procedure Fadepalsstep(Startpal, Endpal : Palettetype; TotalSteps, CurStep : Integer);
Procedure GraphCLS;
Procedure VgaGetPic(x1, y1, x2, y2 : Integer; DestPtr : Pointer);
Procedure OldVgaPutPic(Mode : Byte; x1, y1: Integer; SrcPtr, DestPtr
 : Pointer);

Procedure VGAClipPic(Mode : Byte; X1, Y1, XClip, YClip : Integer;
 SrcPtr, DestPtr : Pointer);
Procedure VGAPutPic(Mode : Byte; X1, Y1 : Integer; SrcPtr, DestPtr :
 Pointer);
Procedure RestoreBackground(X1, Y1, XSize, YSize : Integer; SrcPtr,
 DestPtr : Pointer);
Procedure RestoreBackgroundVertical(Y1, Y2 : Integer; SrcPtr,
 DestPtr : Pointer);
Procedure LoadPcx(FileName : AnyString; Var TPal : PaletteType; Orig
 : Pointer);
Procedure LoadPcxPalette(FileName : AnyString; Var TPal :
 PaletteType);
Procedure ClearPage(P : Pointer);
Procedure CopyPage(P : Pointer);
Procedure CopyPageOffset(P : Pointer; POffset : Word);
Procedure Copy2Pages(SrcP, DestP : Pointer);
Procedure SetStart(p:word);
Procedure SetBank(bank:byte);
Procedure Vgaline(const x1,y1,x2,y2,where:word;const c:byte);

function LongDiv(x : longint; y : integer) : integer;
inline($59/$58/$5A/$F7/$F9);
function LongMul(x, y : integer) : longint;
inline($5A/$58/$F7/$EA);
procedure SetBitplanes(planes : byte);
inline(
       $BA/$C4/$03/    {mov    dx,$3C4}
       $58/                            {pop    ax}
       $88/$C4/                        {mov    ah,al}
       $B0/$02/                        {mov    al,$02}
       $EF);                           {out    dx,ax}

Implementation

procedure CLI; inline($FA);
procedure STI; inline($FB);

Procedure CalcSine;                   {Creates sin/cos tables}
Var direction:integer;
    angle:real;
begin
     For Direction:=0 to Numsins do begin   {use 256 degrees in
 circle}
         angle:=Direction;
         angle:=angle*3.14159265/128;
         SinTable[Direction]:=round(Sin(angle)*256);
         CosTable[Direction]:=round(Cos(angle)*256);

 Sin2Table[Direction]:=round(Sin(angle+3.14159265/2)*256*1.2);

 Cos2Table[Direction]:=round(Cos(angle+3.14159265/2)*256*1.2);
     end;                 { the 1.2 accounts for pixel aspect ratio }
end;

{ Makes an array that speeds up pixel offset calculations }
{ Use like this...
  Mov bx, (Y value here)
  Shl bx, 1
  Mov di, Word Ptr Vlu[bx]
  Add di, (X value here)

  DI now holds proper offset.


>> CONTINUED IN NEXT MESSAGE <<
================================================================================
 Area:    PASCAL
 Date:    24 Jul 96  21:11:56  Public
 From:    Ryan Stowers
 To:      All
 Subject: HERE IT IS FINALLY!!!!!!!!!!                             [2]
ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
>> CONTINUED FROM PREVIOUS MESSAGE <<


  VERY fast!!!
}

Procedure CalcVlu;

  Var
    A : Integer;

  Begin
    For a := 0 to 199 do
      Vlu[A] := A * 320;
  End;

{ Works for any graphics mode }
Procedure SetGraphicsMode(Mode : Byte); Assembler;

  asm
    Mov al, Mode
    Xor ah, ah
    Int 10H
  end;

{ One of Bjarke's routines }

{$F+}
procedure ScreenExitProc;
{$F-}
begin
  ExitProc := OldExitProc;
  If (ExitCode <> 0) then
    Begin
      SetGraphicsMode($03); {if runtime error, restore screen}
      Writeln('Mega screw up error #',ExitCode);
    End;
end;

{ Wait for vertical retrace }
Procedure RefreshWait; Assembler;

  Asm
    Mov  dx,$3da
   @Looper:
    In   al,dx
    And  al,8
    Jz  @Looper
  End;

Procedure SetSingleColor(Var TPal : PaletteType; Col, R, G, B :
 Byte);

  Begin
    Pal[Col].r := R;
    Pal[Col].g := G;
    Pal[Col].b := B;
  End;

{ One of Bjarke's routines.  Very useful. }
Procedure SetRGB(ColNum, R, G, B : Byte); assembler;

  Asm
    Mov  dx, $3c8
    Mov  al, ColNum
    Out  dx, al
    Inc  dx

    Mov  al, R
    Out  dx, al
    Mov  al, G
    Out  dx, al
    Mov  al, B
    Out  dx, al
  End;

{ One of Bjarke's routines, but i modified it to use a static array
 insted
  of a pointer.  }
Procedure SetSPalette(Palette : PaletteType);

Var
  Count : Integer;

Begin
  Asm
    Mov  dx,$3c8
    Xor  al,al
    Out  dx,al
    Inc  dx
    Mov  si,0
    Mov  cx,768

    @Looper:
      Mov  al,Byte Ptr [Palette+si]
      Out  dx,al
      Inc  si
      Dec  cx
      Jnz @Looper
  End;

End;
Procedure Fadepals(Startpal, Endpal : Palettetype; Steps : Integer);

  Var
    Temppal : PaletteType;
    MCount, PCount : Integer;

  Begin
    For MCount := Steps downto 0 do
      Begin
        For PCount := 0 to 255 do
          Begin
            Temppal[PCount].r := ((startpal[PCount].r * MCount) div
 Steps)+
                                 ((endpal[PCount].r *
 (Steps-MCount)) div Steps);
            Temppal[PCount].g := ((startpal[PCount].g * MCount) div
 Steps)+
                                 ((endpal[PCount].g *
 (Steps-MCount)) div Steps);
            Temppal[PCount].b := ((startpal[PCount].b * MCount) div
 Steps)+
                                 ((endpal[PCount].b *
 (Steps-MCount)) div Steps);
          End;
        SetSpalette(Temppal);
        RefreshWait;
      end;
    SetSPalette(Endpal);
  End;

Procedure Fadepalsstep(Startpal, Endpal : Palettetype; TotalSteps,
 CurStep : Integer);

  Var
    Temppal : PaletteType;
    PCount : Integer;

  Begin
    For PCount := 0 to 255 do
      Begin
        SetRGB(PCount,
               ((startpal[PCount].r * CurStep) div TotalSteps)+
               ((endpal[PCount].r * (TotalSteps-CurStep)) div
 TotalSteps),
               ((startpal[PCount].g * CurStep) div TotalSteps)+
               ((endpal[PCount].g * (TotalSteps-CurStep)) div
 TotalSteps),
               ((startpal[PCount].b * CurStep) div TotalSteps)+
               ((endpal[PCount].b * (TotalSteps-CurStep)) div
 TotalSteps));
      End;
  End;

{ Ummm..... What does this procedure do... }
Procedure GraphCLS;

  Begin
    Fillchar(Mem[Sega000:0], 64000, 0);
  End;

{ Just like GET in BASIC for grabbing screen images, but you dont
 need a
{ static array like in BASIC. Just use a pointer }
{ NOT optimized, but works. Just make sure you used GETMEM with
 DestPtr.}
{ x1,y1,x2,y2 = Coordinates of the screen you want to get }

Procedure VgaGetPic(x1, y1, x2, y2 : Integer; DestPtr : Pointer);

Var
  VCount, HCount, DestSeg, DestOfs, CurOfs, W, H :Integer;

Begin
  DestSeg := Seg(DestPtr^);
  DestOfs := Ofs(DestPtr^);
  W := (x2 - x1);
  H := (y2 - y1);

  CurOfs := 0;
  MemW[DestSeg:DestOfs + CurOfs] := W;
  Inc(CurOfs,2);
  MemW[DestSeg:DestOfs + CurOfs] := H;
  Inc(CurOfs,2);

  For VCount := y1 to y2 do
    Begin
      For HCount := x1 to x2 do
        Begin
          Mem[DestSeg:DestOfs + CurOfs] := Mem[$a000:HCount + VCount
 * 320];
          Inc(CurOfs);
        End;
    End;
End;

{ Just like PUT in BASIC for putting images on the screen.  Im
 pretty sure
  this one does all the clipping you need, but its older and slower
 than
  the newer one (look below)
  Mode = Use one of the constants for MOV, ADD, SUB, etc, etc
  x1,y1 = coordinates
  SrcPtr = source bitmap
  DestPtr = destination bitmap can be either direct video or a
 virtual page
}

Procedure OldVgaPutPic(Mode : Byte; x1, y1: Integer; SrcPtr, DestPtr
 : Pointer);

Var DestSeg, Bytes, WordsLeft, BytesLeft : Word;
    DestStartx, DestStarty, XWriteLen, YWriteLen, SrcOfs : Integer;
    PicW, PicH, DestStartYOfs, StartYOfs, DestXerror, Xerror, Tilt :
 Integer;

Begin
  PicW := MemW[Seg(SrcPtr^):Ofs(SrcPtr^) + 0] + 1;
  PicH := MemW[Seg(SrcPtr^):Ofs(SrcPtr^) + 2] + 1;
  If X1 > 319 then exit;
  If Y1 > 199 then Exit;
  If X1 < -PicW then exit;
  If Y1 < -PicH then exit;
  SrcOfs := Ofs(SrcPtr^);

  Asm
    Mov Tilt, 0

    Mov ax, 16
    Sub ax, PicW
    Mov Xerror, 0        { Xerror := (16 - PicW)}
    Mov ax, X1           { DestStartX := X1 }
    Mov DestStartx, ax

    Mov ax, Y1           { DestStarty := Y1 }
    Mov DestStartY, ax

    Mov ax, PicW         { XWriteLen := PicW }
    Mov XWriteLen, ax

    Mov ax, PicH         { YWriteLen := PicH }
    Mov YWriteLen, ax

    Mov StartYOfs, 4

    Cmp Y1, 0            { If Y1 < 0 then }
    Jg @SkipY11
      Mov ax, PicH
      Add ax, Y1
      Mov YWriteLen, ax

      Mov DestStartY, 0  { DestStartY := 0 }

      Mov ax, Y1         { StartYOfs := StartYOfs + Abs(y1) * PicW }
      Not ax
      Add ax, 1
      Mul PicW
      Add StartYOfs, ax
    @SkipY11:
  Mov ax, Y1             { If (Y1 + YWriteLen) > 199 then }
  Add ax, YWriteLen
  Cmp ax, 199
  Jl @SkipY12
    Mov ax, 200          { YWriteLen := 200 - Y1 }
    Sub ax, Y1
    Mov YWriteLen, ax
  @SkipY12:

  Cmp X1, 0              { If X < 0 then }
  Jg @SkipX11
    Mov ax, X1           { Xerror := Abs(X1) }
    Not ax
    add ax, 1
    Mov Xerror, ax

    Mov ax, X1           { XWriteLen := XWriteLen + X1 }
    Add XWriteLen, ax

    Mov ax, Xerror       { StartYofs := StartYOfs + Xerror }
    Add StartYOfs, ax

    Mov DestStartX, 0    { DestStartX := 0 }
  @SkipX11:

  Mov ax, X1             { If (X1 + XWriteLen) > 319 then }
  Add ax, XWriteLen
  Cmp ax, 319
  Jl @SkipX12
    Mov ax, 320          { XWriteLen := 320 - X1 }
    Sub ax, X1
    Mov XWriteLen, ax

    Mov ax, 320          { Xerror := X1 - (320 - PicW) }
    Sub ax, PicW
    Mov bx, X1
    Sub bx, ax
    Mov Xerror, bx
  @SkipX12:

  Cmp XWriteLen, 0
  Jg @Oops1
    Mov Tilt, 1
  @Oops1:
  Cmp YWriteLen, 0
  Jg @Oops2
    Mov Tilt, 1
  @Oops2:

  { Dest start coordinates computer }
  Mov  ax, DestStartY      { Y coordinate }
  Mov  bx, ax
  Shl  ax, 6
  Add  ah, bl
  Add  ax, DestStartX      { X coordinate }
  Mov  DestStartYOfs, ax

  Mov  ax, 320             { DestXError := 320 - XwriteLen }
  Sub  ax, XwriteLen
  Mov  DestXError, ax
  End;
  If Tilt <> 0 Then Exit;

  Case Mode of
   { MOV }
   0:Begin
       Bytes := Word(XWriteLen div 4);
       WordsLeft := (Xwritelen mod 4) and 2;
       BytesLeft := (Xwritelen mod 4) and 1;
       If DestPtr = Nil then
         DestSeg := $a000
        else
         DestSeg := Seg(DestPtr^);
       Asm
        Mov ax, 0 {Y Loop Count}

         Mov es, DestSeg {Dest segment }
         Mov si, StartYOfs {Src offset}
         Mov di, DestStartYOfs {Dest offset}

         Push ds {Save ds}
         Lds cx, SrcPtr {Load SrcPtr into ds}

         @YLooper:

           db 66h; Mov   cx, Bytes; { Move double words at one to
 increase speed }
           db 66h; Rep Movsw

           Mov cx, WordsLeft
           Jcxz @SkipZero1
             Movsw
           @SkipZero1:
           Mov cx, BytesLeft
           Jcxz @SkipZero2
             Movsb
           @SkipZero2:

           Add si, XError {Fix offscreen clipping errors}
           Add di, DestXError

         Inc Ax {Increment Ax}
         Cmp ax, YWriteLen {If ax < YWritelen then.. }
         Jl @YLooper {Goto @YLooper}

         Pop Ds {All done, restore ds to prevent stack errors}
      End;
    End;
   { Addition PUT }
   1:Begin
       If DestPtr = Nil then
         DestSeg := $a000
        else
         DestSeg := Seg(DestPtr^);
       Asm
         Mov ax, 0 {Init Y Count }

         Mov es, DestSeg { Init dest segment }
         Mov si, StartYOfs { Init source offset }
         Mov di, DestStartYOfs

         {Get source segment and figure source start coordinates}
         Push Ds
         Lds cx, SrcPtr {Load SrcPtr into ds}

         @YLooper:

           { Loop length computer }
           Mov  cx, XWriteLen

           Shr  cx,1
           Jnc @SkipSingle
             Mov dl, es:[di]
             Add dl, ds:[si]
             Mov es:[di], dl
             Inc di; Inc si
           @SkipSingle:
             Jcxz @Exit
           @XLooper:
             Mov dl, es:[di]
             Add dl, ds:[si]
             Mov dh, es:[di+1]
             Add dh, ds:[si+1]

             Mov es:[di], dx
             Add si, 2; Add di, 2
           Loop @XLooper

        @Exit:
        Add si, XError {Fix offscreen clipping errors}
        Add di, DestXError

        Inc Ax  {Increment ax counter}
        Cmp ax, YWriteLen {If y < YWriteLen then... }
        Jl @YLooper {Goto YLooper}

        Pop Ds { All done, restore Ds to prevent stack errors }
      End;
    End;
   { Subtraction PUT }
   2:Begin
       If DestPtr = Nil then
         DestSeg := $a000
        else
         DestSeg := Seg(DestPtr^);
       Asm
         Mov ax, 0 {Init Y Count }

         Mov es, DestSeg { Init dest segment }
         Mov si, StartYOfs { Init source offset }
         Mov di, DestStartYofs

         {Get source segment and figure source start coordinates}
         Push Ds
         Lds cx, SrcPtr {Load SrcPtr into ds}

         @YLooper:

           { Loop length computer }
           Mov  cx, XWriteLen
           Shr  cx,1
           Jnc @SkipSingle
             Mov dl, es:[di]
             Sub dl, ds:[si]
             Mov es:[di], dl
             Inc di; Inc si
           @SkipSingle:
             Jcxz @Exit
           @XLooper:
             Mov dl, es:[di]
             Sub dl, ds:[si]
             Mov dh, es:[di+1]
             Sub dh, ds:[si+1]

             Mov es:[di], dx
             Add si, 2; Add di, 2
           Loop @XLooper

        @Exit:
        Add si, XError {Fix offscreen clipping errors}
        Add di, DestXerror

        Inc Ax  {Increment ax counter}
        Cmp ax, YWriteLen {If y < YWriteLen then... }
        Jl @YLooper {Goto YLooper}

        Pop Ds { All done, restore Ds to prevent stack errors }
      End;
    End;
   { XOR PUT }
   3:Begin
       If DestPtr = Nil then
         DestSeg := $a000
        else
         DestSeg := Seg(DestPtr^);
       Asm
         Mov ax, 0 {Init Y Count }

         Mov es, DestSeg { Init dest segment }
         Mov si, StartYOfs { Init source offset }
         Mov di, DestStartYofs

         {Get source segment and figure source start coordinates}
         Push Ds
         Lds cx, SrcPtr {Load SrcPtr into ds}

         @YLooper:

           { Loop length computer }
           Mov  cx, XWriteLen
           Shr  cx,1
           Jnc @SkipSingle
             Mov dl, es:[di]
             Xor dl, ds:[si]
             Mov es:[di], dl
             Inc di; Inc si
           @SkipSingle:
             Jcxz @Exit
           @XLooper:
             Mov dl, es:[di]
             Xor dl, ds:[si]
             Mov dh, es:[di+1]
             Xor dh, ds:[si+1]

             Mov es:[di], dx
             Add si, 2; Add di, 2
           Loop @XLooper

        @Exit:
        Add si, XError {Fix offscreen clipping errors}
        Add di, DestXError

        Inc Ax  {Increment ax counter}
        Cmp ax, YWriteLen {If y < YWriteLen then... }
        Jl @YLooper {Goto YLooper}

        Pop Ds { All done, restore Ds to prevent stack errors }
      End;
    End;
   { AND PUT }
   4:Begin
       If DestPtr = Nil then
         DestSeg := $a000
        else
         DestSeg := Seg(DestPtr^);
       Asm
         Mov ax, 0 {Init Y Count }

         Mov es, DestSeg { Init dest segment }
         Mov si, StartYOfs { Init source offset }
         Mov di, DestStartYofs

         {Get source segment and figure source start coordinates}
         Push Ds
         Lds cx, SrcPtr {Load SrcPtr into ds}

         @YLooper:

           { Loop length computer }
           Mov  cx, XWriteLen
           Shr  cx,1
           Jnc @SkipSingle
             Mov dl, es:[di]
             And dl, ds:[si]
             Mov es:[di], dl
             Inc di; Inc si
           @SkipSingle:
             Jcxz @Exit
           @XLooper:
             Mov dl, es:[di]
             And dl, ds:[si]
             Mov dh, es:[di+1]
             And dh, ds:[si+1]

             Mov es:[di], dx
             Add si, 2; Add di, 2
           Loop @XLooper

        @Exit:
        Add si, XError {Fix offscreen clipping errors}
        Add di, DestXError

        Inc Ax  {Increment ax counter}
        Cmp ax, YWriteLen {If y < YWriteLen then... }
        Jl @YLooper {Goto YLooper}

        Pop Ds { All done, restore Ds to prevent stack errors }
      End;
    End;
   { NOT PUT - This is good for some strange effects if used
 correctly }
   5:Begin
       If DestPtr = Nil then
         DestSeg := $a000
        else
         DestSeg := Seg(DestPtr^);
       Asm
         Mov ax, 0 {Init Y Count }

         Mov es, DestSeg { Init dest segment }
         Mov si, StartYOfs { Init source offset }
         Mov di, DestStartYofs

         {Get source segment and figure source start coordinates}
         Push Ds
         Lds cx, SrcPtr {Load SrcPtr into ds}

         @YLooper:

           { Loop length computer }
           Mov  cx, XWriteLen
           Shr  cx,1
           Jnc @SkipSingle
             Mov dl, es:[di]
             Add dl, ds:[si]; Not dl
             Mov es:[di], dl
             Inc di; Inc si
           @SkipSingle:
             Jcxz @Exit
           @XLooper:
             Mov dl, es:[di]
             Add dl, ds:[si]; Not dl
             Mov dh, es:[di+1]
             Add dh, ds:[si+1]; Not dh

             Mov es:[di], dx
             Add si, 2; Add di, 2
           Loop @XLooper

        @Exit:
        Add si, XError {Fix offscreen clipping errors}
        Add di, DestXerror

        Inc Ax  {Increment ax counter}
        Cmp ax, YWriteLen {If y < YWriteLen then... }
        Jl @YLooper {Goto YLooper}

        Pop Ds { All done, restore Ds to prevent stack errors }
      End;
    End;
   { Transparent MOV }
   6:Begin
       If DestPtr = Nil then
         DestSeg := $a000
        else
         DestSeg := Seg(DestPtr^);
       Asm
         Mov ax, 0 {Init Y Count }

         Mov es, DestSeg { Init dest segment }
         Mov si, StartYOfs { Init source offset }
         Mov di, DestStartYOfs

         {Get source segment and figure source start coordinates}
         Push Ds
         Lds cx, SrcPtr {Load SrcPtr into ds}

         @YLooper:

           { Loop length computer }
           Mov  cx, XWriteLen
           Shr  cx,1
           Jnc @SkipSingle
             Mov dl, ds:[si]
             Or dl, dl
             Jz @SkipZero1
               Mov es:[di], dl
             @SkipZero1:
             Inc di; Inc si
           @SkipSingle:
             Jcxz @Exit
           @XLooper:
             Mov dx, ds:[si]

             Or dl, dl
             Jnz @SkipZero2
               Mov dl, es:[di]
             @SkipZero2:

             Or dh, dh
             Jnz @SkipZero3
               Mov dh, es:[di+1]
             @SkipZero3:
             Mov es:[di], dx
             Add si, 2; Add di, 2
           Loop @XLooper

        @Exit:
        Add si, XError {Fix offscreen clipping errors}
        Add di, DestXerror

        Inc Ax  {Increment ax counter}
        Cmp ax, YWriteLen {If y < YWriteLen then... }
        Jl @YLooper {Goto YLooper}

        Pop Ds { All done, restore Ds to prevent stack errors }
      End;
    End;
  End; {Case}
End;

{ Same thing as OldVGAPutPic, this one (sort of) clips. Clipping not
 quite
  finished yet. Use this PUTPIC only if you know that a bitmap will
 go off
  screen. Routines are quicker (i think?) since I tried to use less
 local
  variables and more registers
  Mode = Use predefined constants from the top of the program
  X1 = X position of picture
  Y1 = Y position of picture

  Next two are user clip functions! I found this useful in
 displaying a fuse
  that is burning it self down (i.e. show less and less of the fuse
 as time
  goes on)

  XClip = Number of pixels to clip from X size
  YClip = Number of pixels to clip from Y size
  SrcPtr, DestPtr = Source and destination virtual pages }

Procedure VGAClipPic(Mode : Byte; X1, Y1, XClip, YClip : Integer;
 SrcPtr, DestPtr : Pointer);

  Label _StopDraw;
  Var OutSeg, YSize, XSize, YOfs, XDiff, XSiDiff : Word;

  Begin
    If DestPtr = Nil then OutSeg := SegA000 else OutSeg :=
 Seg(DestPtr^);
    If XClip < 0 then XClip := 0;
    If YClip < 0 then YClip := 0;
    Asm
      { ----- Determine start adress ----- }

      Mov XSiDiff, 0
      Mov bx, Y1; Shl bx, 1;
      Mov ax, Word Ptr [Vlu+bx]; Mov Yofs, ax

      { ----- Load X and Y sizes ----- }

      Les di, SrcPtr
      Mov ax, es:[di]; Inc ax;
      Mov XSize, ax
      Mov bx, 320; Sub bx, XSize; Mov XDiff, bx

      Mov ax, es:[di+2]; Inc ax
      Mov YSize, ax

      Mov ax, OutSeg
      Mov es, ax

      { ----- Range checking ----- }
      Cmp Y1, 200
      Jae _StopDraw
      Cmp X1, 320
      Jae _StopDraw

      { ----- Clipping routines ----- }
      Mov dx, 200; Sub dx, YSize
      Cmp Y1, dx
      Jbe @SkipMaxY
        Mov ax, Y1
        Sub ax, dx
        Sub YSize, ax
      @SkipMaxY:

      Mov dx, 320; Sub dx, XSize
      Cmp X1, dx
      Jbe @SkipMaxX
        Mov ax, X1
        Sub ax, dx
        Sub XSize, ax
        Add XDiff, ax
        Mov XSiDiff, ax
      @SkipMaxX:

      { ----- User clip. sometimes VERY useful! ----- }
      Mov ax, XClip
      Sub XSize, ax
      Add XDiff, ax
      Add XSiDiff, ax

      Mov ax, YClip
      Sub YSize, ax

      { ----- if we aint even gonna see a sprite, exit for godsake!
 ----- }

      Mov ax, XSize
      And ax, ax
      Js _StopDraw
      And ax, ax
      Jz _StopDraw

      Mov ax, YSize
      And ax, ax
      Js _StopDraw
      And ax, ax
      Jz _StopDraw

      { ----- Misc stuff ----- }

      Mov di, Yofs
      Add di, X1

      @Stop:
    End;
    Case Mode of
      { ----- MOV PUT ----- }
      0: Asm
           Push ds
           Lds si, SrcPtr; Add si, 4

           Mov cx, YSize
           Cld
           @YLooper:

             Push cx
             Mov cx, XSize;

             Shr cx, 1
             Jnc @SkipSingleByte
               Movsb
             @SkipSingleByte:
             Jcxz @Exit

             Shr cx, 1
             Jnc @SkipSingleWord
               Movsw
             @SkipSingleWord:
             Jcxz @Exit

             Db 66h; Rep Movsw

             @Exit:
             Add di, XDiff
             Add si, XSiDiff

             Pop cx
             Dec cx
             Jnz @YLooper

           Pop ds
         End;
      { ----- ADD PUT ----- }
      1: Asm
           Push ds
           Cld
           Lds si, SrcPtr; Add si, 4

           Mov cx, YSize
           @YLooper:

             Push cx
             Mov cx, XSize;
             Shr cx, 1
             Jnc @SkipSingle
               Mov bl, [es:di]
               Mov al, [ds:si]
               Add al, bl;
               Mov [es:di], al; Inc di; Inc si
             @SkipSingle:
               Jcxz @Exit
             @XLooper:
               Mov ax, [ds:si]
               Mov bx, [es:di]

               Add al, bl;
               {$IFDEF CLIPADDPUT}
               Jnc @ResetAL
                 Mov al, 255;
               @ResetAL:
               {$ENDIF}

               Add ah, bh;
               {$IFDEF CLIPADDPUT}
               Jnc @ResetAH
                 Mov ah, 255;
               @ResetAH:
               {$ENDIF}

               Mov [es:di], ax; Add di, 2; Add si, 2
               Dec cx
             Jnz @XLooper

             @Exit:
             Add di, XDiff
             Add si, XSiDiff

             Pop cx
             Dec cx
             Jnz @YLooper

           Pop ds
         End;
      { ----- SUB PUT ----- }
      2: Asm
           Push ds
           Cld
           Lds si, SrcPtr; Add si, 4

           Mov cx, YSize
           @YLooper:

             Push cx
             Mov cx, XSize;
             Shr cx, 1
             Jnc @SkipSingle
               Mov bl, [es:di]
               Mov al, [ds:si]
               Sub al, bl;
               Mov [es:di], al; Inc di; Inc si
             @SkipSingle:
               Jcxz @Exit
             @XLooper:
               Mov bx, [es:di]
               Mov ax, [ds:si]
               Sub al, bl; Sub ah, bh
               Mov [es:di], ax; Add di, 2; Add si, 2
               Dec cx
             Jnz @XLooper

             @Exit:
             Add di, XDiff
             Add si, XSiDiff

             Pop cx
             Dec cx
             Jnz @YLooper

           Pop ds
         End;
      { ----- AND PUT ----- }
      3: Asm
           Push ds
           Cld
           Lds si, SrcPtr; Add si, 4
           Mov cx, YSize
           @YLooper:

             Push cx
             Mov cx, XSize;
             Shr cx, 1
             Jnc @SkipSingle
               Mov bl, [es:di]
               Mov al, [ds:si]
               And al, bl;
               Mov [es:di], al; Inc di; Inc si
             @SkipSingle:
               Jcxz @Exit
             @XLooper:
               Mov bx, [es:di]
               Mov ax, [ds:si]
               And al, bl; And ah, bh
               Mov [es:di], ax; Add di, 2; Add si, 2
               Dec cx
             Jnz @XLooper

             @Exit:
             Add di, XDiff
             Add si, XSiDiff

             Pop cx
             Dec cx
             Jnz @YLooper

           Pop ds
         End;
      { ----- OR PUT ----- }
      4: Asm
           Push ds
           Cld
           Lds si, SrcPtr; Add si, 4

           Mov cx, YSize
           @YLooper:

             Push cx
             Mov cx, XSize;
             Shr cx, 1
             Jnc @SkipSingle
               Mov bl, [es:di]
               Mov al, [ds:si]
               Or al, bl;
               Mov [es:di], al; Inc di; Inc si
             @SkipSingle:
               Jcxz @Exit
             @XLooper:
               Mov bx, [es:di]
               Mov ax, [ds:si]

               Or al, bl; Or ah, bh

               Mov [es:di], ax
               Add di, 2; Add si, 2
               Dec cx
             Jnz @XLooper

             @Exit:
             Add di, XDiff
             Add si, XSiDiff

             Pop cx
             Dec cx
             Jnz @YLooper

           Pop ds
         End;
      { ----- XOR PUT ----- }
      5: Asm
           Push ds
           Cld
           Lds si, SrcPtr; Add si, 4

           Mov cx, YSize
           @YLooper:

             Push cx
             Mov cx, XSize;
             Shr cx, 1
             Jnc @SkipSingle
               Mov bl, [es:di]
               Mov al, [ds:si]
               Xor al, bl;
               Mov [es:di], al; Inc di; Inc si
             @SkipSingle:
               Jcxz @Exit
             @XLooper:
               Mov bx, [es:di]
               Mov ax, [ds:si]
               Xor al, bl; Xor ah, bh
               Mov [es:di], ax; Add di, 2; Add si, 2
               Dec cx
             Jnz @XLooper

             @Exit:
             Add di, XDiff
             Add si, XSiDiff

             Pop cx
             Dec cx
             Jnz @YLooper

           Pop ds
         End;
      { ----- TRANSPARENT PUT ----- }
      6: Asm
           Push ds
           Cld
           Lds si, SrcPtr; Add si, 4

           Mov cx, YSize
           @YLooper:

             Push cx
             Mov cx, XSize;
             Shr cx, 1
             Jnc @TSkipSingle
               Mov al, [ds:si]
               Or al, al
               Jz @TSkipZeroB
                 Mov [es:di], al
               @TSkipZeroB:
               Inc di; Inc si
             @TSkipSingle:
               Jcxz @TExit
             @XLooper:
               Mov ax, [ds:si];

               Or al, al
               Je @TSkipZeroWL
                 Mov [es:di], al
               @TSkipZeroWL:
               Or ah, ah
               Je @TSkipZeroWH
                 Mov [es:di+1], ah
               @TSkipZeroWH:

               Add di, 2; Add si, 2
               Dec cx
             Jnz @XLooper

             @TExit:
             Add di, XDiff
             Add si, XSiDiff

             Pop cx
             Dec cx
             Jnz @YLooper

           Pop ds
         End;
    End;
    _StopDraw:;
  End;

{ DOES NOT CLIP AT ALL! Just does renage checking.  Use this for
 faster
  PUTs if your bitmap will stay within the screen boundaries }

Procedure VGAPutPic(Mode : Byte; X1, Y1 : Integer; SrcPtr, DestPtr :
 Pointer);

  Label _StopDraw;
  Var OutSeg, YSize, XSize, YOfs, XDiff : Word;

  Begin
    If DestPtr = Nil then OutSeg := SegA000 else OutSeg :=
 Seg(DestPtr^);
    Asm
      { ----- Determine start adress ----- }

      Mov bx, Y1; Shl bx, 1;
      Mov ax, Word Ptr [Vlu+bx]; Mov Yofs, ax

      { ----- Load X and Y sizes ----- }

      Les di, SrcPtr
      Mov ax, es:[di]; Inc ax;
      Mov XSize, ax
      Mov bx, 320; Sub bx, XSize; Mov XDiff, bx

      Mov ax, es:[di+2]; Inc ax
      Mov YSize, ax

      Mov ax, OutSeg
      Mov es, ax

      { ----- Range checking ----- }

      { Upper limit check (down and right) }
      Mov ax, Y1
      Add ax, YSize
      Cmp ax, 200
      Jae _StopDraw

      Mov ax, X1
      Add ax, XSize
      Cmp ax, 320
      Jae _StopDraw

      { Lower limit (up and left) }
      Mov ax, Y1
      Cmp ax, 200
      Jae _StopDraw

      Mov ax, X1
      Cmp ax, 320
      Jae _StopDraw

      { No clipping routines here!!! }

      { ----- Misc stuff ----- }

      Mov di, Yofs
      Add di, X1

      @Stop:
    End;
    Case Mode of
      { ----- MOV PUT ----- }
      0: Asm
           Push ds
           Lds si, SrcPtr; Add si, 4

           Mov cx, YSize
           Cld
           @YLooper:

             Push cx
             Mov cx, XSize;

             Shr cx, 1
             Jnc @SkipSingleByte
               Movsb
             @SkipSingleByte:
             Jcxz @Exit

             Shr cx, 1
             Jnc @SkipSingleWord
               Movsw
             @SkipSingleWord:
             Jcxz @Exit

             Db 66h; Rep Movsw

             @Exit:
             Add di, XDiff

             Pop cx
             Dec cx
             Jnz @YLooper

           Pop ds
         End;
      { ----- ADD PUT ----- }
      1: Asm
           Push ds
           Cld
           Lds si, SrcPtr; Add si, 4

           Mov cx, YSize
           @YLooper:

             Push cx
             Mov cx, XSize;
             Shr cx, 1
             Jnc @SkipSingle
               Mov bl, [es:di]
               Mov al, [ds:si]
               Add al, bl;
               Mov [es:di], al; Inc di; Inc si
             @SkipSingle:
               Jcxz @Exit
             @XLooper:
               Mov ax, [ds:si]
               Mov bx, [es:di]

               Add al, bl;
               {$IFDEF CLIPADDPUT}
               Jnc @ResetAL
                 Mov al, 255;
               @ResetAL:
               {$ENDIF}

               Add ah, bh;
               {$IFDEF CLIPADDPUT}
               Jnc @ResetAH
                 Mov ah, 255;
               @ResetAH:


>> CONTINUED IN NEXT MESSAGE <<
================================================================================
 Area:    PASCAL
 Date:    24 Jul 96  21:14:55  Public           
 From:    Ryan Stowers                                      
 To:      All                                               
 Subject: VGAUTIL 4/7                                              [2]
ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
>> CONTINUED FROM PREVIOUS MESSAGE <<

               {$ENDIF}

               Mov [es:di], ax; Add di, 2; Add si, 2
               Dec cx
             Jnz @XLooper

             @Exit:
             Add di, XDiff

             Pop cx
             Dec cx
             Jnz @YLooper
           Pop ds
         End;
      { ----- SUB PUT ----- }
      2: Asm
           Push ds
           Cld
           Lds si, SrcPtr; Add si, 4

           Mov cx, YSize
           @YLooper:

             Push cx
             Mov cx, XSize;
             Shr cx, 1
             Jnc @SkipSingle
               Mov bl, [es:di]
               Mov al, [ds:si]
               Sub al, bl;
               Mov [es:di], al; Inc di; Inc si
             @SkipSingle:
               Jcxz @Exit
             @XLooper:
               Mov bx, [es:di]
               Mov ax, [ds:si]
               Sub al, bl; Sub ah, bh
               Mov [es:di], ax; Add di, 2; Add si, 2
               Dec cx
             Jnz @XLooper

             @Exit:
             Add di, XDiff

             Pop cx
             Dec cx
             Jnz @YLooper

           Pop ds
         End;
      { ----- AND PUT ----- }
      3: Asm
           Push ds
           Cld
           Lds si, SrcPtr; Add si, 4

           Mov cx, YSize
           @YLooper:

             Push cx
             Mov cx, XSize;
             Shr cx, 1
             Jnc @SkipSingle
               Mov bl, [es:di]
               Mov al, [ds:si]
               And al, bl;
               Mov [es:di], al; Inc di; Inc si
             @SkipSingle:
               Jcxz @Exit
             @XLooper:
               Mov bx, [es:di]
               Mov ax, [ds:si]
               And al, bl; And ah, bh
               Mov [es:di], ax; Add di, 2; Add si, 2
               Dec cx
             Jnz @XLooper

             @Exit:
             Add di, XDiff

             Pop cx
             Dec cx
             Jnz @YLooper

           Pop ds
         End;
      { ----- OR PUT ----- }
      4: Asm
           Push ds
           Cld
           Lds si, SrcPtr; Add si, 4

           Mov cx, YSize
           @YLooper:

             Push cx
             Mov cx, XSize;
             Shr cx, 1
             Jnc @SkipSingle
               Mov bl, [es:di]
               Mov al, [ds:si]
               Or al, bl;
               Mov [es:di], al; Inc di; Inc si
             @SkipSingle:
               Jcxz @Exit
             @XLooper:
               Mov bx, [es:di]
               Mov ax, [ds:si]

               Or al, bl; Or ah, bh

               Mov [es:di], ax
               Add di, 2; Add si, 2
               Dec cx
             Jnz @XLooper

             @Exit:
             Add di, XDiff

             Pop cx
             Dec cx
             Jnz @YLooper

           Pop ds
         End;
      { ----- XOR PUT ----- }
      5: Asm
           Push ds
           Cld
           Lds si, SrcPtr; Add si, 4

           Mov cx, YSize
           @YLooper:

             Push cx
             Mov cx, XSize;
             Shr cx, 1
             Jnc @SkipSingle
               Mov bl, [es:di]
               Mov al, [ds:si]
               Xor al, bl;
               Mov [es:di], al; Inc di; Inc si
             @SkipSingle:
               Jcxz @Exit
             @XLooper:
               Mov bx, [es:di]
               Mov ax, [ds:si]
               Xor al, bl; Xor ah, bh
               Mov [es:di], ax; Add di, 2; Add si, 2
               Dec cx
             Jnz @XLooper

             @Exit:
             Add di, XDiff

             Pop cx
             Dec cx
             Jnz @YLooper

           Pop ds
         End;
      { ----- TRANSPARENT PUT ----- }
      6: Asm
           Push ds
           Cld
           Lds si, SrcPtr; Add si, 4

           Mov cx, YSize
           @YLooper:

             Push cx
             Mov cx, XSize;
             Shr cx, 1
             Jnc @TSkipSingle
               Mov al, [ds:si]
               Or al, al
               Jz @TSkipZeroB
                 Mov [es:di], al
                 Inc di; Inc si
               @TSkipZeroB:
             @TSkipSingle:
               Jcxz @TExit
             @XLooper:
               Mov ax, [ds:si];

               Or al, al
               Je @TSkipZeroWL
                 Mov [es:di], al
               @TSkipZeroWL:
               Or ah, ah
               Je @TSkipZeroWH
                 Mov [es:di+1], ah
               @TSkipZeroWH:

               Add di, 2; Add si, 2
               Dec cx
             Jnz @XLooper

             @TExit:
             Add di, XDiff

             Pop cx
             Dec cx
             Jnz @YLooper

           Pop ds
         End;
    End;
    _StopDraw:;
  End;

{ The next two procedures are used for restoring backgrounds in my
 sprite
  and vector routines.  Ask me and ill give them to you }
{ RestoreBackgoround aint really that fast. It would be more useful
 in mode-x
  sprite programming }

Procedure RestoreBackground(X1, Y1, XSize, YSize : Integer; SrcPtr,
 DestPtr : Pointer);

  Label _TotalExit;
  Var OutSeg, YOfs, XDiff : Word;

  Begin
    If DestPtr = Nil then OutSeg := $A000 else OutSeg :=
 Seg(DestPtr^);
    Asm
      { ----- Determine starting offset ----- }

      Mov bx, Y1; Shl bx, 1;
      Mov ax, Word Ptr [Vlu+bx]; Mov Yofs, ax

      Mov ax, OutSeg
      Mov es, ax

      Mov bx, 320; Sub bx, XSize; Mov XDiff, bx
      Mov dx, 320; Sub dx, XSize

      { ----- Range checking ----- }
      Mov ax, Y1;  Add ax, Xsize
      Cmp ax, 199
      Jae @Stop
      Mov ax, X1;  Add ax, Ysize
      Cmp ax, 319
      Jae @Stop

      { ----- Clipping Routines ----- }

      Mov dx, 200; Sub dx, YSize
      Cmp Y1, dx
      Jbe @SkipMaxY
        Mov ax, Y1
        Sub ax, dx
        Sub YSize, ax
      @SkipMaxY:

      Mov dx, 320; Sub dx, XSize
      Cmp X1, dx
      Jbe @SkipMaxX
        Mov ax, X1
        Sub ax, dx
        Sub XSize, ax
        Add XDiff, ax
      @SkipMaxX:

      Mov di, Yofs
      Add di, X1

           { ----- draw the sucker ----- }
           Push ds
           Lds si, SrcPtr;
           Mov si, Yofs; Add si, X1

           Cld
           Mov cx, YSize
           @YLooper:

             Push cx
             Mov cx, XSize;
             Shr cx, 1

             Jnc @SkipSingle
               Movsb
             @SkipSingle:
               Jcxz @Exit
             Rep Movsw

             @Exit:
             Add di, XDiff
             Add si, XDiff
             Pop cx
             Dec cx
             Jnz @YLooper

           Pop ds
      @Stop:
    End;
  End;

{ This one is really fast (386 instr). Y1 is the top line of SrcPtr
 and Y2
  is the bottom line of ScrPtr to copy to DestPtr }

Procedure RestoreBackgroundVertical(Y1, Y2 : Integer; SrcPtr,
 DestPtr : Pointer);

  Var Bytes, StartOfs : Word;
      Tmp : Integer;

  Begin
    If Y1 > Y2 then
      Begin
        Tmp := Y1;
        Y1 := Y2;
        Y2 := Tmp;
      End;
    If Y1 < 0 then Y1 := 0;
    If Y2 > 199 then Y2 := 199;
    Bytes := (Y2-Y1) * 80;
    If Bytes = 0 then Exit;
    StartOfs := Vlu[Y1];
    Asm
      Mov cx, StartOfs
      Mov dx, Bytes
      Push  ds
      Push  es
      Cld
      Les   di, DestPtr
      Lds   si, SrcPtr
      Mov   di, cx; Mov  si, cx
      db  66h; Mov  cx, dx;
      db  66h; Rep  Movsw
      Pop  es
      Pop  ds
    End;
  End;

{ 'down and dirty' pcx loader.  ONLY works with 256 color pictures
 and is
  limited to files <= 64k :(. If you try to load something over 64k
 the
  machine WILL NOT LOCK but pcx will be all screwed up and so will
 the
  palette.
  If you can, please modify it so it can take >64k pcx files and/or
 16 color
  pictures
  FileName = String that holds the filename
  TPal = Palette of the picture. It's AUTOMATICALLY set when you use
 this
         procedure
  Orig = Pointer (remember to use GETMEM) that you want the
 extracted image
         to go
}

Procedure LoadPcx(FileName : AnyString; Var TPal : PaletteType; Orig
 : Pointer);

Var
  Size : Word;
  TextureOffset : Word;
  Count, PcxW, PcxH, TmpCount : Word;
  RunLen : Byte;
  Value : Byte;
  RVal, GVal, BVal : Byte;
  PCXOffset, OutOfs : Word;
  PCXSeg, OutSeg : Word;
  PCXFile : File;
  PCXBuffer : Pointer;
  TmpLong : LongInt;

Begin
  Assign(PcxFile, FileName);
  Reset(PcxFile, 1);
  TmpLong := FileSize(PcxFile);
  If TmpLong > $ffff then TmpLong := $ffff;
  GetMem(PcxBuffer, TmpLong);
  BlockRead(PcxFile, PcxBuffer^, TmpLong);

  OutSeg := Seg(Orig^);
  OutOfs := Ofs(Orig^);
  PcxSeg := Seg(PcxBuffer^);
  PcxOffset := Ofs(PcxBuffer^);

  { Get picture width and height }
  PcxW := MemW[PcxSeg:PcxOffset + 10];
  PcxH := MemW[PcxSeg:PcxOffset + 12];

  PcxOffset := Ofs(PcxBuffer^) + 128;

  TextureOffset := 0;
  Size := 65535;
  While TextureOffset < Size do
    Begin
      RunLen := Mem[PcxSeg:PcxOffset];
      Inc(PcxOffset);
      If (RunLen and $C0) = $C0
        Then Begin
          RunLen := RunLen And $3f;
          Value := Mem[PCXSeg:PcxOffset];
          Inc(PcxOffset);
        End
        Else Begin
          Value := RunLen;
          RunLen := 1;
        End;
      While (RunLen >= 1) and (TextureOffset < Size) do
        Begin
          {If Value < MinCol then Value := MinCol;
          If Value > MaxCol then Value := MaxCol;}
          Mem[OutSeg:OutOfs+TextureOffset] := Value;
          TextureOffset := TextureOffset + 1;
          RunLen := RunLen - 1;
        End;
    End;
  { Get palette }
  PcxOffset := Ofs(PcxBuffer^);
  Count := TmpLong - 768;
  For TmpCount := 0 to 255 do
    Begin
      Port[$3c8] := TmpCount;
      RVal := Mem[PcxSeg : PcxOffset + Count];
      If TmpCount = 0 then RVal := 0;
      Port[$3c9] := RVal div 4;
      Tpal[TmpCount].r := Rval div 4;
      Inc(Count);

      GVal := Mem[PcxSeg : PcxOffset + Count];
      If TmpCount = 0 then gVal := 0;
      Port[$3c9] := GVal div 4;
      Tpal[TmpCount].g := Gval div 4;
      Inc(Count);

      BVal := Mem[PcxSeg : PcxOffset + Count];
      If TmpCount = 0 then bVal := 0;
      Port[$3c9] := BVal div 4;
      Tpal[TmpCount].b := Bval div 4;
      Inc(Count);
    End;
  FreeMem(PcxBuffer, TmpLong);
  Close(PcxFile);
End;

{ Just loads the pcx file's palette into TPal }

Procedure LoadPcxPalette(FileName : AnyString; Var TPal :
 PaletteType);

Var
  Size : Word;
  Count, TmpCount : Word;
  RVal, GVal, BVal : Byte;
  PCXSeg, PCXOffset : Word;
  PCXFile : File;
  PCXBuffer : Pointer;
  TmpLong : LongInt;

Begin
  Assign(PcxFile, FileName);
  Reset(PcxFile, 1);
  TmpLong := FileSize(PcxFile);
  If TmpLong > $ffff then TmpLong := $ffff;
  GetMem(PcxBuffer, TmpLong);
  BlockRead(PcxFile, PcxBuffer^, TmpLong);

  PcxSeg := Seg(PcxBuffer^);
  PcxOffset := Ofs(PcxBuffer^);
  Count := TmpLong - 768;
  For TmpCount := 0 to 255 do
    Begin
      Port[$3c8] := TmpCount;
      RVal := Mem[PcxSeg : PcxOffset + Count];
      If TmpCount = 0 then RVal := 0;
      Port[$3c9] := RVal div 4;
      Tpal[TmpCount].r := Rval div 4;
      Inc(Count);

      GVal := Mem[PcxSeg : PcxOffset + Count];
      If TmpCount = 0 then gVal := 0;
      Port[$3c9] := GVal div 4;
      Tpal[TmpCount].g := Gval div 4;
      Inc(Count);

      BVal := Mem[PcxSeg : PcxOffset + Count];
      If TmpCount = 0 then bVal := 0;
      Port[$3c9] := BVal div 4;
      Tpal[TmpCount].b := Bval div 4;
      Inc(Count);
    End;
  FreeMem(PcxBuffer, TmpLong);
  Close(PcxFile);
End;

{ Clears a virtual page }
Procedure ClearPage(P : Pointer); Assembler;

Asm
  Les  di,P
  Mov  cx, 16000
  db 66h; Xor  ax, ax
  db 66h; Rep Stosw
End;

{Copies a virtual page to video memory}
Procedure CopyPage(P : Pointer); Assembler;

Asm
  Push  ds
  Push  es
  Cld
  Mov   ax,$A000
  Mov   es,ax
  Mov   di, 0
  Lds   si, P
  db 66h; Mov   cx,16000; dw 0;
  db 66h; Rep Movsw
  Pop   es
  Pop   ds
End;

{Copies a virtual page to video memory with 'offset' :P}
{Note: this routine causes a protection fault so dont use it unless
 you can
 debug it}
Procedure CopyPageOffset(P : Pointer; POffset : Word); Assembler;

Asm
  Push  ds
  Push  es
  Cld
  Mov   ax,$A000
  Mov   es,ax
  Mov   di, 0
  Lds   si, P
  db 66h; Mov   cx,16000; dw 0;
  db 66h; Rep Movsw
  Pop   es
  Pop   ds
End;

{ Copies a virtual page to another virtual page }
Procedure Copy2Pages(SrcP, DestP : Pointer); assembler;

  Asm
    Push  ds
    Les   di, DestP
    Lds   si, SrcP
    db 66h; Mov   cx, 16000; dw 0;
    db 66h; Rep Movsw
    Pop   ds
  End;

{ One of Bjarke's routines sets the start position of the video
 cards video
  memory.  Use this for hardware scrolling }
Procedure SetStart(p:word); assembler;
  Asm
    Mov dx,$3d4;Mov bx,p;Mov al,$c; Mov ah,bh;Out dx,ax;Inc al;Mov ah,bl;Out dx,ax;Mov Word Ptr PageOffset, bx;
  End;

{ Only works with my Tseng/ET4000 video card apparently. Selects
 different
  256k sections of my card for SVGA modes. }
Procedure SetBank(bank:byte);

  Begin
    Port[$03cd] := Bank;
  End;
Procedure Vgaline(const x1,y1,x2,y2,where:word;const c:byte);
var
  dex,dey,incf:Integer;
  offset:word;
begin
  {I added the next 2 lines because this routine is not perfect. I
 get
   garbage whenever I use this im my vector program }
  If (y1 <= 0) or (y1 > 319) or (y2 <= 0) or (y2 > 319) then exit;
  {If (x2-x1 = 0) or (x1-x2 = 0) then exit;}
asm
  mov ax,[x2]
  sub ax,[x1]
  jnc @@dont1
  neg ax
@@dont1:
  mov [dex],ax
  mov ax,[y2]
  sub ax,[y1]
  jnc @@dont2
  neg ax
@@dont2:
  mov [dey],ax
  cmp ax,[dex]
  jbe @@otherline
  mov  ax,[y1]
  cmp  ax,[y2]
  jbe  @@DontSwap1
  mov  bx,[y2]
  mov  [y1],bx
  mov  [y2],ax
  mov  ax,[x1]
  mov  bx,[x2]
  mov  [x1],bx
  mov  [x2],ax
@@dontswap1:
  mov [incf],1
  mov ax,[x1]
  cmp ax,[x2]
  jbe @@skipnegate1
  neg [incf]
@@skipnegate1:
  mov di,[y1]
  mov bx,di
  shl di,8
  shl bx,6
  add di,bx
  add di,[x1]
  mov bx,[dey]
  mov cx,bx
  mov ax,where
  mov es,ax
  mov dl,[c]
  mov si,[dex]
@@drawloop1:
  mov es:[di],dl
  add di,320
  sub bx,si
  jnc @@goon1
  add bx,[dey]
  add di,[incf]
@@goon1:
  loop @@drawloop1
  jmp  @@exitline
@@otherline:
  mov ax,[x1]
  cmp ax,[x2]
  jbe @@dontswap2
  mov bx,[x2]
  mov [x1],bx
  mov [x2],ax
  mov ax,[y1]
  mov bx,[y2]
  mov [y1],bx
  mov [y2],ax
@@dontswap2:
  mov [incf],320
  mov ax,[y1]
  cmp ax,[y2]
  jbe @@skipnegate2
  neg [incf]
@@skipnegate2:
  mov di,[y1]
  mov bx,di
  shl di,8
  shl bx,6
  add di,bx
  add di,[x1]
  mov bx,[dex]
  mov cx,bx
  mov ax,where
  mov es,ax
  mov dl,[c]
  mov si,[dey]
@@drawloop2:
  mov es:[di],dl
  inc di
  sub bx,si
  jnc @@goon2
  add bx,[dex]
  add di,[incf]
@@goon2:
  loop @@drawloop2
@@exitline:
end;
end;

Begin
End.
Published in: Pascal
Download

Related snippets