Unit Mode13h;
{$N+}

{$I DEFINES.INC}

Interface

Type
  RGBType = Record
    r, g, b : Byte;
  End;
  Palette = Array[0..255] of RGBType;

Var
  VGAPage, VirtualPage : Pointer;

Procedure SetMode(M : Integer);
Procedure PutMouseCursor(x, y : Integer);
Procedure SetRGB(c, r, g, b : Byte);
Procedure SetPalette(Var P);
Procedure Flip;
Procedure FlipFloat;

Implementation

Const
  MouseCursor : Array[0..7*7 - 1] of Byte = (
  0,0,0,1,0,0,0,
  0,0,0,1,0,0,0,
  0,0,1,1,1,0,0,
  1,1,1,0,1,1,1,
  0,0,1,1,1,0,0,
  0,0,0,1,0,0,0,
  0,0,0,1,0,0,0);

Procedure FlipFloat; Assembler;

Const
  FloatZero : Extended = 0;

Asm
  Push  ds
  Les   di,VGAPage
  Lds   si,VirtualPage
  Mov   cx,64000/10
 @Looper:
  fld   tbyte Ptr [si]
  Add   si,10
  fstp  tbyte Ptr es:[di]
  Add   di,10
  Dec   cx
  Jnz  @Looper
  Pop   ds

  Les   di,VirtualPage
  db 66h; Xor ax,ax
  Mov   cx,64000/4
  db 66h; Rep   Stosw

End;


Procedure Flip; Assembler;

Asm
  Push  ds
  Les   di,VGAPage
  Lds   si,VirtualPage
  Mov   cx,64000/4
  db 66h; Rep   Movsw
  Pop   ds

  Les   di,VirtualPage
  db 66h; Xor ax,ax
  Mov   cx,64000/4
  db 66h; Rep   Stosw
End;

Procedure SetMode(M : Integer); Assembler;

Asm
  Mov  ax,M
  Int  10h
End;

Procedure SetRGB(c, r, g, b : Byte);

Begin
  Port[$3c8] := c;
  Port[$3c9] := r;
  Port[$3c9] := g;
  Port[$3c9] := b;
End;

Procedure SetPalette(Var P);

Var
  i : Integer;
  PSeg, pOfs : Word;

Begin
  PSeg := Seg(P);
  POfs := Ofs(P);
  For i := 0 to 255 do
    SetRGB(i, Mem[PSeg:POfs+i*3], Mem[PSeg:POfs+i*3+1], Mem[PSeg:POfs+i*3+2]);
End;

Procedure PutMouseCursor(x, y : Integer);

Var
  Width, Height : Word;
  CharData : Pointer;
  dwidth, dheight : Integer;
  i, j, sx, sy, tx, ty : Integer;
  c : Byte;

begin
  Width := 7;
  Height := 7;
  CharData := @MouseCursor;
  Asm
    Mov  ax,X
    Mov  cx,ax
    Add  ax,Width
    Mov  tx,ax

    Mov  bx,Y
    Mov  dx,bx
    Add  bx,Height
    Mov  ty,bx

    Cmp  ax,0   { check tx against left side of the screen }
    Jl  @@Exit
    Cmp  bx,0   { check ty against top side of screen }
    Jl  @@Exit
    Cmp  cx,319 { Check x against right of screen }
    Jg  @@Exit
    Cmp  dx,199 { Check y against bottom side of screen }
    Jg  @@Exit

    Mov  sx,0   { Initialize sprite starting position to top left }
    Mov  sy,0

    { Left Clipping }
    Cmp  ax,Width
    Jge @NoLeftClip
      Mov  DWidth,ax
      Neg  cx
      Mov  sx,cx
      Mov  X,0
      Jmp @RightClip
   @NoLeftClip:
      Mov  cx,Width
      Mov  DWidth,cx
   @RightClip:
    { Right Clipping }
    Cmp  ax,319
    Jle @@NoRightClip
      Sub  ax,320
      Sub  DWidth,ax
   @@NoRightClip:

    { Top Clipping }
    Cmp  bx,Height
    Jge @@NoTopClip
      Mov  DHeight,bx
      Neg  dx
      Mov  sy,dx
      Mov  Y,0
      Jmp @@BottomClip
   @@NoTopClip:
      Mov  dx,Height
      Mov  DHeight,dx
   @@BottomClip:

    Cmp  bx,199
    Jle @@NoBottomClip
      Sub  bx,200
      Sub  DHeight,bx
   @@NoBottomClip:

    Mov  ax,DWidth   { Make sure there is something to do after clipping }
    Cmp  ax,0
    Jle @@Exit
    Mov  ax,DHeight
    Cmp  ax,0
    Jle @@Exit

   { Prepare buffers }
    Push  ds
    Lds   si,CharData   { get pointer to character data }
    Mov   ax,sy
    Mov   dx,Width
    Mul   dx
    Add   si,ax
    Add   si,sx   { ds:si points to clipped location }

    Les   di,VirtualPage
    Mov   ax,Y
    Mov   dx,320
    Mul   dx
    Add   di,ax
    Add   di,X    { es:di points to screen location }

    Mov   ax,Width
    Sub   ax,DWidth
    Mov   tx,ax

    Mov   ax,320
    Sub   ax,DWidth
    Mov   ty,ax

    Mov   dx,0   { dl is the seethrough color }

    Mov   cx,DHeight
   @YLooper:
    Push  cx
    Mov   cx,DWidth
   @@XLooper:
    Mov   al,[si]   { get sprite value }
    Inc   si
    Cmp   al,dl     { check with see through value }
    Je   @SkipStore
    Mov   es:[di],al
   @SkipStore:
    Inc   di
    Dec   cx
    Jnz  @@XLooper
    Add   si,tx
    Add   di,ty
    Pop   cx
    Dec   cx
    Jnz  @YLooper
    Pop   ds
   @@Exit:
  End;
End;

Begin
{$IFNDEF VERSION_7}
  VGAPage := Ptr($A000, 0);
{$ELSE}
  VGAPage := Ptr(SegA000, 0);
{$ENDIF}
  Getmem(VirtualPage, 64000);
  FillChar(VirtualPage^, 64000, 0);
End.