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

* make it compilable with fpc 1.1

Browse Source
This commit is contained in:
armin 2002-03-08 19:12:09 +00:00
parent c500543105
commit e03cdd1f5c
1 changed files with 53 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

81
rtl/netware/video.pp
View File

@ -14,7 +14,8 @@
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************} **********************************************************************}
{ 2001/04/16 armin: first version for netware } { 2001/04/16 armin: first version for netware
2002/02/26 armin: changes for current fpc }
unit Video; unit Video;
interface interface
@ -29,12 +30,11 @@ uses
{$i nwsys.inc} {$i nwsys.inc}
var var
OldVideoBuf : PVideoBuf;
MaxVideoBufSize : DWord; MaxVideoBufSize : DWord;
VideoBufAllocated: boolean; VideoBufAllocated: boolean;
procedure InitVideo; procedure SysInitVideo;
VAR height,width : WORD; VAR height,width : WORD;
startline, endline : BYTE; startline, endline : BYTE;
begin begin
@ -74,7 +74,7 @@ begin
end; end;
procedure DoneVideo; procedure SysDoneVideo;
begin begin
{ ClearScreen; also not needed PM } { ClearScreen; also not needed PM }
SetCursorType(crUnderLine); SetCursorType(crUnderLine);
@ -89,33 +89,33 @@ begin
end; end;
function GetCapabilities: Word; function SysGetCapabilities: Word;
begin begin
GetCapabilities:=cpColor or cpChangeCursor; SysGetCapabilities:=cpColor or cpChangeCursor;
end; end;
procedure SetCursorPos(NewCursorX, NewCursorY: Word); procedure SysSetCursorPos(NewCursorX, NewCursorY: Word);
begin begin
_GotoXY (NewCursorX, NewCursorY); _GotoXY (NewCursorX, NewCursorY);
end; end;
function GetCursorType: Word; function SysGetCursorType: Word;
var startline, endline : byte; var startline, endline : byte;
begin begin
_GetCursorShape (startline, endline); _GetCursorShape (startline, endline);
CASE startline of CASE startline of
1 : GetCursorType := crBlock; 1 : SysGetCursorType := crBlock;
5 : GetCursorType := crHalfBlock 5 : SysGetCursorType := crHalfBlock
ELSE ELSE
GetCursorType := crUnderline; SysGetCursorType := crUnderline;
END; END;
{crHidden ?} {crHidden ?}
end; end;
procedure SetCursorType(NewType: Word); procedure SysSetCursorType(NewType: Word);
begin begin
if newType=crHidden then if newType=crHidden then
_HideInputCursor _HideInputCursor
@ -134,20 +134,14 @@ begin
end; end;
function DefaultVideoModeSelector(const VideoMode: TVideoMode; Params: Longint): Boolean; {procedure ClearScreen;
begin
DefaultVideoModeSelector:=true;
end;
procedure ClearScreen;
begin begin
FillWord(VideoBuf^,VideoBufSize div 2,$0720); FillWord(VideoBuf^,VideoBufSize div 2,$0720);
UpdateScreen(true); UpdateScreen(true);
end; end;}
procedure UpdateScreen(Force: Boolean); procedure SysUpdateScreen(Force: Boolean);
begin begin
if (LockUpdateScreen<>0) or (VideoBufSize = 0) then if (LockUpdateScreen<>0) or (VideoBufSize = 0) then
exit; exit;
@ -167,19 +161,50 @@ begin
_CopyToScreenMemory (ScreenHeight, ScreenWidth, VideoBuf, 0, 0); _CopyToScreenMemory (ScreenHeight, ScreenWidth, VideoBuf, 0, 0);
end; end;
procedure RegisterVideoModes;
Const
SysVideoModeCount = 1;
SysVMD : Array[0..SysVideoModeCount-1] of TVideoMode = (
(Col: 80; Row : 25; Color : True));
Function SysSetVideoMode (Const Mode : TVideoMode) : Boolean;
begin begin
{ don't know what to do for netware } SysSetVideoMode := ((Mode.Col = 80) AND (Mode.Row = 25) AND (Mode.Color));
RegisterVideoMode(80, 25, True, @DefaultVideoModeSelector, $00000003);
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;
Const
SysVideoDriver : TVideoDriver = (
InitDriver : @SysInitVideo;
DoneDriver : @SysDoneVideo;
UpdateScreen : @SysUpdateScreen;
ClearScreen : Nil;
SetVideoMode : @SysSetVideoMode;
GetVideoModeCount : @SysGetVideoModeCount;
GetVideoModeData : @SysGetVideoModedata;
SetCursorPos : @SysSetCursorPos;
GetCursorType : @SysGetCursorType;
SetCursorType : @SysSetCursorType;
GetCapabilities : @SysGetCapabilities
);
initialization initialization
VideoBufAllocated := false; VideoBufAllocated := false;
VideoBufSize := 0; VideoBufSize := 0;
RegisterVideoModes; SetVideoDriver (SysVideoDriver);
finalization
UnRegisterVideoModes;
end. end.