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

+ working with VP/2 already (not FPC yet)!video.inc

Browse Source
This commit is contained in:
Tomas Hajny 2000-09-26 18:15:29 +00:00
parent 4d6f20c0d4
commit 531bb2a6ad
1 changed files with 58 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

69
api/os2/video.inc
View File

@ -13,9 +13,14 @@ uses
{$ENDIF} {$ENDIF}
{$ENDIF} {$ENDIF}
{$IFNDEF FPC}
type
cardinal = longint;
{$ENDIF}
const const
InitVideoCalled: boolean = false; InitVideoCalled: boolean = false;
OrigEmpty: boolean = false; OrigEmpty: boolean = true;
LastCursorType: word = crUnderline; LastCursorType: word = crUnderline;
EmptyCell: cardinal = $0720; EmptyCell: cardinal = $0720;
@ -29,11 +34,11 @@ type
var OrigCurType: TVioCursorInfo; var OrigCurType: TVioCursorInfo;
OrigVioMode: TVioModeInfo; OrigVioMode: TVioModeInfo;
OrigHighBit: TVioIntensity; OrigHighBit: TVioIntensity;
OrigCurRow: word;
OrigCurCol: word;
CellHeight: byte; CellHeight: byte;
{$ASMMODE ATT}
procedure CheckCellHeight; procedure CheckCellHeight;
var OldCD, CD: TVioCursorInfo; var OldCD, CD: TVioCursorInfo;
@ -62,11 +67,19 @@ begin
RegisterVideoMode (40, 25, False, @DefaultVideoModeSelector, 0); RegisterVideoMode (40, 25, False, @DefaultVideoModeSelector, 0);
RegisterVideoMode (80, 25, False, @DefaultVideoModeSelector, 0); RegisterVideoMode (80, 25, False, @DefaultVideoModeSelector, 0);
} }
{$IFDEF FPC}
RegisterVideoMode (40, 25, True, @DefaultVideoModeSelector, 0); RegisterVideoMode (40, 25, True, @DefaultVideoModeSelector, 0);
RegisterVideoMode (80, 25, True, @DefaultVideoModeSelector, 0); RegisterVideoMode (80, 25, True, @DefaultVideoModeSelector, 0);
RegisterVideoMode (80, 30, True, @DefaultVideoModeSelector, 0); RegisterVideoMode (80, 30, True, @DefaultVideoModeSelector, 0);
RegisterVideoMode (80, 43, True, @DefaultVideoModeSelector, 0); RegisterVideoMode (80, 43, True, @DefaultVideoModeSelector, 0);
RegisterVideoMode (80, 50, True, @DefaultVideoModeSelector, 0); RegisterVideoMode (80, 50, True, @DefaultVideoModeSelector, 0);
{$ELSE}
RegisterVideoMode (40, 25, True, DefaultVideoModeSelector, 0);
RegisterVideoMode (80, 25, True, DefaultVideoModeSelector, 0);
RegisterVideoMode (80, 30, True, DefaultVideoModeSelector, 0);
RegisterVideoMode (80, 43, True, DefaultVideoModeSelector, 0);
RegisterVideoMode (80, 50, True, DefaultVideoModeSelector, 0);
{$ENDIF}
{ The following modes wouldn't work on plain VGA; is it useful to check { The following modes wouldn't work on plain VGA; is it useful to check
for their availability on the program startup? for their availability on the program startup?
@ -109,6 +122,7 @@ begin
{Remember original video mode, cursor type and high bit behaviour setting} {Remember original video mode, cursor type and high bit behaviour setting}
Move (MI, OrigVioMode, SizeOf (OrigVioMode)); Move (MI, OrigVioMode, SizeOf (OrigVioMode));
VioGetCurType (OrigCurType, 0); VioGetCurType (OrigCurType, 0);
VioGetCurPos (OrigCurRow, OrigCurCol, 0);
with OrigHighBit do with OrigHighBit do
begin begin
cb := 6; cb := 6;
@ -125,8 +139,13 @@ begin
if P = nil then if P = nil then
{Assume we have at least 16 colours available in "colour" modes} {Assume we have at least 16 colours available in "colour" modes}
RegisterVideoMode (Col, Row, Color >= Colors_16, RegisterVideoMode (Col, Row, Color >= Colors_16,
{$IFDEF FPC}
@DefaultVideoModeSelector, 0); @DefaultVideoModeSelector, 0);
{$ELSE}
DefaultVideoModeSelector, 0);
{$ENDIF}
end; end;
OrigEmpty := false;
end; end;
with MI do with MI do
begin begin
@ -138,9 +157,15 @@ begin
LowAscii := true; LowAscii := true;
SetCursorType (LastCursorType); SetCursorType (LastCursorType);
{Get the address of the videobuffer.} {Get the address of the videobuffer.}
if VioGetBuf (VideoBuf, PWord (VideoBufSize)^, 0) = 0 then {$IFDEF PPC_VIRTUAL}
if VioGetBuf (pointer (VideoBuf), PWord (@VideoBufSize)^, 0) = 0 then
begin
SelToFlat (pointer (VideoBuf));
{$ELSE}
if VioGetBuf (VideoBuf, PWord (@VideoBufSize)^, 0) = 0 then
begin begin
VideoBuf := SelToFlat (TFarPtr (VideoBuf)); VideoBuf := SelToFlat (TFarPtr (VideoBuf));
{$ENDIF}
SetHighBitBlink (true); SetHighBitBlink (true);
end end
else else
@ -238,6 +263,7 @@ begin
SetCursorPos (0, 0); SetCursorPos (0, 0);
VioSetState (OrigHighBit, 0); VioSetState (OrigHighBit, 0);
VioSetCurType (OrigCurType, 0); VioSetCurType (OrigCurType, 0);
VioSetCurPos (OrigCurRow, OrigCurCol, 0);
VideoBufSize := 0; VideoBufSize := 0;
InitVideoCalled := false; InitVideoCalled := false;
end; end;
@ -264,7 +290,7 @@ begin
with MI do with MI do
begin begin
cb := 8; cb := 8;
fbType := 0; fbType := 1;
if VideoMode.Color then if VideoMode.Color then
Color := Colors_16 Color := Colors_16
else else
@ -273,9 +299,16 @@ begin
Row := VideoMode.Row; Row := VideoMode.Row;
end; end;
if VioSetMode (MI, 0) = 0 then if VioSetMode (MI, 0) = 0 then
if VioGetBuf (VideoBuf, PWord (VideoBufSize)^, 0) = 0 then {$IFDEF PPC_VIRTUAL}
if VioGetBuf (pointer (VideoBuf),
PWord (@VideoBufSize)^, 0) = 0 then
begin
SelToFlat (pointer (VideoBuf));
{$ELSE}
if VioGetBuf (VideoBuf, PWord (@VideoBufSize)^, 0) = 0 then
begin begin
VideoBuf := SelToFlat (TFarPtr (VideoBuf)); VideoBuf := SelToFlat (TFarPtr (VideoBuf));
{$ENDIF}
DefaultVideoModeSelector := true; DefaultVideoModeSelector := true;
SetHighBitBlink (true); SetHighBitBlink (true);
CheckCellHeight; CheckCellHeight;
@ -286,8 +319,14 @@ begin
begin begin
DefaultVideoModeSelector := false; DefaultVideoModeSelector := false;
VioSetMode (OldMI, 0); VioSetMode (OldMI, 0);
VioGetBuf (VideoBuf, PWord (VideoBufSize)^, 0); {$IFDEF PPC_VIRTUAL}
VioGetBuf (pointer (VideoBuf),
PWord (@VideoBufSize)^, 0);
SelToFlat (pointer (VideoBuf));
{$ELSE}
VioGetBuf (VideoBuf, PWord (@VideoBufSize)^, 0);
VideoBuf := SelToFlat (TFarPtr (VideoBuf)); VideoBuf := SelToFlat (TFarPtr (VideoBuf));
{$ENDIF}
SetHighBitBlink (true); SetHighBitBlink (true);
CheckCellHeight; CheckCellHeight;
SetCursorType (LastCursorType); SetCursorType (LastCursorType);
@ -296,8 +335,13 @@ begin
else else
begin begin
DefaultVideoModeSelector := false; DefaultVideoModeSelector := false;
VioGetBuf (VideoBuf, PWord (VideoBufSize)^, 0); {$IFDEF PPC_VIRTUAL}
VioGetBuf (pointer (VideoBuf), PWord (@VideoBufSize)^, 0);
SelToFlat (pointer (VideoBuf));
{$ELSE}
VioGetBuf (VideoBuf, PWord (@VideoBufSize)^, 0);
VideoBuf := SelToFlat (TFarPtr (VideoBuf)); VideoBuf := SelToFlat (TFarPtr (VideoBuf));
{$ENDIF}
SetHighBitBlink (true); SetHighBitBlink (true);
SetCursorType (LastCursorType); SetCursorType (LastCursorType);
end; end;
@ -308,7 +352,7 @@ end;
procedure ClearScreen; procedure ClearScreen;
begin begin
VioScrollDown (0, 0, word (-1), word (-1), 0, PWord (@EmptyCell)^, 0); VioScrollDn (0, 0, word (-1), word (-1), 0, PWord (@EmptyCell)^, 0);
end; end;
@ -321,10 +365,13 @@ end;
{ {
$Log$ $Log$
Revision 1.3 2000-09-24 19:53:03 hajny Revision 1.4 2000-09-26 18:15:29 hajny
+ working with VP/2 already (not FPC yet)!video.inc
Revision 1.3 2000/09/24 19:53:03 hajny
* OS/2 implementation almost finished, not debugged yet * OS/2 implementation almost finished, not debugged yet
Revision 1.2 2000/07/13 11:32:26 michael Revision 1.2 2000/07/13 11:32:26 michael
+ removed logs + removed logs
} }