+ implemented the video and mouse units for i8086-msdos

git-svn-id: trunk@37743 -

.gitattributes

@@ -7247,6 +7247,8 @@ packages/rtl-console/src/inc/video.inc svneol=native#text/plain
 packages/rtl-console/src/inc/videoh.inc svneol=native#text/plain
 packages/rtl-console/src/msdos/crt.pp svneol=native#text/plain
 packages/rtl-console/src/msdos/keyboard.pp svneol=native#text/plain
+packages/rtl-console/src/msdos/mouse.pp svneol=native#text/plain
+packages/rtl-console/src/msdos/video.pp svneol=native#text/plain
 packages/rtl-console/src/netware/crt.pp svneol=native#text/plain
 packages/rtl-console/src/netware/keyboard.pp svneol=native#text/plain
 packages/rtl-console/src/netware/mouse.pp svneol=native#text/plain

packages/rtl-console/fpmake.pp

@@ -13,11 +13,11 @@ Const
   UnixLikes = AllUnixOSes -[QNX];
 
   WinEventOSes = [win32,win64];
-  KVMAll       = [emx,go32v2,netware,netwlibc,os2,win32,win64,win16]+UnixLikes+AllAmigaLikeOSes;
+  KVMAll       = [emx,go32v2,msdos,netware,netwlibc,os2,win32,win64,win16]+UnixLikes+AllAmigaLikeOSes;
 
   // all full KVMers have crt too, except Amigalikes
-  CrtOSes      = KVMALL+[msdos,WatCom]-[aros,morphos,amiga];
+  CrtOSes      = KVMALL+[WatCom]-[aros,morphos,amiga];
-  KbdOSes      = KVMALL+[msdos];
+  KbdOSes      = KVMALL;
   VideoOSes    = KVMALL;
   MouseOSes    = KVMALL;
   TerminfoOSes = UnixLikes-[beos,haiku];
@@ -84,6 +84,7 @@ begin
        AddInclude('mouseh.inc');
        AddInclude('mouse.inc');
        AddUnit   ('winevent',[win32,win64]);
+       AddUnit   ('video',[go32v2,msdos]);
      end;
 
     T:=P.Targets.AddUnit('video.pp',VideoOSes);
@@ -94,6 +95,7 @@ begin
        AddInclude('videodata.inc',AllAmigaLikeOSes);
        AddInclude('convert.inc',AllUnixOSes);
        AddInclude('nwsys.inc',[netware]);
+       AddUnit   ('mouse',[go32v2,msdos]);
      end;
 
     T:=P.Targets.AddUnit('crt.pp',CrtOSes);

packages/rtl-console/src/msdos/mouse.pp

@@ -0,0 +1,561 @@
+{
+    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
+
+    Mouse unit for MS-DOS
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit Mouse;
+interface
+
+{$i mouseh.inc}
+
+{ tells the mouse unit to draw the mouse cursor itself }
+procedure DoCustomMouse(b : boolean);
+
+implementation
+
+uses
+  video,dos;
+
+{$i mouse.inc}
+
+
+var
+  CurrentMask : word;
+  MouseCallback : CodePointer;                       { Mouse call back ptr }
+const
+  { indicates whether the mouse cursor is visible when the mouse cursor is
+    drawn by this unit (i.e. drawmousecursor=true) }
+  CustomMouse_MouseIsVisible: boolean = false;
+  MousePresent : boolean = false;
+  First_try    : boolean = true;
+  drawmousecursor : boolean = false;
+
+  { CustomMouse_HideCount holds the hide count for the custom drawn mouse
+    cursor. Normally, when the mouse cursor is drawn by the int 33h mouse
+    driver (and not by this unit), the driver internally maintains a 'hide
+    counter', so that if you call HideMouse multiple times, you need to call
+    ShowMouse the same number of times. When the mouse cursor is customly
+    drawn by this unit, we use this variable in order to maintain the same
+    behaviour. }
+  CustomMouse_HideCount: smallint = 1;
+
+  { position where the mouse was drawn the last time }
+  oldmousex : smallint = -1;
+  oldmousey : smallint = -1;
+  mouselock : boolean = false;
+
+{ if the cursor is drawn by this the unit, we must be careful }
+{ when drawing while the interrupt handler is called          }
+procedure lockmouse;assembler;
+
+  asm
+  @@trylockagain:
+     mov     al,1
+     xchg    al,mouselock
+     or      al,al
+     jne     @@trylockagain
+  end;
+
+procedure unlockmouse;
+
+  begin
+     mouselock:=false;
+  end;
+
+
+procedure MouseInt;assembler;
+asm
+        push    ds
+        push    es
+        push    di
+        push    cx
+        push    dx
+{$ifdef FPC_MM_TINY}
+        push    cs
+        pop     ds
+{$else}
+        mov     di, SEG @DATA
+        mov     ds, di
+{$endif}
+        mov     mousebuttons,bl
+        mov     mousewherex,cx
+        mov     mousewherey,dx
+        shr     cx,1
+        shr     cx,1
+        shr     cx,1
+        shr     dx,1
+        shr     dx,1
+        shr     dx,1
+{$ifdef FPC_MM_HUGE}
+        mov     di, SEG ScreenWidth
+        mov     es, di
+        cmp     es:[ScreenWidth], 40
+{$else}
+        cmp     ScreenWidth, 40
+{$endif}
+        jne     @@morethan40cols
+        shr     cx,1
+@@morethan40cols:
+        { should we draw the mouse cursor? }
+        cmp     drawmousecursor, 0
+        je      @@mouse_nocursor
+        cmp     CustomMouse_MouseIsVisible, 0
+        je      @@mouse_nocursor
+        push    ax
+        push    bx
+{$ifdef FPC_MM_HUGE}
+        push    si
+{$endif}
+        { check lock }
+        mov     al, 1
+        xchg    al, mouselock
+        or      al, al
+        { don't update the cursor yet, because hide/showcursor is called }
+        jne     @@dont_draw
+
+        { calculate address of old mouse cursor }
+        mov     ax, oldmousey
+{$ifdef FPC_MM_HUGE}
+        { ES still points to the data segment of unit 'video' }
+        mov     si, es:[screenwidth]
+        imul    si
+{$else}
+        imul    screenwidth
+{$endif}
+        add     ax, oldmousex
+        shl     ax, 1
+        xchg    ax, bx
+        { load start of video buffer }
+{$ifdef FPC_MM_HUGE}
+        { ES still points to the data segment of unit 'video' }
+        mov     di, es:[videoseg]
+{$else}
+        mov     di, videoseg
+{$endif}
+        mov     es, di
+        { remove old cursor }
+        xor     byte ptr es:[bx], 7fh
+
+        { store position of old cursor }
+        mov     oldmousex, cx
+        mov     oldmousey, dx
+
+        { calculate address of new cursor }
+        mov     ax, dx
+{$ifdef FPC_MM_HUGE}
+        imul    si
+{$else}
+        imul    screenwidth
+{$endif}
+        add     ax, cx
+        shl     ax, 1
+        xchg    ax, bx
+        { draw new cursor }
+        xor     byte ptr es:[bx], 7fh
+
+        { unlock mouse }
+        mov     mouselock, 0
+
+@@dont_draw:
+{$ifdef FPC_MM_HUGE}
+        pop     si
+{$endif}
+        pop     bx
+        pop     ax
+@@mouse_nocursor:
+        cmp     PendingMouseEvents, MouseEventBufSize
+        je      @@mouse_exit
+{$if defined(FPC_MM_COMPACT) or defined(FPC_MM_LARGE) or defined(FPC_MM_HUGE)}
+        les     di, [PendingMouseTail]
+        mov     word ptr es:[di], bx
+        mov     word ptr es:[di+2], cx
+        mov     word ptr es:[di+4], dx
+        mov     word ptr es:[di+6], 0
+{$else}
+        mov     di, PendingMouseTail
+        mov     word ptr [di], bx
+        mov     word ptr [di+2], cx
+        mov     word ptr [di+4], dx
+        mov     word ptr [di+6], 0
+{$endif}
+        add     di, 8
+        lea     ax, PendingMouseEvent
+        add     ax, MouseEventBufSize*8
+        cmp     di, ax
+        jne     @@mouse_nowrap
+        lea     di, PendingMouseEvent
+@@mouse_nowrap:
+        mov     word ptr PendingMouseTail, di
+        inc     PendingMouseEvents
+@@mouse_exit:
+        pop     dx
+        pop     cx
+        pop     di
+        pop     es
+        pop     ds
+        retf
+end;
+
+PROCEDURE Mouse_Action (Mask : Word; P : CodePointer);
+VAR
+  Rg    : Registers;
+BEGIN
+  if (P <> MouseCallBack) or (Mask<>CurrentMask) then                        { Check func different }
+    begin
+      { Remove old calback }
+      if (CurrentMask <> 0) then
+      begin
+        Rg.AX := 12;                                   { Function id }
+        Rg.CX := 0;                                    { Zero mask register }
+        Rg.ES := 0;                                    { Zero proc seg }
+        Rg.DX := 0;                                    { Zero proc ofs }
+        Intr($33, Rg);                                 { Stop INT 33 callback }
+      end;
+      if P = nil then
+        Mask := 0;                                    { Zero mask register }
+      MouseCallback := P;                            { Set call back addr }
+      if Mask<>0 then
+        begin
+          Rg.AX := 12;                                   { Set function id }
+          Rg.CX := Mask;                                 { Set mask register }
+          If Mask<>0 then
+            begin
+              Rg.ES := Seg(P^);
+              Rg.DX := Ofs(P^);
+            end
+          else
+            begin
+              Rg.ES:=0;
+              Rg.DX:=0;
+            end;
+          Intr($33, Rg);                                 { Set interrupt 33 }
+        end;
+      CurrentMask:=Mask;
+    end;
+END;
+
+
+{ We need to remove the mouse callback before exiting !! PM }
+
+const StoredExit : CodePointer = Nil;
+      FirstMouseInitDone : boolean = false;
+
+procedure MouseSafeExit;
+begin
+  ExitProc:=StoredExit;
+  if MouseCallBack<>Nil then
+    Mouse_Action(0, Nil);
+  if not FirstMouseInitDone then
+    exit;
+  FirstMouseInitDone:=false;
+end;
+
+procedure SysInitMouse;
+begin
+  if not MousePresent then
+    begin
+      if DetectMouse=0 then
+        begin
+          if First_try then
+            begin
+              Writeln('No mouse driver found ');
+              First_try:=false;
+            end;
+          exit;
+        end
+      else
+        MousePresent:=true;
+    end;
+  { don't do this twice !! PM }
+
+  If not FirstMouseInitDone then
+    begin
+      StoredExit:=ExitProc;
+      ExitProc:=@MouseSafeExit;
+      FirstMouseInitDone:=true;
+    end;
+  If MouseCallBack=Nil then
+    Mouse_Action($ffff, @MouseInt);                    { Set masks/interrupt }
+  drawmousecursor:=false;
+  CustomMouse_MouseIsVisible:=false;
+  if (screenwidth>80) or (screenheight>50) then
+    DoCustomMouse(true);
+  ShowMouse;
+end;
+
+
+procedure SysDoneMouse;
+begin
+  HideMouse;
+  If (MouseCallBack <> Nil) Then
+    Mouse_Action(0, Nil);                            { Clear mask/interrupt }
+end;
+
+
+function SysDetectMouse:byte;assembler;
+asm
+        xor     ax, ax
+        mov     es, ax
+        mov     di, es:[4*33h]
+        or      di, es:[4*33h+2]
+        jz      @@no_mouse
+
+        push    bp
+        int     33h
+        pop     bp
+        or      ax, ax
+        jz      @@no_mouse
+        mov     ax, bx
+@@no_mouse:
+end;
+
+
+procedure SysShowMouse;
+
+begin
+   if drawmousecursor then
+     begin
+        lockmouse;
+        if CustomMouse_HideCount>0 then
+          Dec(CustomMouse_HideCount);
+        if (CustomMouse_HideCount=0) and not(CustomMouse_MouseIsVisible) then
+          begin
+             oldmousex:=getmousex-1;
+             oldmousey:=getmousey-1;
+             mem[videoseg:(((screenwidth*oldmousey)+oldmousex)*2)+1]:=
+               mem[videoseg:(((screenwidth*oldmousey)+oldmousex)*2)+1] xor $7f;
+             CustomMouse_MouseIsVisible:=true;
+          end;
+        unlockmouse;
+     end
+   else
+     asm
+             cmp     MousePresent, 1
+             jne     @@ShowMouseExit
+             mov     ax, 1
+             push    bp
+             int     33h
+             pop     bp
+     @@ShowMouseExit:
+     end;
+end;
+
+
+procedure SysHideMouse;
+
+begin
+   if drawmousecursor then
+     begin
+        lockmouse;
+        Inc(CustomMouse_HideCount);
+        if CustomMouse_MouseIsVisible then
+          begin
+             CustomMouse_MouseIsVisible:=false;
+             mem[videoseg:(((screenwidth*oldmousey)+oldmousex)*2)+1]:=
+               mem[videoseg:(((screenwidth*oldmousey)+oldmousex)*2)+1] xor $7f;
+             oldmousex:=-1;
+             oldmousey:=-1;
+          end;
+        unlockmouse;
+     end
+   else
+     asm
+             cmp     MousePresent, 1
+             jne     @@HideMouseExit
+             mov     ax, 2
+             push    bp
+             int     33h
+             pop     bp
+     @@HideMouseExit:
+     end;
+end;
+
+
+function SysGetMouseX:word;assembler;
+asm
+        cmp     MousePresent, 1
+        jne     @@GetMouseXError
+        mov     ax, 3
+        push    bp
+        int     33h
+        pop     bp
+        xchg    ax, cx
+        shr     ax, 1
+        shr     ax, 1
+        shr     ax, 1
+{$ifdef FPC_MM_HUGE}
+        mov     bx, SEG ScreenWidth
+        mov     es, bx
+        cmp     es:[ScreenWidth], 40
+{$else}
+        cmp     ScreenWidth, 40
+{$endif}
+        jne     @@morethan40cols
+        shr     ax, 1
+@@morethan40cols:
+        inc     ax
+        jmp @@exit
+@@GetMouseXError:
+        xor     ax, ax
+@@exit:
+end;
+
+
+function SysGetMouseY:word;assembler;
+asm
+        cmp     MousePresent, 1
+        jne     @@GetMouseYError
+        mov     ax, 3
+        push    bp
+        int     33h
+        pop     bp
+        xchg    ax, dx
+        shr     ax, 1
+        shr     ax, 1
+        shr     ax, 1
+        inc     ax
+        jmp @@exit
+@@GetMouseYError:
+        xor     ax, ax
+@@exit:
+end;
+
+
+function SysGetMouseButtons:word;assembler;
+asm
+        cmp     MousePresent, 1
+        jne     @@GetMouseButtonsError
+        mov     ax, 3
+        push    bp
+        int     33h
+        pop     bp
+        xchg    ax, bx
+        jmp     @@exit
+@@GetMouseButtonsError:
+        xor     ax, ax
+@@exit:
+end;
+
+
+procedure SysSetMouseXY(x,y:word);assembler;
+asm
+        cmp     MousePresent, 1
+        jne     @@SetMouseXYExit
+        mov     cx, x
+        mov     dx, y
+        mov     ax, 4
+        push    bp
+        int     33h
+        pop     bp
+@@SetMouseXYExit:
+end;
+
+Procedure SetMouseXRange (Min,Max:Longint);
+begin
+  If Not(MousePresent) Then Exit;
+  asm
+        mov     ax, 7
+        mov     cx, min
+        mov     dx, max
+        push    bp
+        int     33h
+        pop     bp
+  end;
+end;
+
+Procedure SetMouseYRange (min,max:Longint);
+begin
+  If Not(MousePresent) Then Exit;
+  asm
+        mov     ax, 8
+        mov     cx, min
+        mov     dx, max
+        push    bp
+        int     33h
+        pop     bp
+  end;
+end;
+
+procedure DoCustomMouse(b : boolean);
+
+  begin
+     lockmouse;
+     CustomMouse_HideCount:=1;
+     oldmousex:=-1;
+     oldmousey:=-1;
+     if ScreenWidth=40 then
+       SetMouseXRange(0,(screenwidth-1)*16)
+     else
+       SetMouseXRange(0,(screenwidth-1)*8);
+     SetMouseYRange(0,(screenheight-1)*8);
+     if b then
+       begin
+          CustomMouse_MouseIsVisible:=false;
+          drawmousecursor:=true;
+       end
+     else
+       drawmousecursor:=false;
+     unlockmouse;
+  end;
+
+procedure SysGetMouseEvent(var MouseEvent: TMouseEvent);
+var
+ RR: Registers;
+begin
+  if not MousePresent then
+    begin
+      Fillchar(MouseEvent,SizeOf(TMouseEvent),#0);
+    end;
+  while PendingMouseEvents = 0 do
+   begin
+(* Give up time slices while waiting for mouse events. *)
+    Intr ($28, RR);
+   end;
+  MouseEvent:=PendingMouseHead^;
+  inc(PendingMouseHead);
+  if PendingMouseHead=@PendingMouseEvent[0]+MouseEventBufsize then
+   PendingMouseHead:=@PendingMouseEvent[0];
+  dec(PendingMouseEvents);
+  if (LastMouseEvent.x<>MouseEvent.x) or (LastMouseEvent.y<>MouseEvent.y) then
+   MouseEvent.Action:=MouseActionMove;
+  if (LastMouseEvent.Buttons<>MouseEvent.Buttons) then
+   begin
+     if (LastMouseEvent.Buttons and MouseEvent.buttons<>LastMouseEvent.Buttons) then
+       MouseEvent.Action:=MouseActionUp
+     else
+       MouseEvent.Action:=MouseActionDown;
+   end;
+  LastMouseEvent:=MouseEvent;
+end;
+
+
+Const
+  SysMouseDriver : TMouseDriver = (
+    useDefaultQueue : true;
+    InitDriver      : @SysInitMouse;
+    DoneDriver      : @SysDoneMouse;
+    DetectMouse     : @SysDetectMouse;
+    ShowMouse       : @SysShowMouse;
+    HideMouse       : @SysHideMouse;
+    GetMouseX       : @SysGetMouseX;
+    GetMouseY       : @SysGetMouseY;
+    GetMouseButtons : @SysGetMouseButtons;
+    SetMouseXY      : @SysSetMouseXY;
+    GetMouseEvent   : @SysGetMouseEvent;
+    PollMouseEvent  : Nil;
+    PutMouseEvent  : Nil;
+  );
+
+Begin
+  SetMouseDriver(SysMouseDriver);
+end.

packages/rtl-console/src/msdos/video.pp

@@ -0,0 +1,296 @@
+{
+    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
+
+    Video unit for MS-DOS
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit Video;
+
+interface
+
+{$i videoh.inc}
+
+var
+  VideoSeg : word;
+
+
+implementation
+
+uses
+  mouse,
+  dos;
+
+{$i video.inc}
+
+  { used to know if LastCursorType is valid }
+const
+  LastCursorType : word = crUnderline;
+
+{ allways set blink state again }
+
+procedure SetHighBitBlink;
+var
+  regs : registers;
+begin
+  regs.ax:=$1003;
+  regs.bx:=$0001;
+  intr($10,regs);
+end;
+
+function BIOSGetScreenMode(var Cols,Rows: word; var Color: boolean): boolean;
+var
+  r: registers;
+  B: array[0..63] of byte;
+  OK: boolean;
+begin
+  r.ah:=$1b; r.bx:=0;
+  r.es:=Seg(B); r.di:=Ofs(B);
+  intr($10,r);
+  OK:=(r.al=$1b);
+  if OK then
+  begin
+    Cols:=PWord(@B[5])^; Rows:=B[$22];
+    Color:=PWord(@B[$27])^<>0;
+  end;
+  BIOSGetScreenMode:=OK;
+end;
+
+procedure SysInitVideo;
+var
+  regs : registers;
+begin
+  VideoSeg:=SegB800;
+  if (ScreenWidth=$ffff) or (ScreenHeight=$ffff) or
+    (ScreenWidth=0) or (ScreenHeight=0) then
+    begin
+       ScreenColor:=true;
+       regs.ah:=$0f;
+       intr($10,regs);
+       if (regs.al and 1)=0 then
+         ScreenColor:=false;
+       if regs.al=7 then
+         begin
+            ScreenColor:=false;
+            VideoSeg:=SegB000;
+         end
+       else
+         VideoSeg:=SegB800;
+       ScreenWidth:=regs.ah;
+       regs.ax:=$1130;
+       regs.bx:=0;
+       intr($10,regs);
+       ScreenHeight:=regs.dl+1;
+       BIOSGetScreenMode(ScreenWidth,ScreenHeight,ScreenColor);
+    end;
+  regs.ah:=$03;
+  regs.bh:=0;
+  intr($10,regs);
+  CursorLines:=regs.cl;
+  CursorX:=regs.dl;
+  CursorY:=regs.dh;
+  SetHighBitBlink;
+  SetCursorType(LastCursorType);
+end;
+
+
+procedure SysDoneVideo;
+begin
+  LastCursorType:=GetCursorType;
+  ClearScreen;
+  SetCursorType(crUnderLine);
+  SetCursorPos(0,0);
+end;
+
+
+function SysGetCapabilities: Word;
+begin
+  SysGetCapabilities := $3F;
+end;
+
+
+procedure SysSetCursorPos(NewCursorX, NewCursorY: Word);
+var
+  regs : registers;
+begin
+  regs.ah:=$02;
+  regs.bh:=0;
+  regs.dh:=NewCursorY;
+  regs.dl:=NewCursorX;
+  intr($10,regs);
+  CursorY:=regs.dh;
+  CursorX:=regs.dl;
+end;
+
+{ I don't know the maximum value for the scan line
+  probably 7 or 15 depending on resolution !!
+  }
+function SysGetCursorType: Word;
+var
+  regs : registers;
+begin
+  regs.ah:=$03;
+  regs.bh:=0;
+  intr($10,regs);
+  SysGetCursorType:=crHidden;
+  if (regs.ch and $60)=0 then
+   begin
+     SysGetCursorType:=crBlock;
+     if (regs.ch and $1f)<>0 then
+      begin
+        SysGetCursorType:=crHalfBlock;
+        if regs.cl-1=(regs.ch and $1F) then
+         SysGetCursorType:=crUnderline;
+      end;
+   end;
+end;
+
+
+procedure SysSetCursorType(NewType: Word);
+var
+  regs : registers;
+const
+  MaxCursorLines = 7;
+begin
+  regs.ah:=$01;
+  regs.bx:=NewType;
+  case NewType of
+   crHidden    : regs.cx:=$2000;
+   crHalfBlock : begin
+                   regs.ch:=MaxCursorLines shr 1;
+                   regs.cl:=MaxCursorLines;
+                 end;
+   crBlock     : begin
+                   regs.ch:=0;
+                   regs.cl:=MaxCursorLines;
+                 end;
+   else          begin
+                   regs.ch:=MaxCursorLines-1;
+                   regs.cl:=MaxCursorLines;
+                 end;
+  end;
+  intr($10,regs);
+end;
+
+procedure SysUpdateScreen(Force: Boolean);
+begin
+  HideMouse;
+  if not force then
+    force:=CompareByte(VideoBuf^,OldVideoBuf^,VideoBufSize)<>0;
+  if Force then
+   begin
+     movedata(Seg(videobuf^),Ofs(videobuf^),videoseg,0,VideoBufSize);
+     move(videobuf^,oldvideobuf^,VideoBufSize);
+   end;
+  ShowMouse;
+end;
+
+Procedure DoSetVideoMode(Params: Longint);
+
+type
+  wordrec=packed record
+    lo,hi : word;
+  end;
+var
+  regs : registers;
+begin
+  regs.ax:=wordrec(Params).lo;
+  regs.bx:=wordrec(Params).hi;
+  intr($10,regs);
+end;
+
+Procedure SetVideo8x8;
+
+type
+  wordrec=packed record
+    lo,hi : word;
+  end;
+var
+  regs : registers;
+begin
+  regs.ax:=3;
+  regs.bx:=0;
+  intr($10,regs);
+  regs.ax:=$1112;
+  regs.bx:=$0;
+  intr($10,regs);
+end;
+
+Const
+  SysVideoModeCount = 5;
+  SysVMD : Array[0..SysVideoModeCount-1] of TVideoMode = (
+   (Col: 40; Row : 25;  Color : False),
+   (Col: 40; Row : 25;  Color : True),
+   (Col: 80; Row : 25;  Color : False),
+   (Col: 80; Row : 25;  Color : True),
+   (Col: 80; 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
+      If (I<SysVideoModeCount-1) then
+        DoSetVideoMode(I)
+      else
+        SetVideo8x8;
+      ScreenWidth:=SysVMD[I].Col;
+      ScreenHeight:=SysVMD[I].Row;
+      ScreenColor:=SysVMD[I].Color;
+      DoCustomMouse(false);
+    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
+  SetVideoDriver(SysVideoDriver);
+end.