[Back to GRAPHICS SWAG index] [Back to Main SWAG index] [Original]
(*
PART 1 OF NEWGRAPH.PAS
APPEND NEWGRPH2.PAS TO THE BOTTOM OF THIS FILE AND SAVE THE
COMBINED FILES AS NEWGRAPH.PAS - COMPILE NEWGRAPH.PAS AND
NOW SEE HOW MUCH FASTER AND MORE COMPLETE IT IS THAN ALL OF
THE OTHER SWAG GRAPHIC & SPRITE UNITS.
**************************************************************
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!!!
**************************************************************
READ THE DISCLAIMER FIRST BEFORE DOING ANYTHING!!!
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.
THE DISCLAIMER
--------------
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
tricks..)
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.
}
{$A+,B-,E+,F-,G+,N+,Q-,R-,S-}
UNIT NEWGRAPH;
INTERFACE
Const
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.
}
TYPE
PaletteType = record
RedLevel: Array[0..MaxColours-1] of byte;
GreenLevel: Array[0..MaxColours-1] of byte;
BlueLevel: Array[0..MaxColours-1] of byte;
end;
{
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 }
End;
{ 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;
x,y,widthtoshow,heighttoshow:word);
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);
IMPLEMENTATION
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
programs)}
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 ? }
end;
{
****************
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.
}
Var
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;
Asm
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 }
MOV [ES:DI],AX
LES DI,Offs { And variable Offs }
MOV [ES:DI],BX
End;
{
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;
asm
XOR AH,AH
MOV AL,$13 { Mode 19 is the mode we want ! ;-) }
INT $10 { VGA 256 Colours here we come }
End;
{
****************************
BITMAP MANIPULATION ROUTINES
****************************
}
(*
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
screen.
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;
Begin
GetMem(MemoryAccessVar,64000);
GetPtrData(MemoryAccessVar,BmapSegment,BmapOffset);
End;
(*
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;
Begin
ThePointer:=Ptr(BmapSegment,BmapOffset);
FreeMem(ThePointer,64000);
End;
{
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;
Asm
MOV CX,2000
CLD
{ The reason I have repeated the instructions 8 times is because
this method is a lot faster than :
@Copy:
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?)
}
@Copy:
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
End;
{
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;
Asm
MOV DX,DS
MOV AX,$a000
MOV ES,AX
XOR DI,DI
MOV SI,BmapOffset
MOV DS,BmapSegment
CALL FastCopy
End;
(*
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;
Asm
MOV DX,DS
MOV ES,DestinationBitmapSegment
MOV DI,DestinationBitmapOffset
MOV SI,SourceBitmapOffset
MOV DS,SourceBitmapSegment
CALL FastCopy
End;
{
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;
Asm
MOV AX,SourceBitmapSegment
MOV BX,SourceBitmapOffset
LES DI,SourceSeg
MOV [ES:DI],AX
LES DI,SourceOfs
MOV [ES:DI],AX
End;
{
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;
Asm
MOV AX,NewSourceSeg
MOV SourceBitmapSegment,AX
MOV AX,NewSourceOfs
MOV SourceBitmapOffset,AX
End;
{
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;
Asm
MOV AX,DestinationBitmapSegment
LES DI,DestinationSeg
MOV [ES:DI],AX
MOV AX,DestinationBitmapOffset
LES DI,DestinationOfs
MOV [ES:DI],AX
End;
{
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;
Asm
MOV AX,NewDestinationBitmapSeg
MOV DestinationBitmapSegment,AX
MOV AX,NewDestinationBitmapOfs
MOV DestinationBitmapOffset,AX
End;
{
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;
Asm
MOV AX,SourceBitmapSegment
MOV DestinationBitmapSegment,AX
MOV AX,SourceBitmapOffset
MOV DestinationBitmapOffset,AX
End;
{
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
effect.
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;
Asm
MOV DX,DS { Save DS - faster than using stack }
MOV DI,DestinationBitmapOffset
MOV ES,DestinationBitmapSegment
MOV SI,SourceBitmapOffset
MOV DS,SourceBitmapSegment
MOV CX,16000
@CheckIfTransparent:
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 }
@ALClear:
INC DI
OR AH,AH { Check if AH is 0 }
JZ @AHClear { Shouldn't blit with a 0 byte }
MOV [ES:DI],AH
@AHClear:
INC DI
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 }
@EALClear:
INC DI
OR AH,AH { Check if AH is 0 }
JZ @NoBlit { Shouldn't blit with a 0 byte }
MOV [ES:DI],AH
@NoBlit:
INC DI { Next byte }
DEC CX { Reduce count }
JNZ @CheckIfTransparent
MOV DS,DX { Restore DS }
End;
{
***********************
PRIMITIVE DRAWING TOOLS
***********************
}
{
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;
Asm
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. }
@OutOfBounds:
MOV BX,-1 { Signal that coordinates were not within
the screen limits }
@Finito:
End;
{
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;
Asm
MOV AX,X
MOV BX,Y
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
XOR AH,AH
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! }
@NoGet:
MOV AX,BX { AX = -1, meaning no pixel could be
read }
@Finished:
End;
{
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;
Asm
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
@NoPlot:
End;
{
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;
Asm
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 }
End;
{
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;
Var
LgDelta,
ShDelta,
LgStep,
ShStep,
Cycle : word;
Asm
MOV BX,X2 { LgDelta = X2 - X1 }
MOV SI,X1
SUB BX,SI
MOV LgDelta,BX
MOV CX,Y2 { ShDelta = Y2 - Y1 }
MOV DI,Y1
SUB CX,DI
MOV ShDelta,CX
TEST BH,$80 { If bit 7 not set .. }
JZ @LgDeltaPos { Goto LgDeltaPos }
NEG BX
MOV LgDelta,BX
MOV LgStep,$FFFF
JMP @Cont1
@LgDeltaPos:
MOV LgStep,1
@Cont1:
CMP CH,$80 { If ShDelta < 0 Then.. }
JB @ShDeltaPos
NEG CX
MOV ShDelta,CX
MOV ShStep,$FFFF
JMP @Cont2
@ShDeltaPos:
MOV ShStep,1
@Cont2:
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.
}
MOV CX,X2
@FirstLoop:
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
MOV CX,ES
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
}
@OtherWay:
MOV AX,CX
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 }
MOV DX,Y2
@SecondLoop:
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
@GetTheShitOut:
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 }
End;
{
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;
Asm
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. }
End;
{
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;
Asm
PUSH EndX
PUSH EndY
PUSH CursorX
PUSH CursorY
CALL Line
MOV AX,EndX
MOV CursorX,AX
MOV AX,EndY
MOV CursorY,AX
End;
{
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);
Begin
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 }
End;
{
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;
Asm
MOV AX,NewCursX
MOV CursorX,AX
MOV AX,NewCursY
MOV CursorY,AX
End;
{
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;
Asm
MOV AX,CursorX
End;
{
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;
Asm
MOV AX, CursorY
End;
{
*************
FONT ROUTINES
*************
}
{
Select which of the Fonts in ROM you use to write text to the
screen.
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;
Asm
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
@Set8x8:
MOV AL,8 { Width of 8 }
MOV AH,8 { Height of 8 }
MOV BL,1 { 1 byte's width }
JMP @DoWrite
@Check8x14Font:
CMP BH,Font8x14
JNZ @Check8x16Font
MOV AL,8 { Width 8, Height 14, ByteWidth 1 }
MOV AH,14
MOV BL,1
JMP @DoWrite
@Check8x16Font:
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
@UseRomAlternateFont:
MOV AL,9
MOV AH,16
MOV BL,2
@DoWrite:
MOV CurrentFontWidth,AL { Write Font details so that }
MOV CurrentFontByteWidth,BL { outtextXY etc. can work with }
MOV CurrentFontHeight,AH { this Font }
@NoWriteSize:
End;
{
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;
Asm
MOV AX,CurrentFontSegment
LES DI,FontSeg
MOV [ES:DI],AX
MOV AX,CurrentFontOffset
LES DI,FontOfs
MOV [ES:DI],AX
End;
{
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
address.
Returns : Nothing
Corrupts : AX
}
Procedure SetCurrentFontAddr(NewFontSeg,NewFontOfs:word); Assembler;
Asm
MOV AX,NewFontSeg
MOV CurrentFontSegment,AX
MOV AX,NewFontOfs
MOV CurrentFontOffset,AX
End;
{
Find out what width and height the current Font is.
Expects: CurrFontWidth and CurrFontHeight are two uninitialised
variables.
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;
Asm
MOV AL,CurrentFontWidth
MOV AH,CurrentFontHeight
LES DI,CurrFontWidth { ES: DI points to variable now }
MOV [ES:DI],AL
LES DI,CurrFontHeight
MOV [ES:DI],AH
End;
{
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;
Asm
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
@IllegalSize:
End;
{
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
character.
Returns : This Function returns the offset address of character.
Corrupts : AX,BX,DX
}
Function GetROMCharOffset(CharNum:byte): word; assembler;
Asm
MOV AL,CharNum { Get number of character into AL }
MOV BH,CurrentFontByteWidth
MOV BL,CurrentFontHeight
MUL BL { Multiply character num by FontHeight }
MOV BL,BH
XOR BH,BH
MUL BX { And FontWidth }
ADD AX,CurrentFontOffset { Now add in the font offset }
End;
(*
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 }
End;
*)
Procedure LoadFont(FontFileName:String; Var FontRec: FontType);
Var FontFile : File;
BytesToReserve : word;
FontPtr : Pointer;
Begin
Assign(FontFile,FontFileName);
Reset(FontFile,1);
BlockRead(FontFile,FontRec,SizeOf(FontRec));
With FontRec Do
Begin
BytesToReserve:=FontChars * (FontByteWidth * FontHeight);
GetMem(FontPtr,BytesToReserve);
GetPtrData(FontPtr,FontSeg,FontOfs);
BlockRead(FontFile,Mem[FontSeg:FontOfs],BytesToReserve);
End;
Close(FontFile);
End;
{
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
(0-255);
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;
Begin
With TempFontRec do
Begin
FontSeg:=0; { 0 Meaning uninitialised }
FontOfs:=0;
FontByteWidth:=CurrentFontByteWidth;
FontWidth:=CurrentFontWidth;
FontHeight:=CurrentFontHeight;
FontChars:=NumChars;
End;
Assign(FontFile,FontFileName);
Rewrite(FontFile,1);
BlockWrite(FontFile,TempFontRec,SizeOf(TempFontRec));
BytesPerChar:=CurrentFontByteWidth * CurrentFontHeight;
FirstCharOffset:=CurrentFontOffset+(FirstChar * BytesPerChar);
BlockWrite(FontFile, Mem[CurrentFontSegment:FirstCharOffset],
NumChars * BytesPerChar);
Close(FontFile);
End;
{
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);
Begin
With FontRec Do
Begin
CurrentFontSegment:=FontSeg;
CurrentFontOffset:=FontOfs;
SetCurrentFontSize(FontWidth,FontHeight);
End;
End;
{
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
printed.
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;
Asm
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 }
@ReadChar:
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
@ScanLineLoop:
PUSH CX { Save Vert Count on stack }
MOV CH,CurrentFontByteWidth
@OuterLoop:
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 }
{
Otherwise..
}
MOV BP, AX { Save X - Coord }
MOV DH,8 { 8 bits make a character's byte }
MOV DL,CurrentColour { FPutPixel needs this }
@PlotLoop:
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 }
@NoPlot:
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
@RestoreByteOffset:
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
@NoWrite:
End;
{
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);
Begin
OutTextXY(CursorX,CursorY,txt);
End;
[Back to GRAPHICS SWAG index] [Back to Main SWAG index] [Original]