|
@@ -1,1825 +0,0 @@
|
|
-unit Graph;
|
|
|
|
-
|
|
|
|
-{ *********************************************************************
|
|
|
|
-
|
|
|
|
- $Id$
|
|
|
|
-
|
|
|
|
- Copyright 1997,1998 Matthias K"oppe <[email protected]>
|
|
|
|
- This library is free software in the sense of the GNU Library GPL;
|
|
|
|
- see `License Conditions' below.
|
|
|
|
-
|
|
|
|
- Info:
|
|
|
|
-
|
|
|
|
- This unit provides the functions of Borland's Graph unit for linux,
|
|
|
|
- it uses the SVGAlib to do the actual work, so you must have svgalib
|
|
|
|
-
|
|
|
|
- on your system
|
|
|
|
-
|
|
|
|
- This version requires Free Pascal 0.99.5 or higher.
|
|
|
|
-
|
|
|
|
- Large parts have not yet been implemented or tested.
|
|
|
|
-
|
|
|
|
- History:
|
|
|
|
-
|
|
|
|
- Date Version Who Comments
|
|
|
|
- ---------- -------- ------- -------------------------------------
|
|
|
|
- 25-Sep-97 0.1 mkoeppe Initial multi-target version.
|
|
|
|
- 05-Oct-97 0.1.1 mkoeppe Linux: Added mouse use. Improved clipping.
|
|
|
|
- Added bitmap functions.
|
|
|
|
- ??-Oct-97 0.1.2 mkoeppe Fixed screenbuf functions.
|
|
|
|
- 07-Feb-98 0.1.3 mkoeppe Fixed a clipping bug in DOS target.
|
|
|
|
- 12-Apr-98 0.1.4 mkoeppe Linux: Using Michael's re-worked SVGALIB
|
|
|
|
- interface; prepared for FPC 0.99.5; removed
|
|
|
|
- dependencies.
|
|
|
|
- 15-Apr-98 0.1.5 michael Renamed to graph, inserted needed SVGlib
|
|
|
|
- declarations here so it can be used independently
|
|
|
|
- of the svgalib unit. Removed things that are NOT
|
|
|
|
- part of Borland's Graph from the unit interface.
|
|
|
|
-
|
|
|
|
-
|
|
|
|
- License Conditions:
|
|
|
|
-
|
|
|
|
- This library is free software; you can redistribute it and/or
|
|
|
|
- modify it under the terms of the GNU Library General Public
|
|
|
|
- License as published by the Free Software Foundation; either
|
|
|
|
- version 2 of the License, or (at your option) any later version.
|
|
|
|
-
|
|
|
|
- This library is distributed in the hope that it will be useful,
|
|
|
|
- but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
|
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
|
|
- Library General Public License for more details.
|
|
|
|
-
|
|
|
|
- You should have received a copy of the GNU Library General Public
|
|
|
|
- License along with this library; if not, write to the Free
|
|
|
|
- Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
|
|
-
|
|
|
|
-
|
|
|
|
- *********************************************************************}
|
|
|
|
-
|
|
|
|
-{
|
|
|
|
- Functions not currently implemented :
|
|
|
|
- -------------------------------------
|
|
|
|
- SetWriteMode
|
|
|
|
- SetLineStyle
|
|
|
|
- SetFillPattern
|
|
|
|
- SetUserCharSize
|
|
|
|
- SetTextStyle
|
|
|
|
- FillPoly
|
|
|
|
- FloodFill
|
|
|
|
- SetAspectRatio
|
|
|
|
-
|
|
|
|
- (please remove what you implement fom this list)
|
|
|
|
-}
|
|
|
|
-
|
|
|
|
-
|
|
|
|
-interface
|
|
|
|
-
|
|
|
|
-
|
|
|
|
-{ ---------------------------------------------------------------------
|
|
|
|
- Constants
|
|
|
|
- ---------------------------------------------------------------------}
|
|
|
|
-
|
|
|
|
-const
|
|
|
|
- NormalPut = 0;
|
|
|
|
- CopyPut = 0;
|
|
|
|
- XORPut = 1;
|
|
|
|
- ORPut = 2;
|
|
|
|
- ANDPut = 3;
|
|
|
|
- NotPut = 4;
|
|
|
|
- BackPut = 8;
|
|
|
|
-
|
|
|
|
- Black = 0;
|
|
|
|
- Blue = 1;
|
|
|
|
- Green = 2;
|
|
|
|
- Cyan = 3;
|
|
|
|
- Red = 4;
|
|
|
|
- Magenta = 5;
|
|
|
|
- Brown = 6;
|
|
|
|
- LightGray = 7;
|
|
|
|
- DarkGray = 8;
|
|
|
|
- LightBlue = 9;
|
|
|
|
- LightGreen = 10;
|
|
|
|
- LightCyan = 11;
|
|
|
|
- LightRed = 12;
|
|
|
|
- LightMagenta = 13;
|
|
|
|
- Yellow = 14;
|
|
|
|
- White = 15;
|
|
|
|
- Border = 16;
|
|
|
|
-
|
|
|
|
- SolidLn = 0;
|
|
|
|
- DottedLn = 1;
|
|
|
|
- CenterLn = 2;
|
|
|
|
- DashedLn = 3;
|
|
|
|
- UserBitLn = 4;
|
|
|
|
-
|
|
|
|
- EmptyFill = 0;
|
|
|
|
- SolidFill = 1;
|
|
|
|
- LineFill = 2;
|
|
|
|
- LtSlashFill = 3;
|
|
|
|
- SlashFill = 4;
|
|
|
|
- BkSlashFill = 5;
|
|
|
|
- LtBkSlashFill = 6;
|
|
|
|
- HatchFill = 7;
|
|
|
|
- XHatchFill = 8;
|
|
|
|
- InterleaveFill = 9;
|
|
|
|
- WideDotFill = 10;
|
|
|
|
- CloseDotFill = 11;
|
|
|
|
- UserFill = 12;
|
|
|
|
-
|
|
|
|
- NormWidth = 1;
|
|
|
|
- ThickWidth = 3;
|
|
|
|
-
|
|
|
|
- LeftText = 0;
|
|
|
|
- CenterText = 1;
|
|
|
|
- RightText = 2;
|
|
|
|
- BottomText = 0;
|
|
|
|
- TopText = 2;
|
|
|
|
- BaseLine = 3;
|
|
|
|
- LeadLine = 4;
|
|
|
|
-
|
|
|
|
- { Error codes }
|
|
|
|
- grOK = 0;
|
|
|
|
- grNoInitGraph = -1;
|
|
|
|
- grNotDetected = -2;
|
|
|
|
- grFileNotFound = -3;
|
|
|
|
- grInvalidDriver = -4;
|
|
|
|
- grNoLOadMem = -5;
|
|
|
|
- grNoScanMem = -6;
|
|
|
|
- grNoFloodMem = -7;
|
|
|
|
- grFontNotFound = -8;
|
|
|
|
- grNoFontMem = -9;
|
|
|
|
- grInvalidmode = -10;
|
|
|
|
- grError = -11;
|
|
|
|
- grIOerror = -12;
|
|
|
|
- grInvalidFont = -13;
|
|
|
|
- grInvalidFontNum = -14;
|
|
|
|
-
|
|
|
|
- { graphic drivers }
|
|
|
|
- CurrentDriver = -128;
|
|
|
|
- Detect = 0;
|
|
|
|
-
|
|
|
|
- { graph modes }
|
|
|
|
- Default = 0;
|
|
|
|
-
|
|
|
|
-
|
|
|
|
-{ ---------------------------------------------------------------------
|
|
|
|
- Types
|
|
|
|
- ---------------------------------------------------------------------}
|
|
|
|
-
|
|
|
|
-Type
|
|
|
|
- FillPatternType = array[1..8] of byte;
|
|
|
|
-
|
|
|
|
- ArcCoordsType = record
|
|
|
|
- x,y : integer;
|
|
|
|
- xstart,ystart : integer;
|
|
|
|
- xend,yend : integer;
|
|
|
|
- end;
|
|
|
|
-
|
|
|
|
- RGBColor = record
|
|
|
|
- r,g,b,i : byte;
|
|
|
|
- end;
|
|
|
|
-
|
|
|
|
-
|
|
|
|
- PaletteType = record
|
|
|
|
- Size : integer;
|
|
|
|
- Colors : array[0..767]of Byte;
|
|
|
|
- end;
|
|
|
|
-
|
|
|
|
-
|
|
|
|
- LineSettingsType = record
|
|
|
|
- linestyle : word;
|
|
|
|
- pattern : word;
|
|
|
|
- thickness : word;
|
|
|
|
- end;
|
|
|
|
-
|
|
|
|
- TextSettingsType = record
|
|
|
|
- font : word;
|
|
|
|
- direction : word;
|
|
|
|
- charsize : word;
|
|
|
|
- horiz : word;
|
|
|
|
- vert : word;
|
|
|
|
- end;
|
|
|
|
-
|
|
|
|
- FillSettingsType = record
|
|
|
|
- pattern : word;
|
|
|
|
- color : longint;
|
|
|
|
- end;
|
|
|
|
-
|
|
|
|
- PointType = record
|
|
|
|
- x,y : integer;
|
|
|
|
- end;
|
|
|
|
-
|
|
|
|
- ViewPortType = record
|
|
|
|
- x1,y1,x2,y2 : integer;
|
|
|
|
- Clip : boolean;
|
|
|
|
- end;
|
|
|
|
-
|
|
|
|
-
|
|
|
|
-
|
|
|
|
- const
|
|
|
|
- fillpattern : array[0..12] of FillPatternType = (
|
|
|
|
- ($00,$00,$00,$00,$00,$00,$00,$00), { Hintergrundfarbe }
|
|
|
|
- ($ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff), { Vordergrundfarbe }
|
|
|
|
- ($ff,$ff,$00,$00,$ff,$ff,$00,$00), { === }
|
|
|
|
- ($01,$02,$04,$08,$10,$20,$40,$80), { /// }
|
|
|
|
- ($07,$0e,$1c,$38,$70,$e0,$c1,$83), { /// als dicke Linien }
|
|
|
|
- ($07,$83,$c1,$e0,$70,$38,$1c,$0e), { \\\ als dicke Linien }
|
|
|
|
- ($5a,$2d,$96,$4b,$a5,$d2,$69,$b4), { \ \\ \ }
|
|
|
|
- ($ff,$88,$88,$88,$ff,$88,$88,$88), { K„stchen }
|
|
|
|
- ($18,$24,$42,$81,$81,$42,$24,$18), { Rauten }
|
|
|
|
- ($cc,$33,$cc,$33,$cc,$33,$cc,$33), { "Mauermuster" }
|
|
|
|
- ($80,$00,$08,$00,$80,$00,$08,$00), { weit auseinanderliegende Punkte }
|
|
|
|
- ($88,$00,$22,$00,$88,$00,$22,$00), { dichte Punkte}
|
|
|
|
- (0,0,0,0,0,0,0,0) { benutzerdefiniert }
|
|
|
|
- );
|
|
|
|
-
|
|
|
|
-
|
|
|
|
-
|
|
|
|
-{ ---------------------------------------------------------------------
|
|
|
|
- Function Declarations
|
|
|
|
-
|
|
|
|
- ---------------------------------------------------------------------}
|
|
|
|
-
|
|
|
|
-{ Retrieving coordinates }
|
|
|
|
-function GetX: Integer;
|
|
|
|
-function GetY: Integer;
|
|
|
|
-
|
|
|
|
-{ Pixel-oriented routines }
|
|
|
|
-procedure PutPixel(X, Y: Integer; Pixel: Word);
|
|
|
|
-function GetPixel(X, Y: Integer): Word;
|
|
|
|
-
|
|
|
|
-{ Line-oriented primitives }
|
|
|
|
-procedure SetWriteMode(WriteMode: Integer);
|
|
|
|
-procedure LineTo(X, Y: Integer);
|
|
|
|
-procedure LineRel(Dx, Dy: Integer);
|
|
|
|
-procedure MoveTo(X, Y: Integer);
|
|
|
|
-procedure MoveRel(Dx, Dy: Integer);
|
|
|
|
-procedure Line(x1, y1, x2, y2: Integer);
|
|
|
|
-procedure SetLineStyle(LineStyle: Word; Pattern: Word; Thickness: Word);
|
|
|
|
-
|
|
|
|
-{ Linearly bounded primitives }
|
|
|
|
-procedure Rectangle(x1, y1, x2, y2: Integer);
|
|
|
|
-procedure Bar(x1, y1, x2, y2: Integer);
|
|
|
|
-procedure Bar3D(x1, y1, x2, y2: Integer; Depth: Word; Top: Boolean);
|
|
|
|
-procedure DrawPoly(NumPoints: Word; var PolyPoints);
|
|
|
|
-procedure FillPoly(NumPoints: Word; var PolyPoints);
|
|
|
|
-procedure SetFillStyle(Pattern: Word; Color: Word);
|
|
|
|
-procedure SetFillPattern(Pattern: FillPatternType; Color: Word);
|
|
|
|
-procedure FloodFill(X, Y: Integer; Border: Word);
|
|
|
|
-
|
|
|
|
-{ Nonlinearly bounded primitives }
|
|
|
|
-
|
|
|
|
-procedure Arc(X, Y: Integer; StAngle, EndAngle, Radius: Word);
|
|
|
|
-procedure GetArcCoords(var ArcCoords: ArcCoordsType);
|
|
|
|
-procedure Circle(X, Y: Integer; Radius: Word);
|
|
|
|
-procedure Ellipse(X, Y: Integer; StAngle, EndAngle: Word; XRadius, YRadius : Word);
|
|
|
|
-procedure FillEllipse(X, Y: Integer; XRadius, YRadius : Word);
|
|
|
|
-procedure SetAspectRatio(Xasp, Yasp: Word);
|
|
|
|
-procedure PieSlice(X, Y: Integer; StAngle, EndAngle, Radius: Word);
|
|
|
|
-procedure Sector(X, Y: Integer; StAngle, EndAngle, XRadius, YRadius: Word);
|
|
|
|
-
|
|
|
|
-{ Color routines }
|
|
|
|
-procedure SetBkColor(ColorNum: Word);
|
|
|
|
-procedure SetColor(Color: Word);
|
|
|
|
-Function GetBkColor : Word;
|
|
|
|
-Function GetColor : Word;
|
|
|
|
-function GetMaxColor : Word;
|
|
|
|
-Procedure GetDefaultPalette (Var Palette : PaletteType);
|
|
|
|
-Procedure GetPalette (Var Palette : PaletteType);
|
|
|
|
-Function GetPaletteSize : Word;
|
|
|
|
-Procedure SetAllPalette (Var Palette);
|
|
|
|
-Procedure SetPalette (ColorNr : Word; NewColor : ShortInt);
|
|
|
|
-
|
|
|
|
-{ Filling/linestyle utilities }
|
|
|
|
-Procedure GetFillSettings (Var FillSettings : FillSettingsType);
|
|
|
|
-Procedure GetFillPattern (Var FillPattern : FillPatternType);
|
|
|
|
-Procedure GetLineSettings (Var LineInfo : LineSettingsType);
|
|
|
|
-
|
|
|
|
-{ Bitmap utilities }
|
|
|
|
-procedure GetImage(x1, y1, x2, y2: Integer; var BitMap);
|
|
|
|
-procedure PutImage(X, Y: Integer; var BitMap; BitBlt: Word);
|
|
|
|
-function ImageSize(x1, y1, x2, y2: Integer): LongInt;
|
|
|
|
-
|
|
|
|
-{ Text routines}
|
|
|
|
-procedure OutText(TextString: string);
|
|
|
|
-procedure OutTextXY(X, Y: Integer; TextString: string);
|
|
|
|
-procedure SetTextJustify(Horiz, Vert: Word);
|
|
|
|
-procedure SetTextStyle(Font, Direction: Word; CharSize: Word);
|
|
|
|
-procedure SetUserCharSize(MultX, DivX, MultY, DivY: Word);
|
|
|
|
-procedure GetTextSettings (Var TextInfo : TextSettingsType);
|
|
|
|
-
|
|
|
|
-{ Graph clipping method }
|
|
|
|
-Procedure SetViewPort(x1, y1, x2, y2: Integer; Clip: Boolean);
|
|
|
|
-Procedure ClearViewPort;
|
|
|
|
-Procedure GetViewSettings (Var ViewPort : ViewPortType);
|
|
|
|
-
|
|
|
|
-{ Init/Done }
|
|
|
|
-procedure InitVideo;
|
|
|
|
-procedure DoneVideo;
|
|
|
|
-
|
|
|
|
-{ Other }
|
|
|
|
-function GetResX: Integer;
|
|
|
|
-function GetResY: Integer;
|
|
|
|
-function GetAspect: Real;
|
|
|
|
-Procedure GetAspectRatio (Var x,y : Word);
|
|
|
|
-function GetMaxX : Integer;
|
|
|
|
-function GetMAxY : Integer;
|
|
|
|
-
|
|
|
|
-{ For compatibility }
|
|
|
|
-Procedure DetectGraph (Var Driver,Mode : Integer);
|
|
|
|
-Procedure InitGraph (Var Driver,Mode : Integer;DriverPath : String);
|
|
|
|
-Procedure CloseGraph;
|
|
|
|
-Function GraphResult : Integer;
|
|
|
|
-Procedure GraphDefaults ;
|
|
|
|
-Function GraphErrorMsg (Errcode : Integer) : String;
|
|
|
|
-Procedure ClearDevice;
|
|
|
|
-Function GetDriverName : String;
|
|
|
|
-Function GetGraphMode : Integer;
|
|
|
|
-Function GetMaxMode : Word;
|
|
|
|
-Function GetModeName (Var Modus : INteger) : String;
|
|
|
|
-Procedure GetModeRange (Driver : Integer; Var loModus,HiModus : Integer);
|
|
|
|
-Function InstallUserDriver (DriverPat :String; AutodetectPtr : Pointer) : Integer;
|
|
|
|
-Function InstallUserFont (FontPath : String) : Integer;
|
|
|
|
-Function RegisterBGIDriver (Driver : Pointer) : Integer;
|
|
|
|
-Function RegisterBGIFont (Font : Pointer) : Integer;
|
|
|
|
-Procedure RestoreCRTmode;
|
|
|
|
-Procedure SetActivePage (Page : Word);
|
|
|
|
-Procedure SetGraphBufSize (BufSize : Word);
|
|
|
|
-Procedure SetGraphMode (Mode :Integer);
|
|
|
|
-Procedure SetVisualPage (Page : Word);
|
|
|
|
-
|
|
|
|
-const
|
|
|
|
- NoGraphics: Boolean = false;
|
|
|
|
-
|
|
|
|
- { VGA modes }
|
|
|
|
- GTEXT = 0; { Compatible with VGAlib v1.2 }
|
|
|
|
- G320x200x16 = 1;
|
|
|
|
- G640x200x16 = 2;
|
|
|
|
- G640x350x16 = 3;
|
|
|
|
- G640x480x16 = 4;
|
|
|
|
- G320x200x256 = 5;
|
|
|
|
- G320x240x256 = 6;
|
|
|
|
- G320x400x256 = 7;
|
|
|
|
- G360x480x256 = 8;
|
|
|
|
- G640x480x2 = 9;
|
|
|
|
-
|
|
|
|
- G640x480x256 = 10;
|
|
|
|
- G800x600x256 = 11;
|
|
|
|
- G1024x768x256 = 12;
|
|
|
|
-
|
|
|
|
- G1280x1024x256 = 13; { Additional modes. }
|
|
|
|
-
|
|
|
|
- G320x200x32K = 14;
|
|
|
|
- G320x200x64K = 15;
|
|
|
|
- G320x200x16M = 16;
|
|
|
|
- G640x480x32K = 17;
|
|
|
|
- G640x480x64K = 18;
|
|
|
|
- G640x480x16M = 19;
|
|
|
|
- G800x600x32K = 20;
|
|
|
|
- G800x600x64K = 21;
|
|
|
|
- G800x600x16M = 22;
|
|
|
|
- G1024x768x32K = 23;
|
|
|
|
- G1024x768x64K = 24;
|
|
|
|
- G1024x768x16M = 25;
|
|
|
|
- G1280x1024x32K = 26;
|
|
|
|
- G1280x1024x64K = 27;
|
|
|
|
- G1280x1024x16M = 28;
|
|
|
|
-
|
|
|
|
- G800x600x16 = 29;
|
|
|
|
- G1024x768x16 = 30;
|
|
|
|
- G1280x1024x16 = 31;
|
|
|
|
-
|
|
|
|
- G720x348x2 = 32; { Hercules emulation mode }
|
|
|
|
-
|
|
|
|
- G320x200x16M32 = 33; { 32-bit per pixel modes. }
|
|
|
|
- G640x480x16M32 = 34;
|
|
|
|
- G800x600x16M32 = 35;
|
|
|
|
- G1024x768x16M32 = 36;
|
|
|
|
- G1280x1024x16M32 = 37;
|
|
|
|
-
|
|
|
|
- { additional resolutions }
|
|
|
|
- G1152x864x16 = 38;
|
|
|
|
- G1152x864x256 = 39;
|
|
|
|
- G1152x864x32K = 40;
|
|
|
|
- G1152x864x64K = 41;
|
|
|
|
- G1152x864x16M = 42;
|
|
|
|
- G1152x864x16M32 = 43;
|
|
|
|
-
|
|
|
|
- G1600x1200x16 = 44;
|
|
|
|
- G1600x1200x256 = 45;
|
|
|
|
- G1600x1200x32K = 46;
|
|
|
|
- G1600x1200x64K = 47;
|
|
|
|
- G1600x1200x16M = 48;
|
|
|
|
- G1600x1200x16M32 = 49;
|
|
|
|
-
|
|
|
|
- GLASTMODE = 49;
|
|
|
|
-
|
|
|
|
-
|
|
|
|
-
|
|
|
|
-implementation
|
|
|
|
-
|
|
|
|
-uses Objects, Linux;
|
|
|
|
-
|
|
|
|
-
|
|
|
|
-{ ---------------------------------------------------------------------
|
|
|
|
- SVGA bindings.
|
|
|
|
-
|
|
|
|
- ---------------------------------------------------------------------}
|
|
|
|
-
|
|
|
|
-{ Link with VGA, gl and c libraries }
|
|
|
|
-{$linklib vga}
|
|
|
|
-{$linklib vgagl}
|
|
|
|
-{$linklib c}
|
|
|
|
-
|
|
|
|
-Const
|
|
|
|
- { Text }
|
|
|
|
-
|
|
|
|
- WRITEMODE_OVERWRITE = 0;
|
|
|
|
- WRITEMODE_MASKED = 1;
|
|
|
|
- FONT_EXPANDED = 0;
|
|
|
|
- FONT_COMPRESSED = 2;
|
|
|
|
-
|
|
|
|
- { Types }
|
|
|
|
- type
|
|
|
|
- pvga_modeinfo = ^vga_modeinfo;
|
|
|
|
- vga_modeinfo = record
|
|
|
|
- width,
|
|
|
|
- height,
|
|
|
|
- bytesperpixel,
|
|
|
|
- colors,
|
|
|
|
- linewidth, { scanline width in bytes }
|
|
|
|
- maxlogicalwidth, { maximum logical scanline width }
|
|
|
|
- startaddressrange, { changeable bits set }
|
|
|
|
- maxpixels, { video memory / bytesperpixel }
|
|
|
|
- haveblit, { mask of blit functions available }
|
|
|
|
- flags: Longint; { other flags }
|
|
|
|
- { Extended fields: }
|
|
|
|
- chiptype, { Chiptype detected }
|
|
|
|
- memory, { videomemory in KB }
|
|
|
|
- linewidth_unit: Longint; { Use only a multiple of this as parameter for set_displaystart }
|
|
|
|
- linear_aperture: PChar; { points to mmap secondary mem aperture of card }
|
|
|
|
- aperture_size: Longint; { size of aperture in KB if size>=videomemory.}
|
|
|
|
-
|
|
|
|
- set_aperture_page: procedure (page: Longint);
|
|
|
|
- { if aperture_size<videomemory select a memory page }
|
|
|
|
- extensions: Pointer; { points to copy of eeprom for mach32 }
|
|
|
|
- { depends from actual driver/chiptype.. etc. }
|
|
|
|
- end;
|
|
|
|
-
|
|
|
|
- PGraphicsContext = ^TGraphicsContext;
|
|
|
|
- TGraphicsContext = record
|
|
|
|
- ModeType: Byte;
|
|
|
|
- ModeFlags: Byte;
|
|
|
|
- Dummy: Byte;
|
|
|
|
- FlipPage: Byte;
|
|
|
|
- Width: LongInt;
|
|
|
|
- Height: LongInt;
|
|
|
|
- BytesPerPixel: LongInt;
|
|
|
|
- Colors: LongInt;
|
|
|
|
- BitsPerPixel: LongInt;
|
|
|
|
- ByteWidth: LongInt;
|
|
|
|
- VBuf: pointer;
|
|
|
|
- Clip: LongInt;
|
|
|
|
- ClipX1: LongInt;
|
|
|
|
- ClipY1: LongInt;
|
|
|
|
- ClipX2: LongInt;
|
|
|
|
- ClipY2: LongInt;
|
|
|
|
- ff: pointer;
|
|
|
|
- end;
|
|
|
|
-
|
|
|
|
-
|
|
|
|
- { vga functions }
|
|
|
|
- Function vga_init: Longint; Cdecl; External;
|
|
|
|
- Function vga_getdefaultmode: Longint; Cdecl; External;
|
|
|
|
-
|
|
|
|
- Function vga_hasmode(mode: Longint): Boolean; Cdecl; External;
|
|
|
|
-
|
|
|
|
- Function vga_getmodeinfo(mode: Longint): pvga_modeinfo; Cdecl; External;
|
|
|
|
- Function vga_setmode(mode: Longint): Longint; Cdecl; External;
|
|
|
|
- Function vga_getxdim : Longint; cdecl;external;
|
|
|
|
- Function vga_getydim : longint; cdecl;external;
|
|
|
|
-
|
|
|
|
- { gl functions }
|
|
|
|
- procedure gl_setpixel(x, y, c: LongInt); Cdecl; External;
|
|
|
|
- function gl_getpixel(x, y: LongInt): LongInt; cdecl; external;
|
|
|
|
- procedure gl_line(x1, y1, x2, y2, c: LongInt); Cdecl; External;
|
|
|
|
- procedure gl_fillbox(x, y, w, h, c: LongInt); Cdecl; External;
|
|
|
|
- procedure gl_circle(x, y, r, c: LongInt ); Cdecl; External;
|
|
|
|
- procedure gl_getbox(x, y, w, h: LongInt; dp: pointer); Cdecl; External;
|
|
|
|
- procedure gl_putbox(x, y, w, h: LongInt; dp: pointer); Cdecl; External;
|
|
|
|
- procedure gl_disableclipping; Cdecl; External;
|
|
|
|
- procedure gl_enableclipping; Cdecl; External;
|
|
|
|
- procedure gl_putboxpart(x, y, w, h, bw, bh: LongInt; b: pointer; xo, yo: LongInt); Cdecl; External;
|
|
|
|
- function gl_rgbcolor(r, g, b: LongInt): LongInt; Cdecl; External;
|
|
|
|
- function gl_setcontextvga(m: LongInt): LongInt; Cdecl; External;
|
|
|
|
- function gl_allocatecontext: PGraphicsContext; Cdecl; External;
|
|
|
|
- procedure gl_getcontext(gc: PGraphicsContext); Cdecl; External;
|
|
|
|
- procedure gl_setrgbpalette; Cdecl; External;
|
|
|
|
- procedure gl_freecontext(gc: PGraphicsContext); Cdecl; External;
|
|
|
|
- procedure gl_setclippingwindow(x1, y1, x2, y2: LongInt); Cdecl; External;
|
|
|
|
- procedure gl_setwritemode(wm: LongInt); Cdecl; External;
|
|
|
|
- procedure gl_setfontcolors(bg, fg: LongInt); Cdecl; External;
|
|
|
|
- procedure gl_writen(x, y, n: LongInt; s: PChar); Cdecl; External;
|
|
|
|
- procedure gl_setfont(fw, fh: LongInt; fdp: pointer); Cdecl; External;
|
|
|
|
-
|
|
|
|
- procedure gl_copyboxfromcontext(var gc: TGraphicsContext; x1, y1, w, h, x2, y2: LongInt); Cdecl; External;
|
|
|
|
- procedure gl_setcontext(gc: PGraphicsContext); Cdecl; External;
|
|
|
|
-
|
|
|
|
- function gl_setcontextvgavirtual(m: LongInt): LongInt; cdecl; external;
|
|
|
|
- procedure gl_font8x8; Cdecl; External;
|
|
|
|
-
|
|
|
|
-
|
|
|
|
-{ ---------------------------------------------------------------------
|
|
|
|
- Types, constants and variables
|
|
|
|
-
|
|
|
|
- ---------------------------------------------------------------------}
|
|
|
|
-
|
|
|
|
-var
|
|
|
|
- DrawDelta: TPoint;
|
|
|
|
- CurX, CurY: Integer;
|
|
|
|
- TheColor, TheFillColor: LongInt;
|
|
|
|
- IsVirtual: Boolean;
|
|
|
|
- PhysicalScreen, BackScreen: PGraphicsContext;
|
|
|
|
- ColorTable: array[0..15] of LongInt;
|
|
|
|
- TheFillPattern : FillPatternType;
|
|
|
|
- TheLineSettings : LineSettingsType;
|
|
|
|
- ThePalette : PaletteType;
|
|
|
|
- TheTextSettings : TextSettingsType;
|
|
|
|
- TheFillSettings : FillSettingsType;
|
|
|
|
-
|
|
|
|
-const
|
|
|
|
- BgiColors: array[0..15] of LongInt
|
|
|
|
- = ($000000, $000080, $008000, $008080,
|
|
|
|
- $800000, $800080, $808000, $C0C0C0,
|
|
|
|
- $808080, $0000FF, $00FF00, $00FFFF,
|
|
|
|
- $FF0000, $FF00FF, $FFFF00, $FFFFFF);
|
|
|
|
-
|
|
|
|
-const
|
|
|
|
- DoUseMarker: Boolean = true;
|
|
|
|
- TheMarker: Char = '~';
|
|
|
|
- TextColor: LongInt = 15;
|
|
|
|
- MarkColor: LongInt = 15;
|
|
|
|
- BackColor: LongInt = 0;
|
|
|
|
- FontWidth: Integer = 8;
|
|
|
|
- FontHeight: Integer = 8;
|
|
|
|
-
|
|
|
|
-var
|
|
|
|
- sHoriz, sVert: Word;
|
|
|
|
-
|
|
|
|
-{ initialisierte Variablen }
|
|
|
|
-const
|
|
|
|
- SourcePage: Word = 0;
|
|
|
|
- DestPage: Word = 0;
|
|
|
|
-
|
|
|
|
-{ Retrieves the capabilities for the current mode }
|
|
|
|
-const
|
|
|
|
- vmcImage = 1;
|
|
|
|
- vmcCopy = 2;
|
|
|
|
- vmcSaveRestore = 4;
|
|
|
|
- vmcBuffer = 8;
|
|
|
|
- vmcBackPut = 16;
|
|
|
|
-
|
|
|
|
-{ ---------------------------------------------------------------------
|
|
|
|
- Graphics Vision Layer
|
|
|
|
- ---------------------------------------------------------------------}
|
|
|
|
-
|
|
|
|
-
|
|
|
|
-{ Types and constants }
|
|
|
|
-var
|
|
|
|
- SizeX, SizeY: Word;
|
|
|
|
-
|
|
|
|
-{ Draw origin and clipping rectangle }
|
|
|
|
-var
|
|
|
|
- DrawOrigin: TPoint;
|
|
|
|
- ClipRect: TRect;
|
|
|
|
- MetaClipRect: TRect;
|
|
|
|
- MetaOrigin: TPoint;
|
|
|
|
-
|
|
|
|
-{ Font attributes }
|
|
|
|
-const
|
|
|
|
- ftNormal = 0;
|
|
|
|
- ftBold = 1;
|
|
|
|
- ftThin = 2;
|
|
|
|
- ftItalic = 4;
|
|
|
|
-
|
|
|
|
-var
|
|
|
|
- sFont, sColor:Word;
|
|
|
|
- sCharSpace: Integer;
|
|
|
|
-{ Not used
|
|
|
|
- sMarker: Char;
|
|
|
|
- sAttr: Word; }
|
|
|
|
-
|
|
|
|
-{ Windows-style text metric }
|
|
|
|
-type
|
|
|
|
- PTextMetric = ^TTextMetric;
|
|
|
|
- TTextMetric = record
|
|
|
|
- tmHeight: Integer;
|
|
|
|
- tmAscent: Integer;
|
|
|
|
- tmDescent: Integer;
|
|
|
|
- tmInternalLeading: Integer;
|
|
|
|
- tmExternalLeading: Integer;
|
|
|
|
- tmAveCharWidth: Integer;
|
|
|
|
- tmMaxCharWidth: Integer;
|
|
|
|
- tmWeight: Integer;
|
|
|
|
- tmItalic: Byte;
|
|
|
|
- tmUnderlined: Byte;
|
|
|
|
- tmStruckOut: Byte;
|
|
|
|
- tmFirstChar: Byte;
|
|
|
|
- tmLastChar: Byte;
|
|
|
|
- tmDefaultChar: Byte;
|
|
|
|
- tmBreakChar: Byte;
|
|
|
|
- tmPitchAndFamily: Byte;
|
|
|
|
- tmCharSet: Byte;
|
|
|
|
- tmOverhang: Integer;
|
|
|
|
- tmDigitizedAspectX: Integer;
|
|
|
|
- tmDigitizedAspectY: Integer;
|
|
|
|
- end;
|
|
|
|
-
|
|
|
|
-
|
|
|
|
-{ Bitmap utilities }
|
|
|
|
-type
|
|
|
|
- PBitmap = ^TBitmap;
|
|
|
|
- TBitmap = record
|
|
|
|
- Width, Height: Integer;
|
|
|
|
- Data: record end;
|
|
|
|
- end;
|
|
|
|
-
|
|
|
|
-
|
|
|
|
- { Storing screen regions }
|
|
|
|
-type
|
|
|
|
- TVgaBuf = record
|
|
|
|
- Bounds: TRect;
|
|
|
|
- Mem: Word;
|
|
|
|
- Size: Word;
|
|
|
|
- end;
|
|
|
|
-
|
|
|
|
-const
|
|
|
|
- pbNone = 0;
|
|
|
|
- pbCopy = 1;
|
|
|
|
- pbClear = 2;
|
|
|
|
-
|
|
|
|
-type
|
|
|
|
- PScreenBuf = ^TScreenBuf;
|
|
|
|
- TScreenBuf = record
|
|
|
|
- Mode: Word;
|
|
|
|
- Rect: TRect;
|
|
|
|
- Size: LongInt;
|
|
|
|
- Info: LongInt
|
|
|
|
- end;
|
|
|
|
-
|
|
|
|
-
|
|
|
|
-
|
|
|
|
- { Procedures and functions }
|
|
|
|
-
|
|
|
|
-
|
|
|
|
-procedure SetColors;
|
|
|
|
-var
|
|
|
|
- i: Integer;
|
|
|
|
-begin
|
|
|
|
- for i:=0 to 15 do
|
|
|
|
- ColorTable[i] := gl_rgbcolor(BgiColors[i] shr 16,
|
|
|
|
- (BgiColors[i] shr 8) and 255,
|
|
|
|
- BgiColors[i] and 255)
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-
|
|
|
|
-
|
|
|
|
-procedure InitVideo;
|
|
|
|
-var
|
|
|
|
- VgaMode: Integer;
|
|
|
|
- ModeInfo: pvga_modeinfo;
|
|
|
|
-begin
|
|
|
|
- if NoGraphics
|
|
|
|
- then begin
|
|
|
|
- SizeX := 640;
|
|
|
|
- SizeY := 480
|
|
|
|
- end
|
|
|
|
- else begin
|
|
|
|
- VgaMode := vga_getdefaultmode;
|
|
|
|
- if (VgaMode = -1) then VgaMode := G320X200X256;
|
|
|
|
- if (not vga_hasmode(VgaMode))
|
|
|
|
- then begin
|
|
|
|
- WriteLn('BGI: Mode not available.');
|
|
|
|
- Halt(1)
|
|
|
|
- end;
|
|
|
|
- ModeInfo := vga_getmodeinfo(VgaMode);
|
|
|
|
- {IsVirtual := (ModeInfo^.colors = 16) or (ModeInfo^.flags and IS_MODEX <> 0);}
|
|
|
|
- IsVirtual := true;
|
|
|
|
- { We always want a back screen (for buffering). }
|
|
|
|
- if IsVirtual
|
|
|
|
- then begin
|
|
|
|
- { Create virtual screen }
|
|
|
|
- gl_setcontextvgavirtual(VgaMode);
|
|
|
|
- BackScreen := gl_allocatecontext;
|
|
|
|
- gl_getcontext(BackScreen)
|
|
|
|
- end;
|
|
|
|
- vga_setmode(VgaMode);
|
|
|
|
- gl_setcontextvga(VgaMode); { Physical screen context. }
|
|
|
|
- PhysicalScreen := gl_allocatecontext;
|
|
|
|
- gl_getcontext(PhysicalScreen);
|
|
|
|
- if (PhysicalScreen^.colors = 256) then gl_setrgbpalette;
|
|
|
|
- SetColors;
|
|
|
|
- SizeX := PhysicalScreen^.Width;
|
|
|
|
- SizeY := PhysicalScreen^.Height
|
|
|
|
- end
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-procedure DoneVideo;
|
|
|
|
-begin
|
|
|
|
- if not NoGraphics
|
|
|
|
- then begin
|
|
|
|
- if IsVirtual then gl_freecontext(BackScreen);
|
|
|
|
- vga_setmode(GTEXT)
|
|
|
|
- end
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-procedure SetDelta;
|
|
|
|
-begin
|
|
|
|
- if ClipRect.Empty
|
|
|
|
- then begin
|
|
|
|
- DrawDelta.X := 10000;
|
|
|
|
- DrawDelta.Y := 10000;
|
|
|
|
- end
|
|
|
|
- else begin
|
|
|
|
- DrawDelta.X := DrawOrigin.X;
|
|
|
|
- DrawDelta.y := DrawOrigin.y
|
|
|
|
- end
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-procedure SetDrawOrigin(x, y: Integer);
|
|
|
|
-begin
|
|
|
|
- DrawOrigin.x := x;
|
|
|
|
- DrawOrigin.y := y;
|
|
|
|
- SetDelta;
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-procedure SetDrawOriginP(var P: TPoint);
|
|
|
|
-begin
|
|
|
|
- SetDrawOrigin(P.x, P.y)
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-procedure SetClipRect(x1, y1, x2, y2: Integer);
|
|
|
|
-begin
|
|
|
|
- Cliprect.Assign(x1, y1, x2, y2);
|
|
|
|
- if not NoGraphics
|
|
|
|
- then begin
|
|
|
|
- if ClipRect.Empty
|
|
|
|
- then gl_setclippingwindow(0, 0, 0, 0)
|
|
|
|
- else gl_setclippingwindow(x1, y1, x2 - 1, y2 - 1);
|
|
|
|
- {gl_enableclipping(0);}
|
|
|
|
- end;
|
|
|
|
- SetDelta
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-procedure SetClipRectR(var R: TRect);
|
|
|
|
-begin
|
|
|
|
- SetClipRect(R.A.X, R.A.Y, R.B.X, R.B.Y);
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-procedure SetMetaOrigin(x, y: Integer);
|
|
|
|
-begin
|
|
|
|
- MetaOrigin.x := x;
|
|
|
|
- MetaOrigin.y := y
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-procedure SetMetaOriginP(P: TPoint);
|
|
|
|
-begin
|
|
|
|
- SetMetaOrigin(P.x, P.y)
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-procedure SetMetaClipRect(x1, y1, x2, y2: Integer);
|
|
|
|
-begin
|
|
|
|
- MetaCliprect.Assign(x1, y1, x2, y2)
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-procedure SetMetaClipRectR(var R: TRect);
|
|
|
|
-begin
|
|
|
|
- MetaCliprect := R
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-function GetBuffer(Size: Word): pointer;
|
|
|
|
-begin
|
|
|
|
- { No metafiling available. }
|
|
|
|
- GetBuffer := nil
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-Procedure HoriLine(x1,y1,x2: Integer);
|
|
|
|
-begin
|
|
|
|
- Line(x1, y1, x2, y1)
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-Procedure VertLine(x1,y1,y2: Integer);
|
|
|
|
-begin
|
|
|
|
- Line(x1, y1, x1, y2)
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-procedure FillCircle(xm, ym, r: Integer);
|
|
|
|
-begin
|
|
|
|
- FillEllipse(xm, ym, r, r)
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-{ Text routines }
|
|
|
|
-
|
|
|
|
-function TextWidth(s: string): Integer;
|
|
|
|
-var
|
|
|
|
- i: Integer;
|
|
|
|
-begin
|
|
|
|
- if DoUseMarker
|
|
|
|
- then begin
|
|
|
|
- For i := Length(s) downto 1 do
|
|
|
|
- If s[i] = TheMarker then Delete(s, i, 1);
|
|
|
|
- If s = ''
|
|
|
|
- then TextWidth := 0
|
|
|
|
- else TextWidth := Length(s) * FontWidth
|
|
|
|
- end
|
|
|
|
- else TextWidth := Length(s) * FontWidth
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-function TextHeight(s: string): Integer;
|
|
|
|
-begin
|
|
|
|
- TextHeight := FontHeight
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-
|
|
|
|
-procedure OutText(TextString: string);
|
|
|
|
-begin
|
|
|
|
- OutTextXY(GetX, GetY, TextString)
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-procedure OutTextXY(X, Y: Integer; TextString: string);
|
|
|
|
-var
|
|
|
|
- P, Q: PChar;
|
|
|
|
- i: Integer;
|
|
|
|
- col: Boolean;
|
|
|
|
-begin
|
|
|
|
- if NoGraphics or (TextString='') then Exit;
|
|
|
|
- gl_setwritemode(FONT_COMPRESSED + WRITEMODE_MASKED);
|
|
|
|
- case sHoriz of
|
|
|
|
- CenterText : Dec(x, TextWidth(TextString) div 2);
|
|
|
|
- RightText : Dec(x, TextWidth(TextString));
|
|
|
|
- end; { case }
|
|
|
|
- case sVert of
|
|
|
|
- CenterText : Dec(y, TextHeight(TextString) div 2);
|
|
|
|
- BottomText, BaseLine : Dec(y, TextHeight(TextString));
|
|
|
|
- end; { case }
|
|
|
|
- MoveTo(X, Y);
|
|
|
|
- P := @TextString[1]; Q := P;
|
|
|
|
- col := false;
|
|
|
|
- gl_setfontcolors(BackColor, TextColor);
|
|
|
|
- For i := 1 to Length(TextString) do
|
|
|
|
- begin
|
|
|
|
- If (Q[0] = TheMarker) and DoUseMarker
|
|
|
|
- then begin
|
|
|
|
- If col then gl_setfontcolors(BackColor, MarkColor)
|
|
|
|
- else gl_setfontcolors(BackColor, TextColor);
|
|
|
|
- If Q <> P then begin
|
|
|
|
- gl_writen(CurX, CurY, Q-P, P);
|
|
|
|
- MoveRel(FontWidth * (Q-P), 0)
|
|
|
|
- end;
|
|
|
|
- col := not col;
|
|
|
|
- P := Q + 1
|
|
|
|
- end;
|
|
|
|
- {Inc(Q)} Q := Q + 1
|
|
|
|
- end;
|
|
|
|
- If col then gl_setfontcolors(BackColor, MarkColor)
|
|
|
|
- else gl_setfontcolors(BackColor, TextColor);
|
|
|
|
- If Q <> P then begin
|
|
|
|
- gl_writen(CurX, CurY, Q-P, P);
|
|
|
|
- MoveRel(FontWidth * (Q-P), 0)
|
|
|
|
- end
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-procedure SetTextJustify(Horiz, Vert: Word);
|
|
|
|
-begin
|
|
|
|
- sHoriz := Horiz; sVert := Vert;
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-procedure SetTextStyle(Font, Direction: Word; CharSize: Word);
|
|
|
|
-begin
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-procedure SetUserCharSize(MultX, DivX, MultY, DivY: Word);
|
|
|
|
-begin
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-procedure SetKern(Enable: Boolean);
|
|
|
|
-begin
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-procedure SetMarker(Marker: Char);
|
|
|
|
-begin
|
|
|
|
- TheMarker := Marker
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-
|
|
|
|
-procedure SetTextParams(Font: Word; CharSpace: Integer; Color: Word;
|
|
|
|
- UseMarker: Boolean);
|
|
|
|
-type
|
|
|
|
- pp = ^pointer;
|
|
|
|
-
|
|
|
|
-function FixCol(Col: Byte): Byte;
|
|
|
|
-{ SVGALIB cannot write black characters... }
|
|
|
|
-begin
|
|
|
|
- if Col=0 then FixCol := 1 else FixCol := Col
|
|
|
|
-end; { FixCol }
|
|
|
|
-
|
|
|
|
-begin
|
|
|
|
- sColor := Color; sCharSpace := CharSpace; sFont := Font;
|
|
|
|
- if not NoGraphics then begin
|
|
|
|
- TextColor := ColorTable[FixCol(Color and 15)];
|
|
|
|
- MarkColor := ColorTable[FixCol((Color shr 8) and 15)];
|
|
|
|
- DoUseMarker := UseMarker;
|
|
|
|
- gl_setfont(8, 8, (pp(@gl_font8x8))^);
|
|
|
|
- end
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-
|
|
|
|
-function GetResX: Integer;
|
|
|
|
-begin
|
|
|
|
- GetResX := 96;
|
|
|
|
-end; { GetResX }
|
|
|
|
-
|
|
|
|
-function GetResY: Integer;
|
|
|
|
-begin
|
|
|
|
- GetResY := 96
|
|
|
|
-end; { GetResY }
|
|
|
|
-
|
|
|
|
-function GetAspect: Real;
|
|
|
|
-begin
|
|
|
|
- GetAspect := 1.0
|
|
|
|
-end; { GetAspect }
|
|
|
|
-
|
|
|
|
-Procedure GetAspectRatio (Var x,y : Word);
|
|
|
|
-begin
|
|
|
|
- X:=GetMaxX;
|
|
|
|
- Y:=GetMaxY
|
|
|
|
-end; { GetAspect }
|
|
|
|
-
|
|
|
|
-Var LastViewPort : ViewPortType;
|
|
|
|
-
|
|
|
|
-procedure SetViewPort(x1, y1, x2, y2: Integer; Clip: Boolean);
|
|
|
|
-begin
|
|
|
|
- LastViewPort.X1:=X1;
|
|
|
|
- LastViewPort.Y1:=Y1;
|
|
|
|
- LastViewPort.X2:=X2;
|
|
|
|
- LastViewPort.Y2:=Y2;
|
|
|
|
- LastViewPort.Clip:=Clip;
|
|
|
|
- SetDrawOrigin(x1, y1);
|
|
|
|
- if Clip then SetClipRect(x1, y1, x2+1, y2+1)
|
|
|
|
- else SetClipRect(0, 0, SizeX, SizeY)
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-
|
|
|
|
-Procedure ClearViewPort;
|
|
|
|
-
|
|
|
|
-begin
|
|
|
|
- With LastViewPort do
|
|
|
|
- gl_fillbox(X1,Y1,X2-X1,Y2-Y1,BackColor);
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-Procedure GetViewSettings (Var ViewPort : ViewPortType);
|
|
|
|
-
|
|
|
|
-begin
|
|
|
|
- ViewPort:=LastViewPort;
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-{ VGAMEM }
|
|
|
|
-
|
|
|
|
-type
|
|
|
|
- TImage = record
|
|
|
|
- end;
|
|
|
|
-
|
|
|
|
-procedure CopyScreen(x1, y1, x2, y2, x3, y3: Integer);
|
|
|
|
-begin
|
|
|
|
- if not NoGraphics and (x2 > x1) and (y2 > y1)
|
|
|
|
- then gl_copyboxfromcontext(PhysicalScreen^, x1, y1, x2 - x1, y2 - y1, x3, y3);
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-{ BGI-like Image routines
|
|
|
|
-}
|
|
|
|
-
|
|
|
|
-function CopyImage(Image: pointer): pointer;
|
|
|
|
-begin
|
|
|
|
- CopyImage := nil
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-function CutImage(x1, y1, x2, y2: Integer): pointer;
|
|
|
|
-var
|
|
|
|
- Image: PBitmap;
|
|
|
|
-begin
|
|
|
|
-
|
|
|
|
- GetMem(Image, ImageSize(x1, y1, x2, y2));
|
|
|
|
- if Image <> nil
|
|
|
|
- then GetImage(x1, y1, x2, y2, Image^);
|
|
|
|
- CutImage := Image;
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-procedure GetImageExtent(Image: pointer; var Extent: Objects.TPoint);
|
|
|
|
-begin
|
|
|
|
- if Image = nil
|
|
|
|
- then begin
|
|
|
|
- Extent.X := 0;
|
|
|
|
- Extent.Y := 0
|
|
|
|
- end
|
|
|
|
- else begin
|
|
|
|
- Extent.X := PBitmap(Image)^.Width;
|
|
|
|
- Extent.Y := PBitmap(Image)^.Height
|
|
|
|
- end;
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-
|
|
|
|
-procedure FreeImage(Image: pointer);
|
|
|
|
-var
|
|
|
|
- P: TPoint;
|
|
|
|
-begin
|
|
|
|
- if Image <> nil
|
|
|
|
- then begin
|
|
|
|
- GetImageExtent(Image, P);
|
|
|
|
- FreeMem(Image, ImageSize(0, 0, P.x - 1, P.y - 1));
|
|
|
|
- end;
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-
|
|
|
|
-function LoadImage(var S: TStream): pointer;
|
|
|
|
-begin
|
|
|
|
- LoadImage := nil
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-function MaskedImage(Image: pointer): pointer;
|
|
|
|
-begin
|
|
|
|
- MaskedImage := nil;
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-procedure PasteImage(X, Y: Integer; Image: pointer; BitBlt: Word);
|
|
|
|
-begin
|
|
|
|
- if Image <> nil then PutImage(X, Y, Image^, BitBlt)
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-procedure StoreImage(var S: TStream; Image: pointer);
|
|
|
|
-begin
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-{ Storing screen regions }
|
|
|
|
-function PrepBuf(var R: Objects.TRect; Action: Word; var Buf: TVgaBuf): Boolean;
|
|
|
|
-begin
|
|
|
|
- if BackScreen <> nil
|
|
|
|
- then begin
|
|
|
|
- Buf.Bounds := R;
|
|
|
|
- gl_setcontext(BackScreen);
|
|
|
|
- gl_disableclipping;
|
|
|
|
- case Action of
|
|
|
|
- pbCopy : gl_copyboxfromcontext(PhysicalScreen^,
|
|
|
|
- R.A.X, R.A.Y, R.B.X - R.A.X, R.B.Y - R.A.Y,
|
|
|
|
- R.A.X, R.A.Y);
|
|
|
|
- pbClear : gl_fillbox(R.A.X, R.A.Y, R.B.X - R.A.X, R.B.Y - R.A.Y, 0);
|
|
|
|
- end;
|
|
|
|
- PrepBuf := true;
|
|
|
|
- SetDrawOrigin(0, 0);
|
|
|
|
- SetClipRectR(R);
|
|
|
|
- end
|
|
|
|
- else PrepBuf := false
|
|
|
|
-end; { PrepBuf }
|
|
|
|
-
|
|
|
|
-procedure EndBufDraw;
|
|
|
|
-begin
|
|
|
|
- if not NoGraphics
|
|
|
|
- then gl_setcontext(PhysicalScreen);
|
|
|
|
-end; { EndBufDraw }
|
|
|
|
-
|
|
|
|
-procedure ReleaseBuf(var Buf: TVgaBuf);
|
|
|
|
-begin
|
|
|
|
-end; { ReleaseBuf }
|
|
|
|
-
|
|
|
|
-procedure PasteRectAt(var R: Objects.TRect; P: Objects.TPoint; var Buf: TVgaBuf);
|
|
|
|
-begin
|
|
|
|
- if not NoGraphics and (BackScreen <> nil)
|
|
|
|
- then gl_copyboxfromcontext(BackScreen^,
|
|
|
|
- R.A.X, R.A.Y, R.B.X - R.A.X, R.B.Y - R.A.Y,
|
|
|
|
- P.X, P.Y);
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-
|
|
|
|
-procedure PasteRect(var R: Objects.TRect; var Buf: TVgaBuf);
|
|
|
|
-begin
|
|
|
|
- PasteRectAt(R, R.A, Buf);
|
|
|
|
-end; { PasteRect }
|
|
|
|
-
|
|
|
|
-
|
|
|
|
-function StoreScreen(x1, y1, x2, y2: Integer): PScreenBuf;
|
|
|
|
-var
|
|
|
|
- s: LongInt;
|
|
|
|
- p: pointer;
|
|
|
|
- SaveOrigin: TPoint;
|
|
|
|
-
|
|
|
|
-function NewScreenBuf(AMode: Word; AnInfo: LongInt): PScreenBuf;
|
|
|
|
- var
|
|
|
|
- p: PScreenBuf;
|
|
|
|
- Begin
|
|
|
|
- New(p);
|
|
|
|
- p^.Mode := AMode;
|
|
|
|
- p^.Size := s;
|
|
|
|
- p^.Rect.Assign(x1, y1, x2, y2);
|
|
|
|
- p^.Info := AnInfo;
|
|
|
|
- NewScreenBuf := p
|
|
|
|
- End;
|
|
|
|
-
|
|
|
|
-Begin
|
|
|
|
- { General Images }
|
|
|
|
- s := 0;
|
|
|
|
- SaveOrigin := DrawOrigin;
|
|
|
|
- SetDrawOrigin(0, 0);
|
|
|
|
- p := CutImage(x1, y1, x2-1, y2-1);
|
|
|
|
- SetDrawOriginP(SaveOrigin);
|
|
|
|
- If p <> nil
|
|
|
|
- then StoreScreen := NewScreenBuf(2, LongInt(p))
|
|
|
|
- else StoreScreen := nil
|
|
|
|
-End;
|
|
|
|
-
|
|
|
|
-procedure FreeScreenBuf(Buf: PScreenBuf);
|
|
|
|
-Begin
|
|
|
|
- If Buf <> nil then Begin
|
|
|
|
- case Buf^.Mode of
|
|
|
|
- 2 : FreeImage(pointer(Buf^.Info));
|
|
|
|
- end;
|
|
|
|
- Dispose(Buf)
|
|
|
|
- End
|
|
|
|
-End;
|
|
|
|
-
|
|
|
|
-procedure DrawScreenBufAt(Buf: PScreenBuf; x3, y3: Integer);
|
|
|
|
-var
|
|
|
|
- SaveOrigin: TPoint;
|
|
|
|
-Begin
|
|
|
|
- If Buf <> nil then
|
|
|
|
- case Buf^.Mode of
|
|
|
|
- 2 :
|
|
|
|
- begin
|
|
|
|
- SaveOrigin := DrawOrigin;
|
|
|
|
- SetDrawOrigin(0, 0);
|
|
|
|
- PasteImage(x3, y3, pointer(Buf^.Info), NormalPut);
|
|
|
|
- SetDrawOriginP(SaveOrigin);
|
|
|
|
- end
|
|
|
|
- end
|
|
|
|
-End;
|
|
|
|
-
|
|
|
|
-procedure DrawScreenBuf(Buf: PScreenBuf);
|
|
|
|
-Begin
|
|
|
|
- If Buf <> nil then
|
|
|
|
- DrawScreenBufAt(Buf, Buf^.Rect.A.x, Buf^.Rect.A.y)
|
|
|
|
-End;
|
|
|
|
-
|
|
|
|
-function GetVgaMemCaps: Word;
|
|
|
|
-begin
|
|
|
|
- GetVgaMemCaps := vmcCopy
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-procedure GetTextMetrics(var Metrics: TTextMetric);
|
|
|
|
-begin
|
|
|
|
- with Metrics do
|
|
|
|
- begin
|
|
|
|
- tmHeight := 8;
|
|
|
|
- tmAscent := 8;
|
|
|
|
- tmDescent := 0;
|
|
|
|
- tmInternalLeading := 0;
|
|
|
|
- tmExternalLeading := 0;
|
|
|
|
- tmAveCharWidth := 8;
|
|
|
|
- tmMaxCharWidth := 8;
|
|
|
|
- tmWeight := 700;
|
|
|
|
- tmItalic := 0;
|
|
|
|
- tmUnderlined := 0;
|
|
|
|
- tmStruckOut := 0;
|
|
|
|
- tmFirstChar := 0;
|
|
|
|
- tmLastChar := 255;
|
|
|
|
- tmDefaultChar := 32;
|
|
|
|
- tmBreakChar := 32;
|
|
|
|
- tmPitchAndFamily := 0;
|
|
|
|
- tmCharSet := 0;
|
|
|
|
- tmOverhang := 0;
|
|
|
|
- tmDigitizedAspectX := 100;
|
|
|
|
- tmDigitizedAspectY := 100
|
|
|
|
- end;
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-{ ---------------------------------------------------------------------
|
|
|
|
- Real graph implementation
|
|
|
|
- ---------------------------------------------------------------------}
|
|
|
|
-
|
|
|
|
-
|
|
|
|
-function GetX: Integer;
|
|
|
|
-begin
|
|
|
|
- GetX := CurX - DrawDelta.X
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-function GetY: Integer;
|
|
|
|
-begin
|
|
|
|
- GetY := CurY - DrawDelta.Y
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-{ Pixel-oriented routines }
|
|
|
|
-procedure PutPixel(X, Y: Integer; Pixel: Word);
|
|
|
|
-begin
|
|
|
|
- if not NoGraphics
|
|
|
|
- then gl_setpixel(X + DrawDelta.X, Y + DrawDelta.Y, Pixel)
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-function GetPixel(X, Y: Integer): Word;
|
|
|
|
-begin
|
|
|
|
- if NoGraphics
|
|
|
|
- then GetPixel := 0
|
|
|
|
- else GetPixel := gl_getpixel(X + DrawDelta.X, Y + DrawDelta.Y)
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-{ Line-oriented primitives }
|
|
|
|
-procedure SetWriteMode(WriteMode: Integer);
|
|
|
|
-begin
|
|
|
|
-{ Graph.SetWriteMode(WriteMode) }
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-procedure LineTo(X, Y: Integer);
|
|
|
|
-begin
|
|
|
|
- if not NoGraphics
|
|
|
|
- then gl_line(CurX, CurY, X + DrawDelta.X, Y + DrawDelta.Y, TheColor);
|
|
|
|
- CurX := X + DrawDelta.X;
|
|
|
|
- CurY := Y + DrawDelta.Y
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-procedure LineRel(Dx, Dy: Integer);
|
|
|
|
-begin
|
|
|
|
- if not NoGraphics
|
|
|
|
- then gl_line(CurX, CurY, CurX + Dx, CurY + Dy, TheColor);
|
|
|
|
- CurX := CurX + Dx;
|
|
|
|
- CurY := CurY + Dy
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-procedure MoveTo(X, Y: Integer);
|
|
|
|
-begin
|
|
|
|
- CurX := X + DrawDelta.X;
|
|
|
|
- CurY := Y + DrawDelta.Y
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-procedure MoveRel(Dx, Dy: Integer);
|
|
|
|
-begin
|
|
|
|
- CurX := CurX + Dx;
|
|
|
|
- CurY := CurY + Dy
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-procedure Line(x1, y1, x2, y2: Integer);
|
|
|
|
-begin
|
|
|
|
- if not NoGraphics
|
|
|
|
- then gl_line(x1 + DrawDelta.X, y1 + DrawDelta.Y,
|
|
|
|
- x2 + DrawDelta.X, y2 + DrawDelta.Y, TheColor)
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-procedure SetLineStyle(LineStyle: Word; Pattern: Word; Thickness: Word);
|
|
|
|
-begin
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-procedure SetFillPattern(Pattern: FillPatternType; Color: Word);
|
|
|
|
-
|
|
|
|
-begin
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-
|
|
|
|
-{ Linearly bounded primitives }
|
|
|
|
-
|
|
|
|
-procedure Rectangle(x1, y1, x2, y2: Integer);
|
|
|
|
-begin
|
|
|
|
- MoveTo(x1, y1);
|
|
|
|
- LineTo(x2, y1);
|
|
|
|
- LineTo(x2, y2);
|
|
|
|
- LineTo(x1, y2);
|
|
|
|
- LineTo(x1, y1)
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-procedure Bar(x1, y1, x2, y2: Integer);
|
|
|
|
-var
|
|
|
|
- R: TRect;
|
|
|
|
-begin
|
|
|
|
- if not NoGraphics
|
|
|
|
- then begin
|
|
|
|
- R.Assign(x1 + DrawDelta.X, y1 + DrawDelta.Y,
|
|
|
|
- x2 + DrawDelta.X + 1, y2 + DrawDelta.Y + 1);
|
|
|
|
- R.Intersect(ClipRect);
|
|
|
|
- if not R.Empty
|
|
|
|
- then gl_fillbox(R.A.X, R.A.Y,
|
|
|
|
- R.B.X - R.A.X, R.B.Y - R.A.Y, TheFillColor)
|
|
|
|
- end;
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-procedure Bar3D(x1, y1, x2, y2: Integer; Depth: Word; Top: Boolean);
|
|
|
|
-begin
|
|
|
|
- Bar(x1,y1,x2,y2);
|
|
|
|
- Rectangle(x1,y1,x2,y2);
|
|
|
|
- if top then begin
|
|
|
|
- Moveto(x1,y1);
|
|
|
|
- Lineto(x1+depth,y1-depth);
|
|
|
|
- Lineto(x2+depth,y1-depth);
|
|
|
|
- Lineto(x2,y1);
|
|
|
|
- end;
|
|
|
|
- Moveto(x2+depth,y1-depth);
|
|
|
|
- Lineto(x2+depth,y2-depth);
|
|
|
|
- Lineto(x2,y2);
|
|
|
|
-
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-procedure DrawPoly(NumPoints: Word; var PolyPoints);
|
|
|
|
-
|
|
|
|
-type
|
|
|
|
- ppointtype = ^pointtype;
|
|
|
|
-
|
|
|
|
-var
|
|
|
|
- i : longint;
|
|
|
|
-
|
|
|
|
-begin
|
|
|
|
- line(ppointtype(@polypoints)[NumPoints-1].x,
|
|
|
|
- ppointtype(@polypoints)[NumPoints-1].y,
|
|
|
|
- ppointtype(@polypoints)[0].x,
|
|
|
|
- ppointtype(@polypoints)[0].y);
|
|
|
|
- for i:=0 to NumPoints-2 do
|
|
|
|
- line(ppointtype(@polypoints)[i].x,
|
|
|
|
- ppointtype(@polypoints)[i].y,
|
|
|
|
- ppointtype(@polypoints)[i+1].x,
|
|
|
|
- ppointtype(@polypoints)[i+1].y);
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-procedure FillPoly(NumPoints: Word; var PolyPoints);
|
|
|
|
-
|
|
|
|
-begin
|
|
|
|
- DrawPoly (NumPoints,PolyPoints);
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-procedure SetFillStyle(Pattern: Word; Color: Word);
|
|
|
|
-begin
|
|
|
|
- TheFillColor := ColorTable[Color]
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-procedure FloodFill(X, Y: Integer; Border: Word);
|
|
|
|
-begin
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-{ Nonlinearly bounded primitives
|
|
|
|
-}
|
|
|
|
-
|
|
|
|
-Var LastArcCoords : ArcCoordsType;
|
|
|
|
-
|
|
|
|
-
|
|
|
|
-procedure SetArcCoords (X,y,xradius,yradius,Stangle,endangle : integer);
|
|
|
|
-
|
|
|
|
-begin
|
|
|
|
- LastArcCoords.X:=X;
|
|
|
|
- LastArccOords.y:=y;
|
|
|
|
- Lastarccoords.xstart:=x+round(xradius*cos(stangle*pi/180));
|
|
|
|
- Lastarccoords.ystart:=y-round(yradius*sin(stangle*pi/180));
|
|
|
|
- LastArccoords.xend:=x+round(xradius*cos(endangle*pi/180));
|
|
|
|
- LastArccoords.yend:=y-round(yradius*sin(endangle*pi/180));
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-
|
|
|
|
-procedure GetArcCoords(var ArcCoords: ArcCoordsType);
|
|
|
|
-
|
|
|
|
-begin
|
|
|
|
- ArcCoords:=LastArcCoords;
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-procedure Arc(X, Y: Integer; StAngle, EndAngle, Radius: Word);
|
|
|
|
-
|
|
|
|
-begin
|
|
|
|
- Ellipse (X,y,stangle,endangle,Radius,radius);
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-procedure Circle(X, Y: Integer; Radius: Word);
|
|
|
|
-begin
|
|
|
|
- if not NoGraphics
|
|
|
|
- then gl_circle(X + DrawDelta.X, Y + DrawDelta.Y, Radius, TheColor)
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-procedure Ellipse(X, Y: Integer;
|
|
|
|
- StAngle, EndAngle: Word; XRadius, YRadius : Word);
|
|
|
|
-
|
|
|
|
-Var I : longint;
|
|
|
|
- tmpang : real;
|
|
|
|
-
|
|
|
|
-begin
|
|
|
|
- SetArcCoords (X,Y,xradius,yradius,Stangle,EndAngle);
|
|
|
|
- For i:= StAngle To EndAngle Do
|
|
|
|
- Begin
|
|
|
|
- tmpAng:= i*Pi/180;
|
|
|
|
- curX:= X + Round (xRadius*Cos (tmpAng));
|
|
|
|
- curY:= Y - Round (YRadius*Sin (tmpAng));
|
|
|
|
- PutPixel (curX, curY, TheColor);
|
|
|
|
- End;
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-procedure FillEllipse(X, Y: Integer; XRadius, YRadius : Word);
|
|
|
|
-
|
|
|
|
-Var I,tmpcolor : longint;
|
|
|
|
- tmpang : real;
|
|
|
|
- tmpx,tmpy : Integer;
|
|
|
|
-
|
|
|
|
-begin
|
|
|
|
- tmpcolor:=Thecolor;
|
|
|
|
- SetColor(TheFillColor);
|
|
|
|
- For i:= 0 to 180 Do
|
|
|
|
- Begin
|
|
|
|
- tmpAng:= i*Pi/180;
|
|
|
|
- curX:= Round (xRadius*Cos (tmpAng));
|
|
|
|
- curY:= Round (YRadius*Sin (tmpAng));
|
|
|
|
- tmpX:= X - curx;
|
|
|
|
- tmpy:= Y + cury;
|
|
|
|
- curx:=x+curx;
|
|
|
|
- cury:=y-cury;
|
|
|
|
- Line (curX, curY,tmpx,tmpy);
|
|
|
|
- PutPixel (curx,cury,tmpcolor);
|
|
|
|
- PutPixel (tmpx,tmpy,tmpcolor);
|
|
|
|
- End;
|
|
|
|
- SetColor(tmpcolor);
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-procedure SetAspectRatio(Xasp, Yasp: Word);
|
|
|
|
-begin
|
|
|
|
- //!! Needs implementing.
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-procedure PieSlice(X, Y: Integer; StAngle, EndAngle, Radius: Word);
|
|
|
|
-
|
|
|
|
-Begin
|
|
|
|
- sector (x,y,stangle,endangle,radius,radius);
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-procedure Sector(X, Y: Integer;
|
|
|
|
- StAngle, EndAngle, XRadius, YRadius: Word);
|
|
|
|
-
|
|
|
|
-Var I,tmpcolor : longint;
|
|
|
|
- tmpang : real;
|
|
|
|
- ac : arccoordstype;
|
|
|
|
-
|
|
|
|
-begin
|
|
|
|
- tmpcolor:=Thecolor;
|
|
|
|
- SetColor(TheFillColor);
|
|
|
|
- For i:= stangle to endangle Do
|
|
|
|
- Begin
|
|
|
|
- tmpAng:= i*Pi/180;
|
|
|
|
- curX:= x+Round (xRadius*Cos (tmpAng));
|
|
|
|
- curY:= y-Round (YRadius*Sin (tmpAng));
|
|
|
|
- Line (x,y,curX, curY);
|
|
|
|
- PutPixel (curx,cury,tmpcolor);
|
|
|
|
- End;
|
|
|
|
- SetColor(tmpcolor);
|
|
|
|
- getarccoords(ac);
|
|
|
|
- Line (x,y,ac.xstart,ac.ystart);
|
|
|
|
- Line (x,y,ac.xend,ac.yend);
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-{ Color routines
|
|
|
|
-}
|
|
|
|
-
|
|
|
|
-procedure SetBkColor(ColorNum: Word);
|
|
|
|
-begin
|
|
|
|
- BackColor := ColorTable[ColorNum];
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-Function GetBkColor : Word;
|
|
|
|
-
|
|
|
|
-begin
|
|
|
|
- GetBkColor:=BackColor;
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-procedure SetColor(Color: Word);
|
|
|
|
-begin
|
|
|
|
- TheColor := ColorTable[Color];
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-Function GetColor : Word;
|
|
|
|
-
|
|
|
|
-begin
|
|
|
|
- GetColor:=TheColor;
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-function GetMaxColor : Word;
|
|
|
|
-
|
|
|
|
-begin
|
|
|
|
- getmaxcolor:=16;
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-procedure GetImage(x1, y1, x2, y2: Integer; var BitMap);
|
|
|
|
-var
|
|
|
|
- SaveClipRect: TRect;
|
|
|
|
-begin
|
|
|
|
- with TBitmap(Bitmap) do
|
|
|
|
- begin
|
|
|
|
- Width := x2 - x1 + 1;
|
|
|
|
- Height := y2 - y1 + 1;
|
|
|
|
- if not NoGraphics
|
|
|
|
- then begin
|
|
|
|
- {gl_disableclipping(0);}
|
|
|
|
- SaveClipRect := ClipRect;
|
|
|
|
- SetClipRect(0, 0, SizeX, SizeY);
|
|
|
|
- gl_getbox(x1 + DrawDelta.X, y1 + DrawDelta.Y,
|
|
|
|
- x2 - x1 + 1, y2 - y1 + 1, @Data);
|
|
|
|
- SetClipRectR(SaveClipRect)
|
|
|
|
- end;
|
|
|
|
- end;
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-procedure PutImage(X, Y: Integer; var BitMap; BitBlt: Word);
|
|
|
|
-var
|
|
|
|
- R: TRect;
|
|
|
|
- SaveClipRect: TRect;
|
|
|
|
-begin
|
|
|
|
- if not NoGraphics then
|
|
|
|
- with TBitmap(Bitmap) do
|
|
|
|
- begin
|
|
|
|
- {gl_putbox(x + DrawDelta.X, y + DrawDelta.Y, Width, Height, @Data)}
|
|
|
|
- R.Assign(X + DrawDelta.X, Y + DrawDelta.Y,
|
|
|
|
- X + DrawDelta.X + Width, Y + DrawDelta.Y + Height);
|
|
|
|
- R.Intersect(ClipRect);
|
|
|
|
- if not R.Empty
|
|
|
|
- then begin
|
|
|
|
- {gl_disableclipping(0);}
|
|
|
|
- SaveClipRect := ClipRect;
|
|
|
|
- SetClipRect(0, 0, SizeX, SizeY);
|
|
|
|
- gl_putboxpart(R.A.X, R.A.Y,
|
|
|
|
- R.B.X - R.A.X, R.B.Y - R.A.Y,
|
|
|
|
- Width, Height,
|
|
|
|
- @Data,
|
|
|
|
- R.A.X - X, R.A.Y - Y);
|
|
|
|
- SetClipRectR(SaveClipRect);
|
|
|
|
- end;
|
|
|
|
- end;
|
|
|
|
-end; { PutImage }
|
|
|
|
-
|
|
|
|
-function ImageSize(x1, y1, x2, y2: Integer): LongInt;
|
|
|
|
-begin
|
|
|
|
- if NoGraphics
|
|
|
|
- then ImageSize := SizeOf(TBitmap)
|
|
|
|
- else ImageSize := SizeOf(TBitmap)
|
|
|
|
- + LongInt(x2 - x1 + 1) * LongInt(y2 - y1 + 1) * PhysicalScreen^.BytesPerPixel;
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-function GetMaxX : Integer;
|
|
|
|
-
|
|
|
|
-begin
|
|
|
|
- GetMaxX:=vga_getxdim;
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-function GetMAxY : Integer;
|
|
|
|
-begin
|
|
|
|
- GetMaxY:=vga_getydim;
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-Procedure DetectGraph (Var Driver,Mode : Integer);
|
|
|
|
-
|
|
|
|
-begin
|
|
|
|
- Driver:=9;
|
|
|
|
- Mode:=vga_getdefaultmode;
|
|
|
|
- If Mode=-1 then mode:=0;
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-Var VgaMode : Integer;
|
|
|
|
-
|
|
|
|
-Procedure InitGraph (Var Driver,Mode : Integer;DriverPath : String);
|
|
|
|
-
|
|
|
|
-var
|
|
|
|
- ModeInfo: pvga_modeinfo;
|
|
|
|
-
|
|
|
|
-begin
|
|
|
|
- If Mode=0 then
|
|
|
|
- VgaMode := vga_getdefaultmode
|
|
|
|
- else
|
|
|
|
- VGAMode :=Mode;
|
|
|
|
- if (VgaMode = -1) then VgaMode := G320X200X256;
|
|
|
|
- if (not vga_hasmode(VgaMode))
|
|
|
|
- then begin
|
|
|
|
- WriteLn('BGI: Mode not available.');
|
|
|
|
- Halt(1)
|
|
|
|
- end;
|
|
|
|
- ModeInfo := vga_getmodeinfo(VgaMode);
|
|
|
|
- {IsVirtual := (ModeInfo^.colors = 16) or (ModeInfo^.flags and IS_MODEX <> 0);}
|
|
|
|
- IsVirtual := true;
|
|
|
|
- { We always want a back screen (for buffering). }
|
|
|
|
- if IsVirtual
|
|
|
|
- then begin
|
|
|
|
- { Create virtual screen }
|
|
|
|
- gl_setcontextvgavirtual(VgaMode);
|
|
|
|
- BackScreen := gl_allocatecontext;
|
|
|
|
- gl_getcontext(BackScreen)
|
|
|
|
- end;
|
|
|
|
- vga_setmode(VgaMode);
|
|
|
|
- gl_setcontextvga(VgaMode); { Physical screen context. }
|
|
|
|
- PhysicalScreen := gl_allocatecontext;
|
|
|
|
- gl_getcontext(PhysicalScreen);
|
|
|
|
- if (PhysicalScreen^.colors = 256) then gl_setrgbpalette;
|
|
|
|
- SetColors;
|
|
|
|
- SizeX := PhysicalScreen^.Width;
|
|
|
|
- SizeY := PhysicalScreen^.Height
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-Procedure CloseGraph;
|
|
|
|
-
|
|
|
|
-begin
|
|
|
|
- DoneVideo;
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-Function GraphResult : Integer;
|
|
|
|
-
|
|
|
|
-begin
|
|
|
|
- GraphResult:=0;
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-Procedure GraphDefaults ;
|
|
|
|
-
|
|
|
|
-begin
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-Function GraphErrorMsg (Errcode : Integer) : String;
|
|
|
|
-
|
|
|
|
-begin
|
|
|
|
- GraphErrorMsg:='';
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-Procedure ClearDevice;
|
|
|
|
-
|
|
|
|
-begin
|
|
|
|
- SetViewPort (0,0,GetMaxX,GetMaxY,False);
|
|
|
|
- ClearViewPort;
|
|
|
|
- MoveTo(0,0);
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-Procedure GetDefaultPalette (Var Palette : Palettetype);
|
|
|
|
-
|
|
|
|
-begin
|
|
|
|
- //!! Not yet implemented.
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-Function GetDriverName : String;
|
|
|
|
-
|
|
|
|
-begin
|
|
|
|
- GetDriverName:='libvga';
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-Function GetGraphMode : Integer;
|
|
|
|
-
|
|
|
|
-begin
|
|
|
|
- GetGraphMode:=VgaMode;
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-Procedure GetFillPattern (Var FillPattern : FillPatternType);
|
|
|
|
-
|
|
|
|
-begin
|
|
|
|
- FillPattern:=TheFillPattern;
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-Procedure GetFillSettings (Var FillSettings : FillSettingsType);
|
|
|
|
-
|
|
|
|
-begin
|
|
|
|
- FillSettings:=TheFillSettings;
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-Procedure GetLineSettings (Var LineInfo : LineSettingsType);
|
|
|
|
-
|
|
|
|
-begin
|
|
|
|
- LineInfo:=TheLineSettings;
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-Function GetMaxMode : Word;
|
|
|
|
-
|
|
|
|
-begin
|
|
|
|
- GetMaxMode:=GLastMode;
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-Function GetModeName (Var Modus : INteger) : String;
|
|
|
|
-
|
|
|
|
-begin
|
|
|
|
- GetModeName:='VGA'
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-Procedure GetModeRange (Driver : Integer; Var loModus,HiModus : Integer);
|
|
|
|
-
|
|
|
|
-begin
|
|
|
|
- LoModus:=1;
|
|
|
|
- HiModus:=GLASTMODE;
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-Procedure GetPalette (Var Palette : PaletteType);
|
|
|
|
-
|
|
|
|
-begin
|
|
|
|
- Palette:=ThePalette;
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-Procedure SetAllPalette (Var Palette);
|
|
|
|
-
|
|
|
|
-begin
|
|
|
|
- ThePalette:=PaletteType(Palette);
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-Procedure SetPalette (ColorNr : Word; NewColor : ShortInt);
|
|
|
|
-
|
|
|
|
-begin
|
|
|
|
- //!! not implemented.
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-Function GetPaletteSize : Word;
|
|
|
|
-
|
|
|
|
-begin
|
|
|
|
- GetPaletteSize:=16;
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-Procedure GetTextSettings (Var TextInfo : TextSettingsType);
|
|
|
|
-
|
|
|
|
-begin
|
|
|
|
- TextInfo:=TheTextSettings;
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-Function InstallUserDriver (DriverPat :String; AutodetectPtr : Pointer) : Integer;
|
|
|
|
-
|
|
|
|
-begin
|
|
|
|
- InstallUserDriver:=grError;
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-Function InstallUserFont (FontPath : String) : Integer;
|
|
|
|
-
|
|
|
|
-begin
|
|
|
|
- InstallUserFont:=0;
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-Function RegisterBGIDriver (Driver : Pointer) : Integer;
|
|
|
|
-
|
|
|
|
-begin
|
|
|
|
- RegisterBGIDriver:=grError;
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-Function RegisterBGIFont (Font : Pointer) : Integer;
|
|
|
|
-begin
|
|
|
|
- RegisterBGIFont:=grError;
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-Procedure RestoreCRTmode;
|
|
|
|
-
|
|
|
|
-begin
|
|
|
|
- vga_setmode(GTEXT);
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-Procedure SetActivePage (Page : Word);
|
|
|
|
-
|
|
|
|
-begin
|
|
|
|
- //!! Not implemented
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-Procedure SetVisualPage (Page : Word);
|
|
|
|
-
|
|
|
|
-begin
|
|
|
|
- //!! Not implemented
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-Procedure SetGraphBufSize (BufSize : Word);
|
|
|
|
-
|
|
|
|
-begin
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-Procedure SetGraphMode (Mode :Integer);
|
|
|
|
-
|
|
|
|
-begin
|
|
|
|
- vga_setmode(Mode);
|
|
|
|
- VgaMode:=Mode;
|
|
|
|
-end;
|
|
|
|
-
|
|
|
|
-begin
|
|
|
|
- { Give up root permissions if we are root. }
|
|
|
|
- if geteuid = 0 then vga_init;
|
|
|
|
-end.
|
|
|
|
-
|
|
|
|
-{
|
|
|
|
- $Log$
|
|
|
|
- Revision 1.10 1999-01-25 20:31:30 peter
|
|
|
|
- + detect,default constants
|
|
|
|
-
|
|
|
|
- Revision 1.9 1998/09/13 19:22:06 michael
|
|
|
|
- + Implemented dummies for all missing functions
|
|
|
|
-
|
|
|
|
- Revision 1.8 1998/09/11 09:24:55 michael
|
|
|
|
- Added missing functions so mandel compiles and runs
|
|
|
|
-
|
|
|
|
- Revision 1.7 1998/08/24 08:23:47 michael
|
|
|
|
- Better initgraph handling.
|
|
|
|
-
|
|
|
|
- Revision 1.6 1998/08/14 09:20:36 michael
|
|
|
|
- Typo fixed. linklib gl to linklib vgagl
|
|
|
|
-
|
|
|
|
- Revision 1.5 1998/08/12 14:01:08 michael
|
|
|
|
- small fix in sector, pieslice replaced by call to sector
|
|
|
|
-
|
|
|
|
- Revision 1.4 1998/08/12 13:25:33 michael
|
|
|
|
- + added arc,ellipse,fillelipse,sector,pieslice
|
|
|
|
-
|
|
|
|
- Revision 1.3 1998/08/10 09:01:58 michael
|
|
|
|
- + Added some functions to improve compatibility
|
|
|
|
-
|
|
|
|
- Revision 1.2 1998/05/12 10:42:47 peter
|
|
|
|
- * moved getopts to inc/, all supported OS's need argc,argv exported
|
|
|
|
- + strpas, strlen are now exported in the systemunit
|
|
|
|
- * removed logs
|
|
|
|
- * removed $ifdef ver_above
|
|
|
|
-
|
|
|
|
- Revision 1.1 1998/04/15 13:40:11 michael
|
|
|
|
- + Initial implementation of graph unit
|
|
|
|
-
|
|
|
|
-}
|
|
|