|
@@ -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
|
|
-
|
|
|
|
|
|
+
|
|
}
|
|
}
|