fpc/rtl/inc/graph/modes.inc
Jonas Maebe 011a187da3 * final fixes for linux support (graphdriver value of the modes
is now also not modified anymore)
2000-07-05 13:07:48 +00:00

690 lines
23 KiB
PHP

{
$Id$
This file is part of the Free Pascal run time library.
Copyright (c) 1999-2000 by the Free Pascal development team
This include implements video mode management.
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.
**********************************************************************}
{-----------------------------------------------------------------------}
{ Internal routines }
{-----------------------------------------------------------------------}
{$ifndef nonewmodes}
procedure res2Mode(x, y, maxColor: longint; var driver,mode: smallInt);
var
l: longint;
begin
case maxColor of
2: driver := D1bit;
4: driver := D2bit;
16: driver := D4bit;
64: driver := D6bit;
256: driver := D8bit;
4096: driver := D12bit;
32768: driver := D15bit;
65536: driver := D16bit;
{ not yet supported
65536*256: driver := D24bit;
65536*65536: driver := D32bit;}
else
begin
driver := maxsmallint;
exit;
end;
end;
{ Check whether this is known/predefined mode }
for l := lowNewMode to highNewMode do
if (resolutions[l].x = x) and
(resolutions[l].y = y) then
begin
{ Found! }
mode := l;
exit;
end;
{ Not Found }
mode := maxsmallint;
end;
function mode2res(modeNr: smallInt; var x,y: longint): boolean;
begin
if (modeNr < lowNewMode) or
(modeNr > highNewMode) then
begin
mode2res := false;
exit;
end;
mode2res := true;
x := resolutions[modeNr].x;
y := resolutions[modeNr].y;
end;
{$endif nonewmodes}
procedure addmode(const mode: TModeInfo);
{********************************************************}
{ Procedure AddMode() }
{--------------------------------------------------------}
{ This routine adds <mode> to the list of recognized }
{ modes. Duplicates are allowed. }
{********************************************************}
var
{$ifndef nonewmodes}
driverNr, modeNr: smallint;
prev: PModeInfo;
{$endif nonewmodes}
list: PModeInfo;
newlst : PModeInfo;
begin
{$ifndef nonewmodes}
res2Mode(mode.maxx+1,mode.maxy+1,mode.maxColor,driverNr,ModeNr);
{ bitdepth supported? }
if (driverNr <> maxsmallint) then
{ Yes, add the mode }
if not assigned(newModeList.modeinfo[driverNr]) then
begin
{$ifdef logging}
logln('Adding resolution '+strf(modenr)+' for drivernr '+strf(drivernr)+
' ('+strf(mode.maxx)+'x'+strf(mode.maxy)+')');
{$endif logging}
new(newModeList.modeinfo[driverNr]);
newModeList.modeinfo[driverNr]^ := mode;
with newModeList.modeinfo[driverNr]^ do
begin
internModeNumber := 1;
next := nil;
end;
newModeList.loHiModeNr[driverNr].lo := 1;
newModeList.loHiModeNr[driverNr].hi := 1;
end
else
begin
prev := nil;
list := newModeList.modeinfo[driverNr];
{ sort first by x resolution, then by yresolution }
while assigned(list) and
((list^.maxx < mode.maxx) or
((list^.maxx = mode.maxx) and
(list^.maxy < mode.maxy))) do
begin
prev := list;
list := list^.next;
end;
{ mode already exists? -> replace (assume later added modes are }
{ better) }
if assigned(list) and
(list^.maxx = mode.maxx) and
(list^.maxy = mode.maxy) then
begin
{$ifdef logging}
logln('replacing resolution '+strf(modenr)+' for drivernr '+strf(drivernr)+
' ('+strf(mode.maxx)+'x'+strf(mode.maxy)+')');
{$endif logging}
{ save/restore next, drivernr and drivermode in list }
modeNr := list^.internModeNumber;
prev := list^.next;
list^ := mode;
list^.internModeNumber := modeNr;
list^.next := prev;
end
else
begin
new(newLst);
{ Increase the number of modes for this driver }
inc(newModeList.loHiModeNr[driverNr].hi);
newLst^ := mode;
{$ifdef logging}
logln('Adding resolution '+strf(modenr)+' for drivernr '+strf(drivernr)+
' ('+strf(mode.maxx)+'x'+strf(mode.maxy)+')');
{$endif logging}
if assigned(list) then
newLst^.next := list^.next
else
newLst^.next := nil;
if assigned(prev) then
begin
prev^.next := newLst;
newLst^.internModeNumber := succ(prev^.internModeNumber)
end
else
begin
newModeList.modeinfo[driverNr] := newLst;
newLst^.internModeNumber := 1;
end;
{ Increase the modenumbers of all modes coming after this one }
{ with 1 }
newLst := newLst^.next;
while assigned(newLst) do
begin
inc(newLst^.internModeNumber);
newLst := newLst^.next;
end;
end;
end;
{$endif nonewmodes}
{ TP-like mode stuff }
if not assigned(ModeList) then
begin
new(ModeList);
move(mode, ModeList^, sizeof(Mode));
end
else
begin
list := ModeList;
{ go to the end of the list }
while assigned(list^.next) do
list:=list^.next;
new(NewLst);
list^.next := NewLst;
move(mode, NewLst^, sizeof(Mode));
end;
end;
procedure initmode(var mode: TModeInfo);
{********************************************************}
{ Procedure InitMode() }
{--------------------------------------------------------}
{ This routine initialized the mode to default values. }
{********************************************************}
begin
FillChar(mode,sizeof(Mode),#0);
end;
function searchmode(ReqDriver : smallint; var reqmode: smallint): PModeInfo;
{********************************************************}
{ Procedure SearchMode() }
{--------------------------------------------------------}
{ This routine searches the list of recognized modes, }
{ and tries to find the <reqmode> in the <reqdriver> }
{ return nil if not found, otherwise returns the found }
{ structure. }
{ note: if reqmode = -32768, the first mode available }
{ for reqdriver is returned (JM) }
{ if reqmode = -32767, the last mode available }
{ for reqdriver is returned (JM) }
{********************************************************}
var
list, lastModeInfo: PModeInfo;
{$ifndef nonewmodes}
x,y: longint;
{$endif}
begin
{$ifdef logging}
LogLn('Searching for driver '+strf(reqdriver)+' and mode '+strf(reqmode));
{$endif logging}
{$ifndef nonewmodes}
if (reqDriver >= lowNewDriver) and
(reqDriver <= highNewDriver) then
begin
case reqMode of
-32768:
begin
reqMode := newModeList.loHiModeNr[reqDriver].lo;
searchMode := newModeList.modeinfo[reqDriver];
end;
-32767:
begin
reqMode := newModeList.loHiModeNr[reqDriver].hi;
searchMode := nil;
{ Are there any modes available for this driver? }
if reqMode <> -1 then
begin
list := newModeList.modeinfo[reqDriver];
while assigned(list^.next) do
list := list^.next;
searchMode := list;
end;
end;
else
begin
list := newModeList.modeinfo[reqDriver];
searchMode := nil;
if not assigned(list) then
exit;
if mode2res(reqMode,x,y) then
begin
x := pred(x);
y := pred(y);
while assigned(list) and
((list^.maxx < x) or
((list^.maxx = x) and
(list^.maxy < y))) do
list := list^.next;
if not assigned(list) or
(list^.maxx <> x) or
(list^.maxy <> y) then
list := nil;
searchmode := list;
end
else
begin
while assigned(list) and
(list^.internModeNumber <> reqMode) do
list := list^.next;
searchMode := list;
end;
end;
end;
exit;
end;
{$endif nonewmodes}
searchmode := nil;
list := ModeList;
If assigned(list) then
lastModeInfo := list;
{ go to the end of the list }
while assigned(list) do
begin
{$ifdef logging}
Log('Found driver '+strf(list^.DriverNumber)+
' and mode $'+hexstr(list^.ModeNumber,4)+'...');
{$endif logging}
if ((list^.DriverNumber = ReqDriver) and
((list^.ModeNumber = ReqMode) or
{ search for lowest mode }
(reqMode = -32768))) or
{ search for highest mode }
((reqMode = -32767) and
(lastModeInfo^.driverNumber = reqDriver) and
((list^.driverNumber <> lastModeInfo^.driverNumber) or
not(assigned(list^.next)))) then
begin
{$ifdef logging}
LogLn('Accepted!');
{$endif logging}
searchmode := list;
If reqMode = -32768 then
reqMode := list^.ModeNumber
else if reqMode = -32767 then
begin
reqMode := lastModeInfo^.ModeNumber;
searchMode := lastModeInfo;
end;
exit;
end;
{$ifdef logging}
LogLn('Rejected.');
{$endif logging}
lastModeInfo := list;
list:=list^.next;
end;
end;
{-----------------------------------------------------------------------}
{ External routines }
{-----------------------------------------------------------------------}
function GetModeName(ModeNumber: smallint): string;
{********************************************************}
{ Function GetModeName() }
{--------------------------------------------------------}
{ Checks the known video list, and returns ModeName }
{ string. On error returns an empty string. }
{********************************************************}
var
mode: PModeInfo;
begin
mode:=nil;
GetModeName:='';
{ only search in the current driver modes ... }
mode:=SearchMode(IntCurrentDriver,ModeNumber);
if assigned(mode) then
GetModeName:=Mode^.ModeName
else
_GraphResult := grInvalidMode;
end;
function GetGraphMode: smallint;
begin
GetGraphMode := IntCurrentMode;
end;
function GetMaxMode: word;
{ I know , i know, this routine is very slow, and it would }
{ be much easier to sort the linked list of possible modes }
{ instead of doing this, but I'm lazy!! And anyways, the }
{ speed of the routine here is not that important.... }
var
i: word;
mode: PModeInfo;
begin
mode:=nil;
i:=0;
repeat
inc(i);
{ mode 0 always exists... }
{ start search at 1.. }
mode:=SearchMode(IntCurrentDriver,i);
until not assigned(mode);
GetMaxMode:=i;
end;
procedure GetModeRange(GraphDriver: smallint; var LoMode,
HiMode: smallint);
var
mode : PModeInfo;
begin
{$ifdef logging}
LogLn('GetModeRange : Enter ('+strf(GraphDriver)+')');
{$endif}
HiMode:=-1;
mode := nil;
{ First search if the graphics driver is supported .. }
{ since mode zero is always supported.. if that driver }
{ is supported it should return something... }
{ not true, e.g. VESA doesn't have a mode 0. Changed so}
{ -32768 means "return lowest mode in second parameter }
{ also, under VESA some modes may not be supported }
{ (e.g. $108 here) while some with a higher number can }
{ be supported ($112 and onward), so I also added that }
{ -32767 means "return highest mode in second parameter}
{ This whole system should be overhauled though to work}
{ without such hacks (JM) }
loMode := -32768;
mode := SearchMode(GraphDriver, loMode);
{ driver not supported...}
if not assigned(mode) then
begin
loMode := -1;
exit;
end;
{$ifdef logging}
LogLn('GetModeRange : Mode '+strf(lomode)+' found');
{$endif}
{ now it exists... find highest available mode... }
hiMode := -32767;
mode:=SearchMode(GraphDriver,hiMode);
end;
procedure SetGraphMode(mode: smallint);
var
modeinfo: PModeInfo;
begin
{ check if the mode exists... }
modeinfo := searchmode(IntcurrentDriver,mode);
if not assigned(modeinfo) then
begin
{$ifdef logging}
LogLn('Mode setting failed in setgraphmode pos 1');
{$endif logging}
_GraphResult := grInvalidMode;
exit;
end;
{ reset all hooks...}
DefaultHooks;
{ arccall not reset - tested against VGA BGI driver }
{ Setup all hooks if none, keep old defaults...}
{ required hooks - returns error if no hooks to these }
{ routines. }
if assigned(modeinfo^.DirectPutPixel) then
DirectPutPixel := modeinfo^.DirectPutPixel
else
begin
{$ifdef logging}
LogLn('Mode setting failed in setgraphmode pos 2');
{$endif logging}
_Graphresult := grInvalidMode;
exit;
end;
if assigned(modeinfo^.PutPixel) then
PutPixel := modeinfo^.PutPixel
else
begin
{$ifdef logging}
LogLn('Mode setting failed in setgraphmode pos 3');
{$endif logging}
_Graphresult := grInvalidMode;
exit;
end;
if assigned(modeinfo^.GetPixel) then
GetPixel := modeinfo^.GetPixel
else
begin
{$ifdef logging}
LogLn('Mode setting failed in setgraphmode pos 4');
{$endif logging}
_Graphresult := grInvalidMode;
exit;
end;
if assigned(modeinfo^.SetRGBPalette) then
SetRGBPalette := modeinfo^.SetRGBPalette
else
begin
{$ifdef logging}
LogLn('Mode setting failed in setgraphmode pos 5');
{$endif logging}
_Graphresult := grInvalidMode;
exit;
end;
if assigned(modeinfo^.GetRGBPalette) then
GetRGBPalette := modeinfo^.GetRGBPalette
else
begin
{$ifdef logging}
LogLn('Mode setting failed in setgraphmode pos 6');
{$endif logging}
_Graphresult := grInvalidMode;
exit;
end;
{ optional hooks. }
if assigned(modeinfo^.ClearViewPort) then
ClearViewPort := modeinfo^.ClearViewPort;
if assigned(modeinfo^.PutImage) then
PutImage := modeinfo^.PutImage;
if assigned(modeinfo^.GetImage) then
GetImage := modeinfo^.GetImage;
if assigned(modeinfo^.ImageSize) then
ImageSize := modeinfo^.ImageSize;
if assigned(modeinfo^.GetScanLine) then
GetScanLine := modeinfo^.GetScanLine;
if assigned(modeinfo^.Line) then
Line := modeinfo^.Line;
if assigned(modeinfo^.InternalEllipse) then
InternalEllipse := modeinfo^.InternalEllipse;
if assigned(modeinfo^.PatternLine) then
PatternLine := modeinfo^.PatternLine;
if assigned(modeinfo^.HLine) then
Hline := modeinfo^.Hline;
if assigned(modeinfo^.Vline) then
VLine := modeinfo^.VLine;
if assigned(modeInfo^.SetVisualPage) then
SetVisualPage := modeInfo^.SetVisualPage;
if assigned(modeInfo^.SetActivePage) then
SetActivePage := modeInfo^.SetActivePage;
if assigned(modeInfo^.OutTextXY) then
OutTextXY:=modeInfo^.OutTextXY;
IntCurrentMode := modeinfo^.ModeNumber;
IntCurrentDriver := modeinfo^.DriverNumber;
{$ifdef logging}
logln('Entering mode '+strf(intCurrentMode)+' of driver '+strf(intCurrentDriver));
{$endif logging}
XAspect := modeinfo^.XAspect;
YAspect := modeinfo^.YAspect;
MaxX := modeinfo^.MaxX;
MaxY := modeinfo^.MaxY;
{$ifdef logging}
logln('maxx = '+strf(maxx)+', maxy = '+strf(maxy));
{$endif logging}
HardwarePages := modeInfo^.HardwarePages;
MaxColor := modeinfo^.MaxColor;
PaletteSize := modeinfo^.PaletteSize;
{ is this a direct color mode? }
DirectColor := modeinfo^.DirectColor;
{ now actually initialize the video mode...}
{ check first if the routine exists }
if not assigned(modeinfo^.InitMode) then
begin
{$ifdef logging}
LogLn('Mode setting failed in setgraphmode pos 7');
{$endif logging}
_GraphResult := grInvalidMode;
exit;
end;
modeinfo^.InitMode;
if _GraphResult <> grOk then exit;
isgraphmode := true;
{ It is very important that this call be made }
{ AFTER the other variables have been setup. }
{ Since it calls some routines which rely on }
{ those variables. }
SetActivePage(0);
SetVisualPage(0);
SetViewPort(0,0,MaxX,MaxY,TRUE);
GraphDefaults;
end;
procedure RestoreCrtMode;
{********************************************************}
{ Procedure RestoreCRTMode() }
{--------------------------------------------------------}
{ Returns to the video mode which was set before the }
{ InitGraph. Hardware state is set to the old values. }
{--------------------------------------------------------}
{ NOTE: - }
{ - }
{********************************************************}
begin
isgraphmode := false;
RestoreVideoState;
end;
{
$Log$
Revision 1.30 2000-07-05 13:07:48 jonas
* final fixes for linux support (graphdriver value of the modes
is now also not modified anymore)
Revision 1.29 2000/07/05 11:25:20 jonas
* added internModeNumber to modeinfo type to fix Linux compatibility
with -dnewmodes code
Revision 1.28 2000/06/27 13:37:04 jonas
* released -dnewmodes
Revision 1.27 2000/06/23 19:56:38 jonas
* setviewport was sometimes called with parameters from the previous
active mode, either directly from setgraphmode or from
setbkcolor
Revision 1.26 2000/06/22 18:36:19 peter
* removed notes
Revision 1.25 2000/06/19 01:18:49 carl
+ added modes for Atari/Amiga and bit depth also
Revision 1.24 2000/06/18 14:59:39 jonas
* changed maxint -> maxsmallint (range error because of objpas mod
somewhere)
Revision 1.23 2000/06/17 19:09:23 jonas
* new platform independent mode handling (between -dnewmodes)
Revision 1.22 2000/04/02 12:13:37 florian
* some more procedures can be now hooked by the OS specific implementation
Revision 1.21 2000/03/24 18:16:33 florian
* introduce a DrawBitmapCharHoriz procedure variable to accelerate output on
win32
Revision 1.20 2000/03/24 13:01:15 florian
* ClearViewPort fixed
Revision 1.19 2000/01/07 16:41:39 daniel
* copyright 2000
Revision 1.18 2000/01/07 16:32:26 daniel
* copyright 2000 added
Revision 1.17 2000/01/02 19:02:39 jonas
* removed/commented out (inited but) unused vars and unused types
Revision 1.16 1999/12/21 17:42:18 jonas
* changed vesa.inc do it doesn't try to use linear modes anymore (doesn't work
yet!!)
* fixed mode detection so the low modenumber of a driver doesn't have to be zero
anymore (so VESA autodetection now works)
Revision 1.15 1999/12/20 11:22:36 peter
* integer -> smallint to overcome -S2 switch needed for ggi version
Revision 1.14 1999/12/04 21:20:04 michael
+ Additional logging
Revision 1.13 1999/11/28 16:13:55 jonas
* corrected misplacement of call to initvars in initgraph
+ some extra debugging commands (for -dlogging) in the mode functions
Revision 1.12 1999/09/28 13:56:31 jonas
* reordered some local variables (first 4 byte vars, then 2 byte vars
etc)
* font data is now disposed in exitproc, exitproc is now called
GraphExitProc (was CleanModes) and resides in graph.pp instead of in
modes.inc
Revision 1.11 1999/09/26 13:31:07 jonas
* changed name of modeinfo variable to vesamodeinfo and fixed
associated errors (fillchar(modeinfo,sizeof(tmodeinfo),#0) instead
of sizeof(TVesamodeinfo) etc)
* changed several sizeof(type) to sizeof(varname) to avoid similar
errors in the future
Revision 1.10 1999/09/24 22:52:39 jonas
* optimized patternline a bit (always use hline when possible)
* isgraphmode stuff cleanup
* vesainfo.modelist now gets disposed in cleanmode instead of in
closegraph (required moving of some declarations from vesa.inc to
new vesah.inc)
* queryadapter gets no longer called from initgraph (is called from
initialization of graph unit)
* bugfix for notput in 32k and 64k vesa modes
* a div replaced by / in fillpoly
Revision 1.9 1999/09/22 13:13:36 jonas
* renamed text.inc -> gtext.inc to avoid conflict with system unit
* fixed textwidth
* isgraphmode now gets properly updated, so mode restoring works
again
Revision 1.8 1999/09/18 22:21:11 jonas
+ hlinevesa256 and vlinevesa256
+ support for not/xor/or/andput in vesamodes with 32k/64k colors
* lots of changes to avoid warnings under FPC
Revision 1.7 1999/07/12 13:27:14 jonas
+ added Log and Id tags
* added first FPC support, only VGA works to some extend for now
* use -dasmgraph to use assembler routines, otherwise Pascal
equivalents are used
* use -dsupportVESA to support VESA (crashes under FPC for now)
* only dispose vesainfo at closegrph if a vesa card was detected
* changed int32 to longint (int32 is not declared under FPC)
* changed the declaration of almost every procedure in graph.inc to
"far;" becquse otherwise you can't assign them to procvars under TP
real mode (but unexplainable "data segnment too large" errors prevent
it from working under real mode anyway)
}