|
|
@@ -40,45 +40,6 @@ var OrigCurType: TVioCursorInfo;
|
|
|
OrigCurRow: word;
|
|
|
OrigCurCol: word;
|
|
|
CellHeight: byte;
|
|
|
- OldVideoBuf: PVideoBuf;
|
|
|
-
|
|
|
-procedure TargetEntry;
|
|
|
-
|
|
|
-var P: PVideoModeList;
|
|
|
- PScr: pointer;
|
|
|
-
|
|
|
-begin
|
|
|
-{Remember original video mode, cursor type and high bit behaviour setting}
|
|
|
- OrigVioMode.cb := SizeOf (OrigVioMode);
|
|
|
- VioGetMode (OrigVioMode, 0);
|
|
|
- VioGetCurType (OrigCurType, 0);
|
|
|
- VioGetCurPos (OrigCurRow, OrigCurCol, 0);
|
|
|
- with OrigHighBit do
|
|
|
- begin
|
|
|
- cb := 6;
|
|
|
- rType := 2;
|
|
|
- end;
|
|
|
- VioGetState (OrigHighBit, 0);
|
|
|
-{Register the curent video mode in Modes if not there yet}
|
|
|
- with OrigVioMode do
|
|
|
- begin
|
|
|
- P := Modes;
|
|
|
- while (P <> nil) and ((P^.Row <> Row) or (P^.Col <> Col)
|
|
|
- or (P^.Color <> (Color >= Colors_16))) do
|
|
|
- P := P^.Next;
|
|
|
- if P = nil then
|
|
|
-{Assume we have at least 16 colours available in "colour" modes}
|
|
|
- RegisterVideoMode (Col, Row, Color >= Colors_16,
|
|
|
- @DefaultVideoModeSelector, 0);
|
|
|
- end;
|
|
|
-{Get the address of the original videobuffer and size.}
|
|
|
- if VioGetBuf (PScr, PWord (@OrigScreenSize)^, 0) = 0 then
|
|
|
- begin
|
|
|
- PScr := SelToFlat (TFarPtr (PScr));
|
|
|
- GetMem (OrigScreen, OrigScreenSize);
|
|
|
- Move (PScr^, OrigScreen^, OrigScreenSize);
|
|
|
- end;
|
|
|
-end;
|
|
|
|
|
|
procedure CheckCellHeight;
|
|
|
|
|
|
@@ -100,29 +61,6 @@ begin
|
|
|
end;
|
|
|
|
|
|
|
|
|
-procedure RegisterVideoModes;
|
|
|
-begin
|
|
|
-{ BW modes are rejected on my (colour) configuration. I can't imagine
|
|
|
- OS/2 running on MCGA anyway... ;-)
|
|
|
-
|
|
|
- RegisterVideoMode (40, 25, False, @DefaultVideoModeSelector, 0);
|
|
|
- RegisterVideoMode (80, 25, False, @DefaultVideoModeSelector, 0);
|
|
|
-}
|
|
|
- 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);
|
|
|
-
|
|
|
-{ The following modes wouldn't work on plain VGA; is it useful to check
|
|
|
- for their availability on the program startup?
|
|
|
-
|
|
|
- RegisterVideoMode (132, 25, True, @DefaultVideoModeSelector, 0);
|
|
|
- RegisterVideoMode (132, 30, True, @DefaultVideoModeSelector, 0);
|
|
|
- RegisterVideoMode (132, 43, True, @DefaultVideoModeSelector, 0);
|
|
|
- RegisterVideoMode (132, 50, True, @DefaultVideoModeSelector, 0);
|
|
|
-}
|
|
|
-end;
|
|
|
|
|
|
|
|
|
procedure SetHighBitBlink (Blink: boolean);
|
|
|
@@ -140,51 +78,49 @@ begin
|
|
|
end;
|
|
|
|
|
|
|
|
|
+Var
|
|
|
+ SysVideoBuf : PVideoBuf;
|
|
|
+
|
|
|
procedure SysInitVideo;
|
|
|
|
|
|
var MI: TVioModeInfo;
|
|
|
|
|
|
begin
|
|
|
- FreeMem (OldVideoBuf, VideoBufSize);
|
|
|
- OldVideoBuf := nil;
|
|
|
- VideoBufSize := 0;
|
|
|
MI.cb := SizeOf (MI);
|
|
|
VioGetMode (MI, 0);
|
|
|
with MI do
|
|
|
- begin
|
|
|
- ScreenWidth := Col;
|
|
|
- ScreenHeight := Row;
|
|
|
- ScreenColor := Color >= Colors_16;
|
|
|
- end;
|
|
|
+ begin
|
|
|
+ ScreenWidth := Col;
|
|
|
+ ScreenHeight := Row;
|
|
|
+ ScreenColor := Color >= Colors_16;
|
|
|
+ end;
|
|
|
VioGetCurPos (CursorY, CursorX, 0);
|
|
|
LowAscii := true;
|
|
|
SetCursorType (LastCursorType);
|
|
|
{ Get the address of the videobuffer.}
|
|
|
- if VioGetBuf (VideoBuf, PWord (@VideoBufSize)^, 0) = 0 then
|
|
|
- begin
|
|
|
- VideoBuf := SelToFlat (TFarPtr (VideoBuf));
|
|
|
- SetHighBitBlink (true);
|
|
|
- GetMem (OldVideoBuf, VideoBufSize);
|
|
|
- Move (VideoBuf^, OldVideoBuf^, VideoBufSize);
|
|
|
- end
|
|
|
+ if VioGetBuf (SysVideoBuf, PWord (@VideoBufSize)^, 0) = 0 then
|
|
|
+ begin
|
|
|
+ SysVideoBuf := SelToFlat (TFarPtr (SysVideoBuf));
|
|
|
+ SetHighBitBlink (true);
|
|
|
+ end
|
|
|
else
|
|
|
- ErrorHandler (errVioInit, nil);
|
|
|
+ ErrorHandler (errVioInit, nil);
|
|
|
end;
|
|
|
|
|
|
|
|
|
procedure SysSetCursorPos (NewCursorX, NewCursorY: word);
|
|
|
|
|
|
begin
|
|
|
- if VioSetCurPos (NewCursorY, NewCursorX, 0) = 0 then
|
|
|
- begin
|
|
|
- CursorX := NewCursorX;
|
|
|
- CursorY := NewCursorY;
|
|
|
- end
|
|
|
- else
|
|
|
- {Do not set an error code; people should fix invalid NewCursorX
|
|
|
- or NewCursorY values when designing, there is no need for detecting
|
|
|
- these errors at runtime.}
|
|
|
- RunError (225);
|
|
|
+ if VioSetCurPos (NewCursorY, NewCursorX, 0) = 0 then
|
|
|
+ begin
|
|
|
+ CursorX := NewCursorX;
|
|
|
+ CursorY := NewCursorY;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ {Do not set an error code; people should fix invalid NewCursorX
|
|
|
+ or NewCursorY values when designing, there is no need for detecting
|
|
|
+ these errors at runtime.}
|
|
|
+ RunError (225);
|
|
|
end;
|
|
|
|
|
|
|
|
|
@@ -195,23 +131,23 @@ var CD: TVioCursorInfo;
|
|
|
begin
|
|
|
VioGetCurType (CD, 0); {Never fails, because handle is default handle.}
|
|
|
with CD do
|
|
|
- begin
|
|
|
- CursorLines := Succ (cEnd) - yStart;
|
|
|
- if Attr = word (-1) then
|
|
|
- SysGetCursorType := crHidden
|
|
|
- else
|
|
|
-{Because the cursor's start and end lines are returned, we'll have
|
|
|
- to guess heuristically what cursor type we have.}
|
|
|
- if CursorLines = 0 then
|
|
|
-{Probably this does not occur, but you'll never know.}
|
|
|
- SysGetCursorType := crHidden
|
|
|
- else if CursorLines <= Succ (CellHeight div 4) then
|
|
|
- SysGetCursorType := crUnderline
|
|
|
- else if CursorLines <= Succ (CellHeight div 2) then
|
|
|
- SysGetCursorType := crHalfBlock
|
|
|
- else
|
|
|
- SysGetCursorType := crBlock;
|
|
|
- end;
|
|
|
+ begin
|
|
|
+ CursorLines := Succ (cEnd) - yStart;
|
|
|
+ if Attr = word (-1) then
|
|
|
+ SysGetCursorType := crHidden
|
|
|
+ else
|
|
|
+ {Because the cursor's start and end lines are returned, we'll have
|
|
|
+ to guess heuristically what cursor type we have.}
|
|
|
+ if CursorLines = 0 then
|
|
|
+ {Probably this does not occur, but you'll never know.}
|
|
|
+ SysGetCursorType := crHidden
|
|
|
+ else if CursorLines <= Succ (CellHeight div 4) then
|
|
|
+ SysGetCursorType := crUnderline
|
|
|
+ else if CursorLines <= Succ (CellHeight div 2) then
|
|
|
+ SysGetCursorType := crHalfBlock
|
|
|
+ else
|
|
|
+ SysGetCursorType := crBlock;
|
|
|
+ end;
|
|
|
end;
|
|
|
|
|
|
|
|
|
@@ -220,34 +156,34 @@ procedure SysSetCursorType (NewType: word);
|
|
|
var CD: TVioCursorInfo;
|
|
|
|
|
|
begin
|
|
|
- VioGetCurType (CD, 0);
|
|
|
- with CD do
|
|
|
+ VioGetCurType (CD, 0);
|
|
|
+ with CD do
|
|
|
+ begin
|
|
|
+ case NewType of
|
|
|
+ crHidden: Attr := word (-1);
|
|
|
+ crUnderline:
|
|
|
+ begin
|
|
|
+ Attr := 0;
|
|
|
+ yStart := word (-90);
|
|
|
+ cEnd := word (-100);
|
|
|
+ end;
|
|
|
+ crHalfBlock:
|
|
|
+ begin
|
|
|
+ Attr := 0;
|
|
|
+ yStart := word (-50);
|
|
|
+ cEnd := word (-100);
|
|
|
+ end;
|
|
|
+ crBlock:
|
|
|
begin
|
|
|
- case NewType of
|
|
|
- crHidden: Attr := word (-1);
|
|
|
- crUnderline:
|
|
|
- begin
|
|
|
- Attr := 0;
|
|
|
- yStart := word (-90);
|
|
|
- cEnd := word (-100);
|
|
|
- end;
|
|
|
- crHalfBlock:
|
|
|
- begin
|
|
|
- Attr := 0;
|
|
|
- yStart := word (-50);
|
|
|
- cEnd := word (-100);
|
|
|
- end;
|
|
|
- crBlock:
|
|
|
- begin
|
|
|
- Attr := 0;
|
|
|
- yStart := 0;
|
|
|
- cEnd := word (-100);
|
|
|
- end;
|
|
|
- end;
|
|
|
- VioSetCurType (CD, 0);
|
|
|
- VioGetCurType (CD, 0);
|
|
|
- CursorLines := Succ (cEnd) - yStart;
|
|
|
+ Attr := 0;
|
|
|
+ yStart := 0;
|
|
|
+ cEnd := word (-100);
|
|
|
end;
|
|
|
+ end;
|
|
|
+ VioSetCurType (CD, 0);
|
|
|
+ VioGetCurType (CD, 0);
|
|
|
+ CursorLines := Succ (cEnd) - yStart;
|
|
|
+ end;
|
|
|
end;
|
|
|
|
|
|
|
|
|
@@ -257,30 +193,27 @@ var PScr: pointer;
|
|
|
ScrSize: cardinal;
|
|
|
|
|
|
begin
|
|
|
- LastCursorType := GetCursorType;
|
|
|
- ClearScreen;
|
|
|
-{Restore original settings}
|
|
|
- VioSetMode (OrigVioMode, 0);
|
|
|
- CheckCellHeight;
|
|
|
+ LastCursorType := GetCursorType;
|
|
|
+ ClearScreen;
|
|
|
+ {Restore original settings}
|
|
|
+ VioSetMode (OrigVioMode, 0);
|
|
|
+ CheckCellHeight;
|
|
|
{Set CursorX and CursorY}
|
|
|
- SetCursorPos (0, 0);
|
|
|
- VioSetState (OrigHighBit, 0);
|
|
|
- VioSetCurType (OrigCurType, 0);
|
|
|
- VioSetCurPos (OrigCurRow, OrigCurCol, 0);
|
|
|
- FreeMem (OldVideoBuf, VideoBufSize);
|
|
|
- OldVideoBuf := nil;
|
|
|
- VideoBufSize := 0;
|
|
|
- if (OrigScreenSize <> 0) and (OrigScreen <> nil) then
|
|
|
- begin
|
|
|
- ScrSize := 0;
|
|
|
- if (VioGetBuf (PScr, PWord (@ScrSize)^, 0) = 0)
|
|
|
- and (ScrSize = OrigScreenSize) then
|
|
|
- begin
|
|
|
- PScr := SelToFlat (TFarPtr (PScr));
|
|
|
- Move (OrigScreen^, PScr^, OrigScreenSize);
|
|
|
- VioShowBuf (0, ScrSize, 0);
|
|
|
- end;
|
|
|
- end;
|
|
|
+ SetCursorPos (0, 0);
|
|
|
+ VioSetState (OrigHighBit, 0);
|
|
|
+ VioSetCurType (OrigCurType, 0);
|
|
|
+ VioSetCurPos (OrigCurRow, OrigCurCol, 0);
|
|
|
+ if (OrigScreenSize <> 0) and (OrigScreen <> nil) then
|
|
|
+ begin
|
|
|
+ ScrSize := 0;
|
|
|
+ if (VioGetBuf (PScr, PWord (@ScrSize)^, 0) = 0) and
|
|
|
+ (ScrSize = OrigScreenSize) then
|
|
|
+ begin
|
|
|
+ PScr := SelToFlat (TFarPtr (PScr));
|
|
|
+ Move (OrigScreen^, PScr^, OrigScreenSize);
|
|
|
+ VioShowBuf (0, ScrSize, 0);
|
|
|
+ end;
|
|
|
+ end;
|
|
|
end;
|
|
|
|
|
|
|
|
|
@@ -291,65 +224,126 @@ begin
|
|
|
end;
|
|
|
|
|
|
|
|
|
-function DefaultVideoModeSelector (const VideoMode: TVideoMode; Params: longint): boolean;
|
|
|
+function SysVideoModeSelector (const VideoMode: TVideoMode): boolean;
|
|
|
|
|
|
var OldMI, MI: TVioModeInfo;
|
|
|
|
|
|
begin
|
|
|
- OldMI.cb := SizeOf (OldMI);
|
|
|
- if VioGetMode (OldMI, 0) <> 0 then
|
|
|
- DefaultVideoModeSelector := false
|
|
|
- else
|
|
|
+ OldMI.cb := SizeOf (OldMI);
|
|
|
+ if VioGetMode (OldMI, 0) <> 0 then
|
|
|
+ SysVideoModeSelector := false
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ with MI do
|
|
|
+ begin
|
|
|
+ cb := 8;
|
|
|
+ fbType := 1;
|
|
|
+ if VideoMode.Color then
|
|
|
+ Color := Colors_16
|
|
|
+ else
|
|
|
+ Color := Colors_2;
|
|
|
+ Col := VideoMode.Col;
|
|
|
+ Row := VideoMode.Row;
|
|
|
+ end;
|
|
|
+ if VioSetMode (MI, 0) = 0 then
|
|
|
+ if VioGetBuf (SysVideoBuf, PWord (@VideoBufSize)^, 0) = 0 then
|
|
|
begin
|
|
|
- with MI do
|
|
|
- begin
|
|
|
- cb := 8;
|
|
|
- fbType := 1;
|
|
|
- if VideoMode.Color then
|
|
|
- Color := Colors_16
|
|
|
- else
|
|
|
- Color := Colors_2;
|
|
|
- Col := VideoMode.Col;
|
|
|
- Row := VideoMode.Row;
|
|
|
- end;
|
|
|
- if VioSetMode (MI, 0) = 0 then
|
|
|
- if VioGetBuf (VideoBuf, PWord (@VideoBufSize)^, 0) = 0 then
|
|
|
- begin
|
|
|
- VideoBuf := SelToFlat (TFarPtr (VideoBuf));
|
|
|
- DefaultVideoModeSelector := true;
|
|
|
- SetHighBitBlink (true);
|
|
|
- CheckCellHeight;
|
|
|
- SetCursorType (LastCursorType);
|
|
|
- ClearScreen;
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- DefaultVideoModeSelector := false;
|
|
|
- VioSetMode (OldMI, 0);
|
|
|
- VioGetBuf (VideoBuf, PWord (@VideoBufSize)^, 0);
|
|
|
- VideoBuf := SelToFlat (TFarPtr (VideoBuf));
|
|
|
- SetHighBitBlink (true);
|
|
|
- CheckCellHeight;
|
|
|
- SetCursorType (LastCursorType);
|
|
|
- ClearScreen;
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- DefaultVideoModeSelector := false;
|
|
|
- VioGetBuf (VideoBuf, PWord (@VideoBufSize)^, 0);
|
|
|
- VideoBuf := SelToFlat (TFarPtr (VideoBuf));
|
|
|
- SetHighBitBlink (true);
|
|
|
- SetCursorType (LastCursorType);
|
|
|
- end;
|
|
|
- end;
|
|
|
+ SysVideoBuf := SelToFlat (TFarPtr (SysVideoBuf));
|
|
|
+ SysVideoModeSelector := true;
|
|
|
+ SetHighBitBlink (true);
|
|
|
+ CheckCellHeight;
|
|
|
+ SetCursorType (LastCursorType);
|
|
|
+ ClearScreen;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ SysVideoModeSelector := false;
|
|
|
+ VioSetMode (OldMI, 0);
|
|
|
+ VioGetBuf (SysVideoBuf, PWord (@VideoBufSize)^, 0);
|
|
|
+ SysVideoBuf := SelToFlat (TFarPtr (SysVideoBuf));
|
|
|
+ SetHighBitBlink (true);
|
|
|
+ CheckCellHeight;
|
|
|
+ SetCursorType (LastCursorType);
|
|
|
+ ClearScreen;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ SysVideoModeSelector := false;
|
|
|
+ VioGetBuf (SysVideoBuf, PWord (@VideoBufSize)^, 0);
|
|
|
+ SysVideoBuf := SelToFlat (TFarPtr (SysVideoBuf));
|
|
|
+ SetHighBitBlink (true);
|
|
|
+ SetCursorType (LastCursorType);
|
|
|
+ end;
|
|
|
+ end;
|
|
|
end;
|
|
|
|
|
|
+Const
|
|
|
+ SysVideoModeCount = 6;
|
|
|
+ SysVMD : Array[0..SysVideoModeCount-1] of TVideoMode = (
|
|
|
+ (Col: 40; Row: 25; Color: True),
|
|
|
+ (Col: 80; Row: 25; Color: True),
|
|
|
+ (Col: 80; Row: 30; Color: True),
|
|
|
+ (Col: 80; Row: 43; Color: True),
|
|
|
+ (Col: 80; Row: 50; Color: True),
|
|
|
+ (Col: 80; Row: 25; Color: True) // Reserved for TargetEntry
|
|
|
+ );
|
|
|
+
|
|
|
+{ .MVC. were commented:
|
|
|
+ BW modes are rejected on my (colour) configuration. I can't imagine
|
|
|
+ OS/2 running on MCGA anyway... ;-)
|
|
|
+ (Col: 40; Row: 25;Color: False),
|
|
|
+ (Col: 80; Row: 25;Color: False),
|
|
|
+ The following modes wouldn't work on plain VGA; is it useful to check
|
|
|
+ for their availability on the program startup?
|
|
|
+ (Col: 132;Row: 25;Color: True),
|
|
|
+ (Col: 132;Row: 30;Color: True),
|
|
|
+ (Col: 132;Row: 43;Color: True),
|
|
|
+ (Col: 132;Row: 50;Color: True),
|
|
|
+}
|
|
|
+
|
|
|
+Function SysSetVideoMode (Const Mode : TVideoMode) : Boolean;
|
|
|
+
|
|
|
+Var
|
|
|
+ I : Integer;
|
|
|
+
|
|
|
+begin
|
|
|
+ I:=SysVideoModeCount-1;
|
|
|
+ SysSetVideoMode:=False;
|
|
|
+ While (I>=0) and Not SysSetVideoMode do
|
|
|
+ If (Mode.col=SysVMD[i].col) and
|
|
|
+ (Mode.Row=SysVMD[i].Row) and
|
|
|
+ (Mode.Color=SysVMD[i].Color) then
|
|
|
+ SysSetVideoMode:=True
|
|
|
+ else
|
|
|
+ Dec(I);
|
|
|
+ If SysSetVideoMode then
|
|
|
+ begin
|
|
|
+ SysVideoModeSelector(Mode);
|
|
|
+ ScreenWidth:=SysVMD[I].Col;
|
|
|
+ ScreenHeight:=SysVMD[I].Row;
|
|
|
+ ScreenColor:=SysVMD[I].Color;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+Function SysGetVideoModeData (Index : Word; Var Data : TVideoMode) : boolean;
|
|
|
+
|
|
|
+begin
|
|
|
+ SysGetVideoModeData:=(Index<=SysVideoModeCount);
|
|
|
+ If SysGetVideoModeData then
|
|
|
+ Data:=SysVMD[Index];
|
|
|
+end;
|
|
|
+
|
|
|
+Function SysGetVideoModeCount : Word;
|
|
|
+
|
|
|
+begin
|
|
|
+ SysGetVideoModeCount:=SysVideoModeCount;
|
|
|
+end;
|
|
|
|
|
|
procedure SysClearScreen;
|
|
|
|
|
|
begin
|
|
|
- VioScrollDn (0, 0, word (-1), word (-1), word (-1), PWord (@EmptyCell)^, 0);
|
|
|
- Move (VideoBuf^, OldVideoBuf^, VideoBufSize);
|
|
|
+ VioScrollDn (0, 0, word (-1), word (-1), word (-1), PWord (@EmptyCell)^, 0);
|
|
|
+ Move (VideoBuf^, OldVideoBuf^, VideoBufSize);
|
|
|
end;
|
|
|
|
|
|
|
|
|
@@ -360,91 +354,128 @@ procedure SysUpdateScreen (Force: boolean);
|
|
|
var SOfs, CLen: cardinal;
|
|
|
|
|
|
begin
|
|
|
- if LockUpdateScreen = 0 then
|
|
|
- begin
|
|
|
- if not (Force) then
|
|
|
- asm
|
|
|
- cld
|
|
|
- mov esi, VideoBuf
|
|
|
- mov edi, OldVideoBuf
|
|
|
- mov eax, VideoBufSize
|
|
|
- mov ecx, eax
|
|
|
- shr ecx, 1
|
|
|
- shr ecx, 1
|
|
|
- repe
|
|
|
- cmpsd
|
|
|
- je @no_update
|
|
|
- inc ecx
|
|
|
- mov edx, eax
|
|
|
- mov ebx, ecx
|
|
|
- shl ebx, 1
|
|
|
- shl ebx, 1
|
|
|
- sub edx, ebx
|
|
|
- mov SOfs, edx
|
|
|
- mov Force, 1
|
|
|
- std
|
|
|
- mov edi, eax
|
|
|
- mov esi, VideoBuf
|
|
|
- add eax, esi
|
|
|
- sub eax, 4
|
|
|
- mov esi, eax
|
|
|
- mov eax, OldVideoBuf
|
|
|
- add eax, edi
|
|
|
- sub eax, 4
|
|
|
- mov edi, eax
|
|
|
- repe
|
|
|
- cmpsd
|
|
|
- inc ecx
|
|
|
- shl ecx, 1
|
|
|
- shl ecx, 1
|
|
|
- mov CLen, ecx
|
|
|
+ if not (Force) then
|
|
|
+ asm
|
|
|
+ cld
|
|
|
+ mov esi, VideoBuf
|
|
|
+ mov edi, OldVideoBuf
|
|
|
+ mov eax, VideoBufSize
|
|
|
+ mov ecx, eax
|
|
|
+ shr ecx, 1
|
|
|
+ shr ecx, 1
|
|
|
+ repe
|
|
|
+ cmpsd
|
|
|
+ je @no_update
|
|
|
+ inc ecx
|
|
|
+ mov edx, eax
|
|
|
+ mov ebx, ecx
|
|
|
+ shl ebx, 1
|
|
|
+ shl ebx, 1
|
|
|
+ sub edx, ebx
|
|
|
+ mov SOfs, edx
|
|
|
+ mov Force, 1
|
|
|
+ std
|
|
|
+ mov edi, eax
|
|
|
+ mov esi, VideoBuf
|
|
|
+ add eax, esi
|
|
|
+ sub eax, 4
|
|
|
+ mov esi, eax
|
|
|
+ mov eax, OldVideoBuf
|
|
|
+ add eax, edi
|
|
|
+ sub eax, 4
|
|
|
+ mov edi, eax
|
|
|
+ repe
|
|
|
+ cmpsd
|
|
|
+ inc ecx
|
|
|
+ shl ecx, 1
|
|
|
+ shl ecx, 1
|
|
|
+ mov CLen, ecx
|
|
|
@no_update:
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- SOfs := 0;
|
|
|
- CLen := VideoBufSize;
|
|
|
- end;
|
|
|
- if Force then
|
|
|
- begin
|
|
|
- VioShowBuf (SOfs, CLen, 0);
|
|
|
- Move (VideoBuf^ [SOfs div SizeOf (TVideoCell)],
|
|
|
- OldVideoBuf^ [SOfs div SizeOf (TVideoCell)], CLen);
|
|
|
- end;
|
|
|
- end;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ SOfs := 0;
|
|
|
+ CLen := VideoBufSize;
|
|
|
+ end;
|
|
|
+ // .MVC. Move video buffer to system video buffer.
|
|
|
+ Move(VideoBuf^,SysVideoBuf^,VideoBufSize);
|
|
|
+ if Force then
|
|
|
+ begin
|
|
|
+ VioShowBuf (SOfs, CLen, 0);
|
|
|
+ Move (VideoBuf^ [SOfs div SizeOf (TVideoCell)],
|
|
|
+ OldVideoBuf^ [SOfs div SizeOf (TVideoCell)], CLen);
|
|
|
+ end;
|
|
|
end;
|
|
|
|
|
|
Const
|
|
|
SysVideoDriver : TVideoDriver = (
|
|
|
- InitDriver : @SysInitVideo;
|
|
|
- DoneDriver : @SysDoneVideo;
|
|
|
- UpdateScreen : @SysUpdateScreen;
|
|
|
- ClearScreen : @SysClearScreen;
|
|
|
- SetVideoMode : Nil;
|
|
|
- HasVideoMode : Nil;
|
|
|
- SetCursorPos : @SysSetCursorPos;
|
|
|
- GetCursorType : @SysGetCursorType;
|
|
|
- SetCursorType : @SysSetCursorType;
|
|
|
- GetCapabilities : @SysGetCapabilities
|
|
|
+ InitDriver : @SysInitVideo;
|
|
|
+ DoneDriver : @SysDoneVideo;
|
|
|
+ UpdateScreen : @SysUpdateScreen;
|
|
|
+ ClearScreen : @SysClearScreen;
|
|
|
+ SetVideoMode : @SysSetVideoMode;
|
|
|
+ GetVideoModeCount : @SysGetVideoModeCount;
|
|
|
+ GetVideoModeData : @SysGetVideoModedata;
|
|
|
+ SetCursorPos : @SysSetCursorPos;
|
|
|
+ GetCursorType : @SysGetCursorType;
|
|
|
+ SetCursorType : @SysSetCursorType;
|
|
|
+ GetCapabilities : @SysGetCapabilities
|
|
|
);
|
|
|
|
|
|
+procedure TargetEntry;
|
|
|
+
|
|
|
+var
|
|
|
+ PScr: pointer;
|
|
|
+
|
|
|
+begin
|
|
|
+{Remember original video mode, cursor type and high bit behaviour setting}
|
|
|
+ OrigVioMode.cb := SizeOf (OrigVioMode);
|
|
|
+ VioGetMode (OrigVioMode, 0);
|
|
|
+ VioGetCurType (OrigCurType, 0);
|
|
|
+ VioGetCurPos (OrigCurRow, OrigCurCol, 0);
|
|
|
+ with OrigHighBit do
|
|
|
+ begin
|
|
|
+ cb := 6;
|
|
|
+ rType := 2;
|
|
|
+ end;
|
|
|
+ VioGetState (OrigHighBit, 0);
|
|
|
+ { Register the curent video mode in reserved slot in System Modes}
|
|
|
+ with OrigVioMode do
|
|
|
+ begin
|
|
|
+ {Assume we have at least 16 colours available in "colour" modes}
|
|
|
+ SysVMD[SysVideoModeCount-1].Col:=Col;
|
|
|
+ SysVMD[SysVideoModeCount-1].Row:=Row;
|
|
|
+ SysVMD[SysVideoModeCount-1].Color:=(Color >= Colors_16);
|
|
|
+ end;
|
|
|
+ {Get the address of the original videobuffer and size.}
|
|
|
+ if VioGetBuf (PScr, PWord (@OrigScreenSize)^, 0) = 0 then
|
|
|
+ begin
|
|
|
+ PScr := SelToFlat (TFarPtr (PScr));
|
|
|
+ GetMem (OrigScreen, OrigScreenSize);
|
|
|
+ Move (PScr^, OrigScreen^, OrigScreenSize);
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+
|
|
|
initialization
|
|
|
SetVideoDriver(SysVideoDriver);
|
|
|
- RegisterVideoModes;
|
|
|
TargetEntry;
|
|
|
-
|
|
|
-finalization
|
|
|
- UnRegisterVideoModes;
|
|
|
end.
|
|
|
|
|
|
{
|
|
|
$Log$
|
|
|
- Revision 1.5 2001-09-21 19:50:19 michael
|
|
|
+ Revision 1.6 2001-10-06 22:28:24 michael
|
|
|
+ + Merged video mode selection/setting system
|
|
|
+
|
|
|
+ Revision 1.5 2001/09/21 19:50:19 michael
|
|
|
+ Merged driver support from fixbranch
|
|
|
|
|
|
Revision 1.4 2001/02/04 01:55:05 hajny
|
|
|
* one more correction (not crucial)
|
|
|
|
|
|
+ Revision 1.2.2.4 2001/10/06 22:23:40 michael
|
|
|
+ + Better video mode selection/setting system
|
|
|
+
|
|
|
Revision 1.2.2.3 2001/09/21 18:42:08 michael
|
|
|
+ Implemented support for custom video drivers.
|
|
|
|
michael