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

add run time option -novesa for go32v2 os target

Browse Source 
git-svn-id: trunk@27787 -
This commit is contained in:
pierre 2014-05-14 13:44:11 +00:00
parent ee2242c407
commit cda643cea4
2 changed files with 52 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
ide/fp.pas
View File

@ -40,7 +40,7 @@ uses
{$ifdef USE_MINGW_GDB}
fpmingw,
{$else}
fpcygwin,
fpcygwin,
{$endif}
{$endif Windows}
{$endif NODEBUG}
@ -53,6 +53,9 @@ uses
{$ifdef go32v2}
dpmiexcp,
{$endif go32v2}
{$ifdef VESA}
vesa,
{$endif VESA}
keyboard,video,mouse,
{$ifdef HasSignal}
fpcatch,
@ -169,6 +172,12 @@ begin
LFNSupport:=false;
end else
{$endif go32v2}
{$ifdef VESA}
if UpcaseStr(Param)='NOVESA' then
begin
disableVESA:=true;
end else
{$endif VESA}
if UpcaseStr(Param)='README' then
begin
ShowReadme:=true;
@ -365,6 +374,8 @@ BEGIN
InitCompilerSwitches;
{$ifdef VESA}
writeln(stderr,'If program stops, try again using -novesa option');
flush(stderr);
InitVESAScreenModes;
{$endif}
InitRedir;

43
ide/vesa.pas
View File

@ -130,6 +130,9 @@ function VESAReturnMemoryWindow(Window: byte; var Position: word): boolean;
function RegisterVesaVideoMode(Mode : word) : boolean;
Procedure FreeVesaModes;
const
DisableVESA : boolean = false;
implementation
uses
@ -190,6 +193,8 @@ var r: registers;
OK: boolean;
M: MemPtr;
begin
if disableVESA then
exit(false);
StrToMem('VBE2',B.Signature);
GetDosMem(M,SizeOf(B));
M.MoveDataTo(B,sizeof(B));
@ -207,6 +212,8 @@ var OK: boolean;
VI: TVESAInfoBlock;
begin
FillChar(B,SizeOf(B),0);
if disableVESA then
exit(false);
OK:=VESAGetInfo(VI);
if OK then
begin
@ -243,6 +250,11 @@ var OK: boolean;
VI: TVESAInfoBlock;
S: array[0..256] of char;
begin
if disableVESA then
begin
VESAGetOemString:='VESA disabled';
exit;
end;
FillChar(S,SizeOf(S),0);
OK:=VESAGetInfo(VI);
if OK then
@ -255,6 +267,8 @@ var r : registers;
M : MemPtr;
OK: boolean;
begin
if disableVESA then
exit(false);
r.ah:=$4f; r.al:=$01; r.cx:=Mode;
GetDosMem(M,sizeof(B));
r.es:=M.DosSeg; r.di:=M.DosOfs; {r.ds:=r.es;}
@ -312,6 +326,8 @@ function VESASetMode(Mode: word): boolean;
var r: registers;
OK: boolean;
begin
if disableVESA then
exit(false);
r.ah:=$4f; r.al:=$02; r.bx:=Mode;
dos.intr($10,r);
OK:=(r.ax=$004f);
@ -322,6 +338,10 @@ function VESAGetMode(var Mode: word): boolean;
var r : registers;
OK: boolean;
begin
if disableVESA then
exit(false);
if disableVESA then
exit(false);
r.ah:=$4f; r.al:=$03;
dos.intr($10,r);
OK:=(r.ax=$004f);
@ -333,6 +353,8 @@ function VESASelectMemoryWindow(Window: byte; Position: word): boolean;
var r : registers;
OK : boolean;
begin
if disableVESA then
exit(false);
r.ah:=$4f; r.al:=$05; r.bh:=0; r.bl:=Window; r.dx:=Position;
dos.intr($10,r);
OK:=(r.ax=$004f);
@ -343,6 +365,8 @@ function VESAReturnMemoryWindow(Window: byte; var Position: word): boolean;
var r : registers;
OK : boolean;
begin
if disableVESA then
exit(false);
r.ah:=$4f; r.al:=$05; r.bh:=1; r.bl:=Window;
dos.intr($10,r);
OK:=(r.ax=$004f);
@ -354,9 +378,10 @@ function VESAInit: boolean;
var OK: boolean;
VI: TVESAInfoBlock;
begin
OK:=VESAGetInfo(VI);
if OK then
if disableVESA then
OK:=false
else
OK:=VESAGetInfo(VI);
VESAInit:=OK;
end;
@ -394,6 +419,8 @@ function SetVESAMode(const VideoMode: TVideoMode): Boolean;
begin
res:=false;
if disableVESA then
exit(res);
VH:=VesaVideoModeHead;
while assigned(VH) do
begin
@ -635,8 +662,12 @@ begin
SysDoneVideo();
end;
function SetVESAVideoDriver : boolean; forward;
procedure VesaInitVideo;
begin
if not SetVESAVideoDriver then
exit;
{$ifdef TESTGRAPHIC}
if IsGraphicMode then
begin
@ -673,7 +704,10 @@ Var
i : longint;
{$endif TESTGRAPHIC}
function SetVESAVideoDriver : boolean;
BEGIN
if disableVESA then
exit(false);
{ Get the videodriver to be used }
GetVideoDriver (Driver);
{ Change needed functions }
@ -706,4 +740,7 @@ BEGIN
{$endif TESTGRAPHIC}
SetVideoDriver (Driver);
SetVESAVideoDriver:=true;
END;
END.