paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-14 07:29:29 +02:00
Code Issues Packages Projects Releases Wiki Activity

- removed all the 'ifdef fpc'/'ifndef fpc' from the go32v2 graph unit to

Browse Source 
make it easier to maintain and because its TP7 compatibility hasn't been
  maintained for a very long time

git-svn-id: trunk@40889 -
This commit is contained in:
nickysn 2019-01-17 17:07:54 +00:00
parent d7d9588569
commit ecfbf8f3cb
2 changed files with 226 additions and 716 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

705
packages/graph/src/go32v2/graph.pp
View File

File diff suppressed because it is too large Load Diff

237
packages/graph/src/go32v2/vesa.inc
View File

@ -85,24 +85,14 @@ var
VESAPtr : ^TVESAInfo; VESAPtr : ^TVESAInfo;
st : string[4]; st : string[4];
regs : TDPMIRegisters; regs : TDPMIRegisters;
{$ifndef fpc}
ModeSel: word;
offs: longint;
{$endif fpc}
{ added... } { added... }
modelist: PmodeList; modelist: PmodeList;
i: longint; i: longint;
RealSeg : word; RealSeg : word;
begin begin
{ Allocate real mode buffer } { Allocate real mode buffer }
{$ifndef fpc}
Ptrlong:=GlobalDosAlloc(sizeof(TVESAInfo));
{ Get selector value }
VESAPtr := pointer(Ptrlong shl 16);
{$else fpc}
Ptrlong:=Global_Dos_Alloc(sizeof(TVESAInfo)); Ptrlong:=Global_Dos_Alloc(sizeof(TVESAInfo));
New(VESAPtr); New(VESAPtr);
{$endif fpc}
{ Get segment value } { Get segment value }
RealSeg := word(Ptrlong shr 16); RealSeg := word(Ptrlong shr 16);
if not assigned(VESAPtr) then if not assigned(VESAPtr) then
@ -114,11 +104,9 @@ var
regs.es := RealSeg; regs.es := RealSeg;
regs.edi := $00; regs.edi := $00;
RealIntr($10, regs); RealIntr($10, regs);
{$ifdef fpc}
{ no far pointer support in FPC yet, so move the vesa info into a memory } { no far pointer support in FPC yet, so move the vesa info into a memory }
{ block in the DS slector space (JM) } { block in the DS slector space (JM) }
dosmemget(RealSeg,0,VesaPtr^,SizeOf(TVESAInfo)); dosmemget(RealSeg,0,VesaPtr^,SizeOf(TVESAInfo));
{$endif fpc}
St:=Vesaptr^.signature; St:=Vesaptr^.signature;
if st<>'VESA' then if st<>'VESA' then
begin begin
@ -126,44 +114,15 @@ var
LogLn('No VESA detected.'); LogLn('No VESA detected.');
{$endif logging} {$endif logging}
getVesaInfo := FALSE; getVesaInfo := FALSE;
{$ifndef fpc}
GlobalDosFree(word(PtrLong and $ffff));
{$else fpc}
If not Global_Dos_Free(word(PtrLong and $ffff)) then If not Global_Dos_Free(word(PtrLong and $ffff)) then
RunError(216); RunError(216);
{ also free the extra allocated buffer } { also free the extra allocated buffer }
Dispose(VESAPtr); Dispose(VESAPtr);
{$endif fpc}
exit; exit;
end end
else else
getVesaInfo := TRUE; getVesaInfo := TRUE;
{$ifndef fpc}
{ The mode pointer buffer points to a real mode memory }
{ Therefore steps to get the modes: }
{ 1. Allocate Selector and SetLimit to max number of }
{ of possible modes. }
ModeSel := AllocSelector(0);
SetSelectorLimit(ModeSel, 256*sizeof(word));
{ 2. Set Selector linear address to the real mode pointer }
{ returned. }
offs := longint(longint(VESAPtr^.ModeList) shr 16) shl 4;
{shouldn't the OR in the next line be a + ?? (JM)}
offs := offs OR (Longint(VESAPtr^.ModeList) and $ffff);
SetSelectorBase(ModeSel, offs);
{ copy VESA mode information to a protected mode buffer and }
{ then free the real mode buffer... }
Move(VESAPtr^, VESAInfo, sizeof(VESAInfo));
GlobalDosFree(word(PtrLong and $ffff));
{ ModeList points to the mode list }
{ We must copy it somewhere... }
ModeList := Ptr(ModeSel, 0);
{$else fpc}
{ No far pointer support, so the Ptr(ModeSel, 0) doesn't work. } { No far pointer support, so the Ptr(ModeSel, 0) doesn't work. }
{ Immediately copy everything to a buffer in the DS selector space } { Immediately copy everything to a buffer in the DS selector space }
New(ModeList); New(ModeList);
@ -180,7 +139,6 @@ var
If not Global_Dos_Free(word(PtrLong and $ffff)) then If not Global_Dos_Free(word(PtrLong and $ffff)) then
RunError(216); RunError(216);
Dispose(VESAPtr); Dispose(VESAPtr);
{$endif fpc}
i:=0; i:=0;
new(VESAInfo.ModeList); new(VESAInfo.ModeList);
@ -197,41 +155,22 @@ var
{$ifdef logging} {$ifdef logging}
LogLn(strf(i) + ' modes found.'); LogLn(strf(i) + ' modes found.');
{$endif logging} {$endif logging}
{$ifndef fpc}
FreeSelector(ModeSel);
{$else fpc}
Dispose(ModeList); Dispose(ModeList);
{$endif fpc}
end; end;
function getVESAModeInfo(var ModeInfo: TVESAModeInfo;mode:word):boolean; function getVESAModeInfo(var ModeInfo: TVESAModeInfo;mode:word):boolean;
var var
Ptr: longint; Ptr: longint;
{$ifndef fpc}
VESAPtr : ^TVESAModeInfo;
{$endif fpc}
regs : TDPMIRegisters; regs : TDPMIRegisters;
RealSeg: word; RealSeg: word;
begin begin
{ Alllocate real mode buffer } { Alllocate real mode buffer }
{$ifndef fpc}
Ptr:=GlobalDosAlloc(sizeof(TVESAModeInfo));
{ get the selector value }
VESAPtr := pointer(longint(Ptr shl 16));
if not assigned(VESAPtr) then
RunError(203);
{$else fpc}
Ptr:=Global_Dos_Alloc(sizeof(TVESAModeInfo)); Ptr:=Global_Dos_Alloc(sizeof(TVESAModeInfo));
{$endif fpc}
{ get the segment value } { get the segment value }
RealSeg := word(Ptr shr 16); RealSeg := word(Ptr shr 16);
{ we have to init everything to zero, since VBE < 1.1 } { we have to init everything to zero, since VBE < 1.1 }
{ may not setup fields correctly. } { may not setup fields correctly. }
{$ifndef fpc}
FillChar(VESAPtr^, sizeof(ModeInfo), #0);
{$else fpc}
DosMemFillChar(RealSeg, 0, sizeof(ModeInfo), #0); DosMemFillChar(RealSeg, 0, sizeof(ModeInfo), #0);
{$endif fpc}
{ setup interrupt registers } { setup interrupt registers }
FillChar(regs, sizeof(regs), #0); FillChar(regs, sizeof(regs), #0);
{ call VESA mode information...} { call VESA mode information...}
@ -245,18 +184,10 @@ var
else else
getVESAModeInfo := TRUE; getVESAModeInfo := TRUE;
{ copy to protected mode buffer ... } { copy to protected mode buffer ... }
{$ifndef fpc}
Move(VESAPtr^, ModeInfo, sizeof(ModeInfo));
{$else fpc}
DosMemGet(RealSeg,0,ModeInfo,sizeof(ModeInfo)); DosMemGet(RealSeg,0,ModeInfo,sizeof(ModeInfo));
{$endif fpc}
{ free real mode memory } { free real mode memory }
{$ifndef fpc}
GlobalDosFree(Word(Ptr and $ffff));
{$else fpc}
If not Global_Dos_Free(Word(Ptr and $ffff)) then If not Global_Dos_Free(Word(Ptr and $ffff)) then
RunError(216); RunError(216);
{$endif fpc}
end; end;
{$ELSE} {$ELSE}
@ -391,7 +322,7 @@ end;
{* 8-bit pixels VESA mode routines *} {* 8-bit pixels VESA mode routines *}
{************************************************************************} {************************************************************************}
procedure PutPixVESA256(x, y : smallint; color : word); {$ifndef fpc}far;{$endif fpc} procedure PutPixVESA256(x, y : smallint; color : word);
var var
offs : longint; offs : longint;
begin begin
@ -413,7 +344,7 @@ end;
end; end;
end; end;
procedure DirectPutPixVESA256(x, y : smallint); {$ifndef fpc}far;{$endif fpc} procedure DirectPutPixVESA256(x, y : smallint);
var var
offs : longint; offs : longint;
col : byte; col : byte;
@ -446,7 +377,7 @@ end;
mem[WinWriteSeg : word(offs)] := Col; mem[WinWriteSeg : word(offs)] := Col;
end; end;
function GetPixVESA256(x, y : smallint): word; {$ifndef fpc}far;{$endif fpc} function GetPixVESA256(x, y : smallint): word;
var var
offs : longint; offs : longint;
begin begin
@ -457,7 +388,7 @@ end;
GetPixVESA256:=mem[WinReadSeg : word(offs)]; GetPixVESA256:=mem[WinReadSeg : word(offs)];
end; end;
Procedure GetScanLineVESA256(x1, x2, y: smallint; var data); {$ifndef fpc}far;{$endif} Procedure GetScanLineVESA256(x1, x2, y: smallint; var data);
var offs: Longint; var offs: Longint;
l, amount, bankrest, index, pixels: longint; l, amount, bankrest, index, pixels: longint;
curbank: smallint; curbank: smallint;
@ -546,7 +477,7 @@ end;
Until amount = 0; Until amount = 0;
end; end;
procedure HLineVESA256(x,x2,y: smallint); {$ifndef fpc}far;{$endif fpc} procedure HLineVESA256(x,x2,y: smallint);
var Offs: Longint; var Offs: Longint;
mask, l, bankrest: longint; mask, l, bankrest: longint;
@ -869,7 +800,7 @@ end;
end; end;
end; end;
procedure VLineVESA256(x,y,y2: smallint); {$ifndef fpc}far;{$endif fpc} procedure VLineVESA256(x,y,y2: smallint);
var Offs: Longint; var Offs: Longint;
l, bankrest: longint; l, bankrest: longint;
@ -1024,7 +955,7 @@ end;
end; end;
end; end;
procedure PatternLineVESA256(x1,x2,y: smallint); {$ifndef fpc}far;{$endif fpc} procedure PatternLineVESA256(x1,x2,y: smallint);
{********************************************************} {********************************************************}
{ Draws a horizontal patterned line according to the } { Draws a horizontal patterned line according to the }
{ current Fill Settings. } { current Fill Settings. }
@ -1156,12 +1087,11 @@ end;
{************************************************************************} {************************************************************************}
{* 256 colors VESA mode routines Linear mode *} {* 256 colors VESA mode routines Linear mode *}
{************************************************************************} {************************************************************************}
{$ifdef FPC}
type type
pbyte = ^byte; pbyte = ^byte;
pword = ^word; pword = ^word;
procedure DirectPutPixVESA256Linear(x, y : smallint); {$ifndef fpc}far;{$endif fpc} procedure DirectPutPixVESA256Linear(x, y : smallint);
var var
offs : longint; offs : longint;
col : byte; col : byte;
@ -1205,7 +1135,7 @@ type
seg_move(get_ds,longint(@col),WinWriteSeg,offs+LinearPageOfs,1); seg_move(get_ds,longint(@col),WinWriteSeg,offs+LinearPageOfs,1);
end; end;
procedure PutPixVESA256Linear(x, y : smallint; color : word); {$ifndef fpc}far;{$endif fpc} procedure PutPixVESA256Linear(x, y : smallint; color : word);
var var
offs : longint; offs : longint;
begin begin
@ -1230,7 +1160,7 @@ type
seg_move(get_ds,longint(@color),WinWriteSeg,offs+LinearPageOfs,1); seg_move(get_ds,longint(@color),WinWriteSeg,offs+LinearPageOfs,1);
end; end;
function GetPixVESA256Linear(x, y : smallint): word; {$ifndef fpc}far;{$endif fpc} function GetPixVESA256Linear(x, y : smallint): word;
var var
offs : longint; offs : longint;
col : byte; col : byte;
@ -1277,14 +1207,13 @@ begin
SetVESADisplayStart:=true; SetVESADisplayStart:=true;
end; end;
*) *)
{$endif FPC}
{************************************************************************} {************************************************************************}
{* 15/16bit pixels VESA mode routines *} {* 15/16bit pixels VESA mode routines *}
{************************************************************************} {************************************************************************}
procedure PutPixVESA32kOr64k(x, y : smallint; color : word); {$ifndef fpc}far;{$endif fpc} procedure PutPixVESA32kOr64k(x, y : smallint; color : word);
var var
offs : longint; offs : longint;
place: word; place: word;
@ -1316,7 +1245,7 @@ end;
memW[WinWriteSeg : place] := color; memW[WinWriteSeg : place] := color;
end; end;
function GetPixVESA32kOr64k(x, y : smallint): word; {$ifndef fpc}far;{$endif fpc} function GetPixVESA32kOr64k(x, y : smallint): word;
var var
offs : longint; offs : longint;
begin begin
@ -1327,7 +1256,7 @@ end;
GetPixVESA32kOr64k:=memW[WinReadSeg : word(offs)]; GetPixVESA32kOr64k:=memW[WinReadSeg : word(offs)];
end; end;
procedure DirectPutPixVESA32kOr64k(x, y : smallint); {$ifndef fpc}far;{$endif fpc} procedure DirectPutPixVESA32kOr64k(x, y : smallint);
var var
offs : longint; offs : longint;
bank : smallint; bank : smallint;
@ -1372,7 +1301,7 @@ end;
End; End;
end; end;
procedure HLineVESA32kOr64k(x,x2,y: smallint); {$ifndef fpc}far;{$endif fpc} procedure HLineVESA32kOr64k(x,x2,y: smallint);
var Offs: Longint; var Offs: Longint;
mask, l, bankrest: longint; mask, l, bankrest: longint;
@ -1689,12 +1618,11 @@ end;
end; end;
end; end;
{$ifdef FPC}
{************************************************************************} {************************************************************************}
{* 15/16bit pixels VESA mode routines Linear mode *} {* 15/16bit pixels VESA mode routines Linear mode *}
{************************************************************************} {************************************************************************}
procedure PutPixVESA32kor64kLinear(x, y : smallint; color : word); {$ifndef fpc}far;{$endif fpc} procedure PutPixVESA32kor64kLinear(x, y : smallint; color : word);
var var
offs : longint; offs : longint;
begin begin
@ -1715,7 +1643,7 @@ end;
seg_move(get_ds,longint(@color),WinWriteSeg,offs+LinearPageOfs,2); seg_move(get_ds,longint(@color),WinWriteSeg,offs+LinearPageOfs,2);
end; end;
function GetPixVESA32kor64kLinear(x, y : smallint): word; {$ifndef fpc}far;{$endif fpc} function GetPixVESA32kor64kLinear(x, y : smallint): word;
var var
offs : longint; offs : longint;
color : word; color : word;
@ -1730,7 +1658,7 @@ end;
GetPixVESA32kor64kLinear:=color; GetPixVESA32kor64kLinear:=color;
end; end;
procedure DirectPutPixVESA32kor64kLinear(x, y : smallint); {$ifndef fpc}far;{$endif fpc} procedure DirectPutPixVESA32kor64kLinear(x, y : smallint);
var var
offs : longint; offs : longint;
col : word; col : word;
@ -1844,13 +1772,12 @@ end;
end; end;
end; end;
end; end;
{$endif FPC}
{************************************************************************} {************************************************************************}
{* 4-bit pixels VESA mode routines *} {* 4-bit pixels VESA mode routines *}
{************************************************************************} {************************************************************************}
procedure PutPixVESA16(x, y : smallint; color : word); {$ifndef fpc}far;{$endif fpc} procedure PutPixVESA16(x, y : smallint; color : word);
var var
offs : longint; offs : longint;
dummy : byte; dummy : byte;
@ -1885,7 +1812,7 @@ end;
end; end;
Function GetPixVESA16(X,Y: smallint):word; {$ifndef fpc}far;{$endif fpc} Function GetPixVESA16(X,Y: smallint):word;
Var dummy: Word; Var dummy: Word;
offset: longint; offset: longint;
shift: byte; shift: byte;
@ -1907,7 +1834,7 @@ end;
end; end;
procedure DirectPutPixVESA16(x, y : smallint); {$ifndef fpc}far;{$endif fpc} procedure DirectPutPixVESA16(x, y : smallint);
var var
offs : longint; offs : longint;
dummy : byte; dummy : byte;
@ -1952,7 +1879,7 @@ end;
end; end;
procedure HLineVESA16(x,x2,y: smallint); {$ifndef fpc}far;{$endif fpc} procedure HLineVESA16(x,x2,y: smallint);
var var
xtmp: smallint; xtmp: smallint;
ScrOfs, BankRest: longint; ScrOfs, BankRest: longint;
@ -2060,7 +1987,6 @@ end;
{$IFDEF DPMI} {$IFDEF DPMI}
{$ifdef fpc}
Procedure SetVESARGBAllPalette(const Palette:PaletteType); Procedure SetVESARGBAllPalette(const Palette:PaletteType);
var var
pal: array[0..255] of palrec; pal: array[0..255] of palrec;
@ -2126,7 +2052,6 @@ end;
end; end;
setallpalettedefault(palette); setallpalettedefault(palette);
end; end;
{$endif fpc}
Procedure SetVESARGBPalette(ColorNum, RedValue, GreenValue, Procedure SetVESARGBPalette(ColorNum, RedValue, GreenValue,
BlueValue : smallint); BlueValue : smallint);
@ -2134,9 +2059,6 @@ end;
pal: palrec; pal: palrec;
regs: TDPMIRegisters; regs: TDPMIRegisters;
Ptr: longint; Ptr: longint;
{$ifndef fpc}
PalPtr : ^PalRec;
{$endif fpc}
RealSeg: word; RealSeg: word;
FunctionNr : byte; { use blankbit or normal RAMDAC programming? } FunctionNr : byte; { use blankbit or normal RAMDAC programming? }
begin begin
@ -2163,25 +2085,13 @@ end;
FunctionNr := $00; FunctionNr := $00;
{ Alllocate real mode buffer } { Alllocate real mode buffer }
{$ifndef fpc}
Ptr:=GlobalDosAlloc(sizeof(palrec));
{ get the selector values }
PalPtr := pointer(Ptr shl 16);
if not assigned(PalPtr) then
RunError(203);
{$else fpc}
Ptr:=Global_Dos_Alloc(sizeof(palrec)); Ptr:=Global_Dos_Alloc(sizeof(palrec));
{$endif fpc}
{get the segment value} {get the segment value}
RealSeg := word(Ptr shr 16); RealSeg := word(Ptr shr 16);
{ setup interrupt registers } { setup interrupt registers }
FillChar(regs, sizeof(regs), #0); FillChar(regs, sizeof(regs), #0);
{ copy palette values to real mode buffer } { copy palette values to real mode buffer }
{$ifndef fpc}
move(pal, palptr^, sizeof(pal));
{$else fpc}
DosMemPut(RealSeg,0,pal,sizeof(pal)); DosMemPut(RealSeg,0,pal,sizeof(pal));
{$endif fpc}
regs.eax := $4F09; regs.eax := $4F09;
regs.ebx := FunctionNr; regs.ebx := FunctionNr;
regs.ecx := $01; regs.ecx := $01;
@ -2191,12 +2101,8 @@ end;
RealIntr($10, regs); RealIntr($10, regs);
{ free real mode memory } { free real mode memory }
{$ifndef fpc}
GlobalDosFree(word(Ptr and $ffff));
{$else fpc}
If not Global_Dos_Free(word(Ptr and $ffff)) then If not Global_Dos_Free(word(Ptr and $ffff)) then
RunError(216); RunError(216);
{$endif fpc}
if word(regs.eax) <> $004F then if word(regs.eax) <> $004F then
begin begin
@ -2219,9 +2125,6 @@ end;
RedValue, GreenValue, BlueValue : smallint); RedValue, GreenValue, BlueValue : smallint);
var var
pal: PalRec; pal: PalRec;
{$ifndef fpc}
palptr : ^PalRec;
{$endif fpc}
regs : TDPMIRegisters; regs : TDPMIRegisters;
RealSeg: word; RealSeg: word;
ptr: longint; ptr: longint;
@ -2238,15 +2141,7 @@ end;
if VESAInfo.Version >= $0200 then if VESAInfo.Version >= $0200 then
Begin Begin
{ Alllocate real mode buffer } { Alllocate real mode buffer }
{$ifndef fpc}
Ptr:=GlobalDosAlloc(sizeof(palrec));
{ get the selector value }
PalPtr := pointer(longint(Ptr and $0000ffff) shl 16);
if not assigned(PalPtr) then
RunError(203);
{$else fpc}
Ptr:=Global_Dos_Alloc(sizeof(palrec)); Ptr:=Global_Dos_Alloc(sizeof(palrec));
{$endif fpc}
{ get the segment value } { get the segment value }
RealSeg := word(Ptr shr 16); RealSeg := word(Ptr shr 16);
{ setup interrupt registers } { setup interrupt registers }
@ -2261,18 +2156,10 @@ end;
RealIntr($10, regs); RealIntr($10, regs);
{ copy to protected mode buffer ... } { copy to protected mode buffer ... }
{$ifndef fpc}
Move(PalPtr^, Pal, sizeof(pal));
{$else fpc}
DosMemGet(RealSeg,0,Pal,sizeof(pal)); DosMemGet(RealSeg,0,Pal,sizeof(pal));
{$endif fpc}
{ free real mode memory } { free real mode memory }
{$ifndef fpc}
GlobalDosFree(word(Ptr and $ffff));
{$else fpc}
If not Global_Dos_Free(word(Ptr and $ffff)) then If not Global_Dos_Free(word(Ptr and $ffff)) then
RunError(216); RunError(216);
{$endif fpc}
if word(regs.eax) <> $004F then if word(regs.eax) <> $004F then
begin begin
@ -2453,7 +2340,6 @@ Const
else else
BytesPerLine := VESAModeInfo.BytesPerScanLine; BytesPerLine := VESAModeInfo.BytesPerScanLine;
{$ifdef FPC}
case mode of case mode of
m320x200x32k, m320x200x32k,
m320x200x64k, m320x200x64k,
@ -2544,7 +2430,6 @@ Const
inc(WinShift); inc(WinShift);
Temp:=Temp shr 1; Temp:=Temp shr 1;
end; } end; }
{$endif FPC}
end; end;
procedure SetupWindows(var ModeInfo: TVESAModeInfo); procedure SetupWindows(var ModeInfo: TVESAModeInfo);
@ -2739,19 +2624,15 @@ Const
asm asm
mov ax,4F02h mov ax,4F02h
mov bx,mode mov bx,mode
{$ifdef fpc}
push ebp push ebp
push esi push esi
push edi push edi
push ebx push ebx
{$endif fpc}
int 10h int 10h
{$ifdef fpc}
pop ebx pop ebx
pop edi pop edi
pop esi pop esi
pop ebp pop ebp
{$endif fpc}
sub ax,004Fh sub ax,004Fh
cmp ax,1 cmp ax,1
sbb al,al sbb al,al
@ -2832,21 +2713,21 @@ Const
{$ENDIF} {$ENDIF}
procedure Init1280x1024x64k; {$ifndef fpc}far;{$endif fpc} procedure Init1280x1024x64k;
begin begin
SetVesaMode(m1280x1024x64k); SetVesaMode(m1280x1024x64k);
{ Get maximum number of scanlines for page flipping } { Get maximum number of scanlines for page flipping }
ScanLines := GetMaxScanLines; ScanLines := GetMaxScanLines;
end; end;
procedure Init1280x1024x32k; {$ifndef fpc}far;{$endif fpc} procedure Init1280x1024x32k;
begin begin
SetVESAMode(m1280x1024x32k); SetVESAMode(m1280x1024x32k);
{ Get maximum number of scanlines for page flipping } { Get maximum number of scanlines for page flipping }
ScanLines := GetMaxScanLines; ScanLines := GetMaxScanLines;
end; end;
procedure Init1280x1024x256; {$ifndef fpc}far;{$endif fpc} procedure Init1280x1024x256;
begin begin
SetVESAMode(m1280x1024x256); SetVESAMode(m1280x1024x256);
{ Get maximum number of scanlines for page flipping } { Get maximum number of scanlines for page flipping }
@ -2854,105 +2735,105 @@ Const
end; end;
procedure Init1280x1024x16; {$ifndef fpc}far;{$endif fpc} procedure Init1280x1024x16;
begin begin
SetVESAMode(m1280x1024x16); SetVESAMode(m1280x1024x16);
{ Get maximum number of scanlines for page flipping } { Get maximum number of scanlines for page flipping }
ScanLines := GetMaxScanLines; ScanLines := GetMaxScanLines;
end; end;
procedure Init1024x768x64k; {$ifndef fpc}far;{$endif fpc} procedure Init1024x768x64k;
begin begin
SetVESAMode(m1024x768x64k); SetVESAMode(m1024x768x64k);
{ Get maximum number of scanlines for page flipping } { Get maximum number of scanlines for page flipping }
ScanLines := GetMaxScanLines; ScanLines := GetMaxScanLines;
end; end;
procedure Init1024x768x32k; {$ifndef fpc}far;{$endif fpc} procedure Init1024x768x32k;
begin begin
SetVESAMode(m1024x768x32k); SetVESAMode(m1024x768x32k);
{ Get maximum number of scanlines for page flipping } { Get maximum number of scanlines for page flipping }
ScanLines := GetMaxScanLines; ScanLines := GetMaxScanLines;
end; end;
procedure Init1024x768x256; {$ifndef fpc}far;{$endif fpc} procedure Init1024x768x256;
begin begin
SetVESAMode(m1024x768x256); SetVESAMode(m1024x768x256);
{ Get maximum number of scanlines for page flipping } { Get maximum number of scanlines for page flipping }
ScanLines := GetMaxScanLines; ScanLines := GetMaxScanLines;
end; end;
procedure Init1024x768x16; {$ifndef fpc}far;{$endif fpc} procedure Init1024x768x16;
begin begin
SetVESAMode(m1024x768x16); SetVESAMode(m1024x768x16);
{ Get maximum number of scanlines for page flipping } { Get maximum number of scanlines for page flipping }
ScanLines := GetMaxScanLines; ScanLines := GetMaxScanLines;
end; end;
procedure Init800x600x64k; {$ifndef fpc}far;{$endif fpc} procedure Init800x600x64k;
begin begin
SetVESAMode(m800x600x64k); SetVESAMode(m800x600x64k);
{ Get maximum number of scanlines for page flipping } { Get maximum number of scanlines for page flipping }
ScanLines := GetMaxScanLines; ScanLines := GetMaxScanLines;
end; end;
procedure Init800x600x32k; {$ifndef fpc}far;{$endif fpc} procedure Init800x600x32k;
begin begin
SetVESAMode(m800x600x32k); SetVESAMode(m800x600x32k);
{ Get maximum number of scanlines for page flipping } { Get maximum number of scanlines for page flipping }
ScanLines := GetMaxScanLines; ScanLines := GetMaxScanLines;
end; end;
procedure Init800x600x256; {$ifndef fpc}far;{$endif fpc} procedure Init800x600x256;
begin begin
SetVESAMode(m800x600x256); SetVESAMode(m800x600x256);
{ Get maximum number of scanlines for page flipping } { Get maximum number of scanlines for page flipping }
ScanLines := GetMaxScanLines; ScanLines := GetMaxScanLines;
end; end;
procedure Init800x600x16; {$ifndef fpc}far;{$endif fpc} procedure Init800x600x16;
begin begin
SetVesaMode(m800x600x16); SetVesaMode(m800x600x16);
{ Get maximum number of scanlines for page flipping } { Get maximum number of scanlines for page flipping }
ScanLines := GetMaxScanLines; ScanLines := GetMaxScanLines;
end; end;
procedure Init640x480x64k; {$ifndef fpc}far;{$endif fpc} procedure Init640x480x64k;
begin begin
SetVESAMode(m640x480x64k); SetVESAMode(m640x480x64k);
{ Get maximum number of scanlines for page flipping } { Get maximum number of scanlines for page flipping }
ScanLines := GetMaxScanLines; ScanLines := GetMaxScanLines;
end; end;
procedure Init640x480x32k; {$ifndef fpc}far;{$endif fpc} procedure Init640x480x32k;
begin begin
SetVESAMode(m640x480x32k); SetVESAMode(m640x480x32k);
{ Get maximum number of scanlines for page flipping } { Get maximum number of scanlines for page flipping }
ScanLines := GetMaxScanLines; ScanLines := GetMaxScanLines;
end; end;
procedure Init640x480x256; {$ifndef fpc}far;{$endif fpc} procedure Init640x480x256;
begin begin
SetVESAMode(m640x480x256); SetVESAMode(m640x480x256);
{ Get maximum number of scanlines for page flipping } { Get maximum number of scanlines for page flipping }
ScanLines := GetMaxScanLines; ScanLines := GetMaxScanLines;
end; end;
procedure Init640x400x256; {$ifndef fpc}far;{$endif fpc} procedure Init640x400x256;
begin begin
SetVESAMode(m640x400x256); SetVESAMode(m640x400x256);
{ Get maximum number of scanlines for page flipping } { Get maximum number of scanlines for page flipping }
ScanLines := GetMaxScanLines; ScanLines := GetMaxScanLines;
end; end;
procedure Init320x200x64k; {$ifndef fpc}far;{$endif fpc} procedure Init320x200x64k;
begin begin
SetVESAMode(m320x200x64k); SetVESAMode(m320x200x64k);
{ Get maximum number of scanlines for page flipping } { Get maximum number of scanlines for page flipping }
ScanLines := GetMaxScanLines; ScanLines := GetMaxScanLines;
end; end;
procedure Init320x200x32k; {$ifndef fpc}far;{$endif fpc} procedure Init320x200x32k;
begin begin
SetVESAMode(m320x200x32k); SetVESAMode(m320x200x32k);
{ Get maximum number of scanlines for page flipping } { Get maximum number of scanlines for page flipping }
@ -2962,7 +2843,7 @@ Const
{$IFDEF DPMI} {$IFDEF DPMI}
Procedure SaveStateVESA; {$ifndef fpc}far;{$endif fpc} Procedure SaveStateVESA;
var var
PtrLong: longint; PtrLong: longint;
regs: TDPMIRegisters; regs: TDPMIRegisters;
@ -2975,19 +2856,15 @@ Const
{ Get the video mode } { Get the video mode }
asm asm
mov ah,0fh mov ah,0fh
{$ifdef fpc}
push ebp push ebp
push esi push esi
push edi push edi
push ebx push ebx
{$endif fpc}
int 10h int 10h
{$ifdef fpc}
pop ebx pop ebx
pop edi pop edi
pop esi pop esi
pop ebp pop ebp
{$endif fpc}
mov [VideoMode], al mov [VideoMode], al
end ['EAX']; end ['EAX'];
{ saving/restoring video state screws up Windows (JM) } { saving/restoring video state screws up Windows (JM) }
@ -3009,22 +2886,10 @@ Const
{$ifdef logging} {$ifdef logging}
LogLn('allocating VESA save buffer of '+strf(64*StateSize)); LogLn('allocating VESA save buffer of '+strf(64*StateSize));
{$endif logging} {$endif logging}
{$ifndef fpc}
PtrLong:=GlobalDosAlloc(64*StateSize); { values returned in 64-byte blocks }
{$else fpc}
PtrLong:=Global_Dos_Alloc(64*StateSize); { values returned in 64-byte blocks } PtrLong:=Global_Dos_Alloc(64*StateSize); { values returned in 64-byte blocks }
{$endif fpc}
if PtrLong = 0 then if PtrLong = 0 then
RunError(203); RunError(203);
SavePtr := pointer(longint(PtrLong and $0000ffff) shl 16); SavePtr := pointer(longint(PtrLong and $0000ffff) shl 16);
{$ifndef fpc}
{ In FPC mode, we can't do anything with this (no far pointers) }
{ However, we still need to keep it to be able to free the }
{ memory afterwards. Since this data is not accessed in PM code, }
{ there's no need to save it in a seperate buffer (JM) }
if not assigned(SavePtr) then
RunError(203);
{$endif fpc}
RealStateSeg := word(PtrLong shr 16); RealStateSeg := word(PtrLong shr 16);
FillChar(regs, sizeof(regs), #0); FillChar(regs, sizeof(regs), #0);
@ -3047,7 +2912,7 @@ Const
end; end;
end; end;
procedure RestoreStateVESA; {$ifndef fpc}far;{$endif fpc} procedure RestoreStateVESA;
var var
regs:TDPMIRegisters; regs:TDPMIRegisters;
begin begin
@ -3055,28 +2920,20 @@ Const
asm asm
mov ah,00 mov ah,00
mov al,[VideoMode] mov al,[VideoMode]
{$ifdef fpc}
push ebp push ebp
push esi push esi
push edi push edi
push ebx push ebx
{$endif fpc}
int 10h int 10h
{$ifdef fpc}
pop ebx pop ebx
pop edi pop edi
pop esi pop esi
pop ebp pop ebp
{$endif fpc}
end ['EAX']; end ['EAX'];
{ then restore all state information } { then restore all state information }
{$ifndef fpc}
if assigned(SavePtr) and (SaveSupported=TRUE) then
{$else fpc}
{ No far pointer support, so it's possible that that assigned(SavePtr) } { No far pointer support, so it's possible that that assigned(SavePtr) }
{ would return false under FPC. Just check if it's different from nil. } { would return false under FPC. Just check if it's different from nil. }
if (SavePtr <> nil) and (SaveSupported=TRUE) then if (SavePtr <> nil) and (SaveSupported=TRUE) then
{$endif fpc}
begin begin
FillChar(regs, sizeof(regs), #0); FillChar(regs, sizeof(regs), #0);
{ restore state, according to Ralph Brown Interrupt list } { restore state, according to Ralph Brown Interrupt list }
@ -3087,11 +2944,7 @@ Const
regs.es := RealStateSeg; regs.es := RealStateSeg;
regs.ebx := 0; regs.ebx := 0;
RealIntr($10,regs); RealIntr($10,regs);
{$ifndef fpc}
if GlobalDosFree(longint(SavePtr) shr 16)<>0 then
{$else fpc}
if Not(Global_Dos_Free(longint(SavePtr) shr 16)) then if Not(Global_Dos_Free(longint(SavePtr) shr 16)) then
{$endif fpc}
RunError(216); RunError(216);
SavePtr := nil; SavePtr := nil;
end; end;
@ -3193,7 +3046,7 @@ Const
{ between VBE versions , we will use the old method where } { between VBE versions , we will use the old method where }
{ the new pixel offset is used to display different pages } { the new pixel offset is used to display different pages }
{******************************************************** } {******************************************************** }
procedure SetVisualVESA(page: word); {$ifndef fpc}far;{$endif fpc} procedure SetVisualVESA(page: word);
var var
newStartVisible : word; newStartVisible : word;
begin begin
@ -3213,23 +3066,19 @@ Const
mov bx, 0000h { set display start } mov bx, 0000h { set display start }
mov cx, 0000h { pixel zero ! } mov cx, 0000h { pixel zero ! }
mov dx, [NewStartVisible] { new scanline } mov dx, [NewStartVisible] { new scanline }
{$ifdef fpc}
push ebp push ebp
push esi push esi
push edi push edi
push ebx push ebx
{$endif}
int 10h int 10h
{$ifdef fpc}
pop ebx pop ebx
pop edi pop edi
pop esi pop esi
pop ebp pop ebp
{$endif}
end ['EDX','ECX','EBX','EAX']; end ['EDX','ECX','EBX','EAX'];
end; end;
procedure SetActiveVESA(page: word); {$ifndef fpc}far;{$endif fpc} procedure SetActiveVESA(page: word);
begin begin
{ video offset is in pixels under VESA VBE! } { video offset is in pixels under VESA VBE! }
{ This value is reset after a mode set to page ZERO = YOffset = 0 ) } { This value is reset after a mode set to page ZERO = YOffset = 0 ) }