+ Merged driver support from fixbranch

rtl/go32v2/video.pp

@@ -4,7 +4,7 @@
     Copyright (c) 1999-2000 by Florian Klaempfl
     member of the Free Pascal development team
 
-    Video unit for linux
+    Video unit for DOS
 
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
@@ -58,9 +58,11 @@ var r: trealregs;
     L: longint;
     LSel,LSeg: word;
     B: array[0..63] of byte;
-type TWord = word; PWord = ^TWord;
-var Size: word;
-    OK: boolean;
+type
+  TWord = word;
+  PWord = ^TWord;
+var
+  OK: boolean;
 begin
   L:=global_dos_alloc(64);
   LSeg:=(L shr 16);
@@ -80,7 +82,7 @@ begin
   BIOSGetScreenMode:=OK;
 end;
 
-procedure InitVideo;
+procedure SysInitVideo;
 var
   regs : trealregs;
 begin
@@ -122,7 +124,6 @@ begin
   VideoBufSize:=ScreenWidth*ScreenHeight*2;
   GetMem(VideoBuf,VideoBufSize);
   GetMem(OldVideoBuf,VideoBufSize);
-  InitVideoCalled:=true;
   SetHighBitBlink;
   SetCursorType(LastCursorType);
   { ClearScreen; removed here
@@ -130,31 +131,27 @@ begin
 end;
 
 
-procedure DoneVideo;
+procedure SysDoneVideo;
 begin
-  If InitVideoCalled then
-    Begin
-      LastCursorType:=GetCursorType;
-      ClearScreen;
-      SetCursorType(crUnderLine);
-      SetCursorPos(0,0);
-      FreeMem(VideoBuf,VideoBufSize);
-      VideoBuf:=nil;
-      FreeMem(OldVideoBuf,VideoBufSize);
-      OldVideoBuf:=nil;
-      InitVideoCalled:=false;
-      VideoBufSize:=0;
-    End;
+  LastCursorType:=GetCursorType;
+  ClearScreen;
+  SetCursorType(crUnderLine);
+  SetCursorPos(0,0);
+  FreeMem(VideoBuf,VideoBufSize);
+  VideoBuf:=nil;
+  FreeMem(OldVideoBuf,VideoBufSize);
+  OldVideoBuf:=nil;
+  VideoBufSize:=0;
 end;
 
 
-function GetCapabilities: Word;
+function SysGetCapabilities: Word;
 begin
-  GetCapabilities := $3F;
+  SysGetCapabilities := $3F;
 end;
 
 
-procedure SetCursorPos(NewCursorX, NewCursorY: Word);
+procedure SysSetCursorPos(NewCursorX, NewCursorY: Word);
 var
   regs : trealregs;
 begin
@@ -170,28 +167,28 @@ end;
 { I don't know the maximum value for the scan line
   probably 7 or 15 depending on resolution !!
   }
-function GetCursorType: Word;
+function SysGetCursorType: Word;
 var
   regs : trealregs;
 begin
   regs.ah:=$03;
   regs.bh:=0;
   realintr($10,regs);
-  GetCursorType:=crHidden;
+  SysGetCursorType:=crHidden;
   if (regs.ch and $60)=0 then
    begin
-     GetCursorType:=crBlock;
+     SysGetCursorType:=crBlock;
      if (regs.ch and $1f)<>0 then
       begin
-        GetCursorType:=crHalfBlock;
+        SysGetCursorType:=crHalfBlock;
         if regs.cl+1=(regs.ch and $1F) then
-         GetCursorType:=crUnderline;
+         SysGetCursorType:=crUnderline;
       end;
    end;
 end;
 
 
-procedure SetCursorType(NewType: Word);
+procedure SysSetCursorType(NewType: Word);
 var
   regs : trealregs;
 const
@@ -254,14 +251,14 @@ begin
   DoCustomMouse(false);
 end;
 
-procedure ClearScreen;
+procedure SysClearScreen;
 begin
   FillWord(VideoBuf^,VideoBufSize shr 1,$0720);
   UpdateScreen(true);
 end;
 
 
-procedure UpdateScreen(Force: Boolean);
+procedure SysUpdateScreen(Force: Boolean);
 begin
   if LockUpdateScreen<>0 then
    exit;
@@ -294,8 +291,22 @@ begin
   RegisterVideoMode(80, 50, True, @VideoModeSelector8x8, 0);
 end;
 
+Const
+  SysVideoDriver : TVideoDriver = (
+    InitDriver : @SysInitVideo;
+    DoneDriver : @SysDoneVideo;
+    UpdateScreen : @SysUpdateScreen;
+    ClearScreen : @SysClearScreen;
+    SetVideoMode : Nil;
+    HasVideoMode : Nil;
+    SetCursorPos : @SysSetCursorPos;
+    GetCursorType : @SysGetCursorType;
+    SetCursorType : @SysSetCursorType;
+    GetCapabilities : @SysGetCapabilities
+  );
 
 initialization
+  SetVideoDriver(SysVideoDriver);
   RegisterVideoModes;
 
 finalization
@@ -303,9 +314,25 @@ finalization
 end.
 {
   $Log$
-  Revision 1.2  2001-05-09 19:53:28  peter
+  Revision 1.3  2001-09-21 19:50:18  michael
+  + Merged driver support from fixbranch
+
+
+  Revision 1.2  2001/05/09 19:53:28  peter
     * removed asm for copy, use dosmemput (merged)
 
+  Revision 1.1.2.4  2001/09/21 18:42:08  michael
+  + Implemented support for custom video drivers.
+
+  Revision 1.1.2.3  2001/05/06 21:54:23  carl
+  * bugfix of Windows NT double exception crash
+
+  Revision 1.1.2.2  2001/04/16 10:56:13  peter
+    * fixes for stricter compiler
+
+  Revision 1.1.2.1  2001/01/30 21:52:01  peter
+    * moved api utils to rtl
+
   Revision 1.1  2001/01/13 11:03:58  peter
     * API 2 RTL commit
 

rtl/inc/video.inc

@@ -12,6 +12,128 @@
 
  **********************************************************************}
 
+Const
+  LockUpdateScreen : Integer = 0;
+
+Procedure LockScreenUpdate;
+
+begin
+  Inc(LockUpdateScreen);
+end;
+
+Procedure UnLockScreenUpdate;
+
+begin
+  Dec(LockUpdateScreen);
+end;
+
+Var 
+  CurrentVideoDriver : TVideoDriver;
+
+Const
+  VideoInitialized : Boolean = False;
+  
+Procedure SetVideoDriver (Const Driver : TVideoDriver);
+{ Sets the videodriver to be used }
+begin
+  If Not VideoInitialized then
+    CurrentVideoDriver:=Driver;
+end;
+
+Procedure GetVideoDriver (Var Driver : TVideoDriver);
+{ Retrieves the current videodriver }                                           
+begin
+  Driver:=CurrentVideoDriver;
+end;
+
+{ ---------------------------------------------------------------------
+  External functions that use the video driver.
+  ---------------------------------------------------------------------}
+
+Procedure InitVideo;
+
+begin
+  If Not VideoInitialized then
+    begin
+    If Assigned(CurrentVideoDriver.InitDriver) then
+      CurrentVideoDriver.InitDriver;
+    VideoInitialized:=True;  
+    end;  
+end;
+
+Procedure DoneVideo;
+
+begin
+  If VideoInitialized then
+    begin
+    If Assigned(CurrentVideoDriver.DoneDriver) then
+      CurrentVideoDriver.DoneDriver;
+    VideoInitialized:=False;  
+    end;  
+end;
+
+Procedure UpdateScreen (Force : Boolean);
+
+begin
+  If (LockUpdateScreen<=0) and
+     Assigned(CurrentVideoDriver.UpdateScreen) then
+      CurrentVideoDriver.UpdateScreen(Force);  
+end;
+
+Procedure ClearScreen;
+
+begin
+  If Assigned(CurrentVideoDriver.ClearScreen) then
+    CurrentVideoDriver.ClearScreen
+  else
+    begin
+    FillWord(VideoBuf^,VideoBufSize shr 1,$0720);
+    UpdateScreen(True);
+    // Is this needed ? 
+    {
+    CurrentX:=1;
+    CurrentY:=1;
+    }
+    end;
+end;
+
+Procedure SetCursorType (NewType : Word);
+
+begin
+  if Assigned(CurrentVideoDriver.SetCursorType) then
+    CurrentVideoDriver.SetCursorType(NewType)
+end;
+
+Function GetCursorType : Word;
+
+begin
+  if Assigned(CurrentVideoDriver.GetCursorType) then
+    GetCursorType:=CurrentVideoDriver.GetCursorType()
+  else
+    GetCursorType:=0;
+end;
+
+procedure SetCursorPos(NewCursorX, NewCursorY: Word);
+
+begin
+  If Assigned(CurrentVideoDriver.SetCursorPos) then
+    CurrentVideoDriver.SetCursorPos(NewCursorX, NewCursorY)
+end;
+
+function GetCapabilities: Word;
+begin
+  If Assigned(CurrentVideoDriver.GetCapabilities) then
+    GetCapabilities:=CurrentVideoDriver.GetCapabilities()
+  else
+    GetCapabilities:=0;  
+end;
+    
+
+{ ---------------------------------------------------------------------
+    General functions
+  ---------------------------------------------------------------------}
+  
+
 procedure GetVideoMode(var Mode: TVideoMode);
 begin
   Mode.Col := ScreenWidth;
@@ -19,6 +141,8 @@ begin
   Mode.Color := ScreenColor;
 end;
 
+
+
 procedure SetVideoMode(Mode: TVideoMode);
 var
   P: PVideoModeList;
@@ -72,9 +196,20 @@ begin
   DefaultErrorHandler := errAbort; { return error code }
 end;
 
+
+
 {
   $Log$
-  Revision 1.1  2001-01-13 11:13:12  peter
+  Revision 1.2  2001-09-21 19:50:18  michael
+  + Merged driver support from fixbranch
+
+  Revision 1.1.2.2  2001/09/21 18:42:08  michael
+  + Implemented support for custom video drivers.
+
+  Revision 1.1.2.1  2001/01/30 22:21:22  peter
+    * move api to rtl
+
+  Revision 1.1  2001/01/13 11:13:12  peter
     * API 2 RTL
 
 }

rtl/inc/videoh.inc

@@ -26,6 +26,19 @@ type
   TVideoBuf = array[0..32759] of TVideoCell;
   PVideoBuf = ^TVideoBuf;
 
+  TVideoDriver = Record
+    InitDriver      : Procedure;
+    DoneDriver      : Procedure;
+    UpdateScreen    : Procedure(Force : Boolean);
+    ClearScreen     : Procedure;
+    SetVideoMode    : Procedure (Const Mode : TVideoMode; Params : Longint);
+    HasVideoMode    : Function (Const Mode : TVideoMode; Params : Longint) : Boolean; 
+    SetCursorPos    : procedure (NewCursorX, NewCursorY: Word);
+    GetCursorType   : function : Word;
+    SetCursorType   : procedure (NewType: Word);
+    GetCapabilities : Function : Word; 
+  end;
+
 const
   { Foreground and background color constants }
   Black         = 0;
@@ -80,15 +93,24 @@ var
   ScreenColor  : Boolean;
   CursorX,
   CursorY      : Word;
-  LockUpdateScreen : Word;
   VideoBuf     : PVideoBuf;
   VideoBufSize : Longint;
   CursorLines  : Byte;
+
 const
   LowAscii     : Boolean = true;
   NoExtendedFrame : Boolean = false;
   FVMaxWidth = 132;
 
+Procedure LockScreenUpdate;
+{ Increments the screen update lock count with one.}
+Procedure UnlockScreenUpdate;
+{ Decrements the screen update lock count with one.}
+Procedure SetVideoDriver (Const Driver : TVideoDriver);
+{ Sets the videodriver to be used }
+Procedure GetVideoDriver (Var Driver : TVideoDriver);
+{ Retrieves the current videodriver }
+
 procedure InitVideo;
 { Initializes the video subsystem }
 procedure DoneVideo;
@@ -152,7 +174,15 @@ const
 
 {
   $Log$
-  Revision 1.2  2001-06-06 17:20:22  jonas
+  Revision 1.3  2001-09-21 19:50:18  michael
+  + Merged driver support from fixbranch
+
+  Revision 1.2  2001/06/06 17:20:22  jonas
+
+  Revision 1.1.2.3  2001/09/21 18:42:08  michael
+  + Implemented support for custom video drivers.
+
+  Revision 1.1.2.2  2001/06/06 14:27:14  jonas
     * fixed wrong typed constant procvars in preparation of my fix which will
       disallow them in FPC mode (plus some other unmerged changes since
       LAST_MERGE)

rtl/os2/video.pp

@@ -29,7 +29,6 @@ uses
 
 
 const
-    InitVideoCalled: boolean = false;
     LastCursorType: word = crUnderline;
     EmptyCell: cardinal = $0720;
     OrigScreen: PVideoBuf = nil;
@@ -141,41 +140,39 @@ begin
 end;
 
 
-procedure InitVideo;
+procedure SysInitVideo;
 
 var MI: TVioModeInfo;
 
 begin
-    if InitVideoCalled then
-        FreeMem (OldVideoBuf, VideoBufSize);
-    OldVideoBuf := nil;
-    InitVideoCalled := true;
-    VideoBufSize := 0;
-    MI.cb := SizeOf (MI);
-    VioGetMode (MI, 0);
-    with MI do
-        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
-    else
-        ErrorHandler (errVioInit, nil);
+  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;
+  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
+  else
+      ErrorHandler (errVioInit, nil);
 end;
 
 
-procedure SetCursorPos (NewCursorX, NewCursorY: word);
+procedure SysSetCursorPos (NewCursorX, NewCursorY: word);
 
 begin
     if VioSetCurPos (NewCursorY, NewCursorX, 0) = 0 then
@@ -191,7 +188,7 @@ begin
 end;
 
 
-function GetCursorType: word;
+function SysGetCursorType: word;
 
 var CD: TVioCursorInfo;
 
@@ -201,24 +198,24 @@ begin
         begin
             CursorLines := Succ (cEnd) - yStart;
             if Attr = word (-1) then
-                GetCursorType := crHidden
+                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.}
-                    GetCursorType := crHidden
+                    SysGetCursorType := crHidden
                 else if CursorLines <= Succ (CellHeight div 4) then
-                    GetCursorType := crUnderline
+                    SysGetCursorType := crUnderline
                 else if CursorLines <= Succ (CellHeight div 2) then
-                    GetCursorType := crHalfBlock
+                    SysGetCursorType := crHalfBlock
                 else
-                    GetCursorType := crBlock;
+                    SysGetCursorType := crBlock;
         end;
 end;
 
 
-procedure SetCursorType (NewType: word);
+procedure SysSetCursorType (NewType: word);
 
 var CD: TVioCursorInfo;
 
@@ -254,14 +251,12 @@ begin
 end;
 
 
-procedure DoneVideo;
+procedure SysDoneVideo;
 
 var PScr: pointer;
     ScrSize: cardinal;
 
 begin
-    if InitVideoCalled then
-        begin
             LastCursorType := GetCursorType;
             ClearScreen;
 {Restore original settings}
@@ -275,7 +270,6 @@ begin
             FreeMem (OldVideoBuf, VideoBufSize);
             OldVideoBuf := nil;
             VideoBufSize := 0;
-            InitVideoCalled := false;
             if (OrigScreenSize <> 0) and (OrigScreen <> nil) then
                 begin
                     ScrSize := 0;
@@ -287,14 +281,13 @@ begin
                             VioShowBuf (0, ScrSize, 0);
                         end;
                 end;
-        end;
 end;
 
 
-function GetCapabilities: word;
+function SysGetCapabilities: word;
 
 begin
-    GetCapabilities := $3F;
+  SysGetCapabilities := $3F;
 end;
 
 
@@ -352,7 +345,7 @@ begin
 end;
 
 
-procedure ClearScreen;
+procedure SysClearScreen;
 
 begin
     VioScrollDn (0, 0, word (-1), word (-1), word (-1), PWord (@EmptyCell)^, 0);
@@ -362,7 +355,7 @@ end;
 
 {$ASMMODE INTEL}
 
-procedure UpdateScreen (Force: boolean);
+procedure SysUpdateScreen (Force: boolean);
 
 var SOfs, CLen: cardinal;
 
@@ -421,7 +414,22 @@ begin
         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
+  );
+
 initialization
+  SetVideoDriver(SysVideoDriver);
   RegisterVideoModes;
   TargetEntry;
 
@@ -431,9 +439,18 @@ end.
 
 {
   $Log$
-  Revision 1.4  2001-02-04 01:55:05  hajny
+  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.3  2001/09/21 18:42:08  michael
+  + Implemented support for custom video drivers.
+
+  Revision 1.2.2.2  2001/02/04 02:02:28  hajny
+    * corrections from the main branch merged
+
   Revision 1.3  2001/02/01 21:35:36  hajny
     * correction of a previously introduced bug
 

rtl/unix/video.pp

@@ -1,5 +1,6 @@
 {
     $Id$
+
     This file is part of the Free Pascal run time library.
     Copyright (c) 1999-2000 by Florian Klaempfl
     member of the Free Pascal development team
@@ -46,6 +47,7 @@ const
 {$endif I386}
 
 const
+
   can_delete_term : boolean = false;
   ACSIn : string = '';
   ACSOut : string = '';
@@ -554,7 +556,7 @@ begin
   restoreRawSettings(preInitVideoTio);
 end;
 
-procedure InitVideo;
+procedure SysInitVideo;
 const
   fontstr : string[3]=#27'(K';
 var
@@ -671,7 +673,7 @@ begin
    ErrorCode:=errVioInit; { not a TTY }
 end;
 
-procedure DoneVideo;
+procedure SysDoneVideo;
 begin
   if VideoBufSize=0 then
    exit;
@@ -705,7 +707,7 @@ begin
 end;
 
 
-procedure ClearScreen;
+procedure SysClearScreen;
 begin
   FillWord(VideoBuf^,VideoBufSize shr 1,$0720);
   if Console then
@@ -718,14 +720,12 @@ begin
 end;
 
 
-procedure UpdateScreen(Force: Boolean);
+procedure SysUpdateScreen(Force: Boolean);
 var
   DoUpdate : boolean;
   i : longint;
   p1,p2 : plongint;
 begin
-  if LockUpdateScreen<>0 then
-   exit;
   if not force then
    begin
 {$ifdef i386}
@@ -772,14 +772,14 @@ begin
 end;
 
 
-function GetCapabilities: Word;
+function SysGetCapabilities: Word;
 begin
 { about cpColor... we should check the terminfo database... }
-  GetCapabilities:=cpUnderLine + cpBlink + cpColor;
+  SysGetCapabilities:=cpUnderLine + cpBlink + cpColor;
 end;
 
 
-procedure SetCursorPos(NewCursorX, NewCursorY: Word);
+procedure SysSetCursorPos(NewCursorX, NewCursorY: Word);
 var
   Pos : array [1..2] of Byte;
 begin
@@ -800,13 +800,13 @@ begin
 end;
 
 
-function GetCursorType: Word;
+function SysGetCursorType: Word;
 begin
-  GetCursorType:=LastCursorType;
+  SysGetCursorType:=LastCursorType;
 end;
 
 
-procedure SetCursorType(NewType: Word);
+procedure SysSetCursorType(NewType: Word);
 begin
   LastCursorType:=NewType;
   case NewType of
@@ -839,7 +839,22 @@ procedure RegisterVideoModes;
 begin
 end;
 
+Const
+  SysVideoDriver : TVideoDriver = (
+    InitDriver : @SysInitVideo;
+    DoneDriver : @SysDoneVideo;
+    UpdateScreen : @SysUpdateScreen;
+    ClearScreen : @SysClearScreen;
+    SetVideoMode : Nil;
+    HasVideoMode : Nil;
+    SetCursorPos : @SysSetCursorPos;
+    GetCursorType : @SysGetCursorType;
+    SetCursorType : @SysSetCursorType;
+    GetCapabilities : @SysGetCapabilities
+  );
+
 initialization
+  SetVideoDriver(SysVideoDriver);
   RegisterVideoModes;
 
 finalization
@@ -847,7 +862,10 @@ finalization
 end.
 {
   $Log$
-  Revision 1.7  2001-08-30 20:55:08  peter
+  Revision 1.8  2001-09-21 19:50:19  michael
+  + Merged driver support from fixbranch
+
+  Revision 1.7  2001/08/30 20:55:08  peter
     * v10 merges
 
   Revision 1.6  2001/08/01 21:42:05  peter
@@ -859,6 +877,27 @@ end.
   Revision 1.4  2001/07/30 21:38:55  peter
     * m68k updates merged
 
+  Revision 1.2.2.8  2001/09/21 18:42:09  michael
+  + Implemented support for custom video drivers.
+
+  Revision 1.2.2.7  2001/08/28 12:23:15  pierre
+   * set skipped to true if changing line and force is false to avoid problems if terminal reports less columns as available
+
+  Revision 1.2.2.6  2001/08/01 10:50:59  pierre
+   * avoid warning for m68k cpu
+
+  Revision 1.2.2.5  2001/07/30 23:34:51  pierre
+   * make tchattr record endian dependant
+
+  Revision 1.2.2.4  2001/07/29 20:25:18  pierre
+   * fix wrong deref in generic compare code
+
+  Revision 1.2.2.3  2001/07/13 14:49:08  pierre
+   + implement videobuf comparaison for non i386 cpus
+
+  Revision 1.2.2.2  2001/01/30 22:23:44  peter
+    * unix back to linux
+
   Revision 1.3  2001/07/13 22:05:09  peter
     * cygwin updates
 

rtl/win32/video.pp

@@ -32,13 +32,10 @@ var
   ConsoleCursorInfo : TConsoleCursorInfo;
   MaxVideoBufSize : DWord;
 
-const
-  VideoInitialized : boolean = false;
 
-procedure InitVideo;
+procedure SysInitVideo;
+
 begin
-  if VideoInitialized then
-    DoneVideo;
   ScreenColor:=true;
   GetConsoleScreenBufferInfo(TextRec(Output).Handle, ConsoleInfo);
   GetConsoleCursorInfo(TextRec(Output).Handle, ConsoleCursorInfo);
@@ -78,30 +75,26 @@ begin
 
   GetMem(VideoBuf,MaxVideoBufSize);
   GetMem(OldVideoBuf,MaxVideoBufSize);
-  VideoInitialized:=true;
 end;
 
 
-procedure DoneVideo;
+procedure SysDoneVideo;
 begin
   SetCursorType(crUnderLine);
-  if VideoInitialized then
-    begin
-      FreeMem(VideoBuf,MaxVideoBufSize);
-      FreeMem(OldVideoBuf,MaxVideoBufSize);
-    end;
+  FreeMem(VideoBuf,MaxVideoBufSize);
+  FreeMem(OldVideoBuf,MaxVideoBufSize);
   VideoBufSize:=0;
   VideoInitialized:=false;
 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);
 var
   pos : COORD;
 begin
@@ -113,24 +106,24 @@ begin
 end;
 
 
-function GetCursorType: Word;
+function SysGetCursorType: Word;
 begin
    GetConsoleCursorInfo(TextRec(Output).Handle,ConsoleCursorInfo);
    if not ConsoleCursorInfo.bvisible then
-     GetCursorType:=crHidden
+     SysGetCursorType:=crHidden
    else
      case ConsoleCursorInfo.dwSize of
         1..30:
-          GetCursorType:=crUnderline;
+          SysGetCursorType:=crUnderline;
         31..70:
-          GetCursorType:=crHalfBlock;
+          SysGetCursorType:=crHalfBlock;
         71..100:
-          GetCursorType:=crBlock;
+          SysGetCursorType:=crBlock;
      end;
 end;
 
 
-procedure SetCursorType(NewType: Word);
+procedure SysSetCursorType(NewType: Word);
 begin
    GetConsoleCursorInfo(TextRec(Output).Handle,ConsoleCursorInfo);
    if newType=crHidden then
@@ -159,7 +152,7 @@ begin
 end;
 
 
-procedure ClearScreen;
+procedure SysClearScreen;
 begin
   FillWord(VideoBuf^,VideoBufSize div 2,$0720);
   UpdateScreen(true);
@@ -171,7 +164,7 @@ function WriteConsoleOutput(hConsoleOutput:HANDLE; lpBuffer:pointer; dwBufferSiz
    var lpWriteRegion:SMALL_RECT):WINBOOL; external 'kernel32' name 'WriteConsoleOutputA';
 {$ENDIF}
 
-procedure UpdateScreen(Force: Boolean);
+procedure SysUpdateScreen(Force: Boolean);
 type TmpRec = Array[0..(1024*32) - 1] of TCharInfo;
 
 type WordRec = record
@@ -242,8 +235,6 @@ var
    x1,y1,x2,y2 : longint;
 
 begin
-  if LockUpdateScreen<>0 then
-   exit;
   if force then
    smallforce:=true
   else
@@ -357,8 +348,23 @@ begin
   RegisterVideoMode(80, 25, True, @DefaultVideoModeSelector, $00000003);
 end;
 
+Const
+  SysVideoDriver : TVideoDriver = (
+    InitDriver : @SysInitVideo;
+    DoneDriver : @SysDoneVideo;
+    UpdateScreen : @SysUpdateScreen;
+    ClearScreen : @SysClearScreen;
+    SetVideoMode : Nil;
+    HasVideoMode : Nil;
+    SetCursorPos : @SysSetCursorPos;
+    GetCursorType : @SysGetCursorType;
+    SetCursorType : @SysSetCursorType;
+    GetCapabilities : @SysGetCapabilities
+
+  );
 
 initialization
+  SetVideoDriver(SysVideoDriver);
   RegisterVideoModes;
 
 finalization
@@ -366,7 +372,10 @@ finalization
 end.
 {
   $Log$
-  Revision 1.5  2001-08-01 18:01:20  peter
+  Revision 1.6  2001-09-21 19:50:19  michael
+  + Merged driver support from fixbranch
+
+  Revision 1.5  2001/08/01 18:01:20  peter
     * WChar fix to compile also with 1.0.x
 
   Revision 1.4  2001/07/30 15:01:12  marco
@@ -378,6 +387,21 @@ end.
   Revision 1.2  2001/04/10 21:28:36  peter
     * removed warnigns
 
+  Revision 1.1.2.5  2001/09/21 18:42:09  michael
+  + Implemented support for custom video drivers.
+
+  Revision 1.1.2.4  2001/06/12 22:34:20  pierre
+   * avoid crash at exit of IDE
+
+  Revision 1.1.2.3  2001/04/10 20:33:04  peter
+    * remove some warnings
+
+  Revision 1.1.2.2  2001/04/02 13:29:41  pierre
+   * avoid crash if DoneVideo called twice
+
+  Revision 1.1.2.1  2001/01/30 21:52:03  peter
+    * moved api utils to rtl
+
   Revision 1.1  2001/01/13 11:03:59  peter
     * API 2 RTL commit