[Back to GRAPHICS SWAG index]  [Back to Main SWAG index]  [Original]


NEWGRAPH! The (now slightly outdated) 320 x 200 x 256 VGA MODE
SUPPORT UNIT by Scott Tunstall (C) 1994, 1996. (Rev 1. created
in 1994, Final rev. Sept 1995)

Next project : This package converted to support VESA 16.7
               Million Colour graphic modes. (That'll be a
               task and a half)

After that   : Sleep for a year!!!



Purpose of unit
The purpose of this unit is to provide an all-in-one package to
allow you to write FAST games in Turbo Pascal.

The unit incorporates :

         o Easy bitmap initialisation and manipulation routines

         o The fastest masked/unmasked/clipped sprite graphics
           routines you will EVER see for a 386/486 processor.

         o Easy to use palette routines (Not as many as I would
           have liked to have included but there are 100s of
           them available in the public domain - feel free to
           use em if ya like.)

         o Font load/save/display routines which are also the
           fastest you'll see (in 1994).

         o Versatile PCX load routines which can handle page sizes
           up to 320 x 200 (Handy for grabbing sprites.)

ALL time critical routines (i.e. Sprite drawing, Bitmap copying)
are written in 100% assembly language and have all been tested
extensively. (Yes Ronny I did write the assembler)

So in other words your machine shouldn't bomb when you use this unit!
(See Disclaimer)

Any drawbacks ?

Err.. unfortunately (due to the limitations of Pascal's 286
restrictions) you can't have a bitmap that exceeds 64K - yes
I know this sucks but huge pointers don't exist in Pascal!!

The speed in some areas isn't as fast as it could be.. shit!!
So, I am considering writing a version of this unit which does
not use standard Pascal "stack frames" (Where Procedure parameters are
moved to) but instead requires registers to be set on entry (about
100% faster).

But this will all be done once me B.Sc is over.


Scott Tunstall (Me), the programmer of this pascal source and hence unit
cannot be held responsible if ANY damage, be it physical or otherwise, to
your system/peripherals etc. occurs from use/misuse of the code
and/or unit. (Not that this unit uses any system-unfriendly hack

You can distribute this unit UNALTERED and it would be nice if you
mentioned me in any software you create with this unit.

Feel free to add parts to the unit. If any good, please post em to the SWAG 
and let everyone see them. However, I would prefer to see ASM stuff be added
instead of plain vanilla pascal.

Name    : Scott Tunstall
Address : 40 leadside crescent, Fife, Scotland.

Minimum System requirements
Turbo Pascal 6 - (Mind and check some of the "switches" below ).
TP7 recommended though.

386 processor.
VGA graphics card that supports mode 13h and the 262,144
    colour palette.

CONTACT: CG93SAT@IBMRISC.DCT.AC.UK (Up till June 15 1996)

{ You may have to remove some of these switches if using TP6.
  Turbo 7 really is the bees knees (?) when it comes to software
  development, laddie.




      GetMaxX                 = 319;    { Maximum X & Y coordinates }
      GetMaxY                 = 199;
      GetMaxColour             = 255;
      MaxColours               = 256;

      Int1fFont               = 0;
      Int43Font               = 1;
      StandardVGAFont         = 1;
      Font8x8                 = 1;      { Why do I get a "Constant Out
                                        of range error" with this ? }
      Font8x14                = 2;
      Font8x8dd               = 3;      { Abbreviated }
      Font8x8ddHigh           = 4;
      AlphaAlternateFont      = 5;
      FontAlpha               = 5;
      Font8x16                = 6;
      Font9x16                = 7;      { This doesn't appear, though }
      FontRomAlt              = 7;      { it may just be my VGA }

This record is used to hold a screen/PCX's palette.

PaletteType = record
   RedLevel:   Array[0..MaxColours-1] of byte;
   GreenLevel: Array[0..MaxColours-1] of byte;
   BlueLevel:  Array[0..MaxColours-1] of byte;

This record is used to hold a Font's details, if you didn't guess
that already ;-)

FontType = record
   FontSeg       : Word;           { Where Font is located }
   FontOfs       : Word;
   FontWidth     : Byte;           { Width (In Pixels) }
   FontByteWidth : Byte;           { Pixel width divided by 8 }
   FontHeight    : Byte;           { Height (In Pixels) }
   FontChars     : Byte;           { Number of characters in Font }

{ Jump into Mode 13h }

Procedure InitVGAMode;

Bitmap initialisation and manipulation routines.

Procedure Bitmap(Var BmapSegment,BmapOffset:word);
Procedure FreeBitmap(BmapSegment,BmapOffset:word);
Procedure ShowBitmap(BmapSegment,BmapOffset:word);
Procedure GetSourceBitmapAddr(VAR SourceSeg,SourceOfs: word);
Procedure SetSourceBitmapAddr(NewSourceSeg,NewSourceOfs:word);
Procedure GetDestinationBitmapAddr(VAR DestinationSeg,DestinationOfs: word);
Procedure SetDestinationBitmapAddr(NewDestinationBitmapSeg,NewDestinationBitmapOfs:word);
Procedure CopySourceBitmap;
Procedure OverlaySourceBitmap;
Procedure DoubleBufferOff;

{ Drawing primitives }

Procedure PutPixel(x, y : integer; ColourValue : Byte);
Function  GetPixel(X,Y: integer): integer;
Procedure Line(X1, Y1, X2, Y2:integer);
Procedure LineRel(DiffX,DiffY: integer);
Procedure LineTo(Endx,Endy:integer);
Procedure Rectangle(x1,y1,x2,y2:integer);
Procedure MoveTo(NewCursX,NewCursY:integer);
Function  GetX: integer;
Function  GetY: integer;
Procedure OutTextXY(x,y:integer; txt:string);
Procedure OutText(txt:string);

{ Palette stuff }

Procedure SetColour(NewColour:byte);
Function  GetColour: byte;
Procedure GetPalette(ColourNumber : Byte; VAR RedValue, GreenValue, BlueValue : Byte);
Procedure SetPalette(ColourNumber, RedValue, GreenValue, BlueValue : Byte);
Procedure LoadPalette(FileName: String; Var Palette : PaletteType);
Procedure SavePalette(FileName: String; Palette : PaletteType);
Procedure GetAllPalette(Var Palette : PaletteType);
Procedure SetAllPalette(Palette : PaletteType);

Fast sprite (shape) routines.

Procedure GetAShape(x1,y1,x2,y2:word;Var DataPtr);
Procedure FreeShape(DataPtr:pointer);
Procedure Blit(x,y:word; Var DataPtr);
Procedure ClipBlit(x,y:integer; Var DataPtr);
Procedure Block(x,y:word; Var DataPtr);
Procedure ClipBlock(x,y:integer; Var DataPtr);
Function  BlitColl(x,y :integer; Var dataptr) : boolean;
Function  ShapeSize(x1,y1,x2,y2:word):word;
Function  ExtShapeSize(ShapeWidth, ShapeHeight : byte): word;
Function  ShapeWidth(Var DataPtr): byte;
Function  ShapeHeight(Var DataPtr): byte;
Procedure LoadShape(FileName:String; Var DataPtr:Pointer);
Procedure SaveShape(FileName:string; DataPtr:Pointer);

Custom Font routines. Unfortunately, I don't know how to load
in Windows bitmapped Fonts which is a real bast..


Procedure UseFont(FontNumber:byte);
Function  GetROMCharOffset(CharNum:byte): word;
Procedure GetCurrentFontAddr(VAR FontSeg,FontOfs:word);
Procedure SetCurrentFontAddr(NewFontSeg,NewFontOfs:word);
Procedure GetCurrentFontSize(Var CurrFontWidth, CurrFontHeight:byte);
Procedure SetCurrentFontSize(NewFontWidth, NewFontHeight:byte);
Procedure LoadFont(FontFileName:String; Var FontRec: FontType);
Procedure UseLoadedFont(FontRec : FontType);
Procedure SaveFont(FontFileName:String; FirstChar, Numchars:byte);

Can't include a GIF loader.. Compuserve don't like people using
their GIF datatype without paying a small fee.. :(

Procedure LoadPCX(FileName:string; Var ThePalette: PaletteType);
Procedure LocatePCX(filename:string; Var ThePalette: PaletteType;
Procedure SavePCX(filename:string;ThePalette: PaletteType);
Procedure SaveAreaAsPCX(filename:string;ThePalette: PaletteType;
          x,y, PCXWidth,PCXHeight: word);

Miscellaneous useful routines.

Procedure Vwait(TimeOut:word);
Procedure Cls;
Procedure CCls(TheColour : byte);


Uses CRT,Dos;

This ** structure ** was nicked from READPCX.PAS that's currently
in the SWAG. Credit to Norman Yen for writing a PCX loader program,
it was very useful for understanding the PCX compression.

But my version of the PCX loader (rewritten from scratch) is faster
(and better) than Norm's effort. And what's more it can handle Mode 13h
PCX's of any size up to 320 x 200 pixels.


type Pcxheader_rec=record               { EXPECTED VALUES / COMMENTS}
                                        { --------------------------}
     manufacturer: byte;                { 10. (Why does Z-Soft have
                                          this field ?) }
     version: byte;                     { 5. }
     encoding: byte;                    { 0.  (RLE PCX encryption) }
     bits_per_pixel: byte;              { 8.  (8 bits = 256 colours) }
     xmin, ymin: word;                  { 0,0 (Top Left) }
     xmax, ymax: word;                  { 319,199 (Bottom right) }
     hres: word;                        { 320 (although this (and vres)
                                          may be ignored by some
     vres: word;                        { 200 }
     palette: array [0..47] of byte;    { Don't use }
     reserved: byte;                    { Don't use }
     colour_planes: byte;               { 0 (Mode 13h is not planar) }
     bytes_per_line: word;              { 320 (usually, may differ -
                                          although I hear this should
                                          be an even number my PCX load
                                          /save routines work with odd
                                          numbers too) }
     palette_type: word;                { 12 (to work with this unit) }
     filler: string[58];                { Don't know the purpose of this,
                                          could it be for comments etc ? }

Variable section

Note : You could make these public variables and that would probably
increase the speed of your programs as you can access the data
directly (via assembler, for example) instead of using the
Setxxx() Procedures.

    SourceBitmapSegment:          word;
    SourceBitmapOffset:           word;
    DestinationBitmapSegment:     word;
    DestinationBitmapOffset:      word;

    CurrentFontSegment:         word;
    CurrentFontOffset:          word;
    CurrentFontWidth:           byte;
    CurrentFontByteWidth:       byte;
    CurrentFontHeight:          byte;
    CurrentColour:               byte;
    CursorX:                    integer;
    CursorY:                    integer;

    header:                     Pcxheader_rec;

This routine has nothing to do with graphics - it just helps
with some routines.

Expects : PT is a standard pointer.
          Segm and Offs are uninitialised word variables.

Returns : On exit Segm holds the segment part of the pointer
          Offs holds the offset.

Corrupts : AX,BX,DI,ES.


Procedure GetPtrData(pt:pointer; VAR Segm, Offs:word); Assembler;
   LES DI,PT            { Point ES:DI to where PT is in memory }
   MOV AX,ES            { Set AX to hold segment }
   MOV BX,DI            { BX to hold offset }

   LES DI,Segm          { Now write directly to variable Segm }
   LES DI,Offs          { And variable Offs }

Switch into VGA256 (320 x 200 x 256 Colour mode).

Expects : Nothing

Returns : Nothing

Affects : It affects the current screen mode (obviously) palette,
          Font (and the weather in eastern Czechoslovakia :-) )

Notes  : If all you want to do is clear the screen then use
         Cls or CCls, which does not affect palettes etc.

Procedure InitVGAMode; Assembler;
   MOV AL,$13   { Mode 19 is the mode we want ! ;-) }
   INT $10      { VGA 256 Colours here we come }


Allocate memory for a virtual screen. (This command
it is ALWAYS 64,000 bytes that are allocated - the same
size as what is used by the VGA bitmap.

Expects  : Two empty variables of word size which will be
           used to hold the segment and offset of the virtual

Returns  : The segment and offset of the memory area.

Corrupts : Don't know (and don't care! ).

Notes    : Unfortunately Pascal doesnt allow allocation of
           > 64K or incorportate HUGE pointers so therefore
           it was made impossible for me to have a huge bitmap
           that exceeds 64K.


Procedure Bitmap(Var BmapSegment,BmapOffset:word);
Var MemoryAccessVar: pointer;

This routine will free a virtual screen allocated by the
Bitmap routine above.

Expects :  The variables passed in as BmapSegment, BmapOffset should hold
           the same contents as what was allocated by Bitmap;

Returns :  Your machine may crash if you try and free a Bitmap that has
           not been allocated !

Corrupts : Don't know which registers are altered.


Procedure FreeBitmap(BmapSegment,BmapOffset:word);
Var ThePointer: pointer;

Procedure used to blit one bitmap to another bitmap. Private
to unit.

Expects : DS:SI points to source page
          ES:DI points to destination page
          DX holds data segment address

Corrupts : CX,SI,DI.

Returns : Nothing


Procedure FastCopy; Assembler;
     MOV CX,2000

     { The reason I have repeated the instructions 8 times is because
     this method is a lot faster than :

     DB $F3,$66,$a5
     LOOP @Copy

     If you are a total speed junkie then why not block copy those
     8 instructions, append them at the bottom, and set CX (Above)
     to 1000. In fact, for total speed freaks why not type 16,000
     of these instructions :-)

     Alternatively, buy a Pentium 120. ;-)

     (Feb 96 update: No point in me cracking that joke now when
     Melv's got a P133 - how fast technology advances eh?)

     DB $66; MOVSW      { MOVSD }
     DB $66; MOVSW
     DB $66; MOVSW
     DB $66; MOVSW
     DB $66; MOVSW
     DB $66; MOVSW
     DB $66; MOVSW
     DB $66; MOVSW      { 32 bytes moved in one loop. Whoa !}
     DEC CX
     JNZ @Copy          { On my 486 this is faster than LOOP }

     MOV DS,DX

Copy a bitmap in memory to the VGA memory, therefore showing it
on screen.

Expects  : BmapSegment, BmapOffset to point to a bitmap in memory.

Returns  : Nothing

Corrupts : AX,CX,DX,SI,DI,ES

Procedure ShowBitmap(BmapSegment,BmapOffset:word); Assembler;
   MOV AX,$a000
   MOV SI,BmapOffset
   MOV DS,BmapSegment
   CALL FastCopy

This copies the Source Bitmap to the Destination Bitmap. Simple as that.
If the Destination Bitmap resides at $a000 : 0 then the VGA screen will
be updated (The main purpose for this routine)

Expects : Source Bitmap & Destination Bitmap to point to two legal 64K
          regions of memory (By "legal" I mean you have reserved these
          regions in the program for your own use, or know that they
          are free)

Returns : Nothing.

Corrupts : CX,DX,DI,ES

Procedure CopySourceBitmap; Assembler;
     MOV DX,DS
     MOV ES,DestinationBitmapSegment
     MOV DI,DestinationBitmapOffset
     MOV SI,SourceBitmapOffset
     MOV DS,SourceBitmapSegment
     CALL FastCopy

Get the segment and offset of the source Bitmap. (Where data
is written to, i.e. Sprites, Lines, etc)

Expects : SourceSeg and SourceOfs are two uninitialised word variables

Returns : On exit from this routine SourceSeg shall hold the segment and
          SourceOfs shall hold the offset.

Corrupts : AX,BX,ES

Notes :    The value on unit initialisation is: Segment = $a000
                                                Offset  = 0.

You can change the Source Bitmap address by using SetSourceBitmapAddr.


Procedure GetSourceBitmapAddr(VAR SourceSeg,SourceOfs: word); Assembler;
   MOV AX,SourceBitmapSegment
   MOV BX,SourceBitmapOffset
   LES DI,SourceSeg
   LES DI,SourceOfs

Set the Source Bitmap address. The source Bitmap is where ALL of the
graphics operations are performed, except for copying.

Expects : NewSourceSeg = Segment of the new Source Bitmap
          NewSourceOfs = Offset of the new Source Bitmap

Returns : Nothing

Notes   : The source Bitmap must reside within the first 640K of DOS memory,
          or at segment $a000 (Video Ram).

          I am sorry about this limitation but that's MS-DOS for you.
          And before a lot of mail floods in saying "what about using XMS"
          etc. I say, "It's in my new unit, old chap" :-)

Corrupts : AX

Procedure SetSourceBitmapAddr(NewSourceSeg,NewSourceOfs:word); Assembler;
     MOV AX,NewSourceSeg
     MOV SourceBitmapSegment,AX
     MOV AX,NewSourceOfs
     MOV SourceBitmapOffset,AX


Get the address of the Destination Bitmap. (Where data is to be copied
to with CopySourceBitmap).

Expects : Two word variables to hold the segment & offset of the
          source Bitmap.

Returns : Segment & Offset of the source Bitmap.

Corrupts : AX,DI,ES.

Note : The Destination Bitmap defaults to segment $a000 offset 0.


Procedure GetDestinationBitmapAddr(VAR DestinationSeg,DestinationOfs: word); Assembler;
   MOV AX,DestinationBitmapSegment
   LES DI,DestinationSeg
   MOV AX,DestinationBitmapOffset
   LES DI,DestinationOfs

Set the address of the Destination Bitmap.

Expects :  NewDestinationBitmapSeg is the segment of the New
           Destination Bitmap. (Never! :-) )
           NewDestinationBitmapOfs is the offset.

Returns :  Nothing

Corrupts : AX


Procedure SetDestinationBitmapAddr(NewDestinationBitmapSeg,NewDestinationBitmapOfs:word); Assembler;
   MOV AX,NewDestinationBitmapSeg
   MOV DestinationBitmapSegment,AX
   MOV AX,NewDestinationBitmapOfs
   MOV DestinationBitmapOffset,AX

By setting the Destination Bitmap to the Source Bitmap, "double buffering"
is effectively turned OFF. This routine is only of use to those who
work with multiple graphics Bitmaps.

This will make sure that data is written to the Destination
Bitmap ALWAYS.

Expects : Nothing.

Returns : DestinationBitmap points to SourceBitmap.

Corrupts : AX

Procedure DoubleBufferOff; Assembler;
   MOV AX,SourceBitmapSegment
   MOV DestinationBitmapSegment,AX
   MOV AX,SourceBitmapOffset
   MOV DestinationBitmapOffset,AX

This routine will overlay the SOURCE Bitmap with the DESTINATION
Bitmap (writing the overlaid Bitmap data to the DESTINATION screen)
therefore making it possible to create a parallaxing

Of course, you could simply use it to overlay two PCXs etc. etc.

Expects : SourceBitmapSegment, SourceBitmapOffset to point to an
          initialised Bitmap. This Bitmap is treated as the
          FOREGROUND. All pixels with colour 0 within the
          bitmap are treated as TRANSPARENT.

          The same applies to DestBitmapSegment, DestBitmapOffset.
          The Dest Bitmap is treated as the BACKGROUND.

Returns : Nothing

Corrupts : AX,CX,DX,SI,DI,ES


Procedure OverlaySourceBitmap; Assembler;
   MOV DX,DS                    { Save DS - faster than using stack }

   MOV DI,DestinationBitmapOffset
   MOV ES,DestinationBitmapSegment
   MOV SI,SourceBitmapOffset
   MOV DS,SourceBitmapSegment
   MOV CX,16000

   DB $66                       { 66h indicates 32 bit destination }
   LODSW                        { LODSD -> Read DWORD from source Bitmap
                                into AX }
   OR AL,AL                     { Check if AL is 0 }
   JZ @ALClear                  { If so, can't overlay it }
   MOV [ES:DI],AL               { Otherwise, write it }

   OR AH,AH                     { Check if AH is 0 }
   JZ @AHClear                  { Shouldn't blit with a 0 byte }

   DB $66
   SHR AX,16                    { Move upper word of EAX into
                                  into AH and AL }
   OR AL,AL                     { Check if AL is 0 }
   JZ @EALClear                 { If so, can't overlay it }
   MOV [ES:DI],AL               { Otherwise, write it }

   OR AH,AH                     { Check if AH is 0 }
   JZ @NoBlit                   { Shouldn't blit with a 0 byte }

   INC DI                       { Next byte }
   DEC CX                       { Reduce count }
   JNZ @CheckIfTransparent

   MOV DS,DX                    { Restore DS }


Calculate the offset of a pixel on the SOURCE Bitmap.

Registers expected on entry:
AX = the horizontal coordinate (0 to GetMaxX) and ..
BX = the vertical coordinate (0 to GetMaxY)

Returns  : BX = -1 if X or Y were out of bounds.
           Otherwise, BX is an offset, which, combined with
           the contents of SourceBitmapSegment point to an address
           in RAM where the pixel can be plotted/read from.

Notes    : This routine is private to the unit. To maintain
           compatibility with further revisions (which I churn out
           with frightening regularity ;-) ) I recommend all extra
           unit routines that require a pixel address calc'ed call
           this proc.

Corrupts : AX, BX, CX are corrupted.


Procedure CalculateOffset; Near; Assembler;
     CMP AX,319         { Is X> 319 ? }
     JA @OutOfBounds    { Yes }
     CMP BX,199         { Is Y> 199 ?. Do not use BL instead as this is
                          when problems will occur.}
     JA @OutOfBounds    { Yes }

     XOR CH,CH                  { CX = Y }
     MOV CL,BL
     SHL CX,6                   { Y * 64 }
     MOV BH,BL                  { BX = Y * 256 }
     XOR BL,BL
     ADD BX,CX                  { BX = BX + CX, which gives Y * 320 }
     ADD BX,AX                  { Add the X position to offset in BX }
     ADD BX,SourceBitmapOffset    { Take into account the offset in memory
                                  of the source Bitmap }

     JMP @Finito                { And exit. }

     MOV BX,-1                  { Signal that coordinates were not within
                                  the screen limits }


This GetPixel routine differs from the Turbo equivalent as the
return type is integer, not word. A small point, but still
(UN)worth mentioning. <grin>

Expects  : X and Y specify the horizontal and vertical coordinates of
           a pixel. X may be 0..GetMaxX, Y may be 0..GetMaxY.

Returns  : If the coordinates are within screen bounds, then GetPixel =
           Colour at X,Y. If not, then GetPixel = -1.

Corrupts : AX/BX/CX/DX/FS.

Function GetPixel(X,Y: integer): integer; Assembler;

   CALL CalculateOffset         { Now get offset in BX }
   CMP BX,-1                    { Is coordinate off screen ? }
   JZ @NoGet                    { Yes, so return value of -1 }
   DB $8E, $26
   DW OFFSET SourceBitmapSegment

   DB $64
   MOV AL,[BX]

   JMP @Finished                { Can't put a RET here - maybe this
                                  unit was compiled in FAR mode, and
                                  a crash would occur! }

   MOV AX,BX                    { AX = -1, meaning no pixel could be
                                  read }


Write a pixel to the screen.

Expects :  AX to be the X coord for a pixel (0 to GetMaxX),
           BX for the Y coord (0 to GetMaxY) - Don't be tempted
           to optimize the code by using BL, as this causes
           problems when using negative Y coordinates. (As some
           programs will)
           DL is the colour (0 to 255) to plot.

Returns :  Nothing

Notes   :  This putpixel is private to the unit and should be
           used when plotting pixels that MAY be off screen
           to keep in step with the rest of the unit.

On exit AX,BX,CX,DX,FS are corrupt.

Procedure FPutPixel; Near; Assembler;
   CALL CalculateOffset                 { AX/ BX already set up }
   CMP BX,-1                            { Coordinates off screen ? }
   JA @NoPlot                           { Yeah, so don't put pixel }
   DB $8E,$26                           { MOV FS, [SourceBitmapSegment] }
   DW OFFSET SourceBitmapSegment
   DB $64                               { MOV [FS:BX],DL }
   MOV [BX],DL


This is the Pascal interface for the Fputpixel routine, it's
really quite sad how Pascal uses the stack so much, when you see
the likes of Turbo C & it's (amazingly interesting) register
usage which is quite fast. :(

But not as fast as me when I'm going to the pub. :-)

Expects : X = Horizontal coordinate of a pixel (0-GetMaxX)
          Y = Vertical coordinate of a pixel (0-GetMaxY)
          ColourValue = Colour to plot , 0 - 255.

Returns : Nothing

Corrupts : See FPutPixel.

Procedure PutPixel(x, y : integer; ColourValue : Byte); Assembler;
   MOV AX,x               { I wish TP had the capacity to load these
                            automatically for you, instead of creating
                            a crappy stack frame and pushing X, Y. }
   MOV BX,y               { Is it any wonder I love C++ more ? }
   MOV DL,ColourValue
   CALL FPutPixel         { Don't use a JMP, your program will crash }

This line routine was converted to assembler (by ME!!) from the
SWAG team's line draw routine (in Pascal) which was very fast.
So this means this'll be ULTRA FAST (hopefully ;-) ).

Bresenham who ? :-)  Diamond Geezer.

I wonder if this is faster than Sean Palmer's line draw in ASM ?
(Check the SWAG for that program - it's smart)

Expects : X1,Y1 defines the horizontal, vertical start of the line
          X2,Y2 defines the horizontal, vertical end of the line.
          Coordinates may be negative or exceed screen bounds.

          Line will be drawn in CurrentColour.

Returns : Nothing

Corrupts: AX,BX,CX,DX,SI,DI,ES,FS.


Procedure Line(X1, Y1, X2, Y2: Integer); Assembler;
  Cycle : word;

  MOV BX,X2             { LgDelta = X2 - X1 }
  MOV LgDelta,BX

  MOV CX,Y2             { ShDelta = Y2 - Y1 }
  MOV ShDelta,CX

  TEST BH,$80           { If bit 7 not set .. }
  JZ @LgDeltaPos        { Goto LgDeltaPos }

  MOV LgDelta,BX
  MOV LgStep,$FFFF
  JMP @Cont1

  MOV LgStep,1

  CMP CH,$80           { If ShDelta < 0 Then.. }
  JB @ShDeltaPos
  MOV ShDelta,CX
  MOV ShStep,$FFFF
  JMP @Cont2

  MOV ShStep,1

  CMP BX,CX                   { BX = LgDelta, CX = ShDelta }
  JB @OtherWay

  SHR BX,1                    { Cycle:= LgDelta SHR 1 }
  MOV Cycle,BX

  O.K. I'm going to use :
  SI as X1, DI as Y1, CX as X2, DX as Y2.


  CMP SI,CX             { While X1 <> X2 }
  JZ @GetTheShitOut     { Why not have an expletive as a label ? }

  MOV AX,SI              { Set AX and BX to X1,Y1 ready for call }
  MOV BX,DI              { BX = Y1 }

  MOV ES,CX              { The only free register ! }
  MOV DL,CurrentColour
  CALL FPutPixel

  ADD SI, LgStep         { X1 = X1 + LgStep }
  MOV AX,Cycle
  ADD AX,ShDelta         { Inc(Cycle,ShDelta) }
  MOV Cycle,AX           { Yes I did check the code and this is fastest }

  MOV BX,LgDelta
  CMP AX,BX              { If Cycle > LgDelta }
  JB @FirstLoop

  ADD DI,ShStep          { Y1 = Y1 + ShStep }
  SUB AX,LgDelta         { Dec(Cycle,LgDelta) }
  MOV Cycle,AX
  JMP @FirstLoop

  O.K. If we go in a different direction..

  On entry, BX = LgDelta, CX = ShDelta


  SHR AX,1              { ShDelta SHR 1 }
  MOV Cycle,AX
  XCHG BX,CX            { BX = ShDelta, CX = LgDelta }
  MOV LgDelta, BX
  MOV ShDelta, CX

  MOV BX,LgStep         { Swap LgStep and ShStep round }
  MOV CX,ShStep
  MOV ShStep,BX
  MOV LgStep,CX

  {MOV CX,X2}             { CX = X2, DX = Y2 }

  CMP DI,DX             { While Y1 <> Y2 do }
  JZ @GetTheShitOut

If it can, then it's time for action!

  MOV AX,SI             { Set AX and BX to X1,Y1 }
  MOV BX,DI             { BX = Y1 }

  MOV ES,DX             { Sorry, but this was the only free register ! }
  MOV DL,CurrentColour
  CALL FPutPixel
  MOV DX,ES             { .. Please don't think I am sloppy ! }

  ADD DI,LgStep         { Inc(Y1,LgStep) }
  MOV AX,Cycle          { Inc(Cycle,ShDelta) }
  ADD AX,ShDelta
  MOV Cycle,AX

  MOV BX,LgDelta

  CMP AX,BX             { If Cycle > LgDelta Then.. }
  JB @SecondLoop

  ADD SI,ShStep         { Inc(X1,ShStep) }
  SUB Cycle,BX          { Dec(Cycle,LgDelta) }
  JMP @SecondLoop

  MOV AX,X2             { Write last pixel. This was an absolute }
  MOV BX,Y2             { b****** to debug :-) }
  MOV DL,CurrentColour
  CALL FPutPixel        { Just a wee bit of Scottish humour there }


Draw a line relative from the current cursor position.
Relative means that the DiffX and DiffY values are added to the
current cursor coordinates to give the resulting horizontal and vertical
end points of the line.

For example, if CursorX and CursorY were 10,10 and DiffX and DiffY
were -10,-10 then the line would be drawn to position 0,0. Conversely,
if DiffX was 10 and DiffY was 20 then the cursor would be drawn to
X 20, Y 30.

Expects : DiffX is a non zero value that may be negative, which
          specifies the relative distance from the current horizontal
          cursor position.

          DiffY specifies the relative distance from the current
          vertical position.

Returns : Nothing

Corrupts : Probably the same as the Line routine.

Procedure LineRel(DiffX,DiffY: integer); Assembler;
     MOV AX,CursorX
     MOV BX,AX
     ADD BX,DiffX
     MOV CX,CursorY
     MOV DX,CX
     ADD DX,DiffY

     Strange method of reading the stack, Borland. :-(

     PUSH BX            { X + DiffX }
     PUSH DX            { Y + DiffY }
     PUSH AX            { X }
     PUSH CX            { Y }
     CALL Line          { Must return so dynamic vars can be moved.
                          Wish I could get rid of them quicker. }

Draw from the current cursor position to the horizontal and vertical
positions specified by EndX and EndY. The Graphics Cursor will be
moved to EndX, EndY.

Expects : EndX to be the horizontal position of the line end. (0 to GetMaxX)
          EndY to be the vertical position of the line end. (0 to GetMaxY)

Returns : Nothing, but you should be aware that the graphics cursor
          position is now at EndX, EndY.

Corrupts : AX,BX,CX,DX,SI,DI,ES,FS

Procedure LineTo(EndX,EndY:integer); Assembler;
   PUSH EndX
   PUSH EndY
   PUSH CursorX
   PUSH CursorY
   CALL Line
   MOV AX,EndX
   MOV CursorX,AX
   MOV AX,EndY
   MOV CursorY,AX

Probably not the fastest rectangle draw you'll see.
But it is economical with memory, and it works !

Expects  : X1,Y1,X2,Y2 define a rectangular window.

Returns  : Nothing

Corrupts : Not a clue.

Notes    : This routine does not move the graphics cursor.

Procedure Rectangle(x1,y1,x2,y2:integer);
     Line(x1,y1,x2,y1);         { Top Line    }
     Line(x1,y2,x2,y2);         { Bottom Line }
     Line(x1,y1+1,x1,y2-1);     { Left edge   }
     Line(x2,y1+1,x2,y2-1);     { Right edge  }

Change position of graphics cursor.

Expects : NewCursX and NewCursY are the horizontal and vertical
          coordinates that you wish to move the cursor to.
          NewCursX may be negative or more than GetMaxX.
          NewCursY may be negative or more than GetMaxY.

Returns : Nothing

Corrupts : AX.

Procedure MoveTo(NewCursX,NewCursY:integer); Assembler;
   MOV AX,NewCursX
   MOV CursorX,AX
   MOV AX,NewCursY
   MOV CursorY,AX

Returns horizontal position of graphics cursor.
GetX May be negative.

Expects : Nothing

Returns : GetX = Current graphics cursor horizontal position, which
          may be negative or even exceed GetMaxX.

Function GetX: integer; Assembler;
   MOV AX,CursorX

Returns vertical position of graphics cursor.
GetY may be negative.

Expects : Nothing

Returns : GetY = Current graphics cursor vertical position, which
          may be negative or even exceed GetMaxY.


Function GetY: integer; Assembler;
     MOV AX, CursorY



Select which of the Fonts in ROM you use to write text to the

Expects : FontNumber can be:

          0: For CGA Font (Dunno what size it is tho')
          1: For 8 x 8 Font
          2: For 8 x 14 Font
          3: For 8 x 8 Font
          4: For 8 x 8 Font high 128 characters
          5: For Rom Alpha Alternate Font
          6: For 8 x 16 Font
          7: For Rom Alternate 9 x 16 Font

Returns : Nothing

Corrupts : AX,BX,ES


Procedure UseFont(FontNumber:byte); Assembler;
     MOV AX,$1130                      { Get Font address }
     MOV BH,FontNumber
     CMP BH,7                          { Font number > 7 ? }
     JA @NoWriteSize                   { Yes, so it's invalid }

     PUSH BP                           { Mustn't corrupt BP, as Turbo
                                         needs it preserved for local
                                         variable access }
     PUSH BX                           { Nor BH as it's to be used later }
     INT $10                           { Now get Font address }
     MOV CurrentFontSegMent,ES         { ES:BP points to where Font is }
     MOV CurrentFontOffset,BP          { located in ROM }
     POP BX                            { Restore Font number }
     POP BP                            { Restore BP }

     CMP BH,Int1fFont                  { User Font in memory ? }
     JZ @NoWriteSize                   { Don't set size, could be more than
                                         8 x 8. User will have to set himself.
                                         Please correct me if I am wrong }
     CMP BH,Font8x8                    { User want any of the 8 x 8 Fonts ? }
     JZ @Set8x8
     CMP BH,Font8x8dd
     JZ @Set8x8
     CMP BH,Font8x8ddHigh
     JZ @Set8x8
     CMP BH,AlphaAlternateFont
     JNZ @Check8x14Font

     MOV AL,8                          { Width of 8 }
     MOV AH,8                          { Height of 8 }
     MOV BL,1                          { 1 byte's width }
     JMP @DoWrite

     CMP BH,Font8x14
     JNZ @Check8x16Font
     MOV AL,8                          { Width 8, Height 14, ByteWidth 1 }
     MOV AH,14
     MOV BL,1
     JMP @DoWrite

     CMP BH,Font8x16
     JNZ @UseRomAlternateFont
     MOV AL,8                          { Oh C'mon do I have to document }
     MOV AH,16                         { this ? }
     MOV BL,1
     JMP @DoWrite

     MOV AL,9
     MOV AH,16
     MOV BL,2

     MOV CurrentFontWidth,AL           { Write Font details so that }
     MOV CurrentFontByteWidth,BL       { outtextXY etc. can work with }
     MOV CurrentFontHeight,AH          { this Font }


If you wish to do your own text routines, then this returns the
address of the current Font in FontSeg and FontOfs which specify the
segment and offset address of the character set.

Expects  : Two uninitialised word variables

Returns  : FontSeg = Segment where Font is located
           FontOfs = Offset of Font

Corrupts : AX,DI,ES.


Procedure GetCurrentFontAddr(VAR FontSeg, FontOfs:word); Assembler;
   MOV AX,CurrentFontSegment
   LES DI,FontSeg
   MOV AX,CurrentFontOffset
   LES DI,FontOfs

If you want to use a Font loaded in from disk use SetFontAddr to
specify where the new Font resides in memory.

Expects : NewFontSeg and NewFontOfs are the segment and offset of the

Returns : Nothing

Corrupts : AX

Procedure SetCurrentFontAddr(NewFontSeg,NewFontOfs:word); Assembler;
   MOV AX,NewFontSeg
   MOV CurrentFontSegment,AX
   MOV AX,NewFontOfs
   MOV CurrentFontOffset,AX

Find out what width and height the current Font is.

Expects: CurrFontWidth and CurrFontHeight are two uninitialised

Returns: CurrFontWidth and CurrFontHeight on exit hold the width
         and height of the current Font. (Bet you never guessed that, huh)

Corrupts : AX,DI,ES

Procedure GetCurrentFontSize(Var CurrFontWidth, CurrFontHeight:byte); Assembler;
   MOV AL,CurrentFontWidth
   MOV AH,CurrentFontHeight

   LES DI,CurrFontWidth         { ES: DI points to variable now }
   LES DI,CurrFontHeight

Specify width and height of a user created Font.

Expects  : NewFontWidth must be above 7,
           NewFontHeight can be any non-zero number.

Returns  : Nothing

Corrupts : AX


Procedure SetCurrentFontSize(NewFontWidth, NewFontHeight:byte); Assembler;
     MOV AL,NewFontWidth
     MOV AH,NewFontHeight

     CMP AL,8                   { Width >= 8 ? }
     JB @IllegalSize
     OR AH,AH                   { Is Height 0 ? }
     JZ @IllegalSize

     MOV CurrentFontWidth,AL
     MOV CurrentFontHeight,AH
     SHR AL,3                   { Calculate byte width of characters
                                  i.e. divide width in pixels by 8 }
     MOV CurrentFontByteWidth,AL



For those of you who want to do your own text routines, this
Procedure may lighten your workload a bit.

Expects : Characternumber to be (obviously) the number of the

Returns : This Function returns the offset address of character.

Corrupts : AX,BX,DX

Function GetROMCharOffset(CharNum:byte): word; assembler;
   MOV AL,CharNum                  { Get number of character into AL }
   MOV BH,CurrentFontByteWidth
   MOV BL,CurrentFontHeight
   MUL BL                          { Multiply character num by FontHeight }
   MUL BX                          { And FontWidth }
   ADD AX,CurrentFontOffset        { Now add in the font offset }

This routine lets you load bitmapped Font files (created by this
unit) from disk. Currently I am examining the file format of
Compugraphic Fonts and basically I understand absolutely sod all
of it.. send me some code for reading them please !!

FontType = record
   FontSeg    : Word;           { Where Font is located; when loaded }
   FontOfs    : Word;           { in these are set by system }
   FontWidth  : Byte;           { Width (In Pixels) }
   FontByteWidth : Byte;
   FontHeight : Byte;           { Height (In Pixels) }
   FontChars  : Byte;           { Number of characters in Font }


Procedure LoadFont(FontFileName:String; Var FontRec: FontType);
Var FontFile : File;
    BytesToReserve : word;
    FontPtr : Pointer;

     With FontRec Do
          BytesToReserve:=FontChars * (FontByteWidth * FontHeight);

This routine will save a portion (or all) of the current Font to disk.

Expects : FontFileName to be an MS-DOS filename to hold the char data.
          FirstChar to be the number of the first character to save
          NumChars to be the number of characters to save (You may
          only want to save part of a Font).

Returns  : Nothing

Corrupts : Don't know.

Procedure SaveFont(FontFileName:String; FirstChar, Numchars:byte);
Var TempFontRec     : FontType;
    FontFile        : File;
    BytesPerChar    : word;
    FirstCharOffset : word;

     With TempFontRec do
          FontSeg:=0;               { 0 Meaning uninitialised }


     BytesPerChar:=CurrentFontByteWidth * CurrentFontHeight;
     FirstCharOffset:=CurrentFontOffset+(FirstChar * BytesPerChar);

     BlockWrite(FontFile, Mem[CurrentFontSegment:FirstCharOffset],
     NumChars * BytesPerChar);



Use a Font loaded in from disk. Yes, I know there are many Font load
routines in the SWAG and most (if not ALL) use interrupt 10h to do
the business. But my routine doesn't because quite frankly using the
BIOS is slow, cack, and is far too limiting.

This routine allows characters of ANY size.

Expects : Variable FontRec to have been initialised (usually by LoadFont).
          You could initialise FontRec yourself if you liked and
          that would be faster than using SetFontAddr, SetFontSize etc.

Returns : Nothing

Corrupts : Don't know. That's the thing about Pascal!

Procedure UseLoadedFont(FontRec : FontType);
     With FontRec Do

Display text at a position on screen. (May be off screen)

Expects : X,Y specify the top left of where the text is to be
          txt is the actual text to be printed.

Returns : Graphics cursor position is changed. (In normal Turbo
          it is not, but what the hell)

Corrupts : AX,BX,CX,DX,SI,DI,ES,FS,GS.


Procedure OutTextXY(x,y:integer; txt:string); Assembler;
         MOV AX,X
         MOV CursorX,AX
         MOV AX,Y
         MOV CursorY,AX

         XOR BH,BH                    { Get Font height into BX }
         MOV BL,CurrentFontHeight
         NEG BX                       { Make BX negative number }

         CMP AX,BX                    { Check if text would not be
                                        seen at top edge of screen
                                        (i.e. If -FontHeight >
                                        CursorY) }
         JL @NoWrite                  { Yes, so don't write text }

         CMP AX,199                   { Check if off bottom of screen }
         JG @NoWrite                  { Yes, so don't write text }

         PUSH BP
         LES DI,TXT                   { Yes, I know LGS DI exists but
                                        it's a lot of hassle to find
                                        out it's opcodes !}
         MOV AX,ES
         DB $8E,$E8                   { MOV GS, AX }

         DB $65                       { GS : }
         MOV CL,[DI]                  { MOV CL, [GS:DI]
                                        CL = Length of string }


         INC DI                      { Prepare to read char }
         PUSH DI                     { And offset of char }
         PUSH CX

         DB $65                      { GS : }
         MOV AL,[DI]                 { AL = Character }
         XOR AH,AH

         PUSH AX

         MOV AL,CurrentFontByteWidth   { Now compute Fontbytewidth
                                         * Fontheight }
         MOV BL,CurrentFontHeight

         MUL BL                        { Fontbytewidth * FontHeight }
         MOV DI,AX                     { DI = Result }

         POP AX                        { Restore character number }
         MUL DI                        { AX = Char * (FontByteWidth *
                                         FontHite) }

         ADD AX,CurrentFontOffset
         MOV DI,AX                     { Now DI is correctly placed }

         Now blit the data to the screen
         Come on Bas, write something faster for this purpose..
         Bet you can't !

         MOV ES,CurrentFontSegment

         MOV AX,CursorX              { Update graphic coordinates }
         MOV BX,CursorY

         MOV CH,CurrentFontHeight

         PUSH CX                     { Save Vert Count on stack }
         MOV CH,CurrentFontByteWidth


         MOV CL,[ES:DI]        { Read byte from charmap }
         OR CL,CL              { test if it's 0 }
         JZ @RestoreByteOffset { If so, no point in wasting CPU time }


         MOV BP, AX            { Save X - Coord }
         MOV DH,8              { 8 bits make a character's byte }
         MOV DL,CurrentColour   { FPutPixel needs this }

         TEST CL,$80           { Bit 7 set ? }
         JZ @NoPlot            { No, so don't plot a pixel }

         MOV SI,AX             { Save X in SI - SI is the only
                                 Free register and it's faster than
                                 a PUSH }

         PUSH BX
         PUSH CX

         CALL FPutPixel        { Plot pixel at AX,BX. }

         POP CX
         POP BX
         MOV AX,SI             { Restore X coord }

         SHL CL,1              { Shift char byte left }
         INC AX                { Adjust X }

         DEC DH                { Reduce horizontal count }
         JNZ @PlotLoop         { If not 0, go to plot loop }

         MOV AX,BP

         INC DI                { move to next byte }

         DEC CH                { Reduce byte count }
         JNZ @OuterLoop

         POP CX                { Restore vert count }

         INC BX                { Add 1 to Y, assuming Y is not more
                                 than 255. Do NOT use BL to gain more
                                 speed! unexpected side effects will
                                 occur when writing text at the top of
                                 your screen }
         DEC CH                { Reduce vert count }

         JNZ @ScanLineLoop

Now is the time to update the graphics cursor after the single
character has been printed.

         MOV AL,CurrentFontWidth
         XOR AH,AH                   { Make AH 0 }
         ADD CursorX,AX              { Update the graphics cursor }

         POP CX                { Restore width. Wish there were more
                                 data registers to work with but there
                                 aren't and it's a bad situation really }
         POP DI                { Restore next char to print's offset }

         DEC CL                { Reduce char length counter }
         JNZ @ReadChar

         POP BP


Display a string of text at the current cursor position, using
the current Font.

Expects : Txt is the text to write at the current cursor position.

Returns : Graphics cursor has moved.

Corrupts : See OutTextXY.

Procedure OutText(txt:string);

[Back to GRAPHICS SWAG index]  [Back to Main SWAG index]  [Original]