|
|
@@ -85,24 +85,14 @@ var
|
|
|
VESAPtr : ^TVESAInfo;
|
|
|
st : string[4];
|
|
|
regs : TDPMIRegisters;
|
|
|
-{$ifndef fpc}
|
|
|
- ModeSel: word;
|
|
|
- offs: longint;
|
|
|
-{$endif fpc}
|
|
|
{ added... }
|
|
|
modelist: PmodeList;
|
|
|
i: longint;
|
|
|
RealSeg : word;
|
|
|
begin
|
|
|
{ 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));
|
|
|
New(VESAPtr);
|
|
|
-{$endif fpc}
|
|
|
{ Get segment value }
|
|
|
RealSeg := word(Ptrlong shr 16);
|
|
|
if not assigned(VESAPtr) then
|
|
|
@@ -114,11 +104,9 @@ var
|
|
|
regs.es := RealSeg;
|
|
|
regs.edi := $00;
|
|
|
RealIntr($10, regs);
|
|
|
-{$ifdef fpc}
|
|
|
{ no far pointer support in FPC yet, so move the vesa info into a memory }
|
|
|
{ block in the DS slector space (JM) }
|
|
|
dosmemget(RealSeg,0,VesaPtr^,SizeOf(TVESAInfo));
|
|
|
-{$endif fpc}
|
|
|
St:=Vesaptr^.signature;
|
|
|
if st<>'VESA' then
|
|
|
begin
|
|
|
@@ -126,44 +114,15 @@ var
|
|
|
LogLn('No VESA detected.');
|
|
|
{$endif logging}
|
|
|
getVesaInfo := FALSE;
|
|
|
-{$ifndef fpc}
|
|
|
- GlobalDosFree(word(PtrLong and $ffff));
|
|
|
-{$else fpc}
|
|
|
If not Global_Dos_Free(word(PtrLong and $ffff)) then
|
|
|
RunError(216);
|
|
|
{ also free the extra allocated buffer }
|
|
|
Dispose(VESAPtr);
|
|
|
-{$endif fpc}
|
|
|
exit;
|
|
|
end
|
|
|
else
|
|
|
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. }
|
|
|
{ Immediately copy everything to a buffer in the DS selector space }
|
|
|
New(ModeList);
|
|
|
@@ -180,7 +139,6 @@ var
|
|
|
If not Global_Dos_Free(word(PtrLong and $ffff)) then
|
|
|
RunError(216);
|
|
|
Dispose(VESAPtr);
|
|
|
-{$endif fpc}
|
|
|
|
|
|
i:=0;
|
|
|
new(VESAInfo.ModeList);
|
|
|
@@ -197,41 +155,22 @@ var
|
|
|
{$ifdef logging}
|
|
|
LogLn(strf(i) + ' modes found.');
|
|
|
{$endif logging}
|
|
|
-{$ifndef fpc}
|
|
|
- FreeSelector(ModeSel);
|
|
|
-{$else fpc}
|
|
|
Dispose(ModeList);
|
|
|
-{$endif fpc}
|
|
|
end;
|
|
|
|
|
|
function getVESAModeInfo(var ModeInfo: TVESAModeInfo;mode:word):boolean;
|
|
|
var
|
|
|
Ptr: longint;
|
|
|
-{$ifndef fpc}
|
|
|
- VESAPtr : ^TVESAModeInfo;
|
|
|
-{$endif fpc}
|
|
|
regs : TDPMIRegisters;
|
|
|
RealSeg: word;
|
|
|
begin
|
|
|
{ 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));
|
|
|
-{$endif fpc}
|
|
|
{ get the segment value }
|
|
|
RealSeg := word(Ptr shr 16);
|
|
|
{ we have to init everything to zero, since VBE < 1.1 }
|
|
|
{ may not setup fields correctly. }
|
|
|
-{$ifndef fpc}
|
|
|
- FillChar(VESAPtr^, sizeof(ModeInfo), #0);
|
|
|
-{$else fpc}
|
|
|
DosMemFillChar(RealSeg, 0, sizeof(ModeInfo), #0);
|
|
|
-{$endif fpc}
|
|
|
{ setup interrupt registers }
|
|
|
FillChar(regs, sizeof(regs), #0);
|
|
|
{ call VESA mode information...}
|
|
|
@@ -245,18 +184,10 @@ var
|
|
|
else
|
|
|
getVESAModeInfo := TRUE;
|
|
|
{ copy to protected mode buffer ... }
|
|
|
-{$ifndef fpc}
|
|
|
- Move(VESAPtr^, ModeInfo, sizeof(ModeInfo));
|
|
|
-{$else fpc}
|
|
|
DosMemGet(RealSeg,0,ModeInfo,sizeof(ModeInfo));
|
|
|
-{$endif fpc}
|
|
|
{ free real mode memory }
|
|
|
-{$ifndef fpc}
|
|
|
- GlobalDosFree(Word(Ptr and $ffff));
|
|
|
-{$else fpc}
|
|
|
If not Global_Dos_Free(Word(Ptr and $ffff)) then
|
|
|
RunError(216);
|
|
|
-{$endif fpc}
|
|
|
end;
|
|
|
|
|
|
{$ELSE}
|
|
|
@@ -391,7 +322,7 @@ end;
|
|
|
{* 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
|
|
|
offs : longint;
|
|
|
begin
|
|
|
@@ -413,7 +344,7 @@ end;
|
|
|
end;
|
|
|
end;
|
|
|
|
|
|
- procedure DirectPutPixVESA256(x, y : smallint); {$ifndef fpc}far;{$endif fpc}
|
|
|
+ procedure DirectPutPixVESA256(x, y : smallint);
|
|
|
var
|
|
|
offs : longint;
|
|
|
col : byte;
|
|
|
@@ -446,7 +377,7 @@ end;
|
|
|
mem[WinWriteSeg : word(offs)] := Col;
|
|
|
end;
|
|
|
|
|
|
- function GetPixVESA256(x, y : smallint): word; {$ifndef fpc}far;{$endif fpc}
|
|
|
+ function GetPixVESA256(x, y : smallint): word;
|
|
|
var
|
|
|
offs : longint;
|
|
|
begin
|
|
|
@@ -457,7 +388,7 @@ end;
|
|
|
GetPixVESA256:=mem[WinReadSeg : word(offs)];
|
|
|
end;
|
|
|
|
|
|
- Procedure GetScanLineVESA256(x1, x2, y: smallint; var data); {$ifndef fpc}far;{$endif}
|
|
|
+ Procedure GetScanLineVESA256(x1, x2, y: smallint; var data);
|
|
|
var offs: Longint;
|
|
|
l, amount, bankrest, index, pixels: longint;
|
|
|
curbank: smallint;
|
|
|
@@ -546,7 +477,7 @@ end;
|
|
|
Until amount = 0;
|
|
|
end;
|
|
|
|
|
|
- procedure HLineVESA256(x,x2,y: smallint); {$ifndef fpc}far;{$endif fpc}
|
|
|
+ procedure HLineVESA256(x,x2,y: smallint);
|
|
|
|
|
|
var Offs: Longint;
|
|
|
mask, l, bankrest: longint;
|
|
|
@@ -869,7 +800,7 @@ end;
|
|
|
end;
|
|
|
end;
|
|
|
|
|
|
- procedure VLineVESA256(x,y,y2: smallint); {$ifndef fpc}far;{$endif fpc}
|
|
|
+ procedure VLineVESA256(x,y,y2: smallint);
|
|
|
|
|
|
var Offs: Longint;
|
|
|
l, bankrest: longint;
|
|
|
@@ -1024,7 +955,7 @@ 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 }
|
|
|
{ current Fill Settings. }
|
|
|
@@ -1156,12 +1087,11 @@ end;
|
|
|
{************************************************************************}
|
|
|
{* 256 colors VESA mode routines Linear mode *}
|
|
|
{************************************************************************}
|
|
|
-{$ifdef FPC}
|
|
|
type
|
|
|
pbyte = ^byte;
|
|
|
pword = ^word;
|
|
|
|
|
|
- procedure DirectPutPixVESA256Linear(x, y : smallint); {$ifndef fpc}far;{$endif fpc}
|
|
|
+ procedure DirectPutPixVESA256Linear(x, y : smallint);
|
|
|
var
|
|
|
offs : longint;
|
|
|
col : byte;
|
|
|
@@ -1205,7 +1135,7 @@ type
|
|
|
seg_move(get_ds,longint(@col),WinWriteSeg,offs+LinearPageOfs,1);
|
|
|
end;
|
|
|
|
|
|
- procedure PutPixVESA256Linear(x, y : smallint; color : word); {$ifndef fpc}far;{$endif fpc}
|
|
|
+ procedure PutPixVESA256Linear(x, y : smallint; color : word);
|
|
|
var
|
|
|
offs : longint;
|
|
|
begin
|
|
|
@@ -1230,7 +1160,7 @@ type
|
|
|
seg_move(get_ds,longint(@color),WinWriteSeg,offs+LinearPageOfs,1);
|
|
|
end;
|
|
|
|
|
|
- function GetPixVESA256Linear(x, y : smallint): word; {$ifndef fpc}far;{$endif fpc}
|
|
|
+ function GetPixVESA256Linear(x, y : smallint): word;
|
|
|
var
|
|
|
offs : longint;
|
|
|
col : byte;
|
|
|
@@ -1277,14 +1207,13 @@ begin
|
|
|
SetVESADisplayStart:=true;
|
|
|
end;
|
|
|
*)
|
|
|
-{$endif FPC}
|
|
|
|
|
|
|
|
|
{************************************************************************}
|
|
|
{* 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
|
|
|
offs : longint;
|
|
|
place: word;
|
|
|
@@ -1316,7 +1245,7 @@ end;
|
|
|
memW[WinWriteSeg : place] := color;
|
|
|
end;
|
|
|
|
|
|
- function GetPixVESA32kOr64k(x, y : smallint): word; {$ifndef fpc}far;{$endif fpc}
|
|
|
+ function GetPixVESA32kOr64k(x, y : smallint): word;
|
|
|
var
|
|
|
offs : longint;
|
|
|
begin
|
|
|
@@ -1327,7 +1256,7 @@ end;
|
|
|
GetPixVESA32kOr64k:=memW[WinReadSeg : word(offs)];
|
|
|
end;
|
|
|
|
|
|
- procedure DirectPutPixVESA32kOr64k(x, y : smallint); {$ifndef fpc}far;{$endif fpc}
|
|
|
+ procedure DirectPutPixVESA32kOr64k(x, y : smallint);
|
|
|
var
|
|
|
offs : longint;
|
|
|
bank : smallint;
|
|
|
@@ -1372,7 +1301,7 @@ end;
|
|
|
End;
|
|
|
end;
|
|
|
|
|
|
- procedure HLineVESA32kOr64k(x,x2,y: smallint); {$ifndef fpc}far;{$endif fpc}
|
|
|
+ procedure HLineVESA32kOr64k(x,x2,y: smallint);
|
|
|
|
|
|
var Offs: Longint;
|
|
|
mask, l, bankrest: longint;
|
|
|
@@ -1689,12 +1618,11 @@ end;
|
|
|
end;
|
|
|
end;
|
|
|
|
|
|
-{$ifdef FPC}
|
|
|
{************************************************************************}
|
|
|
{* 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
|
|
|
offs : longint;
|
|
|
begin
|
|
|
@@ -1715,7 +1643,7 @@ end;
|
|
|
seg_move(get_ds,longint(@color),WinWriteSeg,offs+LinearPageOfs,2);
|
|
|
end;
|
|
|
|
|
|
- function GetPixVESA32kor64kLinear(x, y : smallint): word; {$ifndef fpc}far;{$endif fpc}
|
|
|
+ function GetPixVESA32kor64kLinear(x, y : smallint): word;
|
|
|
var
|
|
|
offs : longint;
|
|
|
color : word;
|
|
|
@@ -1730,7 +1658,7 @@ end;
|
|
|
GetPixVESA32kor64kLinear:=color;
|
|
|
end;
|
|
|
|
|
|
- procedure DirectPutPixVESA32kor64kLinear(x, y : smallint); {$ifndef fpc}far;{$endif fpc}
|
|
|
+ procedure DirectPutPixVESA32kor64kLinear(x, y : smallint);
|
|
|
var
|
|
|
offs : longint;
|
|
|
col : word;
|
|
|
@@ -1774,13 +1702,82 @@ end;
|
|
|
seg_move(get_ds,longint(@col),WinWriteSeg,offs+LinearPageOfs,2);
|
|
|
end;
|
|
|
|
|
|
-{$endif FPC}
|
|
|
+ procedure HLineVESA32kOr64kLinear(x,x2,y: smallint);
|
|
|
+ var
|
|
|
+ Offs: Longint;
|
|
|
+ hlength: smallint;
|
|
|
+ begin
|
|
|
+ { must we swap the values? }
|
|
|
+ if x > x2 then
|
|
|
+ begin
|
|
|
+ x := x xor x2;
|
|
|
+ x2 := x xor x2;
|
|
|
+ x:= x xor x2;
|
|
|
+ end;
|
|
|
+ { First convert to global coordinates }
|
|
|
+ X := X + StartXViewPort;
|
|
|
+ X2 := X2 + StartXViewPort;
|
|
|
+ Y := Y + StartYViewPort;
|
|
|
+ if ClipPixels and
|
|
|
+ LineClipped(x,y,x2,y,
|
|
|
+ StartXViewPort,StartYViewPort,
|
|
|
+ StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
|
|
|
+ exit;
|
|
|
+ {$ifdef logging2}
|
|
|
+ LogLn('hline '+strf(x)+' - '+strf(x2)+' on '+strf(y)+' in mode '+strf(currentwritemode));
|
|
|
+ {$endif logging2}
|
|
|
+ HLength := x2 - x + 1;
|
|
|
+ {$ifdef logging2}
|
|
|
+ LogLn('length: '+strf(hlength));
|
|
|
+ {$endif logging2}
|
|
|
+ Offs:=Longint(y)*BytesPerLine+2*x;
|
|
|
+ {$ifdef logging2}
|
|
|
+ LogLn('Offs: '+strf(offs)+' -- '+hexstr(offs,8));
|
|
|
+ {$endif logging2}
|
|
|
+ case CurrentWriteMode of
|
|
|
+ XorPut:
|
|
|
+ begin
|
|
|
+ if UseNoSelector then
|
|
|
+ seg_xorword(get_ds,PtrUInt(LFBPointer)+PtrUInt(offs)+PtrUInt(LinearPageOfs),HLength,Word(CurrentColor))
|
|
|
+ else
|
|
|
+ seg_xorword(WinWriteSeg,offs+LinearPageOfs,HLength,Word(CurrentColor));
|
|
|
+ end;
|
|
|
+ OrPut:
|
|
|
+ begin
|
|
|
+ if UseNoSelector then
|
|
|
+ seg_orword(get_ds,PtrUInt(LFBPointer)+PtrUInt(offs)+PtrUInt(LinearPageOfs),HLength,Word(CurrentColor))
|
|
|
+ else
|
|
|
+ seg_orword(WinWriteSeg,offs+LinearPageOfs,HLength,Word(CurrentColor));
|
|
|
+ end;
|
|
|
+ AndPut:
|
|
|
+ begin
|
|
|
+ if UseNoSelector then
|
|
|
+ seg_andword(get_ds,PtrUInt(LFBPointer)+PtrUInt(offs)+PtrUInt(LinearPageOfs),HLength,Word(CurrentColor))
|
|
|
+ else
|
|
|
+ seg_andword(WinWriteSeg,offs+LinearPageOfs,HLength,Word(CurrentColor));
|
|
|
+ end;
|
|
|
+ NormalPut:
|
|
|
+ begin
|
|
|
+ if UseNoSelector then
|
|
|
+ FillWord(Pointer(LFBPointer+offs+LinearPageOfs)^,HLength,Word(CurrentColor))
|
|
|
+ else
|
|
|
+ seg_fillword(WinWriteSeg,offs+LinearPageOfs,HLength,Word(CurrentColor));
|
|
|
+ end;
|
|
|
+ NotPut:
|
|
|
+ begin
|
|
|
+ if UseNoSelector then
|
|
|
+ FillWord(Pointer(LFBPointer+offs+LinearPageOfs)^,HLength,Word(not Word(CurrentColor)))
|
|
|
+ else
|
|
|
+ seg_fillword(WinWriteSeg,offs+LinearPageOfs,HLength,Word(not Word(CurrentColor)));
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
|
|
|
{************************************************************************}
|
|
|
{* 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
|
|
|
offs : longint;
|
|
|
dummy : byte;
|
|
|
@@ -1815,7 +1812,7 @@ end;
|
|
|
end;
|
|
|
|
|
|
|
|
|
- Function GetPixVESA16(X,Y: smallint):word; {$ifndef fpc}far;{$endif fpc}
|
|
|
+ Function GetPixVESA16(X,Y: smallint):word;
|
|
|
Var dummy: Word;
|
|
|
offset: longint;
|
|
|
shift: byte;
|
|
|
@@ -1837,7 +1834,7 @@ end;
|
|
|
end;
|
|
|
|
|
|
|
|
|
- procedure DirectPutPixVESA16(x, y : smallint); {$ifndef fpc}far;{$endif fpc}
|
|
|
+ procedure DirectPutPixVESA16(x, y : smallint);
|
|
|
var
|
|
|
offs : longint;
|
|
|
dummy : byte;
|
|
|
@@ -1882,7 +1879,7 @@ end;
|
|
|
end;
|
|
|
|
|
|
|
|
|
- procedure HLineVESA16(x,x2,y: smallint); {$ifndef fpc}far;{$endif fpc}
|
|
|
+ procedure HLineVESA16(x,x2,y: smallint);
|
|
|
var
|
|
|
xtmp: smallint;
|
|
|
ScrOfs, BankRest: longint;
|
|
|
@@ -1990,7 +1987,6 @@ end;
|
|
|
|
|
|
|
|
|
{$IFDEF DPMI}
|
|
|
-{$ifdef fpc}
|
|
|
Procedure SetVESARGBAllPalette(const Palette:PaletteType);
|
|
|
var
|
|
|
pal: array[0..255] of palrec;
|
|
|
@@ -2056,7 +2052,6 @@ end;
|
|
|
end;
|
|
|
setallpalettedefault(palette);
|
|
|
end;
|
|
|
-{$endif fpc}
|
|
|
|
|
|
Procedure SetVESARGBPalette(ColorNum, RedValue, GreenValue,
|
|
|
BlueValue : smallint);
|
|
|
@@ -2064,9 +2059,6 @@ end;
|
|
|
pal: palrec;
|
|
|
regs: TDPMIRegisters;
|
|
|
Ptr: longint;
|
|
|
-{$ifndef fpc}
|
|
|
- PalPtr : ^PalRec;
|
|
|
-{$endif fpc}
|
|
|
RealSeg: word;
|
|
|
FunctionNr : byte; { use blankbit or normal RAMDAC programming? }
|
|
|
begin
|
|
|
@@ -2093,25 +2085,13 @@ end;
|
|
|
FunctionNr := $00;
|
|
|
|
|
|
{ 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));
|
|
|
-{$endif fpc}
|
|
|
{get the segment value}
|
|
|
RealSeg := word(Ptr shr 16);
|
|
|
{ setup interrupt registers }
|
|
|
FillChar(regs, sizeof(regs), #0);
|
|
|
{ copy palette values to real mode buffer }
|
|
|
-{$ifndef fpc}
|
|
|
- move(pal, palptr^, sizeof(pal));
|
|
|
-{$else fpc}
|
|
|
DosMemPut(RealSeg,0,pal,sizeof(pal));
|
|
|
-{$endif fpc}
|
|
|
regs.eax := $4F09;
|
|
|
regs.ebx := FunctionNr;
|
|
|
regs.ecx := $01;
|
|
|
@@ -2121,12 +2101,8 @@ end;
|
|
|
RealIntr($10, regs);
|
|
|
|
|
|
{ free real mode memory }
|
|
|
-{$ifndef fpc}
|
|
|
- GlobalDosFree(word(Ptr and $ffff));
|
|
|
-{$else fpc}
|
|
|
If not Global_Dos_Free(word(Ptr and $ffff)) then
|
|
|
RunError(216);
|
|
|
-{$endif fpc}
|
|
|
|
|
|
if word(regs.eax) <> $004F then
|
|
|
begin
|
|
|
@@ -2149,9 +2125,6 @@ end;
|
|
|
RedValue, GreenValue, BlueValue : smallint);
|
|
|
var
|
|
|
pal: PalRec;
|
|
|
-{$ifndef fpc}
|
|
|
- palptr : ^PalRec;
|
|
|
-{$endif fpc}
|
|
|
regs : TDPMIRegisters;
|
|
|
RealSeg: word;
|
|
|
ptr: longint;
|
|
|
@@ -2168,15 +2141,7 @@ end;
|
|
|
if VESAInfo.Version >= $0200 then
|
|
|
Begin
|
|
|
{ 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));
|
|
|
-{$endif fpc}
|
|
|
{ get the segment value }
|
|
|
RealSeg := word(Ptr shr 16);
|
|
|
{ setup interrupt registers }
|
|
|
@@ -2191,18 +2156,10 @@ end;
|
|
|
RealIntr($10, regs);
|
|
|
|
|
|
{ copy to protected mode buffer ... }
|
|
|
-{$ifndef fpc}
|
|
|
- Move(PalPtr^, Pal, sizeof(pal));
|
|
|
-{$else fpc}
|
|
|
DosMemGet(RealSeg,0,Pal,sizeof(pal));
|
|
|
-{$endif fpc}
|
|
|
{ free real mode memory }
|
|
|
-{$ifndef fpc}
|
|
|
- GlobalDosFree(word(Ptr and $ffff));
|
|
|
-{$else fpc}
|
|
|
If not Global_Dos_Free(word(Ptr and $ffff)) then
|
|
|
RunError(216);
|
|
|
-{$endif fpc}
|
|
|
|
|
|
if word(regs.eax) <> $004F then
|
|
|
begin
|
|
|
@@ -2383,7 +2340,6 @@ Const
|
|
|
else
|
|
|
BytesPerLine := VESAModeInfo.BytesPerScanLine;
|
|
|
|
|
|
-{$ifdef FPC}
|
|
|
case mode of
|
|
|
m320x200x32k,
|
|
|
m320x200x64k,
|
|
|
@@ -2399,8 +2355,8 @@ Const
|
|
|
DirectPutPixel:=@DirectPutPixVESA32kor64kLinear;
|
|
|
PutPixel:=@PutPixVESA32kor64kLinear;
|
|
|
GetPixel:=@GetPixVESA32kor64kLinear;
|
|
|
+ HLine:=@HLineVESA32kOr64kLinear;
|
|
|
{ linear mode for lines not yet implemented PM }
|
|
|
- HLine:=@HLineDefault;
|
|
|
VLine:=@VLineDefault;
|
|
|
GetScanLine := @GetScanLineDefault;
|
|
|
PatternLine := @PatternLineDefault;
|
|
|
@@ -2474,7 +2430,6 @@ Const
|
|
|
inc(WinShift);
|
|
|
Temp:=Temp shr 1;
|
|
|
end; }
|
|
|
-{$endif FPC}
|
|
|
end;
|
|
|
|
|
|
procedure SetupWindows(var ModeInfo: TVESAModeInfo);
|
|
|
@@ -2669,19 +2624,15 @@ Const
|
|
|
asm
|
|
|
mov ax,4F02h
|
|
|
mov bx,mode
|
|
|
-{$ifdef fpc}
|
|
|
push ebp
|
|
|
push esi
|
|
|
push edi
|
|
|
push ebx
|
|
|
-{$endif fpc}
|
|
|
int 10h
|
|
|
-{$ifdef fpc}
|
|
|
pop ebx
|
|
|
pop edi
|
|
|
pop esi
|
|
|
pop ebp
|
|
|
-{$endif fpc}
|
|
|
sub ax,004Fh
|
|
|
cmp ax,1
|
|
|
sbb al,al
|
|
|
@@ -2762,21 +2713,21 @@ Const
|
|
|
|
|
|
{$ENDIF}
|
|
|
|
|
|
- procedure Init1280x1024x64k; {$ifndef fpc}far;{$endif fpc}
|
|
|
+ procedure Init1280x1024x64k;
|
|
|
begin
|
|
|
SetVesaMode(m1280x1024x64k);
|
|
|
{ Get maximum number of scanlines for page flipping }
|
|
|
ScanLines := GetMaxScanLines;
|
|
|
end;
|
|
|
|
|
|
- procedure Init1280x1024x32k; {$ifndef fpc}far;{$endif fpc}
|
|
|
+ procedure Init1280x1024x32k;
|
|
|
begin
|
|
|
SetVESAMode(m1280x1024x32k);
|
|
|
{ Get maximum number of scanlines for page flipping }
|
|
|
ScanLines := GetMaxScanLines;
|
|
|
end;
|
|
|
|
|
|
- procedure Init1280x1024x256; {$ifndef fpc}far;{$endif fpc}
|
|
|
+ procedure Init1280x1024x256;
|
|
|
begin
|
|
|
SetVESAMode(m1280x1024x256);
|
|
|
{ Get maximum number of scanlines for page flipping }
|
|
|
@@ -2784,105 +2735,105 @@ Const
|
|
|
end;
|
|
|
|
|
|
|
|
|
- procedure Init1280x1024x16; {$ifndef fpc}far;{$endif fpc}
|
|
|
+ procedure Init1280x1024x16;
|
|
|
begin
|
|
|
SetVESAMode(m1280x1024x16);
|
|
|
{ Get maximum number of scanlines for page flipping }
|
|
|
ScanLines := GetMaxScanLines;
|
|
|
end;
|
|
|
|
|
|
- procedure Init1024x768x64k; {$ifndef fpc}far;{$endif fpc}
|
|
|
+ procedure Init1024x768x64k;
|
|
|
begin
|
|
|
SetVESAMode(m1024x768x64k);
|
|
|
{ Get maximum number of scanlines for page flipping }
|
|
|
ScanLines := GetMaxScanLines;
|
|
|
end;
|
|
|
|
|
|
- procedure Init1024x768x32k; {$ifndef fpc}far;{$endif fpc}
|
|
|
+ procedure Init1024x768x32k;
|
|
|
begin
|
|
|
SetVESAMode(m1024x768x32k);
|
|
|
{ Get maximum number of scanlines for page flipping }
|
|
|
ScanLines := GetMaxScanLines;
|
|
|
end;
|
|
|
|
|
|
- procedure Init1024x768x256; {$ifndef fpc}far;{$endif fpc}
|
|
|
+ procedure Init1024x768x256;
|
|
|
begin
|
|
|
SetVESAMode(m1024x768x256);
|
|
|
{ Get maximum number of scanlines for page flipping }
|
|
|
ScanLines := GetMaxScanLines;
|
|
|
end;
|
|
|
|
|
|
- procedure Init1024x768x16; {$ifndef fpc}far;{$endif fpc}
|
|
|
+ procedure Init1024x768x16;
|
|
|
begin
|
|
|
SetVESAMode(m1024x768x16);
|
|
|
{ Get maximum number of scanlines for page flipping }
|
|
|
ScanLines := GetMaxScanLines;
|
|
|
end;
|
|
|
|
|
|
- procedure Init800x600x64k; {$ifndef fpc}far;{$endif fpc}
|
|
|
+ procedure Init800x600x64k;
|
|
|
begin
|
|
|
SetVESAMode(m800x600x64k);
|
|
|
{ Get maximum number of scanlines for page flipping }
|
|
|
ScanLines := GetMaxScanLines;
|
|
|
end;
|
|
|
|
|
|
- procedure Init800x600x32k; {$ifndef fpc}far;{$endif fpc}
|
|
|
+ procedure Init800x600x32k;
|
|
|
begin
|
|
|
SetVESAMode(m800x600x32k);
|
|
|
{ Get maximum number of scanlines for page flipping }
|
|
|
ScanLines := GetMaxScanLines;
|
|
|
end;
|
|
|
|
|
|
- procedure Init800x600x256; {$ifndef fpc}far;{$endif fpc}
|
|
|
+ procedure Init800x600x256;
|
|
|
begin
|
|
|
SetVESAMode(m800x600x256);
|
|
|
{ Get maximum number of scanlines for page flipping }
|
|
|
ScanLines := GetMaxScanLines;
|
|
|
end;
|
|
|
|
|
|
- procedure Init800x600x16; {$ifndef fpc}far;{$endif fpc}
|
|
|
+ procedure Init800x600x16;
|
|
|
begin
|
|
|
SetVesaMode(m800x600x16);
|
|
|
{ Get maximum number of scanlines for page flipping }
|
|
|
ScanLines := GetMaxScanLines;
|
|
|
end;
|
|
|
|
|
|
- procedure Init640x480x64k; {$ifndef fpc}far;{$endif fpc}
|
|
|
+ procedure Init640x480x64k;
|
|
|
begin
|
|
|
SetVESAMode(m640x480x64k);
|
|
|
{ Get maximum number of scanlines for page flipping }
|
|
|
ScanLines := GetMaxScanLines;
|
|
|
end;
|
|
|
|
|
|
- procedure Init640x480x32k; {$ifndef fpc}far;{$endif fpc}
|
|
|
+ procedure Init640x480x32k;
|
|
|
begin
|
|
|
SetVESAMode(m640x480x32k);
|
|
|
{ Get maximum number of scanlines for page flipping }
|
|
|
ScanLines := GetMaxScanLines;
|
|
|
end;
|
|
|
|
|
|
- procedure Init640x480x256; {$ifndef fpc}far;{$endif fpc}
|
|
|
+ procedure Init640x480x256;
|
|
|
begin
|
|
|
SetVESAMode(m640x480x256);
|
|
|
{ Get maximum number of scanlines for page flipping }
|
|
|
ScanLines := GetMaxScanLines;
|
|
|
end;
|
|
|
|
|
|
- procedure Init640x400x256; {$ifndef fpc}far;{$endif fpc}
|
|
|
+ procedure Init640x400x256;
|
|
|
begin
|
|
|
SetVESAMode(m640x400x256);
|
|
|
{ Get maximum number of scanlines for page flipping }
|
|
|
ScanLines := GetMaxScanLines;
|
|
|
end;
|
|
|
|
|
|
- procedure Init320x200x64k; {$ifndef fpc}far;{$endif fpc}
|
|
|
+ procedure Init320x200x64k;
|
|
|
begin
|
|
|
SetVESAMode(m320x200x64k);
|
|
|
{ Get maximum number of scanlines for page flipping }
|
|
|
ScanLines := GetMaxScanLines;
|
|
|
end;
|
|
|
|
|
|
- procedure Init320x200x32k; {$ifndef fpc}far;{$endif fpc}
|
|
|
+ procedure Init320x200x32k;
|
|
|
begin
|
|
|
SetVESAMode(m320x200x32k);
|
|
|
{ Get maximum number of scanlines for page flipping }
|
|
|
@@ -2892,7 +2843,7 @@ Const
|
|
|
|
|
|
{$IFDEF DPMI}
|
|
|
|
|
|
- Procedure SaveStateVESA; {$ifndef fpc}far;{$endif fpc}
|
|
|
+ Procedure SaveStateVESA;
|
|
|
var
|
|
|
PtrLong: longint;
|
|
|
regs: TDPMIRegisters;
|
|
|
@@ -2905,19 +2856,15 @@ Const
|
|
|
{ Get the video mode }
|
|
|
asm
|
|
|
mov ah,0fh
|
|
|
-{$ifdef fpc}
|
|
|
push ebp
|
|
|
push esi
|
|
|
push edi
|
|
|
push ebx
|
|
|
-{$endif fpc}
|
|
|
int 10h
|
|
|
-{$ifdef fpc}
|
|
|
pop ebx
|
|
|
pop edi
|
|
|
pop esi
|
|
|
pop ebp
|
|
|
-{$endif fpc}
|
|
|
mov [VideoMode], al
|
|
|
end ['EAX'];
|
|
|
{ saving/restoring video state screws up Windows (JM) }
|
|
|
@@ -2939,22 +2886,10 @@ Const
|
|
|
{$ifdef logging}
|
|
|
LogLn('allocating VESA save buffer of '+strf(64*StateSize));
|
|
|
{$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 }
|
|
|
-{$endif fpc}
|
|
|
if PtrLong = 0 then
|
|
|
RunError(203);
|
|
|
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);
|
|
|
|
|
|
FillChar(regs, sizeof(regs), #0);
|
|
|
@@ -2977,7 +2912,7 @@ Const
|
|
|
end;
|
|
|
end;
|
|
|
|
|
|
- procedure RestoreStateVESA; {$ifndef fpc}far;{$endif fpc}
|
|
|
+ procedure RestoreStateVESA;
|
|
|
var
|
|
|
regs:TDPMIRegisters;
|
|
|
begin
|
|
|
@@ -2985,28 +2920,20 @@ Const
|
|
|
asm
|
|
|
mov ah,00
|
|
|
mov al,[VideoMode]
|
|
|
-{$ifdef fpc}
|
|
|
push ebp
|
|
|
push esi
|
|
|
push edi
|
|
|
push ebx
|
|
|
-{$endif fpc}
|
|
|
int 10h
|
|
|
-{$ifdef fpc}
|
|
|
pop ebx
|
|
|
pop edi
|
|
|
pop esi
|
|
|
pop ebp
|
|
|
-{$endif fpc}
|
|
|
end ['EAX'];
|
|
|
{ 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) }
|
|
|
{ would return false under FPC. Just check if it's different from nil. }
|
|
|
if (SavePtr <> nil) and (SaveSupported=TRUE) then
|
|
|
-{$endif fpc}
|
|
|
begin
|
|
|
FillChar(regs, sizeof(regs), #0);
|
|
|
{ restore state, according to Ralph Brown Interrupt list }
|
|
|
@@ -3017,11 +2944,7 @@ Const
|
|
|
regs.es := RealStateSeg;
|
|
|
regs.ebx := 0;
|
|
|
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
|
|
|
-{$endif fpc}
|
|
|
RunError(216);
|
|
|
SavePtr := nil;
|
|
|
end;
|
|
|
@@ -3123,7 +3046,7 @@ Const
|
|
|
{ between VBE versions , we will use the old method where }
|
|
|
{ the new pixel offset is used to display different pages }
|
|
|
{******************************************************** }
|
|
|
- procedure SetVisualVESA(page: word); {$ifndef fpc}far;{$endif fpc}
|
|
|
+ procedure SetVisualVESA(page: word);
|
|
|
var
|
|
|
newStartVisible : word;
|
|
|
begin
|
|
|
@@ -3143,23 +3066,19 @@ Const
|
|
|
mov bx, 0000h { set display start }
|
|
|
mov cx, 0000h { pixel zero ! }
|
|
|
mov dx, [NewStartVisible] { new scanline }
|
|
|
-{$ifdef fpc}
|
|
|
push ebp
|
|
|
push esi
|
|
|
push edi
|
|
|
push ebx
|
|
|
-{$endif}
|
|
|
int 10h
|
|
|
-{$ifdef fpc}
|
|
|
pop ebx
|
|
|
pop edi
|
|
|
pop esi
|
|
|
pop ebp
|
|
|
-{$endif}
|
|
|
end ['EDX','ECX','EBX','EAX'];
|
|
|
end;
|
|
|
|
|
|
- procedure SetActiveVESA(page: word); {$ifndef fpc}far;{$endif fpc}
|
|
|
+ procedure SetActiveVESA(page: word);
|
|
|
begin
|
|
|
{ video offset is in pixels under VESA VBE! }
|
|
|
{ This value is reset after a mode set to page ZERO = YOffset = 0 ) }
|
marco