paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-05-27 18:42:31 +02:00
Code Issues Packages Projects Releases Wiki Activity
aa90381b86
fpc/rtl/go32v2/graph.pp
florian 001fe80149 * some explicit language removed
1999-05-04 17:17:31 +00:00

1100 lines
28 KiB
ObjectPascal
Raw Blame History

{
$Id$
This file is part of the Free Pascal run time library.
Copyright (c) 1993-98 by Florian Klaempf & Gernot Tenchio
members of the Free Pascal development team.
Graph unit for BP7 compatible RTL
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program 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.
**********************************************************************}
unit GRAPH;
{ there are some problems with ranges in this file !! (PM) }
{$R-}
{$Q-}
{ $DEFINE DEBUG}
{$ifdef DEBUG}
{$define TEST_24BPP}
{$define Test_Linear}
{$endif DEBUG}
{ Output to AT&T for as }
{$OUTPUT_FORMAT AS}
{ Use the direct assembler parser }
{$ASMMODE DIRECT}
{ Don't use smartlinking, because of the direct assembler that is used }
{$SMARTLINK OFF}
interface
uses go32,mmx;
{$I GLOBAL.PPI}
{$I STDCOLOR.PPI}
procedure CloseGraph;
function GraphResult : Integer;
procedure InitGraph(var GraphDriver:Integer;var GraphMode:Integer;const PathToDriver:String);
procedure SetGraphMode(GraphMode : integer);
procedure GraphDefaults;
procedure RestoreCRTMode;
procedure SetGraphBufSize(BufSize : longint);
function RegisterBGIdriver(driver : pointer) : integer;
function InstallUserDriver(const DriverFileName : string;AutoDetectPtr : pointer) : integer;
function GetDriverName: String;
function GetModeName(Mode:Integer):String;
function GetGraphMode:Integer;
procedure GetAspectRatio(var _Xasp,_Yasp : word);
procedure SetAspectRatio(_Xasp,_Yasp : word);
function GraphErrorMsg(ErrorCode: Integer): string;
function GetMaxMode : Integer;
function GetMaxX : Integer;
function GetMaxY : Integer;
function GetX : Integer;
function GetY : Integer;
procedure Bar(x1,y1,x2,y2 : Integer);
procedure bar3D(x1, y1, x2, y2 : integer;depth : word;top : boolean);
procedure GetViewSettings(var viewport : ViewPortType);
function GetNumberOfPages : word;
procedure SetActivePage(page : word);
function GetActivePage : word;
procedure SetVisualPage(page : word);
function GetVisualPage : word;
procedure SetWriteMode(WriteMode : integer);
procedure SetViewPort(x1,y1,x2,y2 : integer;clip : boolean);
procedure Cleardevice;
procedure ClearViewport;
procedure Rectangle(x1,y1,x2,y2 : integer);
{ PIXEL.PPI }
function GetPixel(x,y : integer):longint;
procedure PutPixel(x,y : integer; Colour: longint);
{ LINE.PPI }
procedure Line(x1,y1,x2,y2 : integer);
procedure LineTo(x,y : integer);
procedure LineRel(dx,dy : integer);
procedure MoveTo(x,y : integer);
procedure MoveRel(dx,dy : integer);
procedure GetLineSettings(var LineInfo : LineSettingsType);
procedure SetLineStyle(LineStyle : word;pattern : word;thickness : word);
procedure DrawPoly(points : word;var polypoints);
{ PALETTE.PPI }
procedure GetRGBPalette(ColorNum:byte; var RedValue,GreenValue,BlueValue:byte);
procedure SetRGBPalette(ColorNum,RedValue,GreenValue,BlueValue:byte);
procedure SetAllPalette(var Palette : PaletteType);
procedure GetPalette(var Palette : PaletteType);
procedure SetPalette(ColorNum:word;Color:byte);
{ ELLIPSE.PPI }
procedure FillEllipse(x,y:Integer;XRadius,YRadius:Word);
procedure Circle(x,y:Integer;Radius:Word);
procedure Ellipse(x,y,alpha,beta:Integer;XRad,YRad:word);
procedure Sector(X,Y,alpha,beta:integer;XRadius,YRadius: Word);
{ ARC.PPI }
procedure Arc(x,y,alpha,beta:Integer;Radius:Word);
procedure GetArcCoords(var ArcCoords:ArcCoordsType);
procedure PieSlice(X,Y,alpha,beta:integer;Radius: Word);
{ COLORS.PPI }
function GetBkColor : longint;
function GetColor : longint;
function GetMaxColor : longint;
procedure SetColor(Color : longint);
procedure SetBkColor(Color : longint);
{ FILL.PPI }
procedure FloodFill(x,y:integer; Border:longint);
procedure GetFillSettings(var FillInfo : FillSettingsType);
procedure GetFillPattern(var FillPattern : FillPatternType);
procedure SetFillStyle(pattern : word;color : longint);
procedure SetFillPattern(pattern : FillPatternType;color : longint);
{ just dummy not implemented yet }
procedure FillPoly(points : word;var polypoints);
{ IMAGE.PPI }
function ImageSize(x1,y1,x2,y2 : integer) : longint;
procedure GetImage(x1,y1,x2,y2 : integer;var BitMap);
procedure PutImage(x,y : integer;var BitMap;BitBlt : word);
{ TEXT.PPI }
procedure GetTextSettings(var TextInfo : TextSettingsType);
procedure OutText(const TextString : string);
procedure OutTextXY(x,y : integer;const TextString : string);
procedure OutText(const Charakter : char);
procedure OutTextXY(x,y : integer;const Charakter : char);
procedure SetTextJustify(horiz,vert : word);
procedure SetTextStyle(Font, Direction : word; CharSize : word);
procedure SetUserCharSize(Multx,Divx,Multy,Divy : word);
function TextHeight(const TextString : string) : word;
function TextWidth(const TextString : string) : word;
function RegisterBGIfont(font : pointer) : integer;
function InstallUserFont(const FontFileName : string) : integer;
{ extended non Borland-compatible }
{ TRIANGLE.PPI }
procedure FillTriangle(A,B,C:Pointtype);
{ to compare colors on different resolutions }
function ColorsEqual(c1,c2 : longint) : boolean;
{ this will return true if the two colors will appear
equal in the current video mode }
procedure WaitRetrace;
{$ifdef debug}
procedure pixel(offset:longint);
function Convert(color:longint):longint;
function UnConvert(color:longint):longint;
function SetVESADisplayStart(PageNum : word;x,y : integer):Boolean;
{$endif debug}
{$ifdef Test_linear}
const
UseLinear : boolean = false;
(* Bug was due to alignment problem in VesaInfoBlock !!
{ the two below are the settings the work for ATI 3D Rage Pro !! }
switch_physical_address : boolean = true;*)
{$endif Test_linear}
{$I MODES.PPI}
implementation
{$ASMMODE DIRECT}
type
PString=^String;
PInteger=^integer;
PWord=^word;
PLong=^longint;
VgaInfoBlock = record
VESASignature: array[1..4]of Char;
VESAloVersion: Byte;
VESAhiVersion: Byte;
OEMStringPtr : longint;
Capabilities : longint;
VideoModePtr : longint;
TotalMem : word;
{ VESA 2.0 }
OEMversion : word;
VendorPtr : longint;
ProductPtr : longint;
RevisionPtr : longint;
filler : Array[1..478]of Byte;
end;
VesaInfoBlock=record
ModeAttributes : word; { pos 0 }
WinAAttributes : byte; { pos 2 }
WinBAttributes : byte; { pos 3 }
WinGranularity : word; { pos 4 }
WinSize : word; { pos 6 }
segWINA : word; { pos 8 }
segWINB : word; { pos $A }
RealWinFuncPtr : longint; { pos $C }
BPL : word; { pos $10 }
{ VESA 1.2 }
XResolution : word; { pos $12 }
YResolution : word; { pos $14 }
XCharSize : byte; { pos $16 }
YCharSize : byte; { pos $17 }
MumberOfPlanes : byte; { pos $18 }
BitsPerPixel : byte; { pos $19 }
NumberOfBanks : byte; { pos $1A }
MemoryModel : byte; { pos $1B }
BankSize : byte; { pos $1C }
NumberOfPages : byte; { pos $1D }
reserved : byte; { pos $1E }
rm_size : byte; { pos $1F }
rf_pos : byte; { pos $20 }
gm_size : byte; { pos $21 }
gf_pos : byte; { pos $22 }
bm_size : byte; { pos $23 }
bf_pos : byte; { pos $24 }
(* res_mask : word; { pos $25 }
here there was an alignment problem !!
with default alignment
res_mask was shifted to $26
and after PhysAddress to $2A !!! PM *)
res_size : byte;
res_pos : byte;
DirectColorInfo: byte; { pos $27 }
{ VESA 2.0 }
PhysAddress : longint; { pos $28 }
OffscreenPtr : longint; { pos $2C }
OffscreenMem : word; { pos $30 }
reserved2 : Array[1..458]of Byte; { pos $32 }
end;
const
CheckRange : Boolean=true;
isVESA2 : Boolean=false;
core : longint=$E0000000;
var { X/Y Verhaeltnis des Bildschirm }
AspectRatio : real;
XAsp , YAsp : Word;
{ Zeilen & Spalten des aktuellen Graphikmoduses }
_maxx,_maxy : longint;
{ Current color internal format (depending on bitsperpixel) }
aktcolor : longint;
{ Current color RGB value }
truecolor : longint;
{ Current background color internal format (depending on bitsperpixel) }
aktbackcolor : longint;
{ Current background color RGB value }
truebackcolor : longint;
{ used for fill }
colormask : longint;
{ Videospeicherbereiche }
wbuffer : ^byte;
{ Offset to current page }
AktPageOffset : longint;
AktPage : word;
AktVisualPage : word;
{ these are not used !! PM }
rbuffer,wrbuffer : ^byte;
{ aktueller Ausgabebereich }
aktviewport : ViewPortType;
aktscreen : ViewPortType;
{ der Graphikmodus, der beim Start gesetzt war }
startmode : byte;
{ mode before RestoreCRTMode was called
used by getGraphMode PM }
oldCRTMode : integer;
InTempCRTMode : boolean;
{ Position des Graphikcursors }
curx,cury : longint;
{ true, wenn die Routinen des Graphikpaketes verwendet werden d<>rfen }
isgraphmode : boolean;
{ Einstellung zum Linien zeichnen }
aktlineinfo : LineSettingsType;
{ Fehlercode, wird von graphresult zur<75>ckgegeben }
_graphresult : integer;
{ aktuell eingestellte F<>llart }
aktfillsettings : FillSettingsType;
aktfillbkcolor : longint;
{ aktuelles F<>llmuster }
aktfillpattern : FillPatternType;
{ Schreibmodus }
aktwritemode : word;
{ put background color around text }
ClearText : boolean;
{ Schrifteinstellung }
akttextinfo : TextSettingsType;
{ momentan gesetzte Textskalierungswerte }
aktmultx,aktdivx,aktmulty,aktdivy : word;
{ Pfad zu den Fonts }
bgipath : string;
{ Pointer auf Hilfsspeicher }
buffermem : pointer;
{ momentane Gr<47><72>e des Buffer }
buffersize : longint;
{ in diesem Puffer werden bei SetFillStyle bereits die Pattern in der }
{ zu verwendenden Farbe abgelegt }
PatternBuffer : Array [0..63] of LongInt;
X_Array : array [0..1280] of LongInt;
Y_Array : array [0..1024] of LongInt;
Sel,Seg : word;
VGAInfo : VGAInfoBlock;
VESAInfo : VESAInfoBlock;
{ Selectors for Protected Mode }
seg_WRITE : word;
seg_READ : word;
{ linear Frame Buffer }
LinearFrameBufferSupported : boolean;
FrameBufferLinearAddress : longint;
UseLinearFrameBuffer : Boolean;
const
EnableLinearFrameBuffer = $4000;
{ Registers for RealModeInterrupts in DPMI-Mode }
var
dregs : TRealRegs;
{ read and write bank are allways equal !! }
A_Bank : longint;
AW_window : longint;
AR_Window : longint;
same_window : boolean;
const
AWindow = 0;
BWindow = 1;
{ Variables for Bankswitching }
var
BytesPerLine : longint;
BytesPerPixel: Word;
WinSize : longint; { Expample $0x00010000 . $0x00008000 }
WinLoMask : longint; { $0x0000FFFF $0x00007FFF }
WinLoMaskMinusPixelSize : longint; { $0x0000FFFF $0x00007FFF }
WinShift : byte;
GranShift : byte;
Granular : longint;
Granularity : longint;
graphgetmemptr,
graphfreememptr,
bankswitchptr :pointer;
isDPMI :Boolean;
SwitchCS,SwitchIP : word;
function ColorsEqual(c1,c2 : longint) : boolean;
Begin
ColorsEqual:=((BytesPerPixel=1) and ((c1 and $FF)=(c2 and $FF))) or
((GetMaxColor=$7FFF) and ((c1 and $F8F8F8)=(c2 and $F8F8F8))) or
((GetMaxColor=$FFFF) and ((c1 and $F8FCF8)=(c2 and $F8FCF8))) or
((BytesPerPixel>2) and ((c1 and $FFFFFF)=(c2 and $FFFFFF)));
End;
function GraphErrorMsg(ErrorCode: Integer): string;
Begin
GraphErrorMsg:='';
case ErrorCode of
grOk,grFileNotFound,grInvalidDriver: exit;
grNoInitGraph: GraphErrorMsg:='Graphics driver not installed';
grNotDetected: GraphErrorMsg:='Graphics hardware not detected';
grNoLoadMem,grNoScanMem,grNoFloodMem: GraphErrorMsg := 'Not enough memory for graphics';
grNoFontMem: GraphErrorMsg := 'Not enough memory to load font';
grFontNotFound: GraphErrorMsg:= 'Font file not found';
grInvalidMode: GraphErrorMsg := 'Invalid graphics mode';
grError: GraphErrorMsg:='Graphics error';
grIoError: GraphErrorMsg:='Graphics I/O error';
grInvalidFont,grInvalidFontNum: GraphErrorMsg := 'Invalid font';
grInvalidVersion: GraphErrorMsg:='Invalid driver version';
end;
end;
procedure GraphFault(ErrString:String);
begin
CloseGraph;
writeln('Error in Unit VESA: ',ErrString);
halt;
end;
{$I MOVE.PPI}
{$I IBM.PPI}
procedure WaitRetrace;
begin
asm
cli
movw $0x03Da,%dx
.LWaitNotHSyncLoop:
inb %dx,%al
testb $0x8,%al
jnz .LWaitNotHSyncLoop
.LWaitHSyncLoop:
inb %dx,%al
testb $0x8,%al
jz .LWaitHSyncLoop
sti
end;
end;
(* Unused, commented 20/11/98 PM
procedure getmem(var p : pointer;size : longint);
begin
asm
pushl 12(%ebp)
pushl 8(%ebp)
movl _GRAPHGETMEMPTR,%eax
call %eax
end;
end;
procedure freemem(var p : pointer;size : longint);
begin
asm
pushl 12(%ebp)
pushl 8(%ebp)
movl _GRAPHFREEMEMPTR,%eax
call %eax
end;
end; *)
{$I COLORS.PPI}
procedure graphdefaults;
begin
_graphresult:=grOk;
if not isgraphmode then
begin
_graphresult:=grnoinitgraph;
exit;
end;
{ Linientyp }
aktlineinfo.linestyle:=solidln;
aktlineinfo.thickness:=normwidth;
{ std colors }
setstdcolors;
{ Zeichenfarbe }
setcolor(white);
setbkcolor(black);
{ F<>llmuster }
setfillstyle(solidfill,white);
{ necessary to load patternbuffer !! (PM)
aktfillsettings.color:=white;
aktfillsettings.pattern:=solidfill; }
{ Viewport setzen }
aktviewport.clip:=true;
aktviewport.x1:=0;
aktviewport.y1:=0;
aktviewport.x2:=_maxx-1;
aktviewport.y2:=_maxy-1;
aktscreen:=aktviewport;
{ normaler Schreibmodus }
setwritemode(normalput);
{ Schriftart einstellen }
akttextinfo.font:=DefaultFont;
akttextinfo.direction:=HorizDir;
akttextinfo.charsize:=1;
akttextinfo.horiz:=LeftText;
akttextinfo.vert:=TopText;
{ Vergr<67><72>erungsfaktoren}
XAsp:=10000; YAsp:=10000;
aspectratio:=1;
end;
{ ############################################################### }
{ ################# Ende der internen Routinen ################ }
{ ############################################################### }
{$I PALETTE.PPI}
{$I PIXEL.PPI}
{$I LINE.PPI}
{$I ELLIPSE.PPI}
{$I TRIANGLE.PPI}
{$I ARC.PPI}
{$I IMAGE.PPI}
{$I TEXT.PPI}
{$I FILL.PPI}
function GetDrivername:String;
begin
if not isgraphmode then
begin
_graphresult:=grNoInitGraph;
Exit;
end;
GetDriverName:=('internal VESA-Driver');
end;
function GetModeName(Mode:Integer):String;
var s1,s2,s3:string;
begin
if not isgraphmode then
begin
_graphresult:=grNoInitGraph;
Exit;
end;
str(_maxx,s1);
str(_maxy,s2);
str(getmaxcolor+1,s3);
GetModeName:=('VESA '+s1+'x'+s2+'x'+s3);
end;
function GetGraphMode:Integer;
begin
if InTempCRTMode then
begin
GetGraphMode:=oldCRTMode;
exit;
end;
if not isgraphmode then
begin
_graphresult:=grNoInitGraph;
GetGraphMode:=grNoInitGraph;
Exit;
end;
GetGraphMode:=GetVesaMode;
end;
procedure ClearViewport;
var bank1,bank2,diff,c:longint;
ofs1,ofs2 :longint;
y : integer;
storewritemode : word;
begin
if not isgraphmode then
begin
_graphresult:=grNoInitGraph;
Exit;
end;
c:=aktcolor;
aktcolor:=aktbackcolor;
storewritemode:=aktwritemode;
aktwritemode:=normalput;
ofs1:=Y_ARRAY[aktviewport.y1] + X_ARRAY[aktviewport.x1];
ofs2:=Y_ARRAY[aktviewport.y1] + X_ARRAY[aktviewport.x2];
for y:=aktviewport.y1 to aktviewport.y2 do
begin
bank1:=ofs1 shr winshift;
bank2:=ofs2 shr winshift;
if bank1 <> A_BANK then
begin
Switchbank(bank1);
end;
if bank1 <> bank2 then
begin
diff:=((bank2 shl winshift)-ofs1) div BytesPerPixel;
horizontalline(aktviewport.x1, aktviewport.x1+diff-1, y);
Switchbank(bank2);
horizontalline(aktviewport.x1+diff, aktviewport.x2, y);
end else horizontalline(aktviewport.x1, aktviewport.x2, y);
ofs1:=ofs1 + BytesPerLine;
ofs2:=ofs2 + BytesPerLine;
end;
aktwritemode:=storewritemode;
aktcolor:=c;
end;
procedure GetAspectRatio(var _Xasp,_Yasp : word);
begin
_graphresult:=grOk;
if not isgraphmode then
begin
_graphresult:=grnoinitgraph;
exit;
end;
_XAsp:=XAsp; _YAsp:=YAsp;
end;
procedure SetAspectRatio(_Xasp, _Yasp : word);
begin
_graphresult:=grOk;
if not isgraphmode then
begin
_graphresult:=grnoinitgraph;
exit;
end;
Xasp:=_XAsp; YAsp:=_YAsp;
end;
procedure ClearDevice;
var Viewport:ViewportType;
begin
if not isgraphmode then
begin
_graphresult:=grNoInitGraph;
Exit;
end;
Viewport:=aktviewport;
SetViewport(0,0,_maxx-1,_maxy-1,Clipon);
ClearViewport;
aktviewport:=viewport;
end;
procedure Rectangle(x1,y1,x2,y2:integer);
begin
if not isgraphmode then
begin
_graphresult:=grNoInitGraph;
Exit;
end;
Line(x1,y1,x2,y1);
Line(x1,y1,x1,y2);
Line(x2,y1,x2,y2);
Line(x1,y2,x2,y2);
end;
procedure Bar(x1,y1,x2,y2:integer);
var y : Integer;
origcolor : longint;
origlinesettings: Linesettingstype;
begin
if not isgraphmode then
begin
_graphresult:=grNoInitGraph;
Exit;
end;
origlinesettings:=aktlineinfo;
origcolor:=aktcolor;
aktlineinfo.linestyle:=solidln;
aktlineinfo.thickness:=normwidth;
case aktfillsettings.pattern of
emptyfill : begin
aktcolor:=aktbackcolor;
for y:=y1 to y2 do line(x1,y,x2,y);
end;
solidfill : begin
aktcolor:=aktfillsettings.color;
for y:=y1 to y2 do line(x1,y,x2,y);
end;
else for y:=y1 to y2 do patternline(x1,x2,y);
end;
aktcolor:=origcolor;
aktlineinfo:=origlinesettings;
end;
procedure bar3D(x1, y1, x2, y2 : integer;depth : word;top : boolean);
begin
if not isgraphmode then
begin
_graphresult:=grNoInitGraph;
Exit;
end;
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 SetGraphBufSize(BufSize : longint);
begin
if assigned(buffermem) then
freemem(buffermem,buffersize);
getmem(buffermem,bufsize);
if not assigned(buffermem) then
buffersize:=0
else buffersize:=bufsize;
end;
const
{ Vorgabegr<67><72>e f<>r Hilfsspeicher }
bufferstandardsize = 64*8196; { 0,5 MB }
procedure CloseGraph;
begin
if isgraphmode then
begin
SetVESAMode(startmode);
{ DoneVESA; only in exitproc !! PM }
isgraphmode:=false;
if assigned(buffermem) then
freemem(buffermem,buffersize);
buffermem:=nil;
buffersize:=0;
end;
end;
procedure SetArrays;
var
index:Integer;
begin
for index:=0 to VESAInfo.XResolution do
X_Array[index]:=index * BytesPerPixel;
for index:=0 to VESAInfo.YResolution do
Y_Array[index]:=index * BytesPerLine + AktPageOffset;
end;
procedure InitGraph(var GraphDriver:Integer;var GraphMode:Integer;const PathToDriver:String);
var i : Integer;
begin
{ Pfad zu den Fonts }
bgipath:=PathToDriver;
if bgipath[length(bgipath)]<>'\' then
bgipath:=bgipath+'\';
if Graphdriver=detect then GraphMode:=GetMaxMode;
{ Standardfonts installieren }
InstallUserFont('TRIP');
InstallUserFont('LITT');
InstallUserFont('SANS');
InstallUserFont('GOTH');
InstallUserFont('SCRI');
InstallUserFont('SIMP');
InstallUserFont('TSCR');
InstallUserFont('LCOM');
InstallUserFont('EURO');
InstallUserFont('BOLD');
GetVESAInfo(GraphMode);
{$IFDEF DEBUG}
{$I VESADEB.PPI}
{$ENDIF}
for i:=VESANumber downto 0 do
if GraphMode=VESAModes[i] then break;
{ the modes can be refused due to the monitor ? }
{ that happens by me at home Pierre Muller }
while i>=0 do begin
isgraphmode:=SetVESAMode(GraphMode);
if isgraphmode then begin
GetVESAInfo(GraphMode);
if UseLinearFrameBuffer then
isgraphmode:=SetVESAMode(GraphMode or EnableLinearFrameBuffer);
{ set zero page }
AktPageOffset:=0;
SetActivePage(0);
SetVisualPage(0);
SetArrays;
SetGraphBufSize(bufferstandardsize);
graphdefaults;
InTempCRTMode:=false;
exit;
end;
dec(i);
GraphMode:=VESAModes[i];
end;
_graphresult:=grInvalidMode
end;
procedure SetGraphMode(GraphMode:Integer);
begin
_graphresult:=grOk;
if not isgraphmode and not InTempCRTMode then
begin
_graphresult:=grNoInitGraph;
Exit;
end;
if GetVesaInfo(GraphMode) then
begin
isgraphmode:=SetVESAMode(GraphMode);
if isgraphmode then
begin
if UseLinearFrameBuffer then
isgraphmode:=SetVESAMode(GraphMode or EnableLinearFrameBuffer);
{ set zero page }
AktPageOffset:=0;
SetActivePage(0);
SetVisualPage(0);
SetArrays;
graphdefaults;
InTempCRTMode:=false;
exit;
end;
end;
_graphresult:=grInvalidMode;
end;
function RegisterBGIdriver(driver : pointer) : integer;
begin
RegisterBGIdriver:=grerror;
end;
function InstallUserDriver(const DriverFileName : string;AutoDetectPtr : pointer) : integer;
begin
installuserdriver:=grerror;
end;
function GetMaxMode:Integer;
var i:Byte;
begin
for i:=VESANumber downto 0 do
if GetVesaInfo(VESAModes[i]) then
begin
GetMaxMode:=VESAModes[i];
Exit;
end;
end;
function GetMaxX:Integer;
begin
if not isgraphmode then
begin
_graphresult:=grNoInitGraph;
Exit;
end;
GetMaxX:=VESAInfo.XResolution-1;
end;
function GetMaxY:Integer;
begin
if not isgraphmode then
begin
_graphresult:=grNoInitGraph;
Exit;
end;
GetMaxY:=VESAInfo.YResolution-1;
end;
function GetX : integer;
begin
_graphresult:=grOk;
if not isgraphmode then
begin
_graphresult:=grNoInitGraph;
Exit;
end;
GetX:=curx;
end;
function GetY : integer;
begin
_graphresult:=grOk;
if not isgraphmode then
begin
_graphresult:=grNoInitGraph;
Exit;
end;
GetY:=cury;
end;
procedure SetViewPort(x1,y1,x2,y2 : integer;clip : boolean);
begin
_graphresult:=grOk;
if not isgraphmode then
begin
_graphresult:=grNoInitGraph;
exit;
end;
{ Daten <20>berpr<70>fen }
if (x1<0) or (y1<0) or (x2>=_maxx) or (y2>=_maxy) then exit;
aktviewport.x1:=x1;
aktviewport.y1:=y1;
aktviewport.x2:=x2;
aktviewport.y2:=y2;
aktviewport.clip:=clip;
end;
procedure GetViewSettings(var viewport : ViewPortType);
begin
_graphresult:=grOk;
if not isgraphmode then
begin
_graphresult:=grNoInitGraph;
exit;
end;
viewport:=aktviewport;
end;
{ mehrere Bildschirmseiten werden nicht unterst<73>tzt }
{ Dummy aus Kompatibilit<69>tsgr<67>nden }
procedure SetVisualPage(page : word);
begin
_graphresult:=grOk;
if not isgraphmode then
begin
_graphresult:=grNoInitGraph;;
exit;
end
else if (Page<VESAInfo.NumberOfPages) and (AktVisualPage<>Page) then
begin
SetVESADisplayStart(Page,0,0);
{SetDisplayPage(Page);}
AktVisualPage:=Page;
end;
end;
function GetVisualPage : word;
begin
GetVisualPage:=AktVisualPage;
end;
function GetActivePage : word;
begin
GetActivePage:=AktPage;
end;
{ mehrere Bildschirmseiten werden nicht unterst<73>tzt }
{ Dummy aus Kompatibilit<69>tsgr<67>nden }
procedure SetActivePage(page : word);
begin
_graphresult:=grOk;
if not isgraphmode then
begin
_graphresult:=grNoInitGraph;;
exit;
end
else if (Page<VESAInfo.NumberOfPages) and (Page<>AktPage) then
begin
AktPageOffset:=Page*BytesPerLine*_maxy;
AktPage:=Page;
SetArrays;
end;
end;
function GetNumberOfPages : word;
begin
GetNumberOfPages:=VESAInfo.NumberOfPages;
end;
procedure SetWriteMode(WriteMode : integer);
begin
_graphresult:=grOk;
if not isgraphmode then
begin
_graphresult:=grNoInitGraph;;
exit;
end;
if ((writemode and 7)<>xorput) and ((writemode and 7)<>normalput) then
begin
_graphresult:=grError;
exit;
end;
aktwritemode:=(writemode and 7);
if (writemode and BackPut)<>0 then
ClearText:=true
else
ClearText:=false;
end;
function GraphResult:Integer;
begin
GraphResult:=_graphresult;
end;
procedure RestoreCRTMode;
begin
if not isgraphmode then
begin
_graphresult:=grNoInitGraph;
Exit;
end;
OldCRTMode:=GetGraphMode;
InTempCRTMode:=true;
SetVESAMode(startmode);
isgraphmode:=false;
end;
var PrevExitProc : pointer;
procedure GraphExit;
begin
ExitProc:=PrevExitProc;
CloseGraph;
DoneVesa; { frees the ldt descriptors seg_read and seg_write !! }
end;
begin
InitVESA;
if not DetectVESA then
GraphFault('VESA-BIOS not found...');
startmode:=GetVESAMode;
PrevExitProc:=ExitProc;
ExitProc:=@GraphExit;
bankswitchptr:=@switchbank;
GraphGetMemPtr:=@system.getmem;
GraphFreeMemPtr:=@system.freemem;
Getdefaultfont;
if not isDPMI then begin
wrbuffer:=pointer($D0000000);
rbuffer:=pointer($D0200000);
wbuffer:=pointer($D0200000);
end else begin
wrbuffer:=pointer($0);
rbuffer:=pointer($0);
wbuffer:=pointer($0);
end;
AktPageOffset:=0;
AktPage:=0;
AktVisualPage:=0;
end.
{
$Log$
Revision 1.5 1999-05-04 17:17:31 florian
* some explicit language removed
Revision 1.4 1999/04/08 12:23:00 peter
* removed os.inc
Revision 1.3 1999/03/02 13:56:34 peter
* use ATT assembler in profile
* use AS output in graph
Revision 1.2 1999/02/01 13:19:01 pierre
* getgraphmode returns -1 if not in graphic mode
Revision 1.1 1998/12/21 13:07:03 peter
* use -FE
Revision 1.15 1998/12/15 22:42:50 peter
* removed temp symbols
Revision 1.14 1998/11/25 22:59:23 pierre
* fillpoly works
Revision 1.13 1998/11/25 13:04:43 pierre
+ added multi page support
Revision 1.12 1998/11/23 10:04:16 pierre
* pieslice and sector work now !!
* bugs in text writing removed
+ scaling for defaultfont added
+ VertDir for default font added
* RestoreCRTMode corrected
Revision 1.11 1998/11/20 18:42:04 pierre
* many bugs related to floodfill and ellipse fixed
Revision 1.10 1998/11/20 10:16:01 pierre
* Found out the LinerFrameBuffer problem
Was an alignment problem in VesaInfoBlock (see graph.pp file)
Compile with -dDEBUG and answer 'y' to 'Use Linear ?' to test
Revision 1.9 1998/11/19 15:09:33 pierre
* several bugfixes for sector/ellipse/floodfill
+ graphic driver mode const in interface G800x600x256...
+ added backput mode as in linux graph.pp
(clears the background of textoutput)
Revision 1.8 1998/11/19 09:48:45 pierre
+ added some functions missing like sector ellipse getarccoords
(the filling of sector and ellipse is still buggy
I use floodfill but sometimes the starting point
is outside !!)
* fixed a bug in floodfill for patterns
(still has problems !!)
Revision 1.7 1998/11/18 09:31:29 pierre
* changed color scheme
all colors are in RGB format if more than 256 colors
+ added 24 and 32 bits per pixel mode
(compile with -dDEBUG)
24 bit mode with banked still as problems on pixels across
the bank boundary, but works in LinearFrameBufferMode
Look at install/demo/nmandel.pp
Revision 1.6 1998/10/22 09:44:57 pierre
* PatternBuffer was not set on entry !!
Revision 1.5 1998/09/16 16:47:25 peter
* merged fixes
Revision 1.4.2.1 1998/09/16 16:15:41 peter
* no smartlinking!
Revision 1.4 1998/05/31 14:18:14 peter
* force att or direct assembling
* cleanup of some files
Revision 1.3 1998/05/22 00:39:23 peter
* go32v1, go32v2 recompiles with the new objects
* remake3 works again with go32v2
- removed some "optimizes" from daniel which were wrong
}
Reference in New Issue View Git Blame Copy Permalink