浏览代码

* make it compilable with fpc 1.1

armin 23 年之前
父节点
当前提交
e03cdd1f5c
共有 1 个文件被更改,包括 53 次插入28 次删除
  1. 53 28
      rtl/netware/video.pp

+ 53 - 28
rtl/netware/video.pp

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