+ started the i8086-msdos version of the unit graph, based on the go32v2

  version. Only the CGA routines are enabled for now and the unit compiles, but
  does not work yet.

git-svn-id: trunk@25534 -

.gitattributes

@@ -3336,6 +3336,9 @@ packages/graph/src/inc/makefile.inc svneol=native#text/plain
 packages/graph/src/inc/modes.inc svneol=native#text/plain
 packages/graph/src/inc/palette.inc svneol=native#text/plain
 packages/graph/src/macosx/graph.pp svneol=native#text/plain
+packages/graph/src/msdos/graph.pp svneol=native#text/plain
+packages/graph/src/msdos/vesa.inc svneol=native#text/plain
+packages/graph/src/msdos/vesah.inc svneol=native#text/plain
 packages/graph/src/ptcgraph/ptccrt.pp svneol=native#text/plain
 packages/graph/src/ptcgraph/ptcgraph.pp svneol=native#text/x-pascal
 packages/graph/src/sdlgraph/sdlgraph.pp svneol=native#text/plain

packages/graph/fpmake.pp

@@ -24,8 +24,8 @@ begin
     P.Description := 'A portable, yet usable substitute for the Turbo Pascal Graph unit.';
     P.NeedLibC:= false;  // true for headers that indirectly link to libc? OS specific?
 
-    P.CPUs:=[i386,x86_64,powerpc];
-    P.OSes:=[go32v2,win32,win64,linux,freebsd,darwin];
+    P.CPUs:=[i386,x86_64,powerpc,i8086];
+    P.OSes:=[go32v2,win32,win64,linux,freebsd,darwin,msdos];
 
     P.Dependencies.Add('sdl',[i386,powerpc],[win32,linux,freebsd,darwin]);
     P.Dependencies.Add('ptc',[win32,win64,linux]);
@@ -41,11 +41,13 @@ begin
     P.SourcePath.Add('src/macosx',[darwin]);
     P.SourcePath.Add('src/amiga',[amiga]);
     P.SourcePath.Add('src/go32v2',[go32v2]);
+    P.SourcePath.Add('src/msdos',[msdos]);
     P.SourcePath.Add('src/win32',[win32,win64]);
     P.SourcePath.Add('src/unix',[freebsd,linux]);  // Darwin has own.
 
     P.IncludePath.Add('src/inc');
     P.IncludePath.Add('src/go32v2',[go32v2]);
+    P.IncludePath.Add('src/msdos',[msdos]);
     P.IncludePath.Add('src/unix',[freebsd,linux]);  // Darwin has own.
     P.IncludePath.Add('src/go32v2',[go32v2]);
 
@@ -76,7 +78,7 @@ begin
           AddInclude('graph16.inc',[freebsd,linux]);
         end;
     // Graph unit other targets
-    T:=P.Targets.AddUnit('graph.pp',[go32v2,amiga,win32,win64,freebsd]);
+    T:=P.Targets.AddUnit('graph.pp',[go32v2,amiga,win32,win64,freebsd,msdos]);
       with T.Dependencies do
         begin
           AddInclude('graphh.inc');

packages/graph/src/msdos/graph.pp

@@ -0,0 +1,4568 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by Florian Klaempfl
+
+    This file implements the go32v2 support for the graph unit
+
+    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 Graph;
+interface
+
+{$i graphh.inc}
+{$i vesah.inc}
+
+CONST
+  m640x200x16       = VGALo;
+  m640x400x16       = VGAMed;
+  m640x480x16       = VGAHi;
+
+  { VESA Specific video modes. }
+  m320x200x32k      = $10D;
+  m320x200x64k      = $10E;
+
+  m640x400x256      = $100;
+
+  m640x480x256      = $101;
+  m640x480x32k      = $110;
+  m640x480x64k      = $111;
+
+  m800x600x16       = $102;
+  m800x600x256      = $103;
+  m800x600x32k      = $113;
+  m800x600x64k      = $114;
+
+  m1024x768x16      = $104;
+  m1024x768x256     = $105;
+  m1024x768x32k     = $116;
+  m1024x768x64k     = $117;
+
+  m1280x1024x16     = $106;
+  m1280x1024x256    = $107;
+  m1280x1024x32k    = $119;
+  m1280x1024x64k    = $11A;
+
+const
+  UseLFB : boolean = false;
+  UseNoSelector : boolean = false;
+  LFBPointer : pointer = nil;
+{ Helpful variable to get save/restore support in IDE PM }
+const
+  DontClearGraphMemory : boolean = false;
+
+
+
+implementation
+
+uses
+  dos,ports;
+
+const
+   InternalDriverName = 'DOSGX';
+
+{$i graph.inc}
+
+const
+   VideoOfs : word = 0;   { Segment to draw to }
+   FirstPlane = $0102;   (* 02 = Index to Color plane Select, *)
+                         (* 01 = Enable color plane 1         *)
+
+{    ; ===== VGA Register Values ===== }
+
+    SCREEN_WIDTH    =     80     ; { MODE-X 320 SCREEN WIDTH         }
+                                   { CHANGE THE VALUE IF OTHER MODES }
+                                   { OTHER THEN 320 ARE USED.        }
+    ATTRIB_Ctrl     =   $03C0    ; { VGA Attribute Controller        }
+    GC_Index        =   $03CE    ; { VGA Graphics Controller         }
+    SC_Index        =   $03C4    ; { VGA Sequencer Controller        }
+    SC_Data         =   $03C5    ; { VGA Sequencer Data Port         }
+    CRTC_Index      =   $03D4    ; { VGA CRT Controller              }
+    CRTC_Data       =   $03D5    ; { VGA CRT Controller Data         }
+    MISC_OUTPUT     =   $03C2    ; { VGA Misc Register               }
+    INPUT_1         =   $03DA    ; { Input Status #1 Register        }
+
+    DAC_WRITE_ADDR  =   $03C8    ; { VGA DAC Write Addr Register     }
+    DAC_READ_ADDR   =   $03C7    ; { VGA DAC Read Addr Register      }
+    PEL_DATA_REG    =   $03C9    ; { VGA DAC/PEL data Register R/W   }
+
+    PIXEL_PAN_REG   =   $033     ; { Attrib Index: Pixel Pan Reg     }
+    MAP_MASK        =   $002     ; { S=   $Index: Write Map Mask reg }
+    READ_MAP        =   $004     ; { GC Index: Read Map Register     }
+    START_DISP_HI   =   $00C     ; { CRTC Index: Display Start Hi    }
+    START_DISP_LO   =   $00D     ; { CRTC Index: Display Start Lo    }
+
+    MAP_MASK_PLANE1 =   $00102   ; { Map Register + Plane 1          }
+    MAP_MASK_PLANE2 =   $01102   ; { Map Register + Plane 1          }
+    ALL_PLANES_ON   =   $00F02   ; { Map Register + All Bit Planes   }
+
+    CHAIN4_OFF      =   $00604   ; { Chain 4 mode Off                }
+    ASYNC_RESET     =   $00100   ; { (A)synchronous Reset            }
+    SEQU_RESTART    =   $00300   ; { Sequencer Restart               }
+
+    LATCHES_ON      =   $00008   ; { Bit Mask + Data from Latches    }
+    LATCHES_OFF     =   $0FF08   ; { Bit Mask + Data from CPU        }
+
+    VERT_RETRACE    =   $08      ; { INPUT_1: Vertical Retrace Bit   }
+    PLANE_BITS      =   $03      ; { Bits 0-1 of Xpos = Plane #      }
+    ALL_PLANES      =   $0F      ; { All Bit Planes Selected         }
+    CHAR_BITS       =   $0F      ; { Bits 0-3 of Character Data      }
+
+    GET_CHAR_PTR    =   $01130   ; { VGA BIOS Func: Get Char Set     }
+    ROM_8x8_Lo      =   $03      ; { ROM 8x8 Char Set Lo Pointer     }
+    ROM_8x8_Hi      =   $04      ; { ROM 8x8 Char Set Hi Pointer     }
+
+    { Constants Specific for these routines                          }
+
+    NUM_MODES       =   $8       ; { # of Mode X Variations           }
+
+    { in 16 color modes, the actual colors used are not 0..15, but: }
+    ToRealCols16: Array[0..15] of word =
+      (0,1,2,3,4,5,20,7,56,57,58,59,60,61,62,63);
+
+  var
+     ScrWidth : word absolute $40:$4a;
+     inWindows: boolean;
+
+{$ifndef tp}
+  Procedure seg_bytemove(sseg : word;source : word;dseg : word;dest : word;count : word); assembler;
+    asm
+      push ds
+      cld
+      mov es, dseg
+      mov si, source
+      mov di, dest
+      mov cx, count
+      mov ds,sseg
+      rep movsb
+      pop ds
+    end;
+{$endif tp}
+
+ Procedure CallInt10(val_ax : word); assembler;
+   asm
+     mov ax,val_ax
+     push bp
+     int 10h
+     pop bp
+   end;
+
+{************************************************************************}
+{*                   720x348x2 Hercules mode routines                   *}
+{************************************************************************}
+
+(*var
+  DummyHGCBkColor: Word;
+
+procedure InitHGC720;
+const
+  RegValues: array [0..11] of byte =
+    ($35, $2D, $2E, $07, $5B, $02, $57, $57, $02, $03, $00, $00);
+var
+  I: Integer;
+begin
+  Port[$3BF] := 3; { graphic and page 2 possible }
+  Port[$3B8] := 2; { display page 0, graphic mode, display off }
+  for I := 0 to 11 do
+    PortW[$3B4] := I or (RegValues[I] shl 8);
+  Port[$3B8] := 10; { display page 0, graphic mode, display on }
+  DosMemFillChar($B000, 0, 65536, #0);
+  VideoOfs := 0;
+  DummyHGCBkColor := 0;
+end;
+
+{ compatible with TP7's HERC.BGI }
+procedure SetBkColorHGC720(ColorNum: Word);
+begin
+  if ColorNum > 15 then
+    exit;
+  DummyHGCBkColor := ColorNum;
+end;
+
+{ compatible with TP7's HERC.BGI }
+function GetBkColorHGC720: Word;
+begin
+  GetBkColorHGC720 := DummyHGCBkColor;
+end;
+
+procedure SetHGCRGBPalette(ColorNum, RedValue, GreenValue,
+      BlueValue : smallint); {$ifndef fpc}far;{$endif fpc}
+begin
+end;
+
+procedure GetHGCRGBPalette(ColorNum: smallint; Var
+      RedValue, GreenValue, BlueValue : smallint); {$ifndef fpc}far;{$endif fpc}
+begin
+end;
+
+procedure PutPixelHGC720(X, Y: SmallInt; Pixel: Word); {$ifndef fpc}far;{$endif fpc}
+var
+  Offset: Word;
+  B, Mask, Shift: Byte;
+begin
+  X:= X + StartXViewPort;
+  Y:= Y + StartYViewPort;
+  { convert to absolute coordinates and then verify clipping...}
+  if ClipPixels then
+  begin
+    if (X < StartXViewPort) or (X > (StartXViewPort + ViewWidth)) then
+      exit;
+    if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then
+      exit;
+  end;
+  Offset := (Y shr 2) * 90 + (X shr 3) + VideoOfs;
+  case Y and 3 of
+    1: Inc(Offset, $2000);
+    2: Inc(Offset, $4000);
+    3: Inc(Offset, $6000);
+  end;
+  Shift := 7 - (X and 7);
+  Mask := 1 shl Shift;
+  B := Mem[SegB000:Offset];
+  B := B and (not Mask) or (Pixel shl Shift);
+  Mem[SegB000:Offset] := B;
+end;
+
+function GetPixelHGC720(X, Y: SmallInt): Word; {$ifndef fpc}far;{$endif fpc}
+var
+  Offset: Word;
+  B, Shift: Byte;
+begin
+  X:= X + StartXViewPort;
+  Y:= Y + StartYViewPort;
+  Offset := (Y shr 2) * 90 + (X shr 3) + VideoOfs;
+  case Y and 3 of
+    1: Inc(Offset, $2000);
+    2: Inc(Offset, $4000);
+    3: Inc(Offset, $6000);
+  end;
+  Shift := 7 - (X and 7);
+  B := Mem[SegB000:Offset];
+  GetPixelHGC720 := (B shr Shift) and 1;
+end;
+
+procedure DirectPutPixelHGC720(X, Y: SmallInt); {$ifndef fpc}far;{$endif fpc}
+ { x,y -> must be in global coordinates. No clipping. }
+var
+  Offset: Word;
+  B, Mask, Shift: Byte;
+begin
+  Offset := (Y shr 2) * 90 + (X shr 3) + VideoOfs;
+  case Y and 3 of
+    1: Inc(Offset, $2000);
+    2: Inc(Offset, $4000);
+    3: Inc(Offset, $6000);
+  end;
+  Shift := 7 - (X and 7);
+  case CurrentWriteMode of
+    XORPut:
+      begin
+        { optimization }
+        if CurrentColor = 0 then
+          exit;
+        Mem[SegB000:Offset] := Mem[SegB000:Offset] xor (CurrentColor shl Shift);
+      end;
+    OrPut:
+      begin
+        { optimization }
+        if CurrentColor = 0 then
+          exit;
+        Mem[SegB000:Offset] := Mem[SegB000:Offset] or (CurrentColor shl Shift);
+      end;
+    AndPut:
+      begin
+        { optimization }
+        if CurrentColor = 1 then
+          exit;
+        { therefore, CurrentColor must be 0 }
+        Mem[SegB000:Offset] := Mem[SegB000:Offset] and (not (1 shl Shift));
+      end;
+    NotPut:
+      begin
+        Mask := 1 shl Shift;
+        B := Mem[SegB000:Offset];
+        B := B and (not Mask) or ((CurrentColor xor $01) shl Shift);
+        Mem[SegB000:Offset] := B;
+      end
+    else
+      begin
+        Mask := 1 shl Shift;
+        B := Mem[SegB000:Offset];
+        B := B and (not Mask) or (CurrentColor shl Shift);
+        Mem[SegB000:Offset] := B;
+      end;
+  end;
+end;
+
+procedure HLineHGC720(X, X2, Y: SmallInt); {$ifndef fpc}far;{$endif fpc}
+var
+  Color: Word;
+  YOffset, LOffset, ROffset, CurrentOffset, MiddleAreaLength: Word;
+  B, ForeMask, LForeMask, LBackMask, RForeMask, RBackMask: Byte;
+  xtmp: SmallInt;
+begin
+  { must we swap the values? }
+  if x > x2 then
+  begin
+    xtmp := x2;
+    x2 := x;
+    x:= xtmp;
+  end;
+  { First convert to global coordinates }
+  X   := X + StartXViewPort;
+  X2  := X2 + StartXViewPort;
+  Y   := Y + StartYViewPort;
+  if ClipPixels then
+  begin
+    if LineClipped(x,y,x2,y,StartXViewPort,StartYViewPort,
+           StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
+      exit;
+  end;
+  YOffset := (Y shr 2) * 90 + VideoOfs;
+  case Y and 3 of
+    1: Inc(YOffset, $2000);
+    2: Inc(YOffset, $4000);
+    3: Inc(YOffset, $6000);
+  end;
+  LOffset := YOffset + (X shr 3);
+  ROffset := YOffset + (X2 shr 3);
+
+  if CurrentWriteMode = NotPut then
+    Color := CurrentColor xor $01
+  else
+    Color := CurrentColor;
+  if Color = 1 then
+    ForeMask := $FF
+  else
+    ForeMask := $00;
+
+  LBackMask := Byte($FF00 shr (X and $07));
+  LForeMask := (not LBackMask) and ForeMask;
+
+  RBackMask := Byte(not ($FF shl (7 - (X2 and $07))));
+  RForeMask := (not RBackMask) and ForeMask;
+
+  if LOffset = ROffset then
+  begin
+    LBackMask := LBackMask or RBackMask;
+    LForeMask := LForeMask and RForeMask;
+  end;
+
+  CurrentOffset := LOffset;
+
+  { check if the first byte is only partially full
+    (otherwise, it's completely full and is handled as a part of the middle area) }
+  if LBackMask <> 0 then
+  begin
+    { draw the first byte }
+    case CurrentWriteMode of
+      XORPut:
+        begin
+          { optimization }
+          if CurrentColor = 0 then
+            exit;
+          Mem[SegB000:CurrentOffset] := Mem[SegB000:CurrentOffset] xor LForeMask;
+        end;
+      OrPut:
+        begin
+          { optimization }
+          if CurrentColor = 0 then
+            exit;
+          Mem[SegB000:CurrentOffset] := Mem[SegB000:CurrentOffset] or LForeMask;
+        end;
+      AndPut:
+        begin
+          { optimization }
+          if CurrentColor = 1 then
+            exit;
+          { therefore, CurrentColor must be 0 }
+          Mem[SegB000:CurrentOffset] := Mem[SegB000:CurrentOffset] and LBackMask;
+        end;
+      else
+        begin
+          { note: NotPut is also handled here }
+          B := Mem[SegB000:CurrentOffset];
+          B := B and LBackMask or LForeMask;
+          Mem[SegB000:CurrentOffset] := B;
+        end;
+    end;
+    Inc(CurrentOffset);
+  end;
+
+  if CurrentOffset > ROffset then
+    exit;
+
+  MiddleAreaLength := ROffset + 1 - CurrentOffset;
+  if RBackMask <> 0 then
+    Dec(MiddleAreaLength);
+
+  { draw the middle area }
+  if MiddleAreaLength > 0 then
+  begin
+    case CurrentWriteMode of
+      XORPut:
+        begin
+          { optimization }
+          if CurrentColor = 0 then
+            exit;
+          while MiddleAreaLength > 0 do
+          begin
+            Mem[SegB000:CurrentOffset] := Mem[SegB000:CurrentOffset] xor $FF;
+            Inc(CurrentOffset);
+            Dec(MiddleAreaLength);
+          end;
+        end;
+      OrPut:
+        begin
+          { optimization }
+          if CurrentColor = 0 then
+            exit;
+          while MiddleAreaLength > 0 do
+          begin
+            Mem[SegB000:CurrentOffset] := $FF;
+            Inc(CurrentOffset);
+            Dec(MiddleAreaLength);
+          end;
+        end;
+      AndPut:
+        begin
+          { optimization }
+          if CurrentColor = 1 then
+            exit;
+          { therefore, CurrentColor must be 0 }
+          while MiddleAreaLength > 0 do
+          begin
+            Mem[SegB000:CurrentOffset] := 0;
+            Inc(CurrentOffset);
+            Dec(MiddleAreaLength);
+          end;
+        end;
+      else
+        begin
+          { note: NotPut is also handled here }
+          while MiddleAreaLength > 0 do
+          begin
+            Mem[SegB000:CurrentOffset] := ForeMask;
+            Inc(CurrentOffset);
+            Dec(MiddleAreaLength);
+          end;
+        end;
+    end;
+  end;
+
+  { draw the final right byte, if less than 100% full }
+  if RBackMask <> 0 then
+  begin
+    { draw the last byte }
+    case CurrentWriteMode of
+      XORPut:
+        begin
+          { optimization }
+          if CurrentColor = 0 then
+            exit;
+          Mem[SegB000:CurrentOffset] := Mem[SegB000:CurrentOffset] xor RForeMask;
+        end;
+      OrPut:
+        begin
+          { optimization }
+          if CurrentColor = 0 then
+            exit;
+          Mem[SegB000:CurrentOffset] := Mem[SegB000:CurrentOffset] or RForeMask;
+        end;
+      AndPut:
+        begin
+          { optimization }
+          if CurrentColor = 1 then
+            exit;
+          { therefore, CurrentColor must be 0 }
+          Mem[SegB000:CurrentOffset] := Mem[SegB000:CurrentOffset] and RBackMask;
+        end;
+      else
+        begin
+          { note: NotPut is also handled here }
+          B := Mem[SegB000:CurrentOffset];
+          B := B and RBackMask or RForeMask;
+          Mem[SegB000:CurrentOffset] := B;
+        end;
+    end;
+  end;
+end;
+
+procedure SetVisualHGC720(page: word); {$ifndef fpc}far;{$endif fpc}
+{ two page supPort... }
+begin
+  if page > HardwarePages then exit;
+
+  case page of
+   0 : Port[$3B8] := 10; { display page 0, graphic mode, display on }
+   1 : Port[$3B8] := 10+128; { display page 1, graphic mode, display on }
+  end;
+end;
+
+procedure SetActiveHGC720(page: word); {$ifndef fpc}far;{$endif fpc}
+{ two page supPort... }
+begin
+  case page of
+   0 : VideoOfs := 0;
+   1 : VideoOfs := 32768;
+  else
+    VideoOfs := 0;
+  end;
+end;
+*)
+{************************************************************************}
+{*                     320x200x4 CGA mode routines                      *}
+{************************************************************************}
+var
+  CurrentCGABorder: Word;
+
+procedure SetCGAPalette(CGAPaletteID: Byte); assembler;
+asm
+  mov ax,CGAPaletteID
+  push bp
+  mov bl, al
+  mov bh, 1
+  mov ah, 0Bh
+  int 10h
+  pop bp
+end;
+
+procedure SetCGABorder(CGABorder: Byte); assembler;
+asm
+  mov ax,CGABorder
+  push bp
+  mov bl, al
+  mov bh, 0
+  mov ah, 0Bh
+  int 10h
+  pop bp
+end;
+
+procedure SetBkColorCGA320(ColorNum: Word);
+begin
+  if ColorNum > 15 then
+    exit;
+  CurrentCGABorder := (CurrentCGABorder and 16) or ColorNum;
+  SetCGABorder(CurrentCGABorder);
+end;
+
+function GetBkColorCGA320: Word;
+begin
+  GetBkColorCGA320 := CurrentCGABorder and 15;
+end;
+
+procedure InitCGA320C0;
+begin
+  if DontClearGraphMemory then
+    CallInt10($84)
+  else
+    CallInt10($04);
+  VideoOfs := 0;
+  SetCGAPalette(0);
+  SetCGABorder(16);
+  CurrentCGABorder := 16;
+end;
+
+procedure InitCGA320C1;
+begin
+  if DontClearGraphMemory then
+    CallInt10($84)
+  else
+    CallInt10($04);
+  VideoOfs := 0;
+  SetCGAPalette(1);
+  SetCGABorder(16);
+  CurrentCGABorder := 16;
+end;
+
+procedure InitCGA320C2;
+begin
+  if DontClearGraphMemory then
+    CallInt10($84)
+  else
+    CallInt10($04);
+  VideoOfs := 0;
+  SetCGAPalette(2);
+  SetCGABorder(0);
+  CurrentCGABorder := 0;
+end;
+
+procedure InitCGA320C3;
+begin
+  if DontClearGraphMemory then
+    CallInt10($84)
+  else
+    CallInt10($04);
+  VideoOfs := 0;
+  SetCGAPalette(3);
+  SetCGABorder(0);
+  CurrentCGABorder := 0;
+end;
+
+procedure PutPixelCGA320(X, Y: SmallInt; Pixel: Word); {$ifndef fpc}far;{$endif fpc}
+var
+  Offset: Word;
+  B, Mask, Shift: Byte;
+begin
+  X:= X + StartXViewPort;
+  Y:= Y + StartYViewPort;
+  { convert to absolute coordinates and then verify clipping...}
+  if ClipPixels then
+  begin
+    if (X < StartXViewPort) or (X > (StartXViewPort + ViewWidth)) then
+      exit;
+    if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then
+      exit;
+  end;
+  Offset := (Y shr 1) * 80 + (X shr 2);
+  if (Y and 1) <> 0 then
+    Inc(Offset, 8192);
+  Shift := 6 - ((X and 3) shl 1);
+  Mask := $03 shl Shift;
+  B := Mem[SegB800:Offset];
+  B := B and (not Mask) or (Pixel shl Shift);
+  Mem[SegB800:Offset] := B;
+end;
+
+function GetPixelCGA320(X, Y: SmallInt): Word; {$ifndef fpc}far;{$endif fpc}
+var
+  Offset: Word;
+  B, Shift: Byte;
+begin
+  X:= X + StartXViewPort;
+  Y:= Y + StartYViewPort;
+  Offset := (Y shr 1) * 80 + (X shr 2);
+  if (Y and 1) <> 0 then
+    Inc(Offset, 8192);
+  Shift := 6 - ((X and 3) shl 1);
+  B := Mem[SegB800:Offset];
+  GetPixelCGA320 := (B shr Shift) and $03;
+end;
+
+procedure DirectPutPixelCGA320(X, Y: SmallInt); {$ifndef fpc}far;{$endif fpc}
+ { x,y -> must be in global coordinates. No clipping. }
+var
+  Offset: Word;
+  B, Mask, Shift: Byte;
+begin
+  Offset := (Y shr 1) * 80 + (X shr 2);
+  if (Y and 1) <> 0 then
+    Inc(Offset, 8192);
+  Shift := 6 - ((X and 3) shl 1);
+  case CurrentWriteMode of
+    XORPut:
+      begin
+        { optimization }
+        if CurrentColor = 0 then
+          exit;
+        Mem[SegB800:Offset] := Mem[SegB800:Offset] xor (CurrentColor shl Shift);
+      end;
+    OrPut:
+      begin
+        { optimization }
+        if CurrentColor = 0 then
+          exit;
+        Mem[SegB800:Offset] := Mem[SegB800:Offset] or (CurrentColor shl Shift);
+      end;
+    AndPut:
+      begin
+        { optimization }
+        if CurrentColor = 3 then
+          exit;
+        Mask := $03 shl Shift;
+        Mem[SegB800:Offset] := Mem[SegB800:Offset] and ((CurrentColor shl Shift) or (not Mask));
+      end;
+    NotPut:
+      begin
+        Mask := $03 shl Shift;
+        B := Mem[SegB800:Offset];
+        B := B and (not Mask) or ((CurrentColor xor $03) shl Shift);
+        Mem[SegB800:Offset] := B;
+      end
+    else
+      begin
+        Mask := $03 shl Shift;
+        B := Mem[SegB800:Offset];
+        B := B and (not Mask) or (CurrentColor shl Shift);
+        Mem[SegB800:Offset] := B;
+      end;
+  end;
+end;
+
+procedure HLineCGA320(X, X2, Y: SmallInt); {$ifndef fpc}far;{$endif fpc}
+var
+  Color: Word;
+  YOffset, LOffset, ROffset, CurrentOffset, MiddleAreaLength: Word;
+  B, ForeMask, LForeMask, LBackMask, RForeMask, RBackMask: Byte;
+  xtmp: SmallInt;
+begin
+  { must we swap the values? }
+  if x > x2 then
+  begin
+    xtmp := x2;
+    x2 := x;
+    x:= xtmp;
+  end;
+  { First convert to global coordinates }
+  X   := X + StartXViewPort;
+  X2  := X2 + StartXViewPort;
+  Y   := Y + StartYViewPort;
+  if ClipPixels then
+  begin
+    if LineClipped(x,y,x2,y,StartXViewPort,StartYViewPort,
+           StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
+      exit;
+  end;
+  YOffset := (Y shr 1) * 80;
+  if (Y and 1) <> 0 then
+    Inc(YOffset, 8192);
+  LOffset := YOffset + (X shr 2);
+  ROffset := YOffset + (X2 shr 2);
+
+  if CurrentWriteMode = NotPut then
+    Color := CurrentColor xor $03
+  else
+    Color := CurrentColor;
+  case Color of
+    0: ForeMask := $00;
+    1: ForeMask := $55;
+    2: ForeMask := $AA;
+    3: ForeMask := $FF;
+  end;
+
+  LBackMask := Byte($FF00 shr ((X and $03) shl 1));
+  LForeMask := (not LBackMask) and ForeMask;
+
+  RBackMask := Byte(not ($FF shl (6 - ((X2 and $03) shl 1))));
+  RForeMask := (not RBackMask) and ForeMask;
+
+  if LOffset = ROffset then
+  begin
+    LBackMask := LBackMask or RBackMask;
+    LForeMask := LForeMask and RForeMask;
+  end;
+
+  CurrentOffset := LOffset;
+
+  { check if the first byte is only partially full
+    (otherwise, it's completely full and is handled as a part of the middle area) }
+  if LBackMask <> 0 then
+  begin
+    { draw the first byte }
+    case CurrentWriteMode of
+      XORPut:
+        begin
+          { optimization }
+          if CurrentColor = 0 then
+            exit;
+          Mem[SegB800:CurrentOffset] := Mem[SegB800:CurrentOffset] xor LForeMask;
+        end;
+      OrPut:
+        begin
+          { optimization }
+          if CurrentColor = 0 then
+            exit;
+          Mem[SegB800:CurrentOffset] := Mem[SegB800:CurrentOffset] or LForeMask;
+        end;
+      AndPut:
+        begin
+          { optimization }
+          if CurrentColor = 1 then
+            exit;
+          Mem[SegB800:CurrentOffset] := Mem[SegB800:CurrentOffset] and (LBackMask or LForeMask);
+        end;
+      else
+        begin
+          { note: NotPut is also handled here }
+          B := Mem[SegB800:CurrentOffset];
+          B := B and LBackMask or LForeMask;
+          Mem[SegB800:CurrentOffset] := B;
+        end;
+    end;
+    Inc(CurrentOffset);
+  end;
+
+  if CurrentOffset > ROffset then
+    exit;
+
+  MiddleAreaLength := ROffset + 1 - CurrentOffset;
+  if RBackMask <> 0 then
+    Dec(MiddleAreaLength);
+
+  { draw the middle area }
+  if MiddleAreaLength > 0 then
+  begin
+    case CurrentWriteMode of
+      XORPut:
+        begin
+          { optimization }
+          if CurrentColor = 0 then
+            exit;
+          while MiddleAreaLength > 0 do
+          begin
+            Mem[SegB800:CurrentOffset] := Mem[SegB800:CurrentOffset] xor ForeMask;
+            Inc(CurrentOffset);
+            Dec(MiddleAreaLength);
+          end;
+        end;
+      OrPut:
+        begin
+          { optimization }
+          if CurrentColor = 0 then
+            exit;
+          while MiddleAreaLength > 0 do
+          begin
+            Mem[SegB800:CurrentOffset] := Mem[SegB800:CurrentOffset] or ForeMask;
+            Inc(CurrentOffset);
+            Dec(MiddleAreaLength);
+          end;
+        end;
+      AndPut:
+        begin
+          { optimization }
+          if CurrentColor = 1 then
+            exit;
+          { therefore, CurrentColor must be 0 }
+          while MiddleAreaLength > 0 do
+          begin
+            Mem[SegB800:CurrentOffset] := Mem[SegB800:CurrentOffset] and ForeMask;
+            Inc(CurrentOffset);
+            Dec(MiddleAreaLength);
+          end;
+        end;
+      else
+        begin
+          { note: NotPut is also handled here }
+          while MiddleAreaLength > 0 do
+          begin
+            Mem[SegB800:CurrentOffset] := ForeMask;
+            Inc(CurrentOffset);
+            Dec(MiddleAreaLength);
+          end;
+        end;
+    end;
+  end;
+
+  { draw the final right byte, if less than 100% full }
+  if RBackMask <> 0 then
+  begin
+    { draw the last byte }
+    case CurrentWriteMode of
+      XORPut:
+        begin
+          { optimization }
+          if CurrentColor = 0 then
+            exit;
+          Mem[SegB800:CurrentOffset] := Mem[SegB800:CurrentOffset] xor RForeMask;
+        end;
+      OrPut:
+        begin
+          { optimization }
+          if CurrentColor = 0 then
+            exit;
+          Mem[SegB800:CurrentOffset] := Mem[SegB800:CurrentOffset] or RForeMask;
+        end;
+      AndPut:
+        begin
+          { optimization }
+          if CurrentColor = 1 then
+            exit;
+          Mem[SegB800:CurrentOffset] := Mem[SegB800:CurrentOffset] and (RBackMask or RForeMask);
+        end;
+      else
+        begin
+          { note: NotPut is also handled here }
+          B := Mem[SegB800:CurrentOffset];
+          B := B and RBackMask or RForeMask;
+          Mem[SegB800:CurrentOffset] := B;
+        end;
+    end;
+  end;
+end;
+
+{************************************************************************}
+{*                     640x200x2 CGA mode routines                      *}
+{************************************************************************}
+
+procedure InitCGA640;
+begin
+  if DontClearGraphMemory then
+    CallInt10($86)
+  else
+    CallInt10($06);
+  VideoOfs := 0;
+  CurrentCGABorder := 0; {yes, TP7 CGA.BGI behaves *exactly* like that}
+end;
+
+{yes, TP7 CGA.BGI behaves *exactly* like that}
+procedure SetBkColorCGA640(ColorNum: Word);
+begin
+  if ColorNum > 15 then
+    exit;
+  CurrentCGABorder := ColorNum;
+  if ColorNum = 0 then
+    exit;
+  SetCGABorder(CurrentCGABorder);
+end;
+
+function GetBkColorCGA640: Word;
+begin
+  GetBkColorCGA640 := CurrentCGABorder and 15;
+end;
+
+procedure PutPixelCGA640(X, Y: SmallInt; Pixel: Word); {$ifndef fpc}far;{$endif fpc}
+var
+  Offset: Word;
+  B, Mask, Shift: Byte;
+begin
+  X:= X + StartXViewPort;
+  Y:= Y + StartYViewPort;
+  { convert to absolute coordinates and then verify clipping...}
+  if ClipPixels then
+  begin
+    if (X < StartXViewPort) or (X > (StartXViewPort + ViewWidth)) then
+      exit;
+    if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then
+      exit;
+  end;
+  Offset := (Y shr 1) * 80 + (X shr 3);
+  if (Y and 1) <> 0 then
+    Inc(Offset, 8192);
+  Shift := 7 - (X and 7);
+  Mask := 1 shl Shift;
+  B := Mem[SegB800:Offset];
+  B := B and (not Mask) or (Pixel shl Shift);
+  Mem[SegB800:Offset] := B;
+end;
+
+function GetPixelCGA640(X, Y: SmallInt): Word; {$ifndef fpc}far;{$endif fpc}
+var
+  Offset: Word;
+  B, Shift: Byte;
+begin
+  X:= X + StartXViewPort;
+  Y:= Y + StartYViewPort;
+  Offset := (Y shr 1) * 80 + (X shr 3);
+  if (Y and 1) <> 0 then
+    Inc(Offset, 8192);
+  Shift := 7 - (X and 7);
+  B := Mem[SegB800:Offset];
+  GetPixelCGA640 := (B shr Shift) and 1;
+end;
+
+procedure DirectPutPixelCGA640(X, Y: SmallInt); {$ifndef fpc}far;{$endif fpc}
+ { x,y -> must be in global coordinates. No clipping. }
+var
+  Offset: Word;
+  B, Mask, Shift: Byte;
+begin
+  Offset := (Y shr 1) * 80 + (X shr 3);
+  if (Y and 1) <> 0 then
+    Inc(Offset, 8192);
+  Shift := 7 - (X and 7);
+  case CurrentWriteMode of
+    XORPut:
+      begin
+        { optimization }
+        if CurrentColor = 0 then
+          exit;
+        Mem[SegB800:Offset] := Mem[SegB800:Offset] xor (CurrentColor shl Shift);
+      end;
+    OrPut:
+      begin
+        { optimization }
+        if CurrentColor = 0 then
+          exit;
+        Mem[SegB800:Offset] := Mem[SegB800:Offset] or (CurrentColor shl Shift);
+      end;
+    AndPut:
+      begin
+        { optimization }
+        if CurrentColor = 1 then
+          exit;
+        { therefore, CurrentColor must be 0 }
+        Mem[SegB800:Offset] := Mem[SegB800:Offset] and (not (1 shl Shift));
+      end;
+    NotPut:
+      begin
+        Mask := 1 shl Shift;
+        B := Mem[SegB800:Offset];
+        B := B and (not Mask) or ((CurrentColor xor $01) shl Shift);
+        Mem[SegB800:Offset] := B;
+      end
+    else
+      begin
+        Mask := 1 shl Shift;
+        B := Mem[SegB800:Offset];
+        B := B and (not Mask) or (CurrentColor shl Shift);
+        Mem[SegB800:Offset] := B;
+      end;
+  end;
+end;
+
+procedure HLineCGA640(X, X2, Y: SmallInt); {$ifndef fpc}far;{$endif fpc}
+var
+  Color: Word;
+  YOffset, LOffset, ROffset, CurrentOffset, MiddleAreaLength: Word;
+  B, ForeMask, LForeMask, LBackMask, RForeMask, RBackMask: Byte;
+  xtmp: SmallInt;
+begin
+  { must we swap the values? }
+  if x > x2 then
+  begin
+    xtmp := x2;
+    x2 := x;
+    x:= xtmp;
+  end;
+  { First convert to global coordinates }
+  X   := X + StartXViewPort;
+  X2  := X2 + StartXViewPort;
+  Y   := Y + StartYViewPort;
+  if ClipPixels then
+  begin
+    if LineClipped(x,y,x2,y,StartXViewPort,StartYViewPort,
+           StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
+      exit;
+  end;
+  YOffset := (Y shr 1) * 80;
+  if (Y and 1) <> 0 then
+    Inc(YOffset, 8192);
+  LOffset := YOffset + (X shr 3);
+  ROffset := YOffset + (X2 shr 3);
+
+  if CurrentWriteMode = NotPut then
+    Color := CurrentColor xor $01
+  else
+    Color := CurrentColor;
+  if Color = 1 then
+    ForeMask := $FF
+  else
+    ForeMask := $00;
+
+  LBackMask := Byte($FF00 shr (X and $07));
+  LForeMask := (not LBackMask) and ForeMask;
+
+  RBackMask := Byte(not ($FF shl (7 - (X2 and $07))));
+  RForeMask := (not RBackMask) and ForeMask;
+
+  if LOffset = ROffset then
+  begin
+    LBackMask := LBackMask or RBackMask;
+    LForeMask := LForeMask and RForeMask;
+  end;
+
+  CurrentOffset := LOffset;
+
+  { check if the first byte is only partially full
+    (otherwise, it's completely full and is handled as a part of the middle area) }
+  if LBackMask <> 0 then
+  begin
+    { draw the first byte }
+    case CurrentWriteMode of
+      XORPut:
+        begin
+          { optimization }
+          if CurrentColor = 0 then
+            exit;
+          Mem[SegB800:CurrentOffset] := Mem[SegB800:CurrentOffset] xor LForeMask;
+        end;
+      OrPut:
+        begin
+          { optimization }
+          if CurrentColor = 0 then
+            exit;
+          Mem[SegB800:CurrentOffset] := Mem[SegB800:CurrentOffset] or LForeMask;
+        end;
+      AndPut:
+        begin
+          { optimization }
+          if CurrentColor = 1 then
+            exit;
+          { therefore, CurrentColor must be 0 }
+          Mem[SegB800:CurrentOffset] := Mem[SegB800:CurrentOffset] and LBackMask;
+        end;
+      else
+        begin
+          { note: NotPut is also handled here }
+          B := Mem[SegB800:CurrentOffset];
+          B := B and LBackMask or LForeMask;
+          Mem[SegB800:CurrentOffset] := B;
+        end;
+    end;
+    Inc(CurrentOffset);
+  end;
+
+  if CurrentOffset > ROffset then
+    exit;
+
+  MiddleAreaLength := ROffset + 1 - CurrentOffset;
+  if RBackMask <> 0 then
+    Dec(MiddleAreaLength);
+
+  { draw the middle area }
+  if MiddleAreaLength > 0 then
+  begin
+    case CurrentWriteMode of
+      XORPut:
+        begin
+          { optimization }
+          if CurrentColor = 0 then
+            exit;
+          while MiddleAreaLength > 0 do
+          begin
+            Mem[SegB800:CurrentOffset] := Mem[SegB800:CurrentOffset] xor $FF;
+            Inc(CurrentOffset);
+            Dec(MiddleAreaLength);
+          end;
+        end;
+      OrPut:
+        begin
+          { optimization }
+          if CurrentColor = 0 then
+            exit;
+          while MiddleAreaLength > 0 do
+          begin
+            Mem[SegB800:CurrentOffset] := $FF;
+            Inc(CurrentOffset);
+            Dec(MiddleAreaLength);
+          end;
+        end;
+      AndPut:
+        begin
+          { optimization }
+          if CurrentColor = 1 then
+            exit;
+          { therefore, CurrentColor must be 0 }
+          while MiddleAreaLength > 0 do
+          begin
+            Mem[SegB800:CurrentOffset] := 0;
+            Inc(CurrentOffset);
+            Dec(MiddleAreaLength);
+          end;
+        end;
+      else
+        begin
+          { note: NotPut is also handled here }
+          while MiddleAreaLength > 0 do
+          begin
+            Mem[SegB800:CurrentOffset] := ForeMask;
+            Inc(CurrentOffset);
+            Dec(MiddleAreaLength);
+          end;
+        end;
+    end;
+  end;
+
+  { draw the final right byte, if less than 100% full }
+  if RBackMask <> 0 then
+  begin
+    { draw the last byte }
+    case CurrentWriteMode of
+      XORPut:
+        begin
+          { optimization }
+          if CurrentColor = 0 then
+            exit;
+          Mem[SegB800:CurrentOffset] := Mem[SegB800:CurrentOffset] xor RForeMask;
+        end;
+      OrPut:
+        begin
+          { optimization }
+          if CurrentColor = 0 then
+            exit;
+          Mem[SegB800:CurrentOffset] := Mem[SegB800:CurrentOffset] or RForeMask;
+        end;
+      AndPut:
+        begin
+          { optimization }
+          if CurrentColor = 1 then
+            exit;
+          { therefore, CurrentColor must be 0 }
+          Mem[SegB800:CurrentOffset] := Mem[SegB800:CurrentOffset] and RBackMask;
+        end;
+      else
+        begin
+          { note: NotPut is also handled here }
+          B := Mem[SegB800:CurrentOffset];
+          B := B and RBackMask or RForeMask;
+          Mem[SegB800:CurrentOffset] := B;
+        end;
+    end;
+  end;
+end;
+
+{************************************************************************}
+{*                    640x480x2 MCGA mode routines                      *}
+{************************************************************************}
+
+procedure InitMCGA640;
+begin
+  if DontClearGraphMemory then
+    CallInt10($91)
+  else
+    CallInt10($11);
+  VideoOfs := 0;
+  CurrentCGABorder := 0; {yes, TP7 CGA.BGI behaves *exactly* like that}
+end;
+
+procedure SetBkColorMCGA640(ColorNum: Word);
+begin
+  if ColorNum > 15 then
+    exit;
+  CurrentCGABorder := (CurrentCGABorder and 16) or ColorNum;
+  SetCGABorder(CurrentCGABorder);
+end;
+
+function GetBkColorMCGA640: Word;
+begin
+  GetBkColorMCGA640 := CurrentCGABorder and 15;
+end;
+
+procedure PutPixelMCGA640(X, Y: SmallInt; Pixel: Word); {$ifndef fpc}far;{$endif fpc}
+var
+  Offset: Word;
+  B, Mask, Shift: Byte;
+begin
+  X:= X + StartXViewPort;
+  Y:= Y + StartYViewPort;
+  { convert to absolute coordinates and then verify clipping...}
+  if ClipPixels then
+  begin
+    if (X < StartXViewPort) or (X > (StartXViewPort + ViewWidth)) then
+      exit;
+    if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then
+      exit;
+  end;
+  Offset := Y * 80 + (X shr 3);
+  Shift := 7 - (X and 7);
+  Mask := 1 shl Shift;
+  B := Mem[SegA000:Offset];
+  B := B and (not Mask) or (Pixel shl Shift);
+  Mem[SegA000:Offset] := B;
+end;
+
+function GetPixelMCGA640(X, Y: SmallInt): Word; {$ifndef fpc}far;{$endif fpc}
+var
+  Offset: Word;
+  B, Shift: Byte;
+begin
+  X:= X + StartXViewPort;
+  Y:= Y + StartYViewPort;
+  Offset := Y * 80 + (X shr 3);
+  Shift := 7 - (X and 7);
+  B := Mem[SegA000:Offset];
+  GetPixelMCGA640 := (B shr Shift) and 1;
+end;
+
+procedure DirectPutPixelMCGA640(X, Y: SmallInt); {$ifndef fpc}far;{$endif fpc}
+ { x,y -> must be in global coordinates. No clipping. }
+var
+  Offset: Word;
+  B, Mask, Shift: Byte;
+begin
+  Offset := Y * 80 + (X shr 3);
+  Shift := 7 - (X and 7);
+  case CurrentWriteMode of
+    XORPut:
+      begin
+        { optimization }
+        if CurrentColor = 0 then
+          exit;
+        Mem[SegA000:Offset] := Mem[SegA000:Offset] xor (CurrentColor shl Shift);
+      end;
+    OrPut:
+      begin
+        { optimization }
+        if CurrentColor = 0 then
+          exit;
+        Mem[SegA000:Offset] := Mem[SegA000:Offset] or (CurrentColor shl Shift);
+      end;
+    AndPut:
+      begin
+        { optimization }
+        if CurrentColor = 1 then
+          exit;
+        { therefore, CurrentColor must be 0 }
+        Mem[SegA000:Offset] := Mem[SegA000:Offset] and (not (1 shl Shift));
+      end;
+    NotPut:
+      begin
+        Mask := 1 shl Shift;
+        B := Mem[SegA000:Offset];
+        B := B and (not Mask) or ((CurrentColor xor $01) shl Shift);
+        Mem[SegA000:Offset] := B;
+      end
+    else
+      begin
+        Mask := 1 shl Shift;
+        B := Mem[SegA000:Offset];
+        B := B and (not Mask) or (CurrentColor shl Shift);
+        Mem[SegA000:Offset] := B;
+      end;
+  end;
+end;
+
+procedure HLineMCGA640(X, X2, Y: SmallInt); {$ifndef fpc}far;{$endif fpc}
+var
+  Color: Word;
+  YOffset, LOffset, ROffset, CurrentOffset, MiddleAreaLength: Word;
+  B, ForeMask, LForeMask, LBackMask, RForeMask, RBackMask: Byte;
+  xtmp: SmallInt;
+begin
+  { must we swap the values? }
+  if x > x2 then
+  begin
+    xtmp := x2;
+    x2 := x;
+    x:= xtmp;
+  end;
+  { First convert to global coordinates }
+  X   := X + StartXViewPort;
+  X2  := X2 + StartXViewPort;
+  Y   := Y + StartYViewPort;
+  if ClipPixels then
+  begin
+    if LineClipped(x,y,x2,y,StartXViewPort,StartYViewPort,
+           StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
+      exit;
+  end;
+  YOffset := Y * 80;
+  LOffset := YOffset + (X shr 3);
+  ROffset := YOffset + (X2 shr 3);
+
+  if CurrentWriteMode = NotPut then
+    Color := CurrentColor xor $01
+  else
+    Color := CurrentColor;
+  if Color = 1 then
+    ForeMask := $FF
+  else
+    ForeMask := $00;
+
+  LBackMask := Byte($FF00 shr (X and $07));
+  LForeMask := (not LBackMask) and ForeMask;
+
+  RBackMask := Byte(not ($FF shl (7 - (X2 and $07))));
+  RForeMask := (not RBackMask) and ForeMask;
+
+  if LOffset = ROffset then
+  begin
+    LBackMask := LBackMask or RBackMask;
+    LForeMask := LForeMask and RForeMask;
+  end;
+
+  CurrentOffset := LOffset;
+
+  { check if the first byte is only partially full
+    (otherwise, it's completely full and is handled as a part of the middle area) }
+  if LBackMask <> 0 then
+  begin
+    { draw the first byte }
+    case CurrentWriteMode of
+      XORPut:
+        begin
+          { optimization }
+          if CurrentColor = 0 then
+            exit;
+          Mem[SegA000:CurrentOffset] := Mem[SegA000:CurrentOffset] xor LForeMask;
+        end;
+      OrPut:
+        begin
+          { optimization }
+          if CurrentColor = 0 then
+            exit;
+          Mem[SegA000:CurrentOffset] := Mem[SegA000:CurrentOffset] or LForeMask;
+        end;
+      AndPut:
+        begin
+          { optimization }
+          if CurrentColor = 1 then
+            exit;
+          { therefore, CurrentColor must be 0 }
+          Mem[SegA000:CurrentOffset] := Mem[SegA000:CurrentOffset] and LBackMask;
+        end;
+      else
+        begin
+          { note: NotPut is also handled here }
+          B := Mem[SegA000:CurrentOffset];
+          B := B and LBackMask or LForeMask;
+          Mem[SegA000:CurrentOffset] := B;
+        end;
+    end;
+    Inc(CurrentOffset);
+  end;
+
+  if CurrentOffset > ROffset then
+    exit;
+
+  MiddleAreaLength := ROffset + 1 - CurrentOffset;
+  if RBackMask <> 0 then
+    Dec(MiddleAreaLength);
+
+  { draw the middle area }
+  if MiddleAreaLength > 0 then
+  begin
+    case CurrentWriteMode of
+      XORPut:
+        begin
+          { optimization }
+          if CurrentColor = 0 then
+            exit;
+          while MiddleAreaLength > 0 do
+          begin
+            Mem[SegA000:CurrentOffset] := Mem[SegA000:CurrentOffset] xor $FF;
+            Inc(CurrentOffset);
+            Dec(MiddleAreaLength);
+          end;
+        end;
+      OrPut:
+        begin
+          { optimization }
+          if CurrentColor = 0 then
+            exit;
+          while MiddleAreaLength > 0 do
+          begin
+            Mem[SegA000:CurrentOffset] := $FF;
+            Inc(CurrentOffset);
+            Dec(MiddleAreaLength);
+          end;
+        end;
+      AndPut:
+        begin
+          { optimization }
+          if CurrentColor = 1 then
+            exit;
+          { therefore, CurrentColor must be 0 }
+          while MiddleAreaLength > 0 do
+          begin
+            Mem[SegA000:CurrentOffset] := 0;
+            Inc(CurrentOffset);
+            Dec(MiddleAreaLength);
+          end;
+        end;
+      else
+        begin
+          { note: NotPut is also handled here }
+          while MiddleAreaLength > 0 do
+          begin
+            Mem[SegA000:CurrentOffset] := ForeMask;
+            Inc(CurrentOffset);
+            Dec(MiddleAreaLength);
+          end;
+        end;
+    end;
+  end;
+
+  if RBackMask <> 0 then
+  begin
+    { draw the last byte }
+    case CurrentWriteMode of
+      XORPut:
+        begin
+          { optimization }
+          if CurrentColor = 0 then
+            exit;
+          Mem[SegA000:CurrentOffset] := Mem[SegA000:CurrentOffset] xor RForeMask;
+        end;
+      OrPut:
+        begin
+          { optimization }
+          if CurrentColor = 0 then
+            exit;
+          Mem[SegA000:CurrentOffset] := Mem[SegA000:CurrentOffset] or RForeMask;
+        end;
+      AndPut:
+        begin
+          { optimization }
+          if CurrentColor = 1 then
+            exit;
+          { therefore, CurrentColor must be 0 }
+          Mem[SegA000:CurrentOffset] := Mem[SegA000:CurrentOffset] and RBackMask;
+        end;
+      else
+        begin
+          { note: NotPut is also handled here }
+          B := Mem[SegA000:CurrentOffset];
+          B := B and RBackMask or RForeMask;
+          Mem[SegA000:CurrentOffset] := B;
+        end;
+    end;
+  end;
+end;
+
+ {************************************************************************}
+ {*                     4-bit planar VGA mode routines                   *}
+ {************************************************************************}
+(*
+  Procedure Init640x200x16; {$ifndef fpc}far;{$endif fpc}
+    begin
+      if DontClearGraphMemory then
+        CallInt10($8e)
+      else
+        CallInt10($e);
+      VideoOfs := 0;
+    end;
+
+
+   Procedure Init640x350x16; {$ifndef fpc}far;{$endif fpc}
+    begin
+      if DontClearGraphMemory then
+        CallInt10($90)
+      else
+        CallInt10($10);
+      VideoOfs := 0;
+    end;
+
+
+
+  Procedure Init640x480x16; {$ifndef fpc}far;{$endif fpc}
+    begin
+      if DontClearGraphMemory then
+        CallInt10($92)
+      else
+        CallInt10($12);
+      VideoOfs := 0;
+    end;
+
+
+
+
+ Procedure PutPixel16(X,Y : smallint; Pixel: Word); {$ifndef fpc}far;{$endif fpc}
+{$ifndef asmgraph}
+ var offset: word;
+     dummy: byte;
+{$endif asmgraph}
+  Begin
+    X:= X + StartXViewPort;
+    Y:= Y + StartYViewPort;
+    { convert to absolute coordinates and then verify clipping...}
+    if ClipPixels then
+     Begin
+       if (X < StartXViewPort) or (X > (StartXViewPort + ViewWidth)) then
+         exit;
+       if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then
+         exit;
+     end;
+{$ifndef asmgraph}
+     offset := y * 80 + (x shr 3) + VideoOfs;
+     PortW[$3ce] := $0f01;       { Index 01 : Enable ops on all 4 planes }
+     PortW[$3ce] := (Pixel and $ff) shl 8; { Index 00 : Enable correct plane and write color }
+
+     PortW[$3ce] := ($8000 shr (x and $7)) or 8; { Select correct bits to modify }
+     dummy := Mem[SegA000: offset];  { Latch the data into host space.  }
+     Mem[Sega000: offset] := dummy;  { Write the data into video memory }
+     PortW[$3ce] := $ff08;         { Enable all bit planes.           }
+     PortW[$3ce] := $0001;         { Index 01 : Disable ops on all four planes.         }
+{$else asmgraph}
+      asm
+ {$ifndef fpc}
+        mov  es, [SegA000]
+        { enable the set / reset function and load the color }
+        mov  dx, 3ceh
+        mov  ax, 0f01h
+        out  dx, ax
+        { setup set/reset register }
+        mov  ax, [Pixel]
+        shl  ax, 8
+        out  dx, ax
+        { setup the bit mask register }
+        mov  al, 8
+        out  dx, al
+        inc  dx
+        { load the bitmask register }
+        mov  cx, [X]
+        and  cx, 0007h
+        mov  al, 80h
+        shr  al, cl
+        out  dx, ax
+        { get the x index and divide by 8 for 16-color }
+        mov  ax,[X]
+        shr  ax,3
+        push ax
+        { determine the address }
+        mov  ax,80
+        mov  bx,[Y]
+        mul  bx
+        pop  cx
+        add  ax,cx
+        mov  di,ax
+        add  di, [VideoOfs]
+        { send the data through the display memory through set/reset }
+        mov  bl,es:[di]
+        mov  es:[di],bl
+
+        { reset for formal vga operation }
+        mov  dx,3ceh
+        mov  ax,0ff08h
+        out  dx,ax
+
+        { restore enable set/reset register }
+        mov  ax,0001h
+        out  dx,ax
+ {$else fpc}
+        push eax
+        push ebx
+        push ecx
+        push edx
+        push edi
+        { enable the set / reset function and load the color }
+        mov  dx, 3ceh
+        mov  ax, 0f01h
+        out  dx, ax
+        { setup set/reset register }
+        mov  ax, [Pixel]
+        shl  ax, 8
+        out  dx, ax
+        { setup the bit mask register }
+        mov  al, 8
+        out  dx, al
+        inc  dx
+        { load the bitmask register }
+        mov  cx, [X]
+        and  cx, 0007h
+        mov  al, 80h
+        shr  al, cl
+        out  dx, ax
+        { get the x index and divide by 8 for 16-color }
+        movzx eax,[X]
+        shr  eax,3
+        push eax
+        { determine the address }
+        mov  eax,80
+        mov  bx,[Y]
+        mul  bx
+        pop  ecx
+        add  eax,ecx
+        mov  edi,eax
+        add  edi, [VideoOfs]
+        { send the data through the display memory through set/reset }
+        mov  bl,fs:[edi+$a0000]
+        mov  fs:[edi+$a0000],bl
+
+        { reset for formal vga operation }
+        mov  dx,3ceh
+        mov  ax,0ff08h
+        out  dx,ax
+
+        { restore enable set/reset register }
+        mov  ax,0001h
+        out  dx,ax
+        pop edi
+        pop edx
+        pop ecx
+        pop ebx
+        pop eax
+ {$endif fpc}
+      end;
+{$endif asmgraph}
+   end;
+
+
+ Function GetPixel16(X,Y: smallint):word; {$ifndef fpc}far;{$endif fpc}
+{$ifndef asmgraph}
+ Var dummy, offset: Word;
+     shift: byte;
+{$endif asmgraph}
+  Begin
+    X:= X + StartXViewPort;
+    Y:= Y + StartYViewPort;
+{$ifndef asmgraph}
+    offset := Y * 80 + (x shr 3) + VideoOfs;
+    PortW[$3ce] := $0004;
+    shift := 7 - (X and 7);
+    dummy := (Mem[Sega000:offset] shr shift) and 1;
+    Port[$3cf] := 1;
+    dummy := dummy or (((Mem[Sega000:offset] shr shift) and 1) shl 1);
+    Port[$3cf] := 2;
+    dummy := dummy or (((Mem[Sega000:offset] shr shift) and 1) shl 2);
+    Port[$3cf] := 3;
+    dummy := dummy or (((Mem[Sega000:offset] shr shift) and 1) shl 3);
+    GetPixel16 := dummy;
+{$else asmgraph}
+    asm
+  {$ifndef fpc}
+      mov   ax, [X]          { Get X address                    }
+      push  ax
+      shr   ax, 3
+      push  ax
+
+      mov   ax,80
+      mov   bx,[Y]
+      mul   bx
+      pop   cx
+      add   ax,cx
+      mov   si,ax            { SI = correct offset into video segment }
+
+      mov   es,[SegA000]
+      add   si,[VideoOfs]    { Point to correct page offset... }
+
+      mov   dx,03ceh
+      mov   ax,4
+      out   dx,al
+      inc   dx
+
+      pop   ax
+      and   ax,0007h
+      mov   cl,07
+      sub   cl,al
+      mov   bl,cl
+
+      { read plane 0 }
+      mov   al,0             { Select plane to read }
+      out   dx,al
+      mov   al,es:[si]       { read display memory }
+      shr   al,cl
+      and   al,01h
+      mov   ah,al            { save bit in AH       }
+
+      { read plane 1 }
+      mov   al,1             { Select plane to read }
+      out   dx,al
+      mov   al,es:[si]
+      shr   al,cl
+      and   al,01h
+      shl   al,1
+      or    ah,al            { save bit in AH      }
+
+      { read plane 2 }
+      mov   al,2             { Select plane to read }
+      out   dx,al
+      mov   al,es:[si]
+      shr   al,cl
+      and   al,01h
+      shl   al,2
+      or    ah,al            { save bit in AH       }
+
+      { read plane 3 }
+      mov   al,3             { Select plane to read }
+      out   dx,al
+      mov   al,es:[si]
+      shr   al,cl
+      and   al,01h
+      shl   al,3
+      or    ah,al            { save bit in AH       }
+
+      mov   al,ah            { 16-bit pixel in AX   }
+      xor   ah,ah
+      mov   @Result, ax
+  {$else fpc}
+      push eax
+      push ebx
+      push ecx
+      push edx
+      push esi
+      movzx eax, [X]          { Get X address                    }
+      push  eax
+      shr   eax, 3
+      push  eax
+
+      mov   eax,80
+      mov   bx,[Y]
+      mul   bx
+      pop   ecx
+      add   eax,ecx
+      mov   esi,eax            { SI = correct offset into video segment }
+
+      add   esi,[VideoOfs]    { Point to correct page offset... }
+
+      mov   dx,03ceh
+      mov   ax,4
+      out   dx,al
+      inc   dx
+
+      pop   eax
+      and   eax,0007h
+      mov   cl,07
+      sub   cl,al
+      mov   bl,cl
+
+      { read plane 0 }
+      mov   al,0             { Select plane to read }
+      out   dx,al
+      mov   al,fs:[esi+$a0000]       { read display memory }
+      shr   al,cl
+      and   al,01h
+      mov   ah,al            { save bit in AH       }
+
+      { read plane 1 }
+      mov   al,1             { Select plane to read }
+      out   dx,al
+      mov   al,fs:[esi+$a0000]
+      shr   al,cl
+      and   al,01h
+      shl   al,1
+      or    ah,al            { save bit in AH      }
+
+      { read plane 2 }
+      mov   al,2             { Select plane to read }
+      out   dx,al
+      mov   al,fs:[esi+$a0000]
+      shr   al,cl
+      and   al,01h
+      shl   al,2
+      or    ah,al            { save bit in AH       }
+
+      { read plane 3 }
+      mov   al,3             { Select plane to read }
+      out   dx,al
+      mov   al,fs:[esi+$a0000]
+      shr   al,cl
+      and   al,01h
+      shl   al,3
+      or    ah,al            { save bit in AH       }
+
+      mov   al,ah            { 16-bit pixel in AX   }
+      xor   ah,ah
+      mov   @Result, ax
+      pop esi
+      pop edx
+      pop ecx
+      pop ebx
+      pop eax
+  {$endif fpc}
+    end;
+{$endif asmgraph}
+  end;
+
+Procedure GetScanLine16(x1, x2, y: smallint; var data);
+
+var dummylong: longint;
+    Offset, count, count2, amount, index: word;
+    plane: byte;
+Begin
+  inc(x1,StartXViewPort);
+  inc(x2,StartXViewPort);
+{$ifdef logging}
+  LogLn('GetScanLine16 start, length to get: '+strf(x2-x1+1)+' at y = '+strf(y));
+{$Endif logging}
+  offset := (Y + StartYViewPort) * 80 + (x1 shr 3) + VideoOfs;
+{$ifdef logging}
+  LogLn('Offset: '+HexStr(offset,4)+' - ' + strf(offset));
+{$Endif logging}
+  { first get enough pixels so offset is 32bit aligned }
+  amount := 0;
+  index := 0;
+  If ((x1 and 31) <> 0) Or
+     ((x2-x1+1) < 32) Then
+    Begin
+      If ((x2-x1+1) >= 32+32-(x1 and 31)) Then
+        amount := 32-(x1 and 31)
+      Else amount := x2-x1+1;
+{$ifdef logging}
+      LogLn('amount to align to 32bits or to get all: ' + strf(amount));
+{$Endif logging}
+      For count := 0 to amount-1 do
+        WordArray(Data)[Count] := getpixel16(x1-StartXViewPort+Count,y);
+      index := amount;
+      Inc(Offset,(amount+7) shr 3);
+{$ifdef logging}
+      LogLn('offset now: '+HexStr(offset,4)+' - ' + strf(offset));
+      LogLn('index now: '+strf(index));
+{$Endif logging}
+    End;
+  amount := x2-x1+1 - amount;
+{$ifdef logging}
+  LogLn('amount left: ' + strf(amount));
+{$Endif logging}
+  If amount = 0 Then Exit;
+  { first get everything from plane 3 (4th plane) }
+  PortW[$3ce] := $0304;
+  Count := 0;
+  For Count := 1 to (amount shr 5) Do
+    Begin
+      dummylong := MemL[SegA000:offset+(Count-1)*4];
+      dummylong :=
+        ((dummylong and $ff) shl 24) or
+        ((dummylong and $ff00) shl 8) or
+        ((dummylong and $ff0000) shr 8) or
+        ((dummylong and $ff000000) shr 24);
+      For Count2 := 31 downto 0 Do
+        Begin
+          WordArray(Data)[index+Count2] := DummyLong and 1;
+          DummyLong := DummyLong shr 1;
+        End;
+      Inc(Index, 32);
+    End;
+{ Now get the data from the 3 other planes }
+  plane := 3;
+  Repeat
+    Dec(Index,Count*32);
+    Dec(plane);
+    Port[$3cf] := plane;
+    Count := 0;
+    For Count := 1 to (amount shr 5) Do
+      Begin
+        dummylong := MemL[SegA000:offset+(Count-1)*4];
+        dummylong :=
+          ((dummylong and $ff) shl 24) or
+          ((dummylong and $ff00) shl 8) or
+          ((dummylong and $ff0000) shr 8) or
+          ((dummylong and $ff000000) shr 24);
+        For Count2 := 31 downto 0 Do
+          Begin
+            WordArray(Data)[index+Count2] :=
+              (WordArray(Data)[index+Count2] shl 1) or (DummyLong and 1);
+            DummyLong := DummyLong shr 1;
+          End;
+        Inc(Index, 32);
+      End;
+  Until plane = 0;
+  amount := amount and 31;
+  Dec(index);
+{$ifdef Logging}
+  LogLn('Last array index written to: '+strf(index));
+  LogLn('amount left: '+strf(amount)+' starting at x = '+strf(index+1));
+{$Endif logging}
+  dec(x1,startXViewPort);
+  For Count := 1 to amount Do
+    WordArray(Data)[index+Count] := getpixel16(x1+index+Count,y);
+{$ifdef logging}
+  inc(x1,startXViewPort);
+  LogLn('First 32 bytes gotten with getscanline16: ');
+  If x2-x1+1 >= 32 Then
+    Count2 := 32
+  Else Count2 := x2-x1+1;
+  For Count := 0 to Count2-1 Do
+    Log(strf(WordArray(Data)[Count])+' ');
+  LogLn('');
+  If x2-x1+1 >= 32 Then
+    Begin
+      LogLn('Last 32 bytes gotten with getscanline16: ');
+      For Count := 31 downto 0 Do
+      Log(strf(WordArray(Data)[x2-x1-Count])+' ');
+    End;
+  LogLn('');
+  GetScanLineDefault(x1-StartXViewPort,x2-StartXViewPort,y,Data);
+  LogLn('First 32 bytes gotten with getscanlinedef: ');
+  If x2-x1+1 >= 32 Then
+    Count2 := 32
+  Else Count2 := x2-x1+1;
+  For Count := 0 to Count2-1 Do
+    Log(strf(WordArray(Data)[Count])+' ');
+  LogLn('');
+  If x2-x1+1 >= 32 Then
+    Begin
+      LogLn('Last 32 bytes gotten with getscanlinedef: ');
+      For Count := 31 downto 0 Do
+      Log(strf(WordArray(Data)[x2-x1-Count])+' ');
+    End;
+  LogLn('');
+  LogLn('GetScanLine16 end');
+{$Endif logging}
+End;
+
+ Procedure DirectPutPixel16(X,Y : smallint); {$ifndef fpc}far;{$endif fpc}
+ { x,y -> must be in global coordinates. No clipping. }
+  var
+   color: word;
+{$ifndef asmgraph}
+  offset: word;
+  dummy: byte;
+{$endif asmgraph}
+ begin
+    If CurrentWriteMode <> NotPut Then
+      Color := CurrentColor
+    else Color := not CurrentColor;
+
+    case CurrentWriteMode of
+       XORPut:
+         PortW[$3ce]:=((3 shl 3) shl 8) or 3;
+       ANDPut:
+         PortW[$3ce]:=((1 shl 3) shl 8) or 3;
+       ORPut:
+         PortW[$3ce]:=((2 shl 3) shl 8) or 3;
+       {not needed, this is the default state (e.g. PutPixel16 requires it)}
+       {NormalPut, NotPut:
+         PortW[$3ce]:=$0003
+       else
+         PortW[$3ce]:=$0003}
+    end;
+{$ifndef asmgraph}
+    offset := Y * 80 + (X shr 3) + VideoOfs;
+    PortW[$3ce] := $f01;
+    PortW[$3ce] := Color shl 8;
+    PortW[$3ce] := ($8000 shr (X and 7)) or 8;
+    dummy := Mem[SegA000: offset];
+    Mem[Sega000: offset] := dummy;
+    PortW[$3ce] := $ff08;
+    PortW[$3ce] := $0001;
+    if (CurrentWriteMode = XORPut) or
+       (CurrentWriteMode = ANDPut) or
+       (CurrentWriteMode = ORPut) then
+      PortW[$3ce] := $0003;
+{$else asmgraph}
+{ note: still needs xor/or/and/notput support !!!!! (JM) }
+    asm
+  {$ifndef fpc}
+      mov  es, [SegA000]
+      { enable the set / reset function and load the color }
+      mov  dx, 3ceh
+      mov  ax, 0f01h
+      out  dx, ax
+      { setup set/reset register }
+      mov  ax, [Color]
+      shl  ax, 8
+      out  dx, ax
+      { setup the bit mask register }
+      mov  al, 8
+      out  dx, al
+      inc  dx
+      { load the bitmask register }
+      mov  cx, [X]
+      and  cx, 0007h
+      mov  al, 80h
+      shr  al, cl
+      out  dx, ax
+      { get the x index and divide by 8 for 16-color }
+      mov  ax,[X]
+      shr  ax,3
+      push ax
+      { determine the address }
+      mov  ax,80
+      mov  bx,[Y]
+      mul  bx
+      pop  cx
+      add  ax,cx
+      mov  di,ax
+      { send the data through the display memory through set/reset }
+      add  di,[VideoOfs]   { add correct page }
+      mov  bl,es:[di]
+      mov  es:[di],bl
+
+      { reset for formal vga operation }
+      mov  dx,3ceh
+      mov  ax,0ff08h
+      out  dx,ax
+
+      { restore enable set/reset register }
+      mov  ax,0001h
+      out  dx,ax
+  {$else fpc}
+      push eax
+      push ebx
+      push ecx
+      push edx
+      push edi
+      { enable the set / reset function and load the color }
+      mov  dx, 3ceh
+      mov  ax, 0f01h
+      out  dx, ax
+      { setup set/reset register }
+      mov  ax, [Color]
+      shl  ax, 8
+      out  dx, ax
+      { setup the bit mask register }
+      mov  al, 8
+      out  dx, al
+      inc  dx
+      { load the bitmask register }
+      mov  cx, [X]
+      and  cx, 0007h
+      mov  al, 80h
+      shr  al, cl
+      out  dx, ax
+      { get the x index and divide by 8 for 16-color }
+      movzx eax,[X]
+      shr  eax,3
+      push eax
+      { determine the address }
+      mov  eax,80
+      mov  bx,[Y]
+      mul  bx
+      pop  ecx
+      add  eax,ecx
+      mov  edi,eax
+      { send the data through the display memory through set/reset }
+      add  edi,[VideoOfs]   { add correct page }
+      mov  bl,fs:[edi+$a0000]
+      mov  fs:[edi+$a0000],bl
+
+      { reset for formal vga operation }
+      mov  dx,3ceh
+      mov  ax,0ff08h
+      out  dx,ax
+
+      { restore enable set/reset register }
+      mov  ax,0001h
+      out  dx,ax
+      pop edi
+      pop edx
+      pop ecx
+      pop ebx
+      pop eax
+  {$endif fpc}
+    end;
+{$endif asmgraph}
+ end;
+
+
+  procedure HLine16(x,x2,y: smallint); {$ifndef fpc}far;{$endif fpc}
+
+   var
+      xtmp: smallint;
+      ScrOfs,HLength : word;
+      LMask,RMask : byte;
+
+   Begin
+
+    { must we swap the values? }
+    if x > x2 then
+      Begin
+        xtmp := x2;
+        x2 := x;
+        x:= xtmp;
+      end;
+    { First convert to global coordinates }
+    X   := X + StartXViewPort;
+    X2  := X2 + StartXViewPort;
+    Y   := Y + StartYViewPort;
+    if ClipPixels then
+      Begin
+         if LineClipped(x,y,x2,y,StartXViewPort,StartYViewPort,
+                StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
+            exit;
+      end;
+    ScrOfs:=y*ScrWidth+x div 8 + VideoOfs;
+    HLength:=x2 div 8-x div 8;
+    LMask:=$ff shr (x and 7);
+{$push}
+{$r-}
+{$q-}
+    RMask:=$ff shl (7-(x2 and 7));
+{$pop}
+    if HLength=0 then
+      LMask:=LMask and RMask;
+    If CurrentWriteMode <> NotPut Then
+      PortW[$3ce]:= CurrentColor shl 8
+    else PortW[$3ce]:= (not CurrentColor) shl 8;
+    PortW[$3ce]:=$0f01;
+    case CurrentWriteMode of
+       XORPut:
+         PortW[$3ce]:=((3 shl 3) shl 8) or 3;
+       ANDPut:
+         PortW[$3ce]:=((1 shl 3) shl 8) or 3;
+       ORPut:
+         PortW[$3ce]:=((2 shl 3) shl 8) or 3;
+       NormalPut, NotPut:
+         PortW[$3ce]:=$0003
+       else
+         PortW[$3ce]:=$0003
+    end;
+
+    PortW[$3ce]:=(LMask shl 8) or 8;
+{$push}
+{$r-}
+{$q-}
+    Mem[SegA000:ScrOfs]:=Mem[SegA000:ScrOfs]+1;
+{$pop}
+    {Port[$3ce]:=8;}{not needed, the register is already selected}
+    if HLength>0 then
+      begin
+         dec(HLength);
+         inc(ScrOfs);
+         if HLength>0 then
+           begin
+              Port[$3cf]:=$ff;
+{$ifndef tp}
+              seg_bytemove(dosmemselector,$a0000+ScrOfs,dosmemselector,$a0000+ScrOfs,HLength);
+{$else}
+              move(Ptr(SegA000,ScrOfs)^, Ptr(SegA000,ScrOfs)^, HLength);
+{$endif}
+              ScrOfs:=ScrOfs+HLength;
+           end;
+         Port[$3cf]:=RMask;
+{$push}
+{$r-}
+{$q-}
+         Mem[Sega000:ScrOfs]:=Mem[SegA000:ScrOfs]+1;
+{$pop}
+      end;
+    { clean up }
+    {Port[$3cf]:=0;}{not needed, the register is reset by the next operation:}
+    PortW[$3ce]:=$ff08;
+    PortW[$3ce]:=$0001;
+    PortW[$3ce]:=$0003;
+   end;
+
+  procedure VLine16(x,y,y2: smallint); {$ifndef fpc}far;{$endif fpc}
+
+   var
+     ytmp: smallint;
+     ScrOfs,i : longint;
+     BitMask : byte;
+
+  Begin
+    { must we swap the values? }
+    if y > y2 then
+     Begin
+       ytmp := y2;
+       y2 := y;
+       y:= ytmp;
+     end;
+    { First convert to global coordinates }
+    X   := X + StartXViewPort;
+    Y2  := Y2 + StartYViewPort;
+    Y   := Y + StartYViewPort;
+    if ClipPixels then
+      Begin
+         if LineClipped(x,y,x,y2,StartXViewPort,StartYViewPort,
+                StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
+            exit;
+      end;
+    ScrOfs:=y*ScrWidth+x div 8 + VideoOfs;
+    BitMask:=$80 shr (x and 7);
+    If CurrentWriteMode <> NotPut Then
+      PortW[$3ce]:= (CurrentColor shl 8)
+    else PortW[$3ce]:= (not CurrentColor) shl 8;
+    PortW[$3ce]:=$0f01;
+    PortW[$3ce]:=(BitMask shl 8) or 8;
+    case CurrentWriteMode of
+       XORPut:
+         PortW[$3ce]:=((3 shl 3) shl 8) or 3;
+       ANDPut:
+         PortW[$3ce]:=((1 shl 3) shl 8) or 3;
+       ORPut:
+         PortW[$3ce]:=((2 shl 3) shl 8) or 3;
+       NormalPut, NotPut:
+         PortW[$3ce]:=$0003
+       else
+         PortW[$3ce]:=$0003
+    end;
+    for i:=y to y2 do
+      begin
+{$push}
+{$r-}
+{$q-}
+         Mem[SegA000:ScrOfs]:=Mem[Sega000:ScrOfs]+1;
+{$pop}
+         ScrOfs:=ScrOfs+ScrWidth;
+      end;
+    { clean up }
+    {Port[$3cf]:=0;}{not needed, the register is reset by the next operation}
+    PortW[$3ce]:=$ff08;
+    PortW[$3ce]:=$0001;
+    PortW[$3ce]:=$0003;
+  End;
+
+
+ procedure SetVisual200(page: word); {$ifndef fpc}far;{$endif fpc}
+  { two page supPort... }
+  begin
+    if page > HardwarePages then exit;
+    asm
+      mov ax,[page]    { only lower byte is supPorted. }
+      mov ah,05h
+{$ifdef fpc}
+      push ebp
+      push esi
+      push edi
+      push ebx
+{$endif fpc}
+      int 10h
+{$ifdef fpc}
+      pop ebx
+      pop edi
+      pop esi
+      pop ebp
+{$endif fpc}
+
+      { read start address }
+      mov dx,3d4h
+      mov al,0ch
+      out dx,al
+      inc dx
+      in  al,dx
+      mov ah,al
+      dec dx
+      mov al,0dh
+      out dx,al
+      in  al,dx
+    end ['EDX','EAX'];
+  end;
+
+ procedure SetActive200(page: word); {$ifndef fpc}far;{$endif fpc}
+  { two page supPort... }
+  begin
+    case page of
+     0 : VideoOfs := 0;
+     1 : VideoOfs := 16384;
+     2 : VideoOfs := 32768;
+    else
+      VideoOfs := 0;
+    end;
+  end;
+
+ procedure SetVisual350(page: word); {$ifndef fpc}far;{$endif fpc}
+  { one page supPort... }
+  begin
+    if page > HardwarePages then exit;
+    asm
+      mov ax,[page]    { only lower byte is supPorted. }
+      mov ah,05h
+{$ifdef fpc}
+      push ebp
+      push esi
+      push edi
+      push ebx
+{$endif fpc}
+      int 10h
+{$ifdef fpc}
+      pop ebx
+      pop edi
+      pop esi
+      pop ebp
+{$endif fpc}
+    end ['EAX'];
+  end;
+
+ procedure SetActive350(page: word); {$ifndef fpc}far;{$endif fpc}
+  { one page supPort... }
+  begin
+    case page of
+     0 : VideoOfs := 0;
+     1 : VideoOfs := 32768;
+    else
+      VideoOfs := 0;
+    end;
+  end;
+
+
+
+
+
+ {************************************************************************}
+ {*                     320x200x256c Routines                            *}
+ {************************************************************************}
+
+ Procedure Init320; {$ifndef fpc}far;{$endif fpc}
+    begin
+      if DontClearGraphMemory then
+        CallInt10($93)
+      else
+        CallInt10($13);
+      VideoOfs := 0;
+    end;
+
+
+
+ Procedure PutPixel320(X,Y : smallint; Pixel: Word); {$ifndef fpc}far;{$endif fpc}
+ { x,y -> must be in local coordinates. Clipping if required. }
+  {$ifndef fpc}
+  Begin
+    X:= X + StartXViewPort;
+    Y:= Y + StartYViewPort;
+    { convert to absolute coordinates and then verify clipping...}
+    if ClipPixels then
+     Begin
+       if (X < StartXViewPort) or (X > (StartXViewPort + ViewWidth)) then
+         exit;
+       if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then
+         exit;
+     end;
+    asm
+      mov    es, [SegA000]
+      mov    ax, [Y]
+      mov    di, [X]
+      xchg   ah, al            { The value of Y must be in AH }
+      add    di, ax
+      shr    ax, 2
+      add    di, ax
+      add    di, [VideoOfs]    { point to correct page.. }
+      mov    ax, [Pixel]
+      mov    es:[di], al
+    end;
+  {$else fpc}
+  assembler;
+  asm
+      push eax
+      push ebx
+      push ecx
+      push edi
+{$IFDEF REGCALL}
+      movsx  edi, ax
+      movsx  ebx, dx
+      mov    al, cl
+{$ELSE REGCALL}
+      movsx  edi, x
+      movsx  ebx, y
+{$ENDIF REGCALL}
+      cmp    clippixels, 0
+      je     @putpix320noclip
+      test   edi, edi
+      jl     @putpix320done
+      test   ebx, ebx
+      jl     @putpix320done
+      cmp    di, ViewWidth
+      jg     @putpix320done
+      cmp    bx, ViewHeight
+      jg     @putpix320done
+@putpix320noclip:
+      movsx  ecx, StartYViewPort
+      movsx  edx, StartXViewPort
+      add    ebx, ecx
+      add    edi, edx
+{    add    edi, [VideoOfs]      no multiple pages in 320*200*256 }
+{$IFNDEF REGCALL}
+      mov    ax, [pixel]
+{$ENDIF REGCALL}
+      shl    ebx, 6
+      add    edi, ebx
+      mov    fs:[edi+ebx*4+$a0000], al
+@putpix320done:
+      pop edi
+      pop ecx
+      pop ebx
+      pop eax
+{$endif fpc}
+ end;
+
+
+ Function GetPixel320(X,Y: smallint):word; {$ifndef fpc}far;{$endif fpc}
+  {$ifndef fpc}
+  Begin
+   X:= X + StartXViewPort;
+   Y:= Y + StartYViewPort;
+   asm
+      mov    es, [SegA000]
+      mov    ax, [Y]
+      mov    di, [X]
+      xchg   ah, al            { The value of Y must be in AH }
+      add    di, ax
+      shr    ax, 2
+      add    di, ax
+      xor    ax, ax
+      add    di, [VideoOfs]   { point to correct gfx page ... }
+      mov    al,es:[di]
+      mov    @Result,ax
+    end;
+  {$else fpc}
+  assembler;
+  asm
+    push ebx
+    push ecx
+    push edx
+    push edi
+{$IFDEF REGCALL}
+    movsx  edi, ax
+    movsx  ebx, dx
+{$ELSE REGCALL}
+    movsx  edi, x
+    movsx  ebx, y
+{$ENDIF REGCALL}
+    movsx  ecx, StartYViewPort
+    movsx  edx, StartXViewPort
+    add    ebx, ecx
+    add    edi, edx
+ {   add    edi, [VideoOfs]       no multiple pages in 320*200*256 }
+    shl    ebx, 6
+    add    edi, ebx
+    movzx  eax, byte ptr fs:[edi+ebx*4+$a0000]
+    pop edi
+    pop edx
+    pop ecx
+    pop ebx
+ {$endif fpc}
+  end;
+
+
+ Procedure DirectPutPixel320(X,Y : smallint); {$ifndef fpc}far;{$endif fpc}
+ { x,y -> must be in global coordinates. No clipping. }
+{$ifndef asmgraph}
+ var offset: word;
+     dummy: Byte;
+ begin
+   dummy := CurrentColor;
+   offset := y * 320 + x + VideoOfs;
+   case CurrentWriteMode of
+     XorPut: dummy := dummy xor Mem[Sega000:offset];
+     OrPut: dummy := dummy or Mem[Sega000:offset];
+     AndPut: dummy := dummy and Mem[SegA000:offset];
+     NotPut: dummy := Not dummy;
+   end;
+   Mem[SegA000:offset] := dummy;
+ end;
+{$else asmgraph}
+{ note: still needs or/and/notput support !!!!! (JM) }
+  assembler;
+    asm
+  {$ifndef fpc}
+      mov    es, [SegA000]
+      mov    ax, [Y]
+      mov    di, [X]
+      xchg   ah, al            { The value of Y must be in AH }
+      add    di, ax
+      shr    ax, 2
+      add    di, ax
+{      add    di, [VideoOfs] no multiple pages support in 320*200*256 }
+      mov    ax, [CurrentColor]
+      cmp    [CurrentWriteMode],XORPut   { check write mode   }
+      jne    @MOVMode
+      mov    ah,es:[di]        { read the byte...             }
+      xor    al,ah             { xor it and return value into AL }
+    @MovMode:
+      mov    es:[di], al
+  {$else fpc}
+      push eax
+      push ebx
+      push edi
+{$IFDEF REGCALL}
+      movzx  edi, ax
+      movzx  ebx, dx
+{$ELSE REGCALL}
+      movzx  edi, x
+      movzx  ebx, y
+{$ENDIF REGCALL}
+   {   add    edi, [VideoOfs]       no multiple pages in 320*200*256 }
+      shl    ebx, 6
+      add    edi, ebx
+      mov    ax, [CurrentColor]
+      cmp    [CurrentWriteMode],XORPut   { check write mode   }
+      jne    @MOVMode
+      xor    al, fs:[edi+ebx*4+$a0000]
+     @MovMode:
+      mov    fs:[edi+ebx*4+$a0000], al
+      pop edi
+      pop ebx
+      pop eax
+{$endif fpc}
+  end;
+{$endif asmgraph}
+
+
+ procedure SetVisual320(page: word); {$ifndef fpc}far;{$endif fpc}
+  { no page supPort... }
+  begin
+    VideoOfs := 0;
+  end;
+
+ procedure SetActive320(page: word); {$ifndef fpc}far;{$endif fpc}
+  { no page supPort... }
+  begin
+    VideoOfs := 0;
+  end;
+
+ {************************************************************************}
+ {*                       Mode-X related routines                        *}
+ {************************************************************************}
+const CrtAddress: word = 0;
+
+ procedure InitModeX; {$ifndef fpc}far;{$endif fpc}
+  begin
+   asm
+     {see if we are using color-/monochorme display}
+     MOV DX,3CCh  {use output register:     }
+     IN AL,DX
+     TEST AL,1    {is it a color display?    }
+     MOV DX,3D4h
+     JNZ @L1      {yes  }
+     MOV DX,3B4h  {no  }
+  @L1:          {DX = 3B4h / 3D4h = CRTAddress-register for monochrome/color}
+     MOV CRTAddress,DX
+
+     MOV  AX, 0013h
+     MOV  BL, DontClearGraphMemory
+     OR   BL,BL
+     JZ   @L2
+     OR   AX, 080h
+  @L2:
+{$ifdef fpc}
+     push ebp
+     push esi
+     push edi
+     push ebx
+{$EndIf fpc}
+     INT  10h
+{$ifdef fpc}
+     pop ebx
+     pop edi
+     pop esi
+     pop ebp
+{$EndIf fpc}
+     MOV DX,03C4h   {select memory-mode-register at sequencer Port    }
+     MOV AL,04
+     OUT DX,AL
+     INC DX         {read in data via the according data register     }
+     IN  AL,DX
+     AND AL,0F7h    {bit 3 := 0: don't chain the 4 planes}
+     OR  AL,04      {bit 2 := 1: no odd/even mechanism }
+     OUT DX,AL      {activate new settings    }
+     MOV DX,03C4h   {s.a.: address sequencer reg. 2 (=map-mask),...   }
+     MOV AL,02
+     OUT DX,AL
+     INC DX
+     MOV AL,0Fh     {...and allow access to all 4 bit maps            }
+     OUT DX,AL
+{$ifndef fpc}
+     MOV AX,[SegA000]  {starting with segment A000h, set 8000h logical     }
+     MOV ES,AX      {words = 4*8000h physical words (because of 4     }
+     XOR DI,DI      {bitplanes) to 0                                  }
+     XOR AX,AX
+     MOV CX,8000h
+     CLD
+     REP STOSW
+{$else fpc}
+     push eax
+     push ecx
+     push es
+     push edi
+     push fs
+     mov edi, $a0000
+     pop es
+     xor eax, eax
+     mov ecx, 4000h
+     cld
+     rep stosd
+     pop edi
+     pop es
+     pop ecx
+     pop eax
+{$EndIf fpc}
+     MOV DX,CRTAddress  {address the underline-location-register at }
+     MOV AL,14h         {the CRT-controller Port, read out the according      }
+     OUT DX,AL          {data register:                            }
+     INC DX
+     IN  AL,DX
+     AND AL,0BFh    {bit 6:=0: no double word addressing scheme in}
+     OUT DX,AL      {video RAM                              }
+     DEC DX
+     MOV AL,17h     {select mode control register     }
+     OUT DX,AL
+     INC DX
+     IN  AL,DX
+     OR  AL,40h     {bit 6 := 1: memory access scheme=linear bit array      }
+     OUT DX,AL
+  end ['EDX','EBX','EAX'];
+ end;
+
+
+ Function GetPixelX(X,Y: smallint): word; {$ifndef fpc}far;{$endif fpc}
+{$ifndef asmgraph}
+ var offset: word;
+{$endif asmgraph}
+  begin
+     X:= X + StartXViewPort;
+     Y:= Y + StartYViewPort;
+{$ifndef asmgraph}
+     offset := y * 80 + x shr 2 + VideoOfs;
+     PortW[$3ce] := ((x and 3) shl 8) + 4;
+     GetPixelX := Mem[SegA000:offset];
+{$else asmgraph}
+    asm
+  {$ifndef fpc}
+     mov di,[Y]                   ; (* DI = Y coordinate                 *)
+     (* Multiply by 80 start *)
+     mov bx, di
+     shl di, 6                    ; (* Faster on 286/386/486 machines    *)
+     shl bx, 4
+     add di, bx                   ;  (* Multiply Value by 80             *)
+     (* End multiply by 80  *)
+     mov cx, [X]
+     mov ax, cx
+    {DI = Y * LINESIZE, BX = X, coordinates admissible}
+     shr ax, 1                    ; (* Faster on 286/86 machines         *)
+     shr ax, 1
+     add di, ax                ; {DI = Y * LINESIZE + (X SHR 2) }
+     add di, [VideoOfs]  ; (* Pointing at start of Active page *)
+    (* Select plane to use *)
+    mov dx, 03c4h
+    mov ax, FirstPlane        ; (* Map Mask & Plane Select Register *)
+    and cl, 03h               ; (* Get Plane Bits                   *)
+    shl ah, cl                ; (* Get Plane Select Value           *)
+    out dx, ax
+   (* End selection of plane *)
+    mov es,[SegA000]
+    mov al, ES:[DI]
+    xor ah, ah
+    mov @Result, ax
+  {$else fpc}
+     push eax
+     push ebx
+     push ecx
+     push edx
+     push edi
+     movzx edi,[Y]                   ; (* DI = Y coordinate                 *)
+     (* Multiply by 80 start *)
+     mov ebx, edi
+     shl edi, 6                    ; (* Faster on 286/386/486 machines    *)
+     shl ebx, 4
+     add edi, ebx                   ;  (* Multiply Value by 80             *)
+     (* End multiply by 80  *)
+     movzx ecx, [X]
+     movzx eax, [Y]
+    {DI = Y * LINESIZE, BX = X, coordinates admissible}
+     shr eax, 2
+     add edi, eax                ; {DI = Y * LINESIZE + (X SHR 2) }
+     add edi, [VideoOfs]  ; (* Pointing at start of Active page *)
+    (* Select plane to use *)
+    mov dx, 03c4h
+    mov ax, FirstPlane        ; (* Map Mask & Plane Select Register *)
+    and cl, 03h               ; (* Get Plane Bits                   *)
+    shl ah, cl                ; (* Get Plane Select Value           *)
+    out dx, ax
+   (* End selection of plane *)
+    mov ax, fs:[edi+$a0000]
+    mov @Result, ax
+    pop edi
+    pop edx
+    pop ecx
+    pop ebx
+    pop eax
+  {$endif fpc}
+   end;
+{$endif asmgraph}
+ end;
+
+ procedure SetVisualX(page: word); {$ifndef fpc}far;{$endif fpc}
+  { 4 page supPort... }
+
+   Procedure SetVisibleStart(AOffset: word); Assembler;
+   (* Select where the left corner of the screen will be *)
+   { By Matt Pritchard }
+    asm
+     push ax
+     push cx
+     push dx
+{$IFDEF REGCALL}
+     mov cx, dx
+{$ENDIF REGCALL}
+      { Wait if we are currently in a Vertical Retrace        }
+     MOV     DX, INPUT_1         { Input Status #1 Register       }
+   @DP_WAIT0:
+     IN      AL, DX              { Get VGA status                 }
+     AND     AL, VERT_RETRACE    { In Display mode yet?           }
+     JNZ     @DP_WAIT0           { If Not, wait for it            }
+
+    { Set the Start Display Address to the new page         }
+
+     MOV     DX, CRTC_Index      { We Change the VGA Sequencer    }
+     MOV     AL, START_DISP_LO   { Display Start Low Register     }
+{$ifndef fpc}
+     MOV     AH, BYTE PTR [AOffset] { Low 8 Bits of Start Addr    }
+     OUT     DX, AX              { Set Display Addr Low           }
+     MOV     AL, START_DISP_HI   { Display Start High Register    }
+     MOV     AH, BYTE PTR [AOffset+1] { High 8 Bits of Start Addr }
+{$else fpc}
+{$IFDEF REGCALL}
+    mov ah, cl
+{$ELSE REGCALL}
+    mov ah, byte [AOffset]
+{$ENDIF REGCALL}
+    out dx, ax
+    mov AL, START_DISP_HI
+{$IFDEF REGCALL}
+    mov ah, ch
+{$ELSE REGCALL}
+    mov ah, byte [AOffset+1]
+{$ENDIF REGCALL}
+{$endif fpc}
+     OUT     DX, AX              { Set Display Addr High          }
+     { Wait for a Vertical Retrace to smooth out things      }
+
+     MOV     DX, INPUT_1         { Input Status #1 Register       }
+
+  @DP_WAIT1:
+     IN      AL, DX              { Get VGA status                 }
+     AND     AL, VERT_RETRACE    { Vertical Retrace Start?        }
+     JZ      @DP_WAIT1           { If Not, wait for it            }
+    { Now Set Display Starting Address                     }
+     pop dx
+     pop cx
+     pop ax
+  end;
+
+{$ifdef fpc}
+  {$undef asmgraph}
+{$endif fpc}
+
+  begin
+    Case page of
+      0: SetVisibleStart(0);
+      1: SetVisibleStart(16000);
+      2: SetVisibleStart(32000);
+      3: SetVisibleStart(48000);
+    else
+      SetVisibleStart(0);
+    end;
+  end;
+
+ procedure SetActiveX(page: word); {$ifndef fpc}far;{$endif fpc}
+  { 4 page supPort... }
+  begin
+   case page of
+     0: VideoOfs := 0;
+     1: VideoOfs := 16000;
+     2: VideoOfs := 32000;
+     3: VideoOfs := 48000;
+   else
+     VideoOfs:=0;
+   end;
+  end;
+
+ Procedure PutPixelX(X,Y: smallint; color:word); {$ifndef fpc}far;{$endif fpc}
+{$ifndef asmgraph}
+ var offset: word;
+{$endif asmgraph}
+  begin
+    X:= X + StartXViewPort;
+    Y:= Y + StartYViewPort;
+    { convert to absolute coordinates and then verify clipping...}
+    if ClipPixels then
+     Begin
+       if (X < StartXViewPort) or (X > (StartXViewPort + ViewWidth)) then
+         exit;
+       if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then
+         exit;
+     end;
+{$ifndef asmgraph}
+    offset := y * 80 + x shr 2 + VideoOfs;
+    PortW[$3c4] := (hi(word(FirstPlane)) shl 8) shl (x and 3)+ lo(word(FirstPlane));
+    Mem[SegA000:offset] := color;
+{$else asmgraph}
+     asm
+      push ax
+      push bx
+      push cx
+      push dx
+      push es
+      push di
+      mov di,[Y]                   ; (* DI = Y coordinate                 *)
+      (* Multiply by 80 start *)
+      mov bx, di
+      shl di, 6                    ; (* Faster on 286/386/486 machines    *)
+      shl bx, 4
+      add di, bx                   ;  (* Multiply Value by 80             *)
+      (* End multiply by 80  *)
+      mov cx, [X]
+      mov ax, cx
+      {DI = Y * LINESIZE, BX = X, coordinates admissible}
+      shr ax, 2
+      add di, ax                ; {DI = Y * LINESIZE + (X SHR 2) }
+      add di, [VideoOfs]        ; (* Pointing at start of Active page *)
+      (* Select plane to use *)
+      mov dx, 03c4h
+      mov ax, FirstPlane        ; (* Map Mask & Plane Select Register *)
+      and cl, 03h               ; (* Get Plane Bits                   *)
+      shl ah, cl                ; (* Get Plane Select Value           *)
+      out dx, ax
+      (* End selection of plane *)
+      mov es,[SegA000]
+      mov ax,[Color]            ; { only lower byte is used. }
+      cmp [CurrentWriteMode],XORPut   { check write mode   }
+      jne @MOVMode
+      mov ah,es:[di]        { read the byte...             }
+      xor al,ah             { xor it and return value into AL }
+    @MovMode:
+      mov es:[di], al
+      pop di
+      pop es
+      pop dx
+      pop cx
+      pop bx
+      pop ax
+    end;
+{$endif asmgraph}
+  end;
+
+
+ Procedure DirectPutPixelX(X,Y: smallint); {$ifndef fpc}far;{$endif fpc}
+ { x,y -> must be in global coordinates. No clipping. }
+{$ifndef asmgraph}
+ Var offset: Word;
+     dummy: Byte;
+ begin
+   offset := y * 80 + x shr 2 + VideoOfs;
+   case CurrentWriteMode of
+     XorPut:
+       begin
+         PortW[$3ce] := ((x and 3) shl 8) + 4;
+         dummy := CurrentColor xor Mem[Sega000: offset];
+       end;
+     OrPut:
+       begin
+         PortW[$3ce] := ((x and 3) shl 8) + 4;
+         dummy := CurrentColor or Mem[Sega000: offset];
+       end;
+     AndPut:
+       begin
+         PortW[$3ce] := ((x and 3) shl 8) + 4;
+         dummy := CurrentColor and Mem[Sega000: offset];
+       end;
+     NotPut: dummy := Not CurrentColor;
+     else dummy := CurrentColor;
+   end;
+   PortW[$3c4] := (hi(word(FirstPlane)) shl 8) shl (x and 3)+ lo(word(FirstPlane));
+   Mem[Sega000: offset] := Dummy;
+ end;
+{$else asmgraph}
+{ note: still needs or/and/notput support !!!!! (JM) }
+ Assembler;
+ asm
+   push ax
+   push bx
+   push cx
+   push dx
+   push es
+   push di
+{$IFDEF REGCALL}
+   mov cl, al
+   mov di, dx
+{$ELSE REGCALL}
+   mov cx, [X]
+   mov ax, cx
+   mov di, [Y]                   ; (* DI = Y coordinate                 *)
+{$ENDIF REGCALL}
+ (* Multiply by 80 start *)
+   mov bx, di
+   shl di, 6                    ; (* Faster on 286/386/486 machines    *)
+   shl bx, 4
+   add di, bx                   ;  (* Multiply Value by 80             *)
+ (* End multiply by 80  *)
+  {DI = Y * LINESIZE, BX = X, coordinates admissible}
+   shr ax, 2
+   add di, ax                ; {DI = Y * LINESIZE + (X SHR 2) }
+   add di, [VideoOfs]        ; (* Pointing at start of Active page *)
+ (* Select plane to use *)
+   mov dx, 03c4h
+   mov ax, FirstPlane        ; (* Map Mask & Plane Select Register *)
+   and cl, 03h               ; (* Get Plane Bits                   *)
+   shl ah, cl                ; (* Get Plane Select Value           *)
+   out dx, ax
+ (* End selection of plane *)
+   mov es,[SegA000]
+   mov ax,[CurrentColor]     ; { only lower byte is used. }
+   cmp [CurrentWriteMode],XORPut   { check write mode   }
+   jne @MOVMode
+   mov ah,es:[di]        { read the byte...             }
+   xor al,ah             { xor it and return value into AL }
+ @MovMode:
+   mov es:[di], al
+   pop di
+   pop es
+   pop dx
+   pop cx
+   pop bx
+   pop ax
+ end;
+{$endif asmgraph}
+*)
+
+
+ {************************************************************************}
+ {*                       General routines                               *}
+ {************************************************************************}
+ var
+  SavePtr : pointer;    { pointer to video state                 }
+{  CrtSavePtr: pointer;}  { pointer to video state when CrtMode gets called }
+  StateSize: word;      { size in 64 byte blocks for video state }
+  VideoMode: byte;      { old video mode before graph mode       }
+  SaveSupPorted : Boolean;    { Save/Restore video state supPorted? }
+
+
+      {**************************************************************}
+      {*                     DPMI Routines                          *}
+      {**************************************************************}
+
+{//$IFDEF DPMI}
+  RealStateSeg: word;    { Real segment of saved video state }
+
+ Procedure SaveStateVGA; {$ifndef fpc}far;{$endif fpc}
+ var
+  PtrLong: longint;
+  regs: Registers;
+  begin
+    SaveSupPorted := FALSE;
+    SavePtr := nil;
+    { Get the video mode }
+    asm
+      mov  ah,0fh
+      push bp
+      push si
+      push di
+      push bx
+      int  10h
+      pop bx
+      pop di
+      pop si
+      pop bp
+      mov  [VideoMode], al
+    end ['AX'];
+    { saving/restoring video state screws up Windows (JM) }
+    if inWindows then
+      exit;
+(*    { Prepare to save video state...}
+    asm
+      mov  ax, 1C00h       { get buffer size to save state }
+      mov  cx, 00000111b   { Save DAC / Data areas / Hardware states }
+{$ifdef fpc}
+      push ebx
+      push ebp
+      push esi
+      push edi
+{$endif fpc}
+      int  10h
+{$ifdef fpc}
+      pop edi
+      pop esi
+      pop ebp
+{$endif fpc}
+      mov  [StateSize], bx
+{$ifdef fpc}
+      pop ebx
+{$endif fpc}
+      cmp  al,01ch
+      jnz  @notok
+      mov  [SaveSupPorted],TRUE
+     @notok:
+    end ['ECX','EAX'];
+    if SaveSupPorted then
+      begin
+
+{$ifndef fpc}
+        PtrLong:=GlobalDosAlloc(64*StateSize);  { values returned in 64-byte blocks }
+{$else fpc}
+        PtrLong:=Global_Dos_Alloc(64*StateSize);  { values returned in 64-byte blocks }
+{$endif fpc}
+        if PtrLong = 0 then
+           RunError(203);
+        SavePtr := pointer(longint(PtrLong and $0000ffff) shl 16);
+{$ifndef fpc}
+        { In FPC mode, we can't do anything with this (no far pointers)  }
+        { However, we still need to keep it to be able to free the       }
+        { memory afterwards. Since this data is not accessed in PM code, }
+        { there's no need to save it in a seperate buffer (JM)           }
+        if not assigned(SavePtr) then
+           RunError(203);
+{$endif fpc}
+        RealStateSeg := word(PtrLong shr 16);
+        FillChar(regs, sizeof(regs), #0);
+        { call the real mode interrupt ... }
+        regs.eax := $1C01;      { save the state buffer                   }
+        regs.ecx := $07;        { Save DAC / Data areas / Hardware states }
+        regs.es := RealStateSeg;
+        regs.ebx := 0;
+        RealIntr($10,regs);
+        FillChar(regs, sizeof(regs), #0);
+        { restore state, according to Ralph Brown Interrupt list }
+        { some BIOS corrupt the hardware after a save...         }
+        regs.eax := $1C02;      { restore the state buffer                }
+        regs.ecx := $07;        { rest DAC / Data areas / Hardware states }
+        regs.es := RealStateSeg;
+        regs.ebx := 0;
+        RealIntr($10,regs);
+      end;*)
+  end;
+
+ procedure RestoreStateVGA; {$ifndef fpc}far;{$endif fpc}
+  var
+   regs:Registers;
+  begin
+     { go back to the old video mode...}
+     asm
+      mov  ah,00
+      mov  al,[VideoMode]
+      push bp
+      push si
+      push di
+      push bx
+      int  10h
+      pop bx
+      pop di
+      pop si
+      pop bp
+     end ['AX'];
+(*     { then restore all state information }
+{$ifndef fpc}
+     if assigned(SavePtr) and (SaveSupPorted=TRUE) then
+{$else fpc}
+     { No far pointer supPort, so it's possible that that assigned(SavePtr) }
+     { would return false under FPC. Just check if it's different from nil. }
+     if (SavePtr <> nil) and (SaveSupPorted=TRUE) then
+{$endif fpc}
+      begin
+        FillChar(regs, sizeof(regs), #0);
+        { restore state, according to Ralph Brown Interrupt list }
+        { some BIOS corrupt the hardware after a save...         }
+         regs.eax := $1C02;      { restore the state buffer                }
+         regs.ecx := $07;        { rest DAC / Data areas / Hardware states }
+         regs.es := RealStateSeg;
+         regs.ebx := 0;
+         RealIntr($10,regs);
+(*
+{$ifndef fpc}
+         if GlobalDosFree(longint(SavePtr) shr 16)<>0 then
+{$else fpc}
+         if Not Global_Dos_Free(longint(SavePtr) shr 16) then
+{$endif fpc}
+          RunError(216);
+
+         SavePtr := nil;
+*)
+       end;*)
+  end;
+
+{//$ELSE}
+(*
+      {**************************************************************}
+      {*                     Real mode routines                     *}
+      {**************************************************************}
+
+
+ Procedure SaveStateVGA; far;
+  begin
+    SavePtr := nil;
+    SaveSupPorted := FALSE;
+    { Get the video mode }
+    asm
+      mov  ah,0fh
+      int  10h
+      mov  [VideoMode], al
+    end;
+    { Prepare to save video state...}
+    asm
+      mov  ax, 1C00h       { get buffer size to save state }
+      mov  cx, 00000111b   { Save DAC / Data areas / Hardware states }
+      int  10h
+      mov  [StateSize], bx
+      cmp  al,01ch
+      jnz  @notok
+      mov  [SaveSupPorted],TRUE
+     @notok:
+    end;
+    if SaveSupPorted then
+      Begin
+        GetMem(SavePtr, 64*StateSize); { values returned in 64-byte blocks }
+        if not assigned(SavePtr) then
+           RunError(203);
+        asm
+         mov  ax, 1C01h       { save the state buffer                   }
+         mov  cx, 00000111b   { Save DAC / Data areas / Hardware states }
+         mov  es, WORD PTR [SavePtr+2]
+         mov  bx, WORD PTR [SavePtr]
+         int  10h
+        end;
+        { restore state, according to Ralph Brown Interrupt list }
+        { some BIOS corrupt the hardware after a save...         }
+        asm
+         mov  ax, 1C02h       { save the state buffer                   }
+         mov  cx, 00000111b   { Save DAC / Data areas / Hardware states }
+         mov  es, WORD PTR [SavePtr+2]
+         mov  bx, WORD PTR [SavePtr]
+         int  10h
+        end;
+      end;
+  end;
+
+ procedure RestoreStateVGA; far;
+  begin
+     { go back to the old video mode...}
+     asm
+      mov  ah,00
+      mov  al,[VideoMode]
+      int  10h
+     end;
+
+     { then restore all state information }
+     if assigned(SavePtr) and (SaveSupPorted=TRUE) then
+       begin
+         { restore state, according to Ralph Brown Interrupt list }
+         asm
+           mov  ax, 1C02h       { save the state buffer                   }
+           mov  cx, 00000111b   { Save DAC / Data areas / Hardware states }
+           mov  es, WORD PTR [SavePtr+2]
+           mov  bx, WORD PTR [SavePtr]
+           int  10h
+         end;
+{        done in exitproc (JM)
+         FreeMem(SavePtr, 64*StateSize);}
+         SavePtr := nil;
+       end;
+  end;*)
+{//$ENDIF DPMI}
+
+   Procedure SetVGARGBAllPalette(const Palette:PaletteType); {$ifndef fpc}far;{$endif fpc}
+    var
+      c: byte;
+    begin
+      { wait for vertical retrace start/end}
+      while (port[$3da] and $8) <> 0 do;
+      while (port[$3da] and $8) = 0 do;
+      If MaxColor = 16 Then
+        begin
+          for c := 0 to 15 do
+            begin
+              { translate the color number for 16 color mode }
+              portb[$3c8] := toRealCols16[c];
+              portb[$3c9] := palette.colors[c].red shr 2;
+              portb[$3c9] := palette.colors[c].green shr 2;
+              portb[$3c9] := palette.colors[c].blue shr 2;
+            end
+        end
+      else
+        begin
+          portb[$3c8] := 0;
+          for c := 0 to 255 do
+            begin
+              { no need to set port[$3c8] every time if you set the entries }
+              { for successive colornumbers (JM)                            }
+              portb[$3c9] := palette.colors[c].red shr 2;
+              portb[$3c9] := palette.colors[c].green shr 2;
+              portb[$3c9] := palette.colors[c].blue shr 2;
+          end
+        end;
+    End;
+
+
+   { VGA is never a direct color mode, so no need to check ... }
+   Procedure SetVGARGBPalette(ColorNum, RedValue, GreenValue,
+      BlueValue : smallint); {$ifndef fpc}far;{$endif fpc}
+    begin
+      { translate the color number for 16 color mode }
+      If MaxColor = 16 Then
+        ColorNum := ToRealCols16[ColorNum];
+      asm
+        { on some hardware - there is a snow like effect       }
+        { when changing the palette register directly          }
+        { so we wait for a vertical retrace start period.      }
+        push ax
+        push dx
+        mov dx, $03da
+      @1:
+        in    al, dx          { Get input status register    }
+        test  al, $08         { check if in vertical retrace }
+        jnz   @1              { yes, complete it             }
+                              { we have to wait for the next }
+                              { retrace to assure ourselves  }
+                              { that we have time to complete }
+                              { the DAC operation within      }
+                              { the vertical retrace period   }
+       @2:
+        in    al, dx
+        test  al, $08
+        jz    @2              { repeat until vertical retrace start }
+
+        mov dx, $03c8       { Set color register address to use }
+        mov ax, [ColorNum]
+        out dx, al
+        inc dx              { Point to DAC registers            }
+        mov ax, [RedValue]  { Get RedValue                      }
+        shr ax, 1
+        shr ax, 1
+        out dx, al
+        mov ax, [GreenValue]{ Get RedValue                      }
+        shr ax, 1
+        shr ax, 1
+        out dx, al
+        mov ax, [BlueValue] { Get RedValue                      }
+        shr ax, 1
+        shr ax, 1
+        out dx, al
+        pop dx
+        pop ax
+      end
+    End;
+
+
+   { VGA is never a direct color mode, so no need to check ... }
+  Procedure GetVGARGBPalette(ColorNum: smallint; Var
+      RedValue, GreenValue, BlueValue : smallint); {$ifndef fpc}far;{$endif fpc}
+   begin
+     If MaxColor = 16 Then
+       ColorNum := ToRealCols16[ColorNum];
+     Port[$03C7] := ColorNum;
+     { we must convert to lsb values... because the vga uses the 6 msb bits }
+     { which is not compatible with anything.                               }
+     RedValue := smallint(Port[$3C9]) shl 2;
+     GreenValue := smallint(Port[$3C9]) shl 2;
+     BlueValue := smallint(Port[$3C9]) shl 2;
+   end;
+
+
+ {************************************************************************}
+ {*                       VESA related routines                          *}
+ {************************************************************************}
+{//$I vesa.inc}
+
+ {************************************************************************}
+ {*                       General routines                               *}
+ {************************************************************************}
+ procedure CloseGraph;
+ Begin
+    If not isgraphmode then
+      begin
+        _graphresult := grnoinitgraph;
+        exit
+      end;
+    if not assigned(RestoreVideoState) then
+      RunError(216);
+    RestoreVideoState;
+    isgraphmode := false;
+ end;
+(*
+ procedure LoadFont8x8;
+
+   var
+      r : registers;
+      x,y,c : longint;
+      data : array[0..127,0..7] of byte;
+
+   begin
+      r.ah:=$11;
+      r.al:=$30;
+      r.bh:=1;
+      RealIntr($10,r);
+      dosmemget(r.es,r.bp,data,sizeof(data));
+      for c:=0 to 127 do
+        for y:=0 to 7 do
+          for x:=0 to 7 do
+            if (data[c,y] and ($80 shr x))<>0 then
+              DefaultFontData[chr(c),y,x]:=1
+            else
+              DefaultFontData[chr(c),y,x]:=0;
+      { second part }
+      r.ah:=$11;
+      r.al:=$30;
+      r.bh:=0;
+      RealIntr($10,r);
+      dosmemget(r.es,r.bp,data,sizeof(data));
+      for c:=0 to 127 do
+        for y:=0 to 7 do
+          for x:=0 to 7 do
+            if (data[c,y] and ($80 shr x))<>0 then
+              DefaultFontData[chr(c+128),y,x]:=1
+            else
+              DefaultFontData[chr(c+128),y,x]:=0;
+   end;
+*)
+  function QueryAdapterInfo:PModeInfo;
+  { This routine returns the head pointer to the list }
+  { of supPorted graphics modes.                      }
+  { Returns nil if no graphics mode supported.        }
+  { This list is READ ONLY!                           }
+
+    function Test6845(CRTCPort: Word): Boolean;
+    const
+      TestRegister = $0F;
+    var
+      OldValue, TestValue, ReadValue: Byte;
+    begin
+      { save the old value }
+      Port[CRTCPort] := TestRegister;
+      OldValue := Port[CRTCPort + 1];
+      TestValue := OldValue xor $56;
+
+      { try writing a new value to the CRTC register }
+      Port[CRTCPort] := TestRegister;
+      Port[CRTCPort + 1] := TestValue;
+
+      { check if the value has been written }
+      Port[CRTCPort] := TestRegister;
+      ReadValue := Port[CRTCPort + 1];
+      if ReadValue = TestValue then
+      begin
+        Test6845 := True;
+        { restore old value }
+        Port[CRTCPort] := TestRegister;
+        Port[CRTCPort + 1] := OldValue;
+      end
+      else
+        Test6845 := False;
+    end;
+
+   var
+    HGCDetected : Boolean;
+    CGADetected : Boolean; { TRUE means real CGA, *not* EGA or VGA }
+    EGADetected : Boolean; { TRUE means EGA or higher (VGA) }
+    VGADetected : Boolean;
+    mode: TModeInfo;
+   begin
+     QueryAdapterInfo := ModeList;
+     { If the mode listing already exists... }
+     { simply return it, without changing    }
+     { anything...                           }
+     if assigned(ModeList) then
+       exit;
+
+
+     HGCDetected := FALSE;
+     CGADetected := FALSE;
+     EGADetected := FALSE;
+     VGADetected := FALSE;
+     { check if EGA adapter supPorted...       }
+     asm
+       mov ah,12h
+       mov bx,0FF10h
+       push bx
+       push bp
+       push si
+       push di
+       int 10h              { get EGA information }
+       pop di
+       pop si
+       pop bp
+       cmp bh,0ffh
+       pop bx
+       jz  @noega
+       mov [EGADetected],TRUE
+     @noega:
+     end ['BX','AX'];
+{$ifdef logging}
+     LogLn('EGA detected: '+strf(Longint(EGADetected)));
+{$endif logging}
+     { check if VGA adapter supPorted...       }
+     if EGADetected then
+       begin
+        asm
+         mov ax,1a00h
+         push bp
+         push si
+         push di
+         push bx
+         int 10h            { get display combination code...}
+         pop bx
+         pop di
+         pop si
+         pop bp
+         cmp al,1ah         { check if supPorted...          }
+         jne @novga
+         { now check if this is the ATI EGA }
+         mov ax,1c00h       { get state size for save...     }
+                            { ... all imPortant data         }
+         mov cx,07h
+         push bp
+         push si
+         push di
+         push bx
+         int 10h
+         pop bx
+         pop di
+         pop si
+         pop bp
+         cmp al,1ch         { success?                       }
+         jne @novga
+         mov [VGADetected],TRUE
+        @novga:
+        end ['CX','AX'];
+       end;
+{$ifdef logging}
+       LogLn('VGA detected: '+strf(Longint(VGADetected)));
+{$endif logging}
+     { older than EGA? }
+     if not EGADetected then
+       begin
+         { check if Hercules adapter supPorted ... }
+         HGCDetected := Test6845($3B4);
+         { check if CGA adapter supPorted ... }
+         CGADetected := Test6845($3D4);
+       end;
+(*     if HGCDetected then
+       begin
+         { HACK:
+           until we create Save/RestoreStateHGC, we use Save/RestoreStateVGA
+           with the inWindows flag enabled (so we only save the mode number
+           and nothing else) }
+         if not VGADetected then
+           inWindows := true;
+         SaveVideoState := @SaveStateVGA;
+         RestoreVideoState := @RestoreStateVGA;
+
+         InitMode(mode);
+         mode.DriverNumber := HercMono;
+         mode.HardwarePages := 1;
+         mode.ModeNumber := HercMonoHi;
+         mode.ModeName:='720 x 348 HERCULES';
+         mode.MaxColor := 2;
+         mode.PaletteSize := 16;
+         mode.DirectColor := FALSE;
+         mode.MaxX := 719;
+         mode.MaxY := 347;
+         mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixelHGC720;
+         mode.PutPixel:={$ifdef fpc}@{$endif}PutPixelHGC720;
+         mode.GetPixel:={$ifdef fpc}@{$endif}GetPixelHGC720;
+         mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetHGCRGBPalette;
+         mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetHGCRGBPalette;
+         mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualHGC720;
+         mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveHGC720;
+         mode.InitMode := {$ifdef fpc}@{$endif}InitHGC720;
+         mode.HLine := {$ifdef fpc}@{$endif}HLineHGC720;
+         mode.SetBkColor := {$ifdef fpc}@{$endif}SetBkColorHGC720;
+         mode.GetBkColor := {$ifdef fpc}@{$endif}GetBkColorHGC720;
+         mode.XAspect := 7500;
+         mode.YAspect := 10000;
+         AddMode(mode);
+       end;*)
+     if CGADetected or EGADetected then
+       begin
+         { HACK:
+           until we create Save/RestoreStateCGA, we use Save/RestoreStateVGA
+           with the inWindows flag enabled (so we only save the mode number
+           and nothing else) }
+         if not VGADetected then
+           inWindows := true;
+         SaveVideoState := @SaveStateVGA;
+         RestoreVideoState := @RestoreStateVGA;
+
+         { now add all standard CGA modes...       }
+         InitMode(mode);
+         mode.DriverNumber := CGA;
+         mode.HardwarePages := 0;
+         mode.ModeNumber := CGAC0;
+         mode.ModeName:='320 x 200 CGA C0';
+         mode.MaxColor := 4;
+         mode.PaletteSize := 16;
+         mode.DirectColor := FALSE;
+         mode.MaxX := 319;
+         mode.MaxY := 199;
+         mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixelCGA320;
+         mode.PutPixel:={$ifdef fpc}@{$endif}PutPixelCGA320;
+         mode.GetPixel:={$ifdef fpc}@{$endif}GetPixelCGA320;
+         mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVGARGBPalette;
+         mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVGARGBPalette;
+         mode.SetAllPalette := {$ifdef fpc}@{$endif}SetVGARGBAllPalette;
+         mode.InitMode := {$ifdef fpc}@{$endif}InitCGA320C0;
+         mode.HLine := {$ifdef fpc}@{$endif}HLineCGA320;
+         mode.SetBkColor := {$ifdef fpc}@{$endif}SetBkColorCGA320;
+         mode.GetBkColor := {$ifdef fpc}@{$endif}GetBkColorCGA320;
+         mode.XAspect := 8333;
+         mode.YAspect := 10000;
+         AddMode(mode);
+
+         InitMode(mode);
+         mode.DriverNumber := CGA;
+         mode.HardwarePages := 0;
+         mode.ModeNumber := CGAC1;
+         mode.ModeName:='320 x 200 CGA C1';
+         mode.MaxColor := 4;
+         mode.PaletteSize := 16;
+         mode.DirectColor := FALSE;
+         mode.MaxX := 319;
+         mode.MaxY := 199;
+         mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixelCGA320;
+         mode.PutPixel:={$ifdef fpc}@{$endif}PutPixelCGA320;
+         mode.GetPixel:={$ifdef fpc}@{$endif}GetPixelCGA320;
+         mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVGARGBPalette;
+         mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVGARGBPalette;
+         mode.SetAllPalette := {$ifdef fpc}@{$endif}SetVGARGBAllPalette;
+         mode.InitMode := {$ifdef fpc}@{$endif}InitCGA320C1;
+         mode.HLine := {$ifdef fpc}@{$endif}HLineCGA320;
+         mode.SetBkColor := {$ifdef fpc}@{$endif}SetBkColorCGA320;
+         mode.GetBkColor := {$ifdef fpc}@{$endif}GetBkColorCGA320;
+         mode.XAspect := 8333;
+         mode.YAspect := 10000;
+         AddMode(mode);
+
+         InitMode(mode);
+         mode.DriverNumber := CGA;
+         mode.HardwarePages := 0;
+         mode.ModeNumber := CGAC2;
+         mode.ModeName:='320 x 200 CGA C2';
+         mode.MaxColor := 4;
+         mode.PaletteSize := 16;
+         mode.DirectColor := FALSE;
+         mode.MaxX := 319;
+         mode.MaxY := 199;
+         mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixelCGA320;
+         mode.PutPixel:={$ifdef fpc}@{$endif}PutPixelCGA320;
+         mode.GetPixel:={$ifdef fpc}@{$endif}GetPixelCGA320;
+         mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVGARGBPalette;
+         mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVGARGBPalette;
+         mode.SetAllPalette := {$ifdef fpc}@{$endif}SetVGARGBAllPalette;
+         mode.InitMode := {$ifdef fpc}@{$endif}InitCGA320C2;
+         mode.HLine := {$ifdef fpc}@{$endif}HLineCGA320;
+         mode.SetBkColor := {$ifdef fpc}@{$endif}SetBkColorCGA320;
+         mode.GetBkColor := {$ifdef fpc}@{$endif}GetBkColorCGA320;
+         mode.XAspect := 8333;
+         mode.YAspect := 10000;
+         AddMode(mode);
+
+         InitMode(mode);
+         mode.DriverNumber := CGA;
+         mode.HardwarePages := 0;
+         mode.ModeNumber := CGAC3;
+         mode.ModeName:='320 x 200 CGA C3';
+         mode.MaxColor := 4;
+         mode.PaletteSize := 16;
+         mode.DirectColor := FALSE;
+         mode.MaxX := 319;
+         mode.MaxY := 199;
+         mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixelCGA320;
+         mode.PutPixel:={$ifdef fpc}@{$endif}PutPixelCGA320;
+         mode.GetPixel:={$ifdef fpc}@{$endif}GetPixelCGA320;
+         mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVGARGBPalette;
+         mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVGARGBPalette;
+         mode.SetAllPalette := {$ifdef fpc}@{$endif}SetVGARGBAllPalette;
+         mode.InitMode := {$ifdef fpc}@{$endif}InitCGA320C3;
+         mode.HLine := {$ifdef fpc}@{$endif}HLineCGA320;
+         mode.SetBkColor := {$ifdef fpc}@{$endif}SetBkColorCGA320;
+         mode.GetBkColor := {$ifdef fpc}@{$endif}GetBkColorCGA320;
+         mode.XAspect := 8333;
+         mode.YAspect := 10000;
+         AddMode(mode);
+
+         InitMode(mode);
+         mode.DriverNumber := CGA;
+         mode.HardwarePages := 0;
+         mode.ModeNumber := CGAHi;
+         mode.ModeName:='640 x 200 CGA';
+         mode.MaxColor := 2;
+         mode.PaletteSize := 16;
+         mode.DirectColor := FALSE;
+         mode.MaxX := 639;
+         mode.MaxY := 199;
+         mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixelCGA640;
+         mode.PutPixel:={$ifdef fpc}@{$endif}PutPixelCGA640;
+         mode.GetPixel:={$ifdef fpc}@{$endif}GetPixelCGA640;
+         mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVGARGBPalette;
+         mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVGARGBPalette;
+         mode.SetAllPalette := {$ifdef fpc}@{$endif}SetVGARGBAllPalette;
+         mode.InitMode := {$ifdef fpc}@{$endif}InitCGA640;
+         mode.HLine := {$ifdef fpc}@{$endif}HLineCGA640;
+         mode.SetBkColor := {$ifdef fpc}@{$endif}SetBkColorCGA640;
+         mode.GetBkColor := {$ifdef fpc}@{$endif}GetBkColorCGA640;
+         mode.XAspect := 4167;
+         mode.YAspect := 10000;
+         AddMode(mode);
+       end;
+
+(*     if EGADetected then
+       begin
+         { HACK:
+           until we create Save/RestoreStateEGA, we use Save/RestoreStateVGA
+           with the inWindows flag enabled (so we only save the mode number
+           and nothing else) }
+         if not VGADetected then
+           inWindows := true;
+         SaveVideoState := @SaveStateVGA;
+         RestoreVideoState := @RestoreStateVGA;
+
+         InitMode(mode);
+         mode.ModeNumber:=EGALo;
+         mode.DriverNumber := EGA;
+         mode.ModeName:='640 x 200 EGA';
+         mode.MaxColor := 16;
+         mode.HardwarePages := 2;
+         mode.DirectColor := FALSE;
+         mode.PaletteSize := mode.MaxColor;
+         mode.MaxX := 639;
+         mode.MaxY := 199;
+         mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixel16;
+         mode.PutPixel:={$ifdef fpc}@{$endif}PutPixel16;
+         mode.GetPixel:={$ifdef fpc}@{$endif}GetPixel16;
+         mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVGARGBPalette;
+         mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVGARGBPalette;
+         mode.SetAllPalette := {$ifdef fpc}@{$endif}SetVGARGBAllPalette;
+         mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisual200;
+         mode.SetActivePage := {$ifdef fpc}@{$endif}SetActive200;
+         mode.InitMode := {$ifdef fpc}@{$endif}Init640x200x16;
+         mode.HLine := {$ifdef fpc}@{$endif}HLine16;
+         mode.VLine := {$ifdef fpc}@{$endif}VLine16;
+         mode.GetScanLine := {$ifdef fpc}@{$endif}GetScanLine16;
+         mode.XAspect := 4500;
+         mode.YAspect := 10000;
+         AddMode(mode);
+
+         InitMode(mode);
+         mode.ModeNumber:=EGAHi;
+         mode.DriverNumber := EGA;
+         mode.ModeName:='640 x 350 EGA';
+         mode.HardwarePages := 1;
+         mode.MaxColor := 16;
+         mode.DirectColor := FALSE;
+         mode.PaletteSize := mode.MaxColor;
+         mode.MaxX := 639;
+         mode.MaxY := 349;
+         mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixel16;
+         mode.PutPixel:={$ifdef fpc}@{$endif}PutPixel16;
+         mode.GetPixel:={$ifdef fpc}@{$endif}GetPixel16;
+         mode.InitMode := {$ifdef fpc}@{$endif}Init640x350x16;
+         mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVGARGBPalette;
+         mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVGARGBPalette;
+         mode.SetAllPalette := {$ifdef fpc}@{$endif}SetVGARGBAllPalette;
+         mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisual350;
+         mode.SetActivePage := {$ifdef fpc}@{$endif}SetActive350;
+         mode.HLine := {$ifdef fpc}@{$endif}HLine16;
+         mode.VLine := {$ifdef fpc}@{$endif}VLine16;
+         mode.GetScanLine := {$ifdef fpc}@{$endif}GetScanLine16;
+         mode.XAspect := 7750;
+         mode.YAspect := 10000;
+         AddMode(mode);
+       end;
+
+     if VGADetected then
+       begin
+         SaveVideoState := @SaveStateVGA;
+{$ifdef logging}
+         LogLn('Setting VGA SaveVideoState to '+strf(longint(SaveVideoState)));
+{$endif logging}
+         RestoreVideoState := @RestoreStateVGA;
+{$ifdef logging}
+         LogLn('Setting VGA RestoreVideoState to '+strf(longint(RestoreVideoState)));
+{$endif logging}
+
+         { now add all standard MCGA modes...       }
+         { yes, most of these are the same as the CGA modes; this is TP7
+           compatible }
+         InitMode(mode);
+         mode.DriverNumber := MCGA;
+         mode.HardwarePages := 0;
+         mode.ModeNumber := MCGAC0;
+         mode.ModeName:='320 x 200 CGA C0'; { yes, it says 'CGA' even for the MCGA driver; this is TP7 compatible }
+         mode.MaxColor := 4;
+         mode.PaletteSize := 16;
+         mode.DirectColor := FALSE;
+         mode.MaxX := 319;
+         mode.MaxY := 199;
+         mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixelCGA320;
+         mode.PutPixel:={$ifdef fpc}@{$endif}PutPixelCGA320;
+         mode.GetPixel:={$ifdef fpc}@{$endif}GetPixelCGA320;
+         mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVGARGBPalette;
+         mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVGARGBPalette;
+         mode.SetAllPalette := {$ifdef fpc}@{$endif}SetVGARGBAllPalette;
+         mode.InitMode := {$ifdef fpc}@{$endif}InitCGA320C0;
+         mode.HLine := {$ifdef fpc}@{$endif}HLineCGA320;
+         mode.SetBkColor := {$ifdef fpc}@{$endif}SetBkColorCGA320;
+         mode.GetBkColor := {$ifdef fpc}@{$endif}GetBkColorCGA320;
+         mode.XAspect := 8333;
+         mode.YAspect := 10000;
+         AddMode(mode);
+
+         InitMode(mode);
+         mode.DriverNumber := MCGA;
+         mode.HardwarePages := 0;
+         mode.ModeNumber := MCGAC1;
+         mode.ModeName:='320 x 200 CGA C1'; { yes, it says 'CGA' even for the MCGA driver; this is TP7 compatible }
+         mode.MaxColor := 4;
+         mode.PaletteSize := 16;
+         mode.DirectColor := FALSE;
+         mode.MaxX := 319;
+         mode.MaxY := 199;
+         mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixelCGA320;
+         mode.PutPixel:={$ifdef fpc}@{$endif}PutPixelCGA320;
+         mode.GetPixel:={$ifdef fpc}@{$endif}GetPixelCGA320;
+         mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVGARGBPalette;
+         mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVGARGBPalette;
+         mode.SetAllPalette := {$ifdef fpc}@{$endif}SetVGARGBAllPalette;
+         mode.InitMode := {$ifdef fpc}@{$endif}InitCGA320C1;
+         mode.HLine := {$ifdef fpc}@{$endif}HLineCGA320;
+         mode.SetBkColor := {$ifdef fpc}@{$endif}SetBkColorCGA320;
+         mode.GetBkColor := {$ifdef fpc}@{$endif}GetBkColorCGA320;
+         mode.XAspect := 8333;
+         mode.YAspect := 10000;
+         AddMode(mode);
+
+         InitMode(mode);
+         mode.DriverNumber := MCGA;
+         mode.HardwarePages := 0;
+         mode.ModeNumber := MCGAC2;
+         mode.ModeName:='320 x 200 CGA C2'; { yes, it says 'CGA' even for the MCGA driver; this is TP7 compatible }
+         mode.MaxColor := 4;
+         mode.PaletteSize := 16;
+         mode.DirectColor := FALSE;
+         mode.MaxX := 319;
+         mode.MaxY := 199;
+         mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixelCGA320;
+         mode.PutPixel:={$ifdef fpc}@{$endif}PutPixelCGA320;
+         mode.GetPixel:={$ifdef fpc}@{$endif}GetPixelCGA320;
+         mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVGARGBPalette;
+         mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVGARGBPalette;
+         mode.SetAllPalette := {$ifdef fpc}@{$endif}SetVGARGBAllPalette;
+         mode.InitMode := {$ifdef fpc}@{$endif}InitCGA320C2;
+         mode.HLine := {$ifdef fpc}@{$endif}HLineCGA320;
+         mode.SetBkColor := {$ifdef fpc}@{$endif}SetBkColorCGA320;
+         mode.GetBkColor := {$ifdef fpc}@{$endif}GetBkColorCGA320;
+         mode.XAspect := 8333;
+         mode.YAspect := 10000;
+         AddMode(mode);
+
+         InitMode(mode);
+         mode.DriverNumber := MCGA;
+         mode.HardwarePages := 0;
+         mode.ModeNumber := MCGAC3;
+         mode.ModeName:='320 x 200 CGA C3'; { yes, it says 'CGA' even for the MCGA driver; this is TP7 compatible }
+         mode.MaxColor := 4;
+         mode.PaletteSize := 16;
+         mode.DirectColor := FALSE;
+         mode.MaxX := 319;
+         mode.MaxY := 199;
+         mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixelCGA320;
+         mode.PutPixel:={$ifdef fpc}@{$endif}PutPixelCGA320;
+         mode.GetPixel:={$ifdef fpc}@{$endif}GetPixelCGA320;
+         mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVGARGBPalette;
+         mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVGARGBPalette;
+         mode.SetAllPalette := {$ifdef fpc}@{$endif}SetVGARGBAllPalette;
+         mode.InitMode := {$ifdef fpc}@{$endif}InitCGA320C3;
+         mode.HLine := {$ifdef fpc}@{$endif}HLineCGA320;
+         mode.SetBkColor := {$ifdef fpc}@{$endif}SetBkColorCGA320;
+         mode.GetBkColor := {$ifdef fpc}@{$endif}GetBkColorCGA320;
+         mode.XAspect := 8333;
+         mode.YAspect := 10000;
+         AddMode(mode);
+
+         InitMode(mode);
+         mode.DriverNumber := MCGA;
+         mode.HardwarePages := 0;
+         mode.ModeNumber := MCGAMed;
+         mode.ModeName:='640 x 200 CGA'; { yes, it says 'CGA' even for the MCGA driver; this is TP7 compatible }
+         mode.MaxColor := 2;
+         mode.PaletteSize := 16;
+         mode.DirectColor := FALSE;
+         mode.MaxX := 639;
+         mode.MaxY := 199;
+         mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixelCGA640;
+         mode.PutPixel:={$ifdef fpc}@{$endif}PutPixelCGA640;
+         mode.GetPixel:={$ifdef fpc}@{$endif}GetPixelCGA640;
+         mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVGARGBPalette;
+         mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVGARGBPalette;
+         mode.SetAllPalette := {$ifdef fpc}@{$endif}SetVGARGBAllPalette;
+         mode.InitMode := {$ifdef fpc}@{$endif}InitCGA640;
+         mode.HLine := {$ifdef fpc}@{$endif}HLineCGA640;
+         mode.SetBkColor := {$ifdef fpc}@{$endif}SetBkColorCGA640;
+         mode.GetBkColor := {$ifdef fpc}@{$endif}GetBkColorCGA640;
+         mode.XAspect := 4167;
+         mode.YAspect := 10000;
+         AddMode(mode);
+
+         InitMode(mode);
+         mode.DriverNumber := MCGA;
+         mode.HardwarePages := 0;
+         mode.ModeNumber := MCGAHi;
+         mode.ModeName:='640 x 480 MCGA';
+         mode.MaxColor := 2;
+         mode.PaletteSize := 16;
+         mode.DirectColor := FALSE;
+         mode.MaxX := 639;
+         mode.MaxY := 479;
+         mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixelMCGA640;
+         mode.PutPixel:={$ifdef fpc}@{$endif}PutPixelMCGA640;
+         mode.GetPixel:={$ifdef fpc}@{$endif}GetPixelMCGA640;
+         mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVGARGBPalette;
+         mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVGARGBPalette;
+         mode.SetAllPalette := {$ifdef fpc}@{$endif}SetVGARGBAllPalette;
+         mode.InitMode := {$ifdef fpc}@{$endif}InitMCGA640;
+         mode.HLine := {$ifdef fpc}@{$endif}HLineMCGA640;
+         mode.SetBkColor := {$ifdef fpc}@{$endif}SetBkColorMCGA640;
+         mode.GetBkColor := {$ifdef fpc}@{$endif}GetBkColorMCGA640;
+         mode.XAspect := 10000;
+         mode.YAspect := 10000;
+         AddMode(mode);
+
+
+         InitMode(mode);
+         { now add all standard VGA modes...       }
+         mode.DriverNumber:= LowRes;
+         mode.HardwarePages:= 0;
+         mode.ModeNumber:=0;
+         mode.ModeName:='320 x 200 VGA';
+         mode.MaxColor := 256;
+         mode.PaletteSize := mode.MaxColor;
+         mode.DirectColor := FALSE;
+         mode.MaxX := 319;
+         mode.MaxY := 199;
+         mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixel320;
+         mode.PutPixel:={$ifdef fpc}@{$endif}PutPixel320;
+         mode.GetPixel:={$ifdef fpc}@{$endif}GetPixel320;
+         mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVGARGBPalette;
+         mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVGARGBPalette;
+         mode.SetAllPalette := {$ifdef fpc}@{$endif}SetVGARGBAllPalette;
+         mode.InitMode := {$ifdef fpc}@{$endif}Init320;
+         mode.XAspect := 8333;
+         mode.YAspect := 10000;
+         AddMode(mode);
+
+         { now add all standard VGA modes...       }
+         InitMode(mode);
+         mode.DriverNumber:= LowRes;
+         mode.ModeNumber:=1;
+         mode.HardwarePages := 3; { 0..3 }
+         mode.ModeName:='320 x 200 ModeX';
+         mode.MaxColor := 256;
+         mode.DirectColor := FALSE;
+         mode.PaletteSize := mode.MaxColor;
+         mode.MaxX := 319;
+         mode.MaxY := 199;
+         mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixelX;
+         mode.PutPixel:={$ifdef fpc}@{$endif}PutPixelX;
+         mode.GetPixel:={$ifdef fpc}@{$endif}GetPixelX;
+         mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVGARGBPalette;
+         mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVGARGBPalette;
+         mode.SetAllPalette := {$ifdef fpc}@{$endif}SetVGARGBAllPalette;
+         mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualX;
+         mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveX;
+         mode.InitMode := {$ifdef fpc}@{$endif}InitModeX;
+         mode.XAspect := 8333;
+         mode.YAspect := 10000;
+         AddMode(mode);
+
+         InitMode(mode);
+         mode.ModeNumber:=VGALo;
+         mode.DriverNumber := VGA;
+         mode.ModeName:='640 x 200 EGA'; { yes, it says 'EGA' even for the VGA driver; this is TP7 compatible }
+         mode.MaxColor := 16;
+         mode.HardwarePages := 2;
+         mode.DirectColor := FALSE;
+         mode.PaletteSize := mode.MaxColor;
+         mode.MaxX := 639;
+         mode.MaxY := 199;
+         mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixel16;
+         mode.PutPixel:={$ifdef fpc}@{$endif}PutPixel16;
+         mode.GetPixel:={$ifdef fpc}@{$endif}GetPixel16;
+         mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVGARGBPalette;
+         mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVGARGBPalette;
+         mode.SetAllPalette := {$ifdef fpc}@{$endif}SetVGARGBAllPalette;
+         mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisual200;
+         mode.SetActivePage := {$ifdef fpc}@{$endif}SetActive200;
+         mode.InitMode := {$ifdef fpc}@{$endif}Init640x200x16;
+         mode.HLine := {$ifdef fpc}@{$endif}HLine16;
+         mode.VLine := {$ifdef fpc}@{$endif}VLine16;
+         mode.GetScanLine := {$ifdef fpc}@{$endif}GetScanLine16;
+         mode.XAspect := 4500;
+         mode.YAspect := 10000;
+         AddMode(mode);
+
+         InitMode(mode);
+         mode.ModeNumber:=VGAMed;
+         mode.DriverNumber := VGA;
+         mode.ModeName:='640 x 350 EGA'; { yes, it says 'EGA' even for the VGA driver; this is TP7 compatible }
+         mode.HardwarePages := 1;
+         mode.MaxColor := 16;
+         mode.DirectColor := FALSE;
+         mode.PaletteSize := mode.MaxColor;
+         mode.MaxX := 639;
+         mode.MaxY := 349;
+         mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixel16;
+         mode.PutPixel:={$ifdef fpc}@{$endif}PutPixel16;
+         mode.GetPixel:={$ifdef fpc}@{$endif}GetPixel16;
+         mode.InitMode := {$ifdef fpc}@{$endif}Init640x350x16;
+         mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVGARGBPalette;
+         mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVGARGBPalette;
+         mode.SetAllPalette := {$ifdef fpc}@{$endif}SetVGARGBAllPalette;
+         mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisual350;
+         mode.SetActivePage := {$ifdef fpc}@{$endif}SetActive350;
+         mode.HLine := {$ifdef fpc}@{$endif}HLine16;
+         mode.VLine := {$ifdef fpc}@{$endif}VLine16;
+         mode.GetScanLine := {$ifdef fpc}@{$endif}GetScanLine16;
+         mode.XAspect := 7750;
+         mode.YAspect := 10000;
+         AddMode(mode);
+
+         InitMode(mode);
+         mode.ModeNumber:=VGAHi;
+         mode.DriverNumber := VGA;
+         mode.HardwarePages := 0;
+         mode.ModeName:='640 x 480 VGA';
+         mode.MaxColor := 16;
+         mode.DirectColor := FALSE;
+         mode.PaletteSize := mode.MaxColor;
+         mode.MaxX := 639;
+         mode.MaxY := 479;
+         mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixel16;
+         mode.PutPixel:={$ifdef fpc}@{$endif}PutPixel16;
+         mode.GetPixel:={$ifdef fpc}@{$endif}GetPixel16;
+         mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVGARGBPalette;
+         mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVGARGBPalette;
+         mode.SetAllPalette := {$ifdef fpc}@{$endif}SetVGARGBAllPalette;
+         mode.InitMode := {$ifdef fpc}@{$endif}Init640x480x16;
+         mode.HLine := {$ifdef fpc}@{$endif}HLine16;
+         mode.VLine := {$ifdef fpc}@{$endif}VLine16;
+         mode.GetScanLine := {$ifdef fpc}@{$endif}GetScanLine16;
+         mode.XAspect := 10000;
+         mode.YAspect := 10000;
+         AddMode(mode);
+       end;
+
+     { check if VESA adapter supPorted...      }
+{$ifndef noSupPortVESA}
+     hasVesa := getVesaInfo(VESAInfo);
+     { VBE Version v1.00 is unstable, therefore }
+     { only VBE v1.1 and later are supported.   }
+     if (hasVESA=TRUE) and (VESAInfo.Version <= $0100) then
+       hasVESA := False;
+{$else noSupPortVESA}
+     hasVESA := false;
+{$endif noSupPortVESA}
+     if hasVesa then
+       begin
+         { We have to set and restore the entire VESA state }
+         { otherwise, if we use the VGA BIOS only function  }
+         { there might be a crash under DPMI, such as in the}
+         { ATI Mach64                                       }
+         SaveVideoState := @SaveStateVESA;
+{$ifdef logging}
+         LogLn('Setting SaveVideoState to '+strf(longint(SaveVideoState)));
+{$endif logging}
+         RestoreVideoState := @RestoreStateVESA;
+{$ifdef logging}
+         LogLn('Setting RestoreVideoState to '+strf(longint(RestoreVideoState)));
+{$endif logging}
+         { now check all supported modes...}
+         if SearchVESAModes(m320x200x32k) then
+           begin
+             InitMode(mode);
+             mode.ModeNumber:=m320x200x32k;
+             mode.DriverNumber := VESA;
+             mode.ModeName:='320 x 200 VESA';
+             mode.MaxColor := 32768;
+             { the ModeInfo is automatically set if the mode is supPorted }
+             { by the call to SearchVESAMode.                             }
+             mode.HardwarePages := VESAModeInfo.NumberOfPages;
+             mode.PaletteSize := mode.MaxColor;
+             mode.DirectColor := TRUE;
+             mode.MaxX := 319;
+             mode.MaxY := 199;
+             mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixVESA32kOr64k;
+             mode.PutPixel:={$ifdef fpc}@{$endif}PutPixVESA32kOr64k;
+             mode.GetPixel:={$ifdef fpc}@{$endif}GetPixVESA32kOr64k;
+             mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVESARGBPalette;
+             mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
+             mode.InitMode := {$ifdef fpc}@{$endif}Init320x200x32k;
+             mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
+             mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
+             mode.XAspect := 8333;
+             mode.YAspect := 10000;
+             AddMode(mode);
+           end;
+         if SearchVESAModes(m320x200x64k) then
+           begin
+             InitMode(mode);
+             mode.ModeNumber:=m320x200x64k;
+             mode.DriverNumber := VESA;
+             mode.ModeName:='320 x 200 VESA';
+             mode.MaxColor := 65536;
+             { the ModeInfo is automatically set if the mode is supPorted }
+             { by the call to SearchVESAMode.                             }
+             mode.HardwarePages := VESAModeInfo.NumberOfPages;
+             mode.PaletteSize := mode.MaxColor;
+             mode.DirectColor := TRUE;
+             mode.MaxX := 319;
+             mode.MaxY := 199;
+             mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixVESA32kOr64k;
+             mode.PutPixel:={$ifdef fpc}@{$endif}PutPixVESA32kOr64k;
+             mode.GetPixel:={$ifdef fpc}@{$endif}GetPixVESA32kOr64k;
+             mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVESARGBPalette;
+             mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
+             mode.InitMode := {$ifdef fpc}@{$endif}Init320x200x64k;
+             mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
+             mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
+             mode.XAspect := 8333;
+             mode.YAspect := 10000;
+             AddMode(mode);
+           end;
+         if SearchVESAModes(m640x400x256) then
+           begin
+             InitMode(mode);
+             mode.ModeNumber:=m640x400x256;
+             mode.DriverNumber := VESA;
+             mode.ModeName:='640 x 400 VESA';
+             mode.MaxColor := 256;
+             { the ModeInfo is automatically set if the mode is supPorted }
+             { by the call to SearchVESAMode.                             }
+             mode.HardwarePages := VESAModeInfo.NumberOfPages;
+             mode.PaletteSize := mode.MaxColor;
+             mode.DirectColor := FALSE;
+             mode.MaxX := 639;
+             mode.MaxY := 399;
+             mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixVESA256;
+             mode.PutPixel:={$ifdef fpc}@{$endif}PutPixVESA256;
+             mode.GetPixel:={$ifdef fpc}@{$endif}GetPixVESA256;
+             mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVESARGBPalette;
+             mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
+{$ifdef fpc}
+             mode.SetAllPalette := @SetVESARGBAllPalette;
+{$endif fpc}
+             mode.InitMode := {$ifdef fpc}@{$endif}Init640x400x256;
+             mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
+             mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
+             mode.hline := {$ifdef fpc}@{$endif}HLineVESA256;
+             mode.vline := {$ifdef fpc}@{$endif}VLineVESA256;
+             mode.GetScanLine := {$ifdef fpc}@{$endif}GetScanLineVESA256;
+             mode.XAspect := 8333;
+             mode.YAspect := 10000;
+             AddMode(mode);
+           end;
+         if SearchVESAModes(m640x480x256) then
+           begin
+             InitMode(mode);
+             mode.ModeNumber:=m640x480x256;
+             mode.DriverNumber := VESA;
+             mode.ModeName:='640 x 480 VESA';
+             mode.MaxColor := 256;
+             { the ModeInfo is automatically set if the mode is supPorted }
+             { by the call to SearchVESAMode.                             }
+             mode.HardwarePages := VESAModeInfo.NumberOfPages;
+             mode.PaletteSize := mode.MaxColor;
+             mode.MaxX := 639;
+             mode.MaxY := 479;
+             mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixVESA256;
+             mode.PutPixel:={$ifdef fpc}@{$endif}PutPixVESA256;
+             mode.GetPixel:={$ifdef fpc}@{$endif}GetPixVESA256;
+             mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVESARGBPalette;
+             mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
+{$ifdef fpc}
+             mode.SetAllPalette := @SetVESARGBAllPalette;
+{$endif fpc}
+             mode.InitMode := {$ifdef fpc}@{$endif}Init640x480x256;
+             mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
+             mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
+             mode.hline := {$ifdef fpc}@{$endif}HLineVESA256;
+             mode.vline := {$ifdef fpc}@{$endif}VLineVESA256;
+             mode.GetScanLine := {$ifdef fpc}@{$endif}GetScanLineVESA256;
+             mode.PatternLine := {$ifdef fpc}@{$endif}PatternLineVESA256;
+             mode.XAspect := 10000;
+             mode.YAspect := 10000;
+             AddMode(mode);
+           end;
+         if SearchVESAModes(m640x480x32k) then
+           begin
+             InitMode(mode);
+             mode.ModeNumber:=m640x480x32k;
+             mode.DriverNumber := VESA;
+             mode.ModeName:='640 x 480 VESA';
+             mode.MaxColor := 32768;
+             { the ModeInfo is automatically set if the mode is supPorted }
+             { by the call to SearchVESAMode.                             }
+             mode.HardwarePages := VESAModeInfo.NumberOfPages;
+             mode.PaletteSize := mode.MaxColor;
+             mode.DirectColor := TRUE;
+             mode.MaxX := 639;
+             mode.MaxY := 479;
+             mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixVESA32kOr64k;
+             mode.PutPixel:={$ifdef fpc}@{$endif}PutPixVESA32kOr64k;
+             mode.GetPixel:={$ifdef fpc}@{$endif}GetPixVESA32kOr64k;
+             mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVESARGBPalette;
+             mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
+             mode.InitMode := {$ifdef fpc}@{$endif}Init640x480x32k;
+             mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
+             mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
+             mode.XAspect := 10000;
+             mode.YAspect := 10000;
+             AddMode(mode);
+           end;
+         if SearchVESAModes(m640x480x64k) then
+           begin
+             InitMode(mode);
+             mode.ModeNumber:=m640x480x64k;
+             mode.DriverNumber := VESA;
+             mode.ModeName:='640 x 480 VESA';
+             mode.MaxColor := 65536;
+             { the ModeInfo is automatically set if the mode is supPorted }
+             { by the call to SearchVESAMode.                             }
+             mode.HardwarePages := VESAModeInfo.NumberOfPages;
+             mode.PaletteSize := mode.MaxColor;
+             mode.DirectColor := TRUE;
+             mode.MaxX := 639;
+             mode.MaxY := 479;
+             mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixVESA32kOr64k;
+             mode.PutPixel:={$ifdef fpc}@{$endif}PutPixVESA32kOr64k;
+             mode.GetPixel:={$ifdef fpc}@{$endif}GetPixVESA32kOr64k;
+             mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVESARGBPalette;
+             mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
+             mode.InitMode := {$ifdef fpc}@{$endif}Init640x480x64k;
+             mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
+             mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
+             mode.XAspect := 10000;
+             mode.YAspect := 10000;
+             AddMode(mode);
+           end;
+         if SearchVESAModes(m800x600x16) then
+           begin
+             InitMode(mode);
+             mode.ModeNumber:=m800x600x16;
+             mode.DriverNumber := VESA;
+             mode.ModeName:='800 x 600 VESA';
+             mode.MaxColor := 16;
+             { the ModeInfo is automatically set if the mode is supPorted }
+             { by the call to SearchVESAMode.                             }
+             mode.HardwarePages := VESAModeInfo.NumberOfPages;
+             mode.DirectColor := FALSE;
+             mode.PaletteSize := mode.MaxColor;
+             mode.MaxX := 799;
+             mode.MaxY := 599;
+             mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixVESA16;
+             mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVESARGBPalette;
+             mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
+{$ifdef fpc}
+             mode.SetAllPalette := @SetVESARGBAllPalette;
+{$endif fpc}
+             mode.PutPixel:={$ifdef fpc}@{$endif}PutPixVESA16;
+             mode.GetPixel:={$ifdef fpc}@{$endif}GetPixVESA16;
+             mode.InitMode := {$ifdef fpc}@{$endif}Init800x600x16;
+             mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
+             mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
+             mode.HLine := {$ifdef fpc}@{$endif}HLineVESA16;
+             mode.XAspect := 10000;
+             mode.YAspect := 10000;
+             AddMode(mode);
+           end;
+         if SearchVESAModes(m800x600x256) then
+           begin
+             InitMode(mode);
+             mode.ModeNumber:=m800x600x256;
+             mode.DriverNumber := VESA;
+             mode.ModeName:='800 x 600 VESA';
+             mode.MaxColor := 256;
+             { the ModeInfo is automatically set if the mode is supPorted }
+             { by the call to SearchVESAMode.                             }
+             mode.HardwarePages := VESAModeInfo.NumberOfPages;
+             mode.PaletteSize := mode.MaxColor;
+             mode.DirectColor := FALSE;
+             mode.MaxX := 799;
+             mode.MaxY := 599;
+             mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixVESA256;
+             mode.PutPixel:={$ifdef fpc}@{$endif}PutPixVESA256;
+             mode.GetPixel:={$ifdef fpc}@{$endif}GetPixVESA256;
+             mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVESARGBPalette;
+             mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
+{$ifdef fpc}
+             mode.SetAllPalette := @SetVESARGBAllPalette;
+{$endif fpc}
+             mode.InitMode := {$ifdef fpc}@{$endif}Init800x600x256;
+             mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
+             mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
+             mode.hline := {$ifdef fpc}@{$endif}HLineVESA256;
+             mode.vline := {$ifdef fpc}@{$endif}VLineVESA256;
+             mode.GetScanLine := {$ifdef fpc}@{$endif}GetScanLineVESA256;
+             mode.PatternLine := {$ifdef fpc}@{$endif}PatternLineVESA256;
+             mode.XAspect := 10000;
+             mode.YAspect := 10000;
+             AddMode(mode);
+           end;
+         if SearchVESAModes(m800x600x32k) then
+           begin
+             InitMode(mode);
+             mode.ModeNumber:=m800x600x32k;
+             mode.DriverNumber := VESA;
+             mode.ModeName:='800 x 600 VESA';
+             mode.MaxColor := 32768;
+             { the ModeInfo is automatically set if the mode is supPorted }
+             { by the call to SearchVESAMode.                             }
+             mode.HardwarePages := VESAModeInfo.NumberOfPages;
+             mode.PaletteSize := mode.MaxColor;
+             mode.DirectColor := TRUE;
+             mode.MaxX := 799;
+             mode.MaxY := 599;
+             mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixVESA32kOr64k;
+             mode.PutPixel:={$ifdef fpc}@{$endif}PutPixVESA32kOr64k;
+             mode.GetPixel:={$ifdef fpc}@{$endif}GetPixVESA32kOr64k;
+             mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVESARGBPalette;
+             mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
+             mode.InitMode := {$ifdef fpc}@{$endif}Init800x600x32k;
+             mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
+             mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
+             mode.XAspect := 10000;
+             mode.YAspect := 10000;
+             AddMode(mode);
+           end;
+         if SearchVESAModes(m800x600x64k) then
+           begin
+             InitMode(mode);
+             mode.ModeNumber:=m800x600x64k;
+             mode.DriverNumber := VESA;
+             mode.ModeName:='800 x 600 VESA';
+             mode.MaxColor := 65536;
+             { the ModeInfo is automatically set if the mode is supPorted }
+             { by the call to SearchVESAMode.                             }
+             mode.HardwarePages := VESAModeInfo.NumberOfPages;
+             mode.PaletteSize := mode.MaxColor;
+             mode.DirectColor := TRUE;
+             mode.MaxX := 799;
+             mode.MaxY := 599;
+             mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixVESA32kOr64k;
+             mode.PutPixel:={$ifdef fpc}@{$endif}PutPixVESA32kOr64k;
+             mode.GetPixel:={$ifdef fpc}@{$endif}GetPixVESA32kOr64k;
+             mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVESARGBPalette;
+             mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
+             mode.InitMode := {$ifdef fpc}@{$endif}Init800x600x64k;
+             mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
+             mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
+             mode.XAspect := 10000;
+             mode.YAspect := 10000;
+             AddMode(mode);
+           end;
+         if SearchVESAModes(m1024x768x16) then
+           begin
+             InitMode(mode);
+             mode.ModeNumber:=m1024x768x16;
+             mode.DriverNumber := VESA;
+             mode.ModeName:='1024 x 768 VESA';
+             mode.MaxColor := 16;
+             { the ModeInfo is automatically set if the mode is supPorted }
+             { by the call to SearchVESAMode.                             }
+             mode.HardwarePages := VESAModeInfo.NumberOfPages;
+             mode.PaletteSize := mode.MaxColor;
+             mode.DirectColor := FALSE;
+             mode.MaxX := 1023;
+             mode.MaxY := 767;
+             mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixVESA16;
+             mode.PutPixel:={$ifdef fpc}@{$endif}PutPixVESA16;
+             mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVESARGBPalette;
+             mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
+{$ifdef fpc}
+             mode.SetAllPalette := @SetVESARGBAllPalette;
+{$endif fpc}
+             mode.GetPixel:={$ifdef fpc}@{$endif}GetPixVESA16;
+             mode.InitMode := {$ifdef fpc}@{$endif}Init1024x768x16;
+             mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
+             mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
+             mode.HLine := {$ifdef fpc}@{$endif}HLineVESA16;
+             mode.XAspect := 10000;
+             mode.YAspect := 10000;
+             AddMode(mode);
+           end;
+         if SearchVESAModes(m1024x768x256) then
+           begin
+             InitMode(mode);
+             mode.ModeNumber:=m1024x768x256;
+             mode.DriverNumber := VESA;
+             mode.ModeName:='1024 x 768 VESA';
+             mode.MaxColor := 256;
+             { the ModeInfo is automatically set if the mode is supPorted }
+             { by the call to SearchVESAMode.                             }
+             mode.HardwarePages := VESAModeInfo.NumberOfPages;
+             mode.PaletteSize := mode.MaxColor;
+             mode.DirectColor := FALSE;
+             mode.MaxX := 1023;
+             mode.MaxY := 767;
+             mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixVESA256;
+             mode.PutPixel:={$ifdef fpc}@{$endif}PutPixVESA256;
+             mode.GetPixel:={$ifdef fpc}@{$endif}GetPixVESA256;
+             mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVESARGBPalette;
+             mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
+{$ifdef fpc}
+             mode.SetAllPalette := @SetVESARGBAllPalette;
+{$endif fpc}
+             mode.InitMode := {$ifdef fpc}@{$endif}Init1024x768x256;
+             mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
+             mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
+             mode.vline := {$ifdef fpc}@{$endif}VLineVESA256;
+             mode.hline := {$ifdef fpc}@{$endif}HLineVESA256;
+             mode.GetScanLine := {$ifdef fpc}@{$endif}GetScanLineVESA256;
+             mode.PatternLine := {$ifdef fpc}@{$endif}PatternLineVESA256;
+             mode.XAspect := 10000;
+             mode.YAspect := 10000;
+             AddMode(mode);
+           end;
+         if SearchVESAModes(m1024x768x32k) then
+           begin
+             InitMode(mode);
+             mode.ModeNumber:=m1024x768x32k;
+             mode.DriverNumber := VESA;
+             mode.ModeName:='1024 x 768 VESA';
+             mode.MaxColor := 32768;
+             { the ModeInfo is automatically set if the mode is supPorted }
+             { by the call to SearchVESAMode.                             }
+             mode.HardwarePages := VESAModeInfo.NumberOfPages;
+             mode.PaletteSize := mode.MaxColor;
+             mode.DirectColor := TRUE;
+             mode.MaxX := 1023;
+             mode.MaxY := 767;
+             mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixVESA32kOr64k;
+             mode.PutPixel:={$ifdef fpc}@{$endif}PutPixVESA32kOr64k;
+             mode.GetPixel:={$ifdef fpc}@{$endif}GetPixVESA32kOr64k;
+             mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVESARGBPalette;
+             mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
+             mode.InitMode := {$ifdef fpc}@{$endif}Init1024x768x32k;
+             mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
+             mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
+             mode.XAspect := 10000;
+             mode.YAspect := 10000;
+             AddMode(mode);
+           end;
+         if SearchVESAModes(m1024x768x64k) then
+           begin
+             InitMode(mode);
+             mode.ModeNumber:=m1024x768x64k;
+             mode.DriverNumber := VESA;
+             mode.ModeName:='1024 x 768 VESA';
+             mode.MaxColor := 65536;
+             mode.DirectColor := TRUE;
+             { the ModeInfo is automatically set if the mode is supPorted }
+             { by the call to SearchVESAMode.                             }
+             mode.HardwarePages := VESAModeInfo.NumberOfPages;
+             mode.PaletteSize := mode.MaxColor;
+             mode.MaxX := 1023;
+             mode.MaxY := 767;
+             mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixVESA32kOr64k;
+             mode.PutPixel:={$ifdef fpc}@{$endif}PutPixVESA32kOr64k;
+             mode.GetPixel:={$ifdef fpc}@{$endif}GetPixVESA32kOr64k;
+             mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVESARGBPalette;
+             mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
+             mode.InitMode := {$ifdef fpc}@{$endif}Init1024x768x64k;
+             mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
+             mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
+             mode.XAspect := 10000;
+             mode.YAspect := 10000;
+             AddMode(mode);
+           end;
+         if SearchVESAModes(m1280x1024x16) then
+           begin
+             InitMode(mode);
+             mode.ModeNumber:=m1280x1024x16;
+             mode.DriverNumber := VESA;
+             mode.ModeName:='1280 x 1024 VESA';
+             mode.MaxColor := 16;
+             { the ModeInfo is automatically set if the mode is supPorted }
+             { by the call to SearchVESAMode.                             }
+             mode.HardwarePages := VESAModeInfo.NumberOfPages;
+             mode.DirectColor := FALSE;
+             mode.PaletteSize := mode.MaxColor;
+             mode.MaxX := 1279;
+             mode.MaxY := 1023;
+             mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixVESA16;
+             mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVESARGBPalette;
+             mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
+{$ifdef fpc}
+             mode.SetAllPalette := @SetVESARGBAllPalette;
+{$endif fpc}
+             mode.PutPixel:={$ifdef fpc}@{$endif}PutPixVESA16;
+             mode.GetPixel:={$ifdef fpc}@{$endif}GetPixVESA16;
+             mode.InitMode := {$ifdef fpc}@{$endif}Init1280x1024x16;
+             mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
+             mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
+             mode.HLine := {$ifdef fpc}@{$endif}HLineVESA16;
+             mode.XAspect := 10000;
+             mode.YAspect := 10000;
+             AddMode(mode);
+           end;
+         if SearchVESAModes(m1280x1024x256) then
+           begin
+             InitMode(mode);
+             mode.ModeNumber:=m1280x1024x256;
+             mode.DriverNumber := VESA;
+             mode.ModeName:='1280 x 1024 VESA';
+             mode.MaxColor := 256;
+             { the ModeInfo is automatically set if the mode is supPorted }
+             { by the call to SearchVESAMode.                             }
+             mode.HardwarePages := VESAModeInfo.NumberOfPages;
+             mode.DirectColor := FALSE;
+             mode.PaletteSize := mode.MaxColor;
+             mode.MaxX := 1279;
+             mode.MaxY := 1023;
+             mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixVESA256;
+             mode.PutPixel:={$ifdef fpc}@{$endif}PutPixVESA256;
+             mode.GetPixel:={$ifdef fpc}@{$endif}GetPixVESA256;
+             mode.InitMode := {$ifdef fpc}@{$endif}Init1280x1024x256;
+             mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVESARGBPalette;
+             mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
+{$ifdef fpc}
+             mode.SetAllPalette := @SetVESARGBAllPalette;
+{$endif fpc}
+             mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
+             mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
+             mode.vline := {$ifdef fpc}@{$endif}VLineVESA256;
+             mode.hline := {$ifdef fpc}@{$endif}HLineVESA256;
+             mode.GetScanLine := {$ifdef fpc}@{$endif}GetScanLineVESA256;
+             mode.PatternLine := {$ifdef fpc}@{$endif}PatternLineVESA256;
+             mode.XAspect := 10000;
+             mode.YAspect := 10000;
+             AddMode(mode);
+           end;
+         if SearchVESAModes(m1280x1024x32k) then
+           begin
+             InitMode(mode);
+             mode.ModeNumber:=m1280x1024x32k;
+             mode.DriverNumber := VESA;
+             mode.ModeName:='1280 x 1024 VESA';
+             mode.MaxColor := 32768;
+             { the ModeInfo is automatically set if the mode is supPorted }
+             { by the call to SearchVESAMode.                             }
+             mode.HardwarePages := VESAModeInfo.NumberOfPages;
+             mode.DirectColor := TRUE;
+             mode.PaletteSize := mode.MaxColor;
+             mode.MaxX := 1279;
+             mode.MaxY := 1023;
+             mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixVESA32kOr64k;
+             mode.PutPixel:={$ifdef fpc}@{$endif}PutPixVESA32kOr64k;
+             mode.GetPixel:={$ifdef fpc}@{$endif}GetPixVESA32kOr64k;
+             mode.InitMode := {$ifdef fpc}@{$endif}Init1280x1024x32k;
+             mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVESARGBPalette;
+             mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
+             mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
+             mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
+             mode.XAspect := 10000;
+             mode.YAspect := 10000;
+             AddMode(mode);
+           end;
+         if SearchVESAModes(m1280x1024x64k) then
+           begin
+             InitMode(mode);
+             mode.ModeNumber:=m1280x1024x64k;
+             mode.DriverNumber := VESA;
+             mode.ModeName:='1280 x 1024 VESA';
+             mode.MaxColor := 65536;
+             { the ModeInfo is automatically set if the mode is supPorted }
+             { by the call to SearchVESAMode.                             }
+             mode.HardwarePages := VESAModeInfo.NumberOfPages;
+             mode.DirectColor := TRUE;
+             mode.PaletteSize := mode.MaxColor;
+             mode.MaxX := 1279;
+             mode.MaxY := 1023;
+             mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixVESA32kOr64k;
+             mode.PutPixel:={$ifdef fpc}@{$endif}PutPixVESA32kOr64k;
+             mode.GetPixel:={$ifdef fpc}@{$endif}GetPixVESA32kOr64k;
+             mode.InitMode := {$ifdef fpc}@{$endif}Init1280x1024x64k;
+             mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVESARGBPalette;
+             mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
+             mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
+             mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
+             mode.XAspect := 10000;
+             mode.YAspect := 10000;
+             AddMode(mode);
+           end;
+       end;*)
+   end;
+
+var
+  go32exitsave: codepointer;
+
+procedure freeSaveStateBuffer; {$ifndef fpc}far; {$endif}
+begin
+  if savePtr <> nil then
+    begin
+{$ifdef dpmi}
+{$ifndef fpc}
+      if GlobalDosFree(longint(SavePtr) shr 16)<>0 then;
+{$else fpc}
+      if Not Global_Dos_Free(longint(SavePtr) shr 16) then;
+{$endif fpc}
+{$else dpmi}
+      FreeMem(SavePtr, 64*StateSize);
+{$endif dpmi}
+      SavePtr := nil;
+  end;
+  exitproc := go32exitsave;
+end;
+
+begin
+  { must be done *before* initialize graph is called, because the save }
+  { buffer can be used in the normal exit_proc (which is hooked in     }
+  { initializegraph and as such executed first) (JM)                   }
+  go32exitsave := exitproc;
+  exitproc := @freeSaveStateBuffer;
+  { windows screws up the display if the savestate/restore state  }
+  { stuff is used (or uses an abnormal amount of cpu time after   }
+  { such a problem has exited), so detect its presense and do not }
+  { use those functions if it's running. I'm really tired of      }
+  { working around Windows bugs :( (JM)                           }
+  asm
+    mov  ax,$160a
+    push bp
+    push si
+    push di
+    push bx
+    int  $2f
+    pop bx
+    pop di
+    pop si
+    pop bp
+    test ax,ax
+    jz @no_win
+    mov al, 1
+@no_win:
+    mov inWindows,al
+  end ['AX'];
+  InitializeGraph;
+end.

packages/graph/src/msdos/vesa.inc

@@ -0,0 +1,2901 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by Carl Eric Codere
+
+    This include implements VESA basic access.
+
+    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.
+
+ **********************************************************************}
+type
+
+  palrec = packed record              { record used for set/get DAC palette }
+       blue, green, red, align: byte;
+  end;
+
+const
+  { VESA attributes     }
+  attrSwitchDAC        = $01;    { DAC is switchable           (1.2)   }
+  attrNotVGACompatible = $02;    { Video is NOT VGA compatible (2.0)   }
+  attrSnowCheck        = $04;    { Video must use snow checking(2.0)   }
+
+  { mode attribute bits }
+  modeAvail          = $01;      { Hardware supports this mode (1.0)   }
+  modeExtendInfo     = $02;      { Extended information        (1.0)   }
+  modeBIOSSupport    = $04;      { TTY BIOS Support            (1.0)   }
+  modeColor          = $08;      { This is a color mode        (1.0)   }
+  modeGraphics       = $10;      { This is a graphics mode     (1.0)   }
+  modeNotVGACompatible = $20;    { this mode is NOT I/O VGA compatible (2.0)}
+  modeNoWindowed     = $40;      { This mode does not support Windows (2.0) }
+  modeLinearBuffer   = $80;      { This mode supports linear buffers  (2.0) }
+
+  { window attributes }
+  winSupported       = $01;
+  winReadable        = $02;
+  winWritable        = $04;
+
+  { memory model }
+  modelText          = $00;
+  modelCGA           = $01;
+  modelHerc          = $02;
+  model4plane        = $03;
+  modelPacked        = $04;
+  modelModeX         = $05;
+  modelRGB           = $06;
+  modelYUV           = $07;
+
+{$ifndef dpmi}
+{$i vesah.inc}
+{ otherwise it's already included in graph.pp }
+{$endif dpmi}
+
+var
+
+  BytesPerLine: word;              { Number of bytes per scanline }
+  YOffset : word;                  { Pixel offset for VESA page flipping }
+
+  { window management }
+  ReadWindow : byte;      { Window number for reading. }
+  WriteWindow: byte;      { Window number for writing. }
+  winReadSeg : word;      { Address of segment for read  }
+  winWriteSeg: word;      { Address of segment for writes}
+  CurrentReadBank : smallint; { active read bank          }
+  CurrentWriteBank: smallint; { active write bank         }
+
+  BankShift : word;       { address to shift by when switching banks. }
+
+  { linear mode specific stuff }
+  InLinear  : boolean;    { true if in linear mode }
+  LinearPageOfs : longint; { offset used to set active page }
+  FrameBufferLinearAddress : longint;
+
+  ScanLines: word;        { maximum number of scan lines for mode }
+
+function hexstr(val : longint;cnt : byte) : string;
+const
+  HexTbl : array[0..15] of char='0123456789ABCDEF';
+var
+  i : longint;
+begin
+  hexstr[0]:=char(cnt);
+  for i:=cnt downto 1 do
+   begin
+     hexstr[i]:=hextbl[val and $f];
+     val:=val shr 4;
+   end;
+end;
+
+
+{$IFDEF DPMI}
+
+  function getVESAInfo(var VESAInfo: TVESAInfo) : boolean;
+   var
+    ptrlong : longint;
+    VESAPtr : ^TVESAInfo;
+    st : string[4];
+    regs : Registers;
+{$ifndef fpc}
+    ModeSel: word;
+    offs: longint;
+{$endif fpc}
+    { added... }
+    modelist: PmodeList;
+    i: longint;
+    RealSeg : word;
+   begin
+    { Allocate real mode buffer }
+{$ifndef fpc}
+    Ptrlong:=GlobalDosAlloc(sizeof(TVESAInfo));
+    { Get selector value }
+    VESAPtr := pointer(Ptrlong shl 16);
+{$else fpc}
+    Ptrlong:=Global_Dos_Alloc(sizeof(TVESAInfo));
+    New(VESAPtr);
+{$endif fpc}
+    { Get segment value }
+    RealSeg := word(Ptrlong shr 16);
+    if not assigned(VESAPtr) then
+      RunError(203);
+    FillChar(regs, sizeof(regs), #0);
+
+    { Get VESA Mode information ... }
+    regs.eax := $4f00;
+    regs.es := RealSeg;
+    regs.edi := $00;
+    RealIntr($10, regs);
+{$ifdef fpc}
+   { no far pointer support in FPC yet, so move the vesa info into a memory }
+   { block in the DS slector space (JM)                                     }
+    dosmemget(RealSeg,0,VesaPtr^,SizeOf(TVESAInfo));
+{$endif fpc}
+    St:=Vesaptr^.signature;
+    if st<>'VESA' then
+     begin
+{$ifdef logging}
+         LogLn('No VESA detected.');
+{$endif logging}
+         getVesaInfo := FALSE;
+{$ifndef fpc}
+         GlobalDosFree(word(PtrLong and $ffff));
+{$else fpc}
+         If not Global_Dos_Free(word(PtrLong and $ffff)) then
+           RunError(216);
+         { also free the extra allocated buffer }
+         Dispose(VESAPtr);
+{$endif fpc}
+         exit;
+     end
+    else
+      getVesaInfo := TRUE;
+
+{$ifndef fpc}
+    { The mode pointer buffer points to a real mode memory }
+    { Therefore steps to get the modes:                    }
+    {  1. Allocate Selector and SetLimit to max number of  }
+    {     of possible modes.                               }
+    ModeSel := AllocSelector(0);
+    SetSelectorLimit(ModeSel, 256*sizeof(word));
+
+    {  2. Set Selector linear address to the real mode pointer }
+    {     returned.                                            }
+    offs := longint(longint(VESAPtr^.ModeList) shr 16) shl 4;
+   {shouldn't the OR in the next line be a + ?? (JM)}
+    offs :=  offs OR (Longint(VESAPtr^.ModeList) and $ffff);
+    SetSelectorBase(ModeSel, offs);
+
+     { copy VESA mode information to a protected mode buffer and }
+     { then free the real mode buffer...                         }
+     Move(VESAPtr^, VESAInfo, sizeof(VESAInfo));
+     GlobalDosFree(word(PtrLong and $ffff));
+
+    { ModeList points to the mode list     }
+    { We must copy it somewhere...         }
+    ModeList := Ptr(ModeSel, 0);
+
+{$else fpc}
+    { No far pointer support, so the Ptr(ModeSel, 0) doesn't work.     }
+    { Immediately copy everything to a buffer in the DS selector space }
+     New(ModeList);
+    { The following may copy data from outside the VESA buffer, but it   }
+    { shouldn't get past the 1MB limit, since that would mean the buffer }
+    { has been allocated in the BIOS or high memory region, which seems  }
+    { impossible to me (JM)}
+     DosMemGet(word(longint(VESAPtr^.ModeList) shr 16),
+        word(longint(VESAPtr^.ModeList) and $ffff), ModeList^,256*sizeof(word));
+
+     { copy VESA mode information to a protected mode buffer and }
+     { then free the real mode buffer...                         }
+     Move(VESAPtr^, VESAInfo, sizeof(VESAInfo));
+     If not Global_Dos_Free(word(PtrLong and $ffff)) then
+       RunError(216);
+     Dispose(VESAPtr);
+{$endif fpc}
+
+    i:=0;
+    new(VESAInfo.ModeList);
+    while ModeList^[i]<> $ffff do
+     begin
+{$ifdef logging}
+      LogLn('Found mode $'+hexstr(ModeList^[i],4));
+{$endif loggin}
+      VESAInfo.ModeList^[i] := ModeList^[i];
+      Inc(i);
+     end;
+    VESAInfo.ModeList^[i]:=$ffff;
+    { Free the temporary selector used to get mode information }
+{$ifdef logging}
+    LogLn(strf(i) + ' modes found.');
+{$endif logging}
+{$ifndef fpc}
+    FreeSelector(ModeSel);
+{$else fpc}
+    Dispose(ModeList);
+{$endif fpc}
+   end;
+
+  function getVESAModeInfo(var ModeInfo: TVESAModeInfo;mode:word):boolean;
+   var
+    Ptr: longint;
+{$ifndef fpc}
+    VESAPtr : ^TVESAModeInfo;
+{$endif fpc}
+    regs : Registers;
+    RealSeg: word;
+   begin
+    { Alllocate real mode buffer }
+{$ifndef fpc}
+    Ptr:=GlobalDosAlloc(sizeof(TVESAModeInfo));
+    { get the selector value }
+    VESAPtr := pointer(longint(Ptr shl 16));
+    if not assigned(VESAPtr) then
+      RunError(203);
+{$else fpc}
+    Ptr:=Global_Dos_Alloc(sizeof(TVESAModeInfo));
+{$endif fpc}
+    { get the segment value }
+    RealSeg := word(Ptr shr 16);
+    { we have to init everything to zero, since VBE < 1.1  }
+    { may not setup fields correctly.                      }
+{$ifndef fpc}
+    FillChar(VESAPtr^, sizeof(ModeInfo), #0);
+{$else fpc}
+    DosMemFillChar(RealSeg, 0, sizeof(ModeInfo), #0);
+{$endif fpc}
+    { setup interrupt registers }
+    FillChar(regs, sizeof(regs), #0);
+    { call VESA mode information...}
+    regs.eax := $4f01;
+    regs.es := RealSeg;
+    regs.edi := $00;
+    regs.ecx := mode;
+    RealIntr($10, regs);
+    if word(regs.eax) <> $4f then
+      getVESAModeInfo := FALSE
+    else
+      getVESAModeInfo := TRUE;
+    { copy to protected mode buffer ... }
+{$ifndef fpc}
+    Move(VESAPtr^, ModeInfo, sizeof(ModeInfo));
+{$else fpc}
+    DosMemGet(RealSeg,0,ModeInfo,sizeof(ModeInfo));
+{$endif fpc}
+    { free real mode memory  }
+{$ifndef fpc}
+    GlobalDosFree(Word(Ptr and $ffff));
+{$else fpc}
+    If not Global_Dos_Free(Word(Ptr and $ffff)) then
+      RunError(216);
+{$endif fpc}
+   end;
+
+{$ELSE}
+  function getVESAInfo(var VESAInfo: TVESAInfo) : boolean; assembler;
+  asm
+       mov ax,4F00h
+       les di,VESAInfo
+       int 10h
+       sub ax,004Fh  {make sure we got 004Fh back}
+       cmp ax,1
+       sbb al,al
+       cmp word ptr es:[di],'V'or('E'shl 8)  {signature should be 'VESA'}
+       jne @@ERR
+       cmp word ptr es:[di+2],'S'or('A'shl 8)
+       je @@X
+     @@ERR:
+       mov al,0
+     @@X:
+  end;
+
+
+  function getVESAModeInfo(var ModeInfo: TVESAModeInfo;mode:word):boolean;assembler;
+   asm
+     mov ax,4F01h
+     mov cx,mode
+     les di,ModeInfo
+     int 10h
+     sub ax,004Fh   {make sure it's 004Fh}
+     cmp ax,1
+     sbb al,al
+   end;
+
+{$ENDIF}
+
+  function SearchVESAModes(mode: Word): boolean;
+  {********************************************************}
+  { Searches for a specific DEFINED vesa mode. If the mode }
+  { is not available for some reason, then returns FALSE   }
+  { otherwise returns TRUE.                                }
+  {********************************************************}
+   var
+     i: word;
+     ModeSupported : Boolean;
+    begin
+      i:=0;
+      { let's assume it's not available ... }
+      ModeSupported := FALSE;
+      { This is a STUB VESA implementation  }
+      if VESAInfo.ModeList^[0] = $FFFF then exit;
+      repeat
+        if VESAInfo.ModeList^[i] = mode then
+         begin
+            { we found it, the card supports this mode... }
+            ModeSupported := TRUE;
+            break;
+         end;
+        Inc(i);
+      until VESAInfo.ModeList^[i] = $ffff;
+      { now check if the hardware supports it... }
+      If ModeSupported then
+        begin
+          { we have to init everything to zero, since VBE < 1.1  }
+          { may not setup fields correctly.                      }
+          { bugfix: for DPMI this is now done in GetVESAModeInfo }
+{$IFNDEF DPMI}
+          FillChar(VESAModeInfo, sizeof(VESAModeInfo), #0);
+{$ENDIF}
+          If GetVESAModeInfo(VESAModeInfo, Mode) And
+             ((VESAModeInfo.attr and modeAvail) <> 0) then
+            ModeSupported := TRUE
+          else
+            ModeSupported := FALSE;
+        end;
+       SearchVESAModes := ModeSupported;
+    end;
+
+procedure SetBankIndex(win: byte; BankNr: smallint);
+{I don't know why but the previous assembler version changed by some mechanism
+ unknown to me some places in memory what lead to changing some variables not
+ belonging to this procedure (Laaca)}
+var r:Registers;
+begin
+  r.ax:=$4f05;
+  r.bx:=win;
+  r.dx:=BankNr;
+  RealIntr($10,r);
+end;
+
+  {********************************************************}
+  { There are two routines for setting banks. This may in  }
+  { in some cases optimize a bit some operations, if the   }
+  { hardware supports it, because one window is used for   }
+  { reading and one window is used for writing.            }
+  {********************************************************}
+  procedure SetReadBank(BankNr: smallint);
+   begin
+     { check if this is the current bank... if so do nothing. }
+     if BankNr = CurrentReadBank then exit;
+{$ifdef logging}
+{     LogLn('Setting read bank to '+strf(BankNr));}
+{$endif logging}
+     CurrentReadBank := BankNr;          { save current bank number     }
+     BankNr := BankNr shl BankShift;     { adjust to window granularity }
+     { we set both banks, since one may read only }
+     SetBankIndex(ReadWindow, BankNr);
+     { if the hardware supports only one window }
+     { then there is only one single bank, so   }
+     { update both bank numbers.                }
+     if ReadWindow = WriteWindow then
+       CurrentWriteBank := CurrentReadBank;
+   end;
+
+  procedure SetWriteBank(BankNr: smallint);
+   begin
+     { check if this is the current bank... if so do nothing. }
+     if BankNr = CurrentWriteBank then exit;
+{$ifdef logging}
+{     LogLn('Setting write bank to '+strf(BankNr));}
+{$endif logging}
+     CurrentWriteBank := BankNr;          { save current bank number     }
+     BankNr := BankNr shl BankShift;     { adjust to window granularity }
+     { we set both banks, since one may read only }
+     SetBankIndex(WriteWindow, BankNr);
+     { if the hardware supports only one window }
+     { then there is only one single bank, so   }
+     { update both bank numbers.                }
+     if ReadWindow = WriteWindow then
+       CurrentReadBank := CurrentWriteBank;
+   end;
+
+ {************************************************************************}
+ {*                     8-bit pixels VESA mode routines                  *}
+ {************************************************************************}
+
+  procedure PutPixVESA256(x, y : smallint; color : word); {$ifndef fpc}far;{$endif fpc}
+  var
+     offs : longint;
+  begin
+     X:= X + StartXViewPort;
+     Y:= Y + StartYViewPort;
+     { convert to absolute coordinates and then verify clipping...}
+     if ClipPixels then
+     Begin
+       if (X < StartXViewPort) or (X > (StartXViewPort + ViewWidth)) then
+         exit;
+       if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then
+         exit;
+     end;
+     Y := Y + YOffset; { adjust pixel for correct virtual page }
+     offs := longint(y) * BytesPerLine + x;
+       begin
+         SetWriteBank(smallint(offs shr 16));
+         mem[WinWriteSeg : word(offs)] := byte(color);
+       end;
+  end;
+
+  procedure DirectPutPixVESA256(x, y : smallint); {$ifndef fpc}far;{$endif fpc}
+  var
+     offs : longint;
+     col : byte;
+  begin
+     offs := (longint(y) + YOffset) * BytesPerLine + x;
+     Case CurrentWriteMode of
+       XorPut:
+         Begin
+           SetReadBank(smallint(offs shr 16));
+           col := mem[WinReadSeg : word(offs)] xor byte(CurrentColor);
+         End;
+       AndPut:
+         Begin
+           SetReadBank(smallint(offs shr 16));
+           col := mem[WinReadSeg : word(offs)] And byte(CurrentColor);
+         End;
+       OrPut:
+         Begin
+           SetReadBank(smallint(offs shr 16));
+           col := mem[WinReadSeg : word(offs)] or byte(currentcolor);
+         End
+       else
+         Begin
+           If CurrentWriteMode <> NotPut then
+             col := Byte(CurrentColor)
+           else col := Not(Byte(CurrentColor));
+         End
+     End;
+     SetWriteBank(smallint(offs shr 16));
+     mem[WinWriteSeg : word(offs)] := Col;
+  end;
+
+  function GetPixVESA256(x, y : smallint): word; {$ifndef fpc}far;{$endif fpc}
+  var
+     offs : longint;
+  begin
+     X:= X + StartXViewPort;
+     Y:= Y + StartYViewPort + YOffset;
+     offs := longint(y) * BytesPerLine + x;
+     SetReadBank(smallint(offs shr 16));
+     GetPixVESA256:=mem[WinReadSeg : word(offs)];
+  end;
+
+  Procedure GetScanLineVESA256(x1, x2, y: smallint; var data); {$ifndef fpc}far;{$endif}
+  var offs: Longint;
+      l, amount, bankrest, index, pixels: longint;
+      curbank: smallint;
+  begin
+    inc(x1,StartXViewPort);
+    inc(x2,StartXViewPort);
+    {$ifdef logging}
+    LogLn('getscanline256 '+strf(x1)+' - '+strf(x2)+' at '+strf(y+StartYViewPort));
+    {$endif logging}
+    index := 0;
+    amount := x2-x1+1;
+    Offs:=(Longint(y)+StartYViewPort+YOffset)*bytesperline+x1;
+    Repeat
+      curbank := smallint(offs shr 16);
+      SetReadBank(curbank);
+      {$ifdef logging}
+      LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
+      {$endif logging}
+      If ((amount >= 4) and
+          ((offs and 3) = 0)) or
+         (amount >= 4+4-(offs and 3)) Then
+      { allign target }
+        Begin
+          If (offs and 3) <> 0 then
+          { this cannot go past a window boundary bacause the }
+          { size of a window is always a multiple of 4        }
+            Begin
+              {$ifdef logging}
+              LogLn('Alligning by reading '+strf(4-(offs and 3))+' pixels');
+              {$endif logging}
+              for l := 1 to 4-(offs and 3) do
+                WordArray(Data)[index+l-1] :=
+                  Mem[WinReadSeg:word(offs)+l-1];
+              inc(index, l);
+              inc(offs, l);
+              dec(amount, l);
+            End;
+          {$ifdef logging}
+          LogLn('Offset is now '+hexstr(offs,8)+', amount left: '+strf(amount));
+          {$endif logging}
+          { offs is now 4-bytes alligned }
+          If amount <= ($10000-(Offs and $ffff)) Then
+             bankrest := amount
+          else {the rest won't fit anymore in the current window }
+            bankrest := $10000 - (Offs and $ffff);
+          { it is possible that by aligning, we ended up in a new }
+          { bank, so set the correct bank again to make sure      }
+          setreadbank(offs shr 16);
+          {$ifdef logging}
+          LogLn('Rest to be read from this window: '+strf(bankrest));
+          {$endif logging}
+          For l := 0 to (Bankrest div 4)-1 Do
+            begin
+              pixels := MemL[WinReadSeg:word(offs)+l*4];
+              WordArray(Data)[index+l*4] := pixels and $ff;
+              pixels := pixels shr 8;
+              WordArray(Data)[index+l*4+1] := pixels and $ff;
+              pixels := pixels shr 8;
+              WordArray(Data)[index+l*4+2] := pixels and $ff;
+              pixels := pixels shr 8;
+              WordArray(Data)[index+l*4+3] := pixels{ and $ff};
+            end;
+          inc(index,l*4+4);
+          inc(offs,l*4+4);
+          dec(amount,l*4+4);
+          {$ifdef logging}
+          LogLn('Offset is now '+hexstr(offs,8)+', amount left: '+strf(amount));
+          {$endif logging}
+        End
+      Else
+        Begin
+          {$ifdef logging}
+          LogLn('Leftover: '+strf(amount)+' at offset '+hexstr(offs,8));
+          {$endif logging}
+          For l := 0 to amount - 1 do
+            begin
+              { this may cross a bank at any time, so adjust          }
+              { because this loop alwys runs for very little pixels,  }
+              { there's little gained by splitting it up              }
+              setreadbank(offs shr 16);
+              WordArray(Data)[index+l] := mem[WinReadSeg:word(offs)];
+              inc(offs);
+            end;
+          amount := 0
+        End
+    Until amount = 0;
+  end;
+
+  procedure HLineVESA256(x,x2,y: smallint); {$ifndef fpc}far;{$endif fpc}
+
+   var Offs: Longint;
+       mask, l, bankrest: longint;
+       curbank, hlength: smallint;
+   Begin
+    { must we swap the values? }
+    if x > x2 then
+      Begin
+        x := x xor x2;
+        x2 := x xor x2;
+        x:= x xor x2;
+      end;
+    { First convert to global coordinates }
+    X   := X + StartXViewPort;
+    X2  := X2 + StartXViewPort;
+    Y   := Y + StartYViewPort;
+    if ClipPixels then
+      Begin
+         if LineClipped(x,y,x2,y,StartXViewPort,StartYViewPort,
+                StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
+            exit;
+      end;
+    {$ifdef logging2}
+    LogLn('hline '+strf(x)+' - '+strf(x2)+' on '+strf(y)+' in mode '+strf(currentwritemode));
+    {$endif logging2}
+    HLength := x2 - x + 1;
+    {$ifdef logging2}
+    LogLn('length: '+strf(hlength));
+    {$endif logging2}
+    if HLength>0 then
+      begin
+         Offs:=(Longint(y)+YOffset)*bytesperline+x;
+         {$ifdef logging2}
+         LogLn('Offs: '+strf(offs)+' -- '+hexstr(offs,8));
+         {$endif logging2}
+         Mask := byte(CurrentColor)+byte(CurrentColor) shl 8;
+         Mask := Mask + Mask shl 16;
+         Case CurrentWriteMode of
+           AndPut:
+             Begin
+               Repeat
+                 curbank := smallint(offs shr 16);
+                 SetWriteBank(curbank);
+                 SetReadBank(curbank);
+                 {$ifdef logging2}
+                 LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
+                 {$endif logging2}
+                 If ((HLength >= 4) and
+                     ((offs and 3) = 0)) or
+                    (HLength >= 4+4-(offs and 3)) Then
+                 { align target }
+                   Begin
+                     l := 0;
+                     If (offs and 3) <> 0 then
+                     { this cannot go past a window boundary bacause the }
+                     { size of a window is always a multiple of 4        }
+                       Begin
+                         {$ifdef logging2}
+                         LogLn('Alligning by drawing '+strf(4-(offs and 3))+' pixels');
+                         {$endif logging2}
+                         for l := 1 to 4-(offs and 3) do
+                           Mem[WinWriteSeg:word(offs)+l-1] :=
+                             Mem[WinReadSeg:word(offs)+l-1] And Byte(CurrentColor);
+                       End;
+                     Dec(HLength, l);
+                     inc(offs, l);
+                     {$ifdef logging2}
+                     LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
+                     {$endif logging}
+                     { offs is now 4-bytes alligned }
+                     If HLength <= ($10000-(Offs and $ffff)) Then
+                        bankrest := HLength
+                     else {the rest won't fit anymore in the current window }
+                       bankrest := $10000 - (Offs and $ffff);
+                     { it is possible that by aligningm we ended up in a new }
+                     { bank, so set the correct bank again to make sure      }
+                     setwritebank(offs shr 16);
+                     setreadbank(offs shr 16);
+                     {$ifdef logging2}
+                     LogLn('Rest to be drawn in this window: '+strf(bankrest));
+                     {$endif logging}
+                     For l := 0 to (Bankrest div 4)-1 Do
+                       MemL[WinWriteSeg:word(offs)+l*4] :=
+                         MemL[WinReadSeg:word(offs)+l*4] And Mask;
+                     inc(offs,l*4+4);
+                     dec(hlength,l*4+4);
+                     {$ifdef logging2}
+                     LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
+                     {$endif logging}
+                   End
+                 Else
+                   Begin
+                     {$ifdef logging2}
+                     LogLn('Drawing leftover: '+strf(HLength)+' at offset '+hexstr(offs,8));
+                     {$endif logging}
+                     For l := 0 to HLength - 1 do
+                       begin
+                         { this may cross a bank at any time, so adjust          }
+                         { becauese this loop alwys runs for very little pixels, }
+                         { there's little gained by splitting it up              }
+                         setreadbank(offs shr 16);
+                         setwritebank(offs shr 16);
+                         Mem[WinWriteSeg:word(offs)] :=
+                           Mem[WinReadSeg:word(offs)] And byte(currentColor);
+                         inc(offs);
+                       end;
+                     HLength := 0
+                   End
+               Until HLength = 0;
+             End;
+           XorPut:
+             Begin
+               Repeat
+                 curbank := smallint(offs shr 16);
+                 SetWriteBank(curbank);
+                 SetReadBank(curbank);
+                 {$ifdef logging2}
+                 LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
+                 {$endif logging}
+                 If ((HLength >= 4) and
+                     ((offs and 3) = 0)) or
+                    (HLength >= 4+4-(offs and 3)) Then
+                 { allign target }
+                   Begin
+                     l := 0;
+                     If (offs and 3) <> 0 then
+                     { this cannot go past a window boundary bacause the }
+                     { size of a window is always a multiple of 4        }
+                       Begin
+                         {$ifdef logging2}
+                         LogLn('Alligning by drawing '+strf(4-(offs and 3))+' pixels');
+                         {$endif logging}
+                         for l := 1 to 4-(offs and 3) do
+                           Mem[WinWriteSeg:word(offs)+l-1] :=
+                             Mem[WinReadSeg:word(offs)+l-1] Xor Byte(CurrentColor);
+                       End;
+                     Dec(HLength, l);
+                     inc(offs, l);
+                     {$ifdef logging2}
+                     LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
+                     {$endif logging}
+                     { offs is now 4-bytes alligned }
+                     If HLength <= ($10000-(Offs and $ffff)) Then
+                        bankrest := HLength
+                     else {the rest won't fit anymore in the current window }
+                       bankrest := $10000 - (Offs and $ffff);
+                     { it is possible that by aligningm we ended up in a new }
+                     { bank, so set the correct bank again to make sure      }
+                     setwritebank(offs shr 16);
+                     setreadbank(offs shr 16);
+                     {$ifdef logging2}
+                     LogLn('Rest to be drawn in this window: '+strf(bankrest));
+                     {$endif logging}
+                     For l := 0 to (Bankrest div 4)-1 Do
+                       MemL[WinWriteSeg:word(offs)+l*4] :=
+                         MemL[WinReadSeg:word(offs)+l*4] Xor Mask;
+                     inc(offs,l*4+4);
+                     dec(hlength,l*4+4);
+                     {$ifdef logging2}
+                     LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
+                     {$endif logging}
+                   End
+                 Else
+                   Begin
+                     {$ifdef logging2}
+                     LogLn('Drawing leftover: '+strf(HLength)+' at offset '+hexstr(offs,8));
+                     {$endif logging}
+                     For l := 0 to HLength - 1 do
+                       begin
+                         { this may cross a bank at any time, so adjust          }
+                         { because this loop alwys runs for very little pixels,  }
+                         { there's little gained by splitting it up              }
+                         setreadbank(offs shr 16);
+                         setwritebank(offs shr 16);
+                         Mem[WinWriteSeg:word(offs)] :=
+                           Mem[WinReadSeg:word(offs)] xor byte(currentColor);
+                         inc(offs);
+                       end;
+                     HLength := 0
+                   End
+               Until HLength = 0;
+             End;
+           OrPut:
+             Begin
+               Repeat
+                 curbank := smallint(offs shr 16);
+                 SetWriteBank(curbank);
+                 SetReadBank(curbank);
+                 {$ifdef logging2}
+                 LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
+                 {$endif logging}
+                 If ((HLength >= 4) and
+                     ((offs and 3) = 0)) or
+                    (HLength >= 4+4-(offs and 3)) Then
+                 { allign target }
+                   Begin
+                     l := 0;
+                     If (offs and 3) <> 0 then
+                     { this cannot go past a window boundary bacause the }
+                     { size of a window is always a multiple of 4        }
+                       Begin
+                         {$ifdef logging2}
+                         LogLn('Alligning by drawing '+strf(4-(offs and 3))+' pixels');
+                         {$endif logging}
+                         for l := 1 to 4-(offs and 3) do
+                           Mem[WinWriteSeg:word(offs)+l-1] :=
+                             Mem[WinReadSeg:word(offs)+l-1] Or Byte(CurrentColor);
+                       End;
+                     Dec(HLength, l);
+                     inc(offs, l);
+                     { it is possible that by aligningm we ended up in a new }
+                     { bank, so set the correct bank again to make sure      }
+                     setwritebank(offs shr 16);
+                     setreadbank(offs shr 16);
+                     {$ifdef logging2}
+                     LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
+                     {$endif logging}
+                     { offs is now 4-bytes alligned }
+                     If HLength <= ($10000-(Offs and $ffff)) Then
+                        bankrest := HLength
+                     else {the rest won't fit anymore in the current window }
+                       bankrest := $10000 - (Offs and $ffff);
+                     {$ifdef logging2}
+                     LogLn('Rest to be drawn in this window: '+strf(bankrest));
+                     {$endif logging}
+                     For l := 0 to (Bankrest div 4)-1 Do
+                       MemL[WinWriteSeg:offs+l*4] :=
+                         MemL[WinReadSeg:word(offs)+l*4] Or Mask;
+                     inc(offs,l*4+4);
+                     dec(hlength,l*4+4);
+                     {$ifdef logging2}
+                     LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
+                     {$endif logging}
+                   End
+                 Else
+                   Begin
+                     {$ifdef logging2}
+                     LogLn('Drawing leftover: '+strf(HLength)+' at offset '+hexstr(offs,8));
+                     {$endif logging}
+                     For l := 0 to HLength - 1 do
+                       begin
+                         { this may cross a bank at any time, so adjust          }
+                         { because this loop alwys runs for very little pixels,  }
+                         { there's little gained by splitting it up              }
+                         setreadbank(offs shr 16);
+                         setwritebank(offs shr 16);
+                         Mem[WinWriteSeg:word(offs)] :=
+                           Mem[WinReadSeg:word(offs)] Or byte(currentColor);
+                         inc(offs);
+                       end;
+                     HLength := 0
+                   End
+               Until HLength = 0;
+             End
+           Else
+             Begin
+               If CurrentWriteMode = NotPut Then
+                 Mask := Not(Mask);
+               Repeat
+                 curbank := smallint(offs shr 16);
+                 SetWriteBank(curbank);
+                 {$ifdef logging2}
+                 LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8)+' -- '+strf(offs));
+                 {$endif logging}
+                 If ((HLength >= 4) and
+                     ((offs and 3) = 0)) or
+                    (HLength >= 4+4-(offs and 3)) Then
+                 { allign target }
+                   Begin
+                     l := 0;
+                     If (offs and 3) <> 0 then
+                     { this cannot go past a window boundary bacause the }
+                     { size of a window is always a multiple of 4        }
+                       Begin
+                         {$ifdef logging2}
+                         LogLn('Alligning by drawing '+strf(4-(offs and 3))+' pixels');
+                         {$endif logging}
+                         for l := 1 to 4-(offs and 3) do
+                           Mem[WinWriteSeg:word(offs)+l-1] := Byte(Mask);
+                       End;
+                     Dec(HLength, l);
+                     inc(offs, l);
+                     {$ifdef logging2}
+                     LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
+                     {$endif logging}
+                     { offs is now 4-bytes alligned }
+                     If HLength <= ($10000-(Offs and $ffff)) Then
+                        bankrest := HLength
+                     else {the rest won't fit anymore in the current window }
+                       bankrest := $10000 - (Offs and $ffff);
+                     { it is possible that by aligningm we ended up in a new }
+                     { bank, so set the correct bank again to make sure      }
+                     setwritebank(offs shr 16);
+                     {$ifdef logging2}
+                     LogLn('Rest to be drawn in this window: '+strf(bankrest)+' -- '+hexstr(bankrest,8));
+                     {$endif logging}
+                     For l := 0 to (Bankrest div 4)-1 Do
+                       MemL[WinWriteSeg:word(offs)+l*4] := Mask;
+                     inc(offs,l*4+4);
+                     dec(hlength,l*4+4);
+                     {$ifdef logging2}
+                     LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
+                     {$endif logging}
+                   End
+                 Else
+                   Begin
+                     {$ifdef logging2}
+                     LogLn('Drawing leftover: '+strf(HLength)+' at offset '+hexstr(offs,8));
+                     {$endif logging}
+                     For l := 0 to HLength - 1 do
+                       begin
+                         { this may cross a bank at any time, so adjust          }
+                         { because this loop alwys runs for very little pixels,  }
+                         { there's little gained by splitting it up              }
+                         setwritebank(offs shr 16);
+                         Mem[WinWriteSeg:word(offs)] := byte(mask);
+                         inc(offs);
+                       end;
+                     HLength := 0
+                   End
+               Until HLength = 0;
+             End;
+         End;
+       end;
+   end;
+
+  procedure VLineVESA256(x,y,y2: smallint); {$ifndef fpc}far;{$endif fpc}
+
+   var Offs: Longint;
+       l, bankrest: longint;
+       curbank, vlength: smallint;
+       col: byte;
+   Begin
+    { must we swap the values? }
+    if y > y2 then
+      Begin
+        y := y xor y2;
+        y2 := y xor y2;
+        y:= y xor y2;
+      end;
+    { First convert to global coordinates }
+    X   := X + StartXViewPort;
+    Y   := Y + StartYViewPort;
+    Y2  := Y2 + StartYViewPort;
+    if ClipPixels then
+      Begin
+         if LineClipped(x,y,x,y2,StartXViewPort,StartYViewPort,
+                StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
+            exit;
+      end;
+    Col := Byte(CurrentColor);
+    {$ifdef logging2}
+    LogLn('vline '+strf(y)+' - '+strf(y2)+' on '+strf(x)+' in mode '+strf(currentwritemode));
+    {$endif logging}
+    VLength := y2 - y + 1;
+    {$ifdef logging2}
+    LogLn('length: '+strf(vlength));
+    {$endif logging}
+    if VLength>0 then
+      begin
+         Offs:=(Longint(y)+YOffset)*bytesperline+x;
+         {$ifdef logging2}
+         LogLn('Offs: '+strf(offs)+' -- '+hexstr(offs,8));
+         {$endif logging}
+         Case CurrentWriteMode of
+           AndPut:
+             Begin
+               Repeat
+                 curbank := smallint(offs shr 16);
+                 SetWriteBank(curbank);
+                 SetReadBank(curbank);
+                 {$ifdef logging2}
+                 LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
+                 {$endif logging}
+                 If (VLength-1)*bytesperline <= ($ffff-(Offs and $ffff)) Then
+                   bankrest := VLength
+                 else {the rest won't fit anymore in the current window }
+                   bankrest := (($ffff - (Offs and $ffff)) div bytesperline)+1;
+                 {$ifdef logging2}
+                 LogLn('Rest to be drawn in this window: '+strf(bankrest));
+                 {$endif logging}
+                 For l := 0 to Bankrest-1 Do
+                   begin
+                     Mem[WinWriteSeg:word(offs)] :=
+                       Mem[WinReadSeg:word(offs)] And Col;
+                     inc(offs,bytesperline);
+                   end;
+                 dec(VLength,l+1);
+                 {$ifdef logging2}
+                 LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(vlength));
+                 {$endif logging}
+               Until VLength = 0;
+             End;
+           XorPut:
+             Begin
+               Repeat
+                 curbank := smallint(offs shr 16);
+                 SetWriteBank(curbank);
+                 SetReadBank(curbank);
+                 {$ifdef logging2}
+                 LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
+                 {$endif logging}
+                 If (VLength-1)*bytesperline <= ($ffff-(Offs and $ffff)) Then
+                   bankrest := VLength
+                 else {the rest won't fit anymore in the current window }
+                   bankrest := (($ffff - (Offs and $ffff)) div bytesperline)+1;
+                 {$ifdef logging2}
+                 LogLn('Rest to be drawn in this window: '+strf(bankrest));
+                 {$endif logging}
+                 For l := 0 to Bankrest-1 Do
+                   begin
+                     Mem[WinWriteSeg:word(offs)] :=
+                       Mem[WinReadSeg:word(offs)] Xor Col;
+                     inc(offs,bytesperline);
+                   end;
+                 dec(VLength,l+1);
+                 {$ifdef logging2}
+                 LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(vlength));
+                 {$endif logging}
+               Until VLength = 0;
+             End;
+           OrPut:
+             Begin
+               Repeat
+                 curbank := smallint(offs shr 16);
+                 SetWriteBank(curbank);
+                 SetReadBank(curbank);
+                 {$ifdef logging2}
+                 LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
+                 {$endif logging}
+                 If (VLength-1)*bytesperline <= ($ffff-(Offs and $ffff)) Then
+                   bankrest := VLength
+                 else {the rest won't fit anymore in the current window }
+                   bankrest := (($ffff - (Offs and $ffff)) div bytesperline)+1;
+                 {$ifdef logging2}
+                 LogLn('Rest to be drawn in this window: '+strf(bankrest));
+                 {$endif logging}
+                 For l := 0 to Bankrest-1 Do
+                   begin
+                     Mem[WinWriteSeg:word(offs)] :=
+                       Mem[WinReadSeg:word(offs)] Or Col;
+                     inc(offs,bytesperline);
+                   end;
+                 dec(VLength,l+1);
+                 {$ifdef logging2}
+                 LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(vlength));
+                 {$endif logging}
+               Until VLength = 0;
+             End;
+           Else
+             Begin
+               If CurrentWriteMode = NotPut Then
+                 Col := Not(Col);
+               Repeat
+                 curbank := smallint(offs shr 16);
+                 SetWriteBank(curbank);
+                 {$ifdef logging2}
+                 LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
+                 {$endif logging}
+                 If (VLength-1)*bytesperline <= ($ffff-(Offs and $ffff)) Then
+                   bankrest := VLength
+                 else {the rest won't fit anymore in the current window }
+                   bankrest := (($ffff - (Offs and $ffff)) div bytesperline)+1;
+                 {$ifdef logging2}
+                 LogLn('Rest to be drawn in this window: '+strf(bankrest));
+                 {$endif logging}
+                 For l := 0 to Bankrest-1 Do
+                   begin
+                     Mem[WinWriteSeg:word(offs)] := Col;
+                     inc(offs,bytesperline);
+                   end;
+                 dec(VLength,l+1);
+                 {$ifdef logging2}
+                 LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(vlength));
+                 {$endif logging}
+               Until VLength = 0;
+             End;
+         End;
+       end;
+   end;
+
+  procedure PatternLineVESA256(x1,x2,y: smallint); {$ifndef fpc}far;{$endif fpc}
+  {********************************************************}
+  { Draws a horizontal patterned line according to the     }
+  { current Fill Settings.                                 }
+  {********************************************************}
+  { Important notes:                                       }
+  {  - CurrentColor must be set correctly before entering  }
+  {    this routine.                                       }
+  {********************************************************}
+   type
+     TVESA256Fill = Record
+       case byte of
+         0: (data1, data2: longint);
+         1: (pat: array[0..7] of byte);
+     end;
+
+   var
+    fill: TVESA256Fill;
+    bankrest, l : longint;
+    offs, amount: longint;
+    i           : smallint;
+    j           : smallint;
+    OldWriteMode : word;
+    TmpFillPattern, patternPos : byte;
+   begin
+     { convert to global coordinates ... }
+     x1 := x1 + StartXViewPort;
+     x2 := x2 + StartXViewPort;
+     y  := y + StartYViewPort;
+     { if line was fully clipped then exit...}
+     if LineClipped(x1,y,x2,y,StartXViewPort,StartYViewPort,
+        StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
+         exit;
+     OldWriteMode := CurrentWriteMode;
+     CurrentWriteMode := NormalPut;
+     { Get the current pattern }
+     TmpFillPattern := FillPatternTable
+       [FillSettings.Pattern][((y + startYViewPort) and $7)+1];
+     {$ifdef logging2}
+     LogLn('patternline '+strf(x1)+' - '+strf(x2)+' on '+strf(y));
+     {$endif logging2}
+     { how long is the line }
+     amount := x2 - x1 + 1;
+     { offset to start at }
+     offs := (longint(y)+yoffset)*bytesperline+x1;
+     { convert the pattern data into the actual color sequence }
+     j := 1;
+     FillChar(fill,sizeOf(fill),byte(currentBkColor));
+     for i := 0 to 7 do
+       begin
+         if TmpFillPattern and j <> 0 then
+           fill.pat[7-i] := currentColor;
+{$push}
+{$q-}
+         j := j shl 1;
+{$pop}
+       end;
+     Repeat
+       SetWriteBank(smallint(offs shr 16));
+       If (amount > 7) and
+          (((offs and 7) = 0) or
+           (amount > 7+8-(offs and 7))) Then
+         Begin
+           { align target }
+           l := 0;
+           If (offs and 7) <> 0 then
+           { this cannot go past a window boundary bacause the }
+           { size of a window is always a multiple of 8        }
+             Begin
+               { position in the pattern where to start }
+               patternPos := offs and 7;
+               {$ifdef logging2}
+               LogLn('Aligning by drawing '+strf(8-(offs and 7))+' pixels');
+               {$endif logging2}
+               for l := 1 to 8-(offs and 7) do
+                 begin
+                   Mem[WinWriteSeg:word(offs)+l-1] := fill.pat[patternPos and 7];
+                   inc(patternPos)
+                 end;
+             End;
+           Dec(amount, l);
+           inc(offs, l);
+           {$ifdef logging2}
+           LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(amount));
+           {$endif logging2}
+           { offs is now 8-bytes alligned }
+           If amount <= ($10000-(Offs and $ffff)) Then
+              bankrest := amount
+           else {the rest won't fit anymore in the current window }
+             bankrest := $10000 - (Offs and $ffff);
+           { it is possible that by aligningm we ended up in a new }
+           { bank, so set the correct bank again to make sure      }
+           setwritebank(offs shr 16);
+           {$ifdef logging2}
+           LogLn('Rest to be drawn in this window: '+strf(bankrest));
+           {$endif logging2}
+           for l := 0 to (bankrest div 8)-1 Do
+             begin
+               MemL[WinWriteSeg:word(offs)+l*8] := fill.data1;
+               MemL[WinWriteSeg:word(offs)+l*8+4] := fill.data2;
+             end;
+           inc(offs,l*8+8);
+           dec(amount,l*8+8);
+           {$ifdef logging2}
+           LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(amount));
+           {$endif logging2}
+         End
+       Else
+         Begin
+           {$ifdef logging2}
+           LogLn('Drawing leftover: '+strf(amount)+' at offset '+hexstr(offs,8));
+           {$endif logging2}
+           patternPos := offs and 7;
+           For l := 0 to amount - 1 do
+             begin
+               { this may cross a bank at any time, so adjust          }
+               { because this loop alwys runs for very little pixels,  }
+               { there's little gained by splitting it up              }
+               setwritebank(offs shr 16);
+               Mem[WinWriteSeg:word(offs)] := fill.pat[patternPos and 7];
+               inc(offs);
+               inc(patternPos);
+             end;
+           amount := 0;
+         End
+     Until amount = 0;
+     currentWriteMode := oldWriteMode;
+   end;
+
+
+ {************************************************************************}
+ {*                    256 colors VESA mode routines  Linear mode        *}
+ {************************************************************************}
+{$ifdef FPC}
+type
+  pbyte = ^byte;
+  pword = ^word;
+
+  procedure DirectPutPixVESA256Linear(x, y : smallint); {$ifndef fpc}far;{$endif fpc}
+  var
+     offs : longint;
+     col : byte;
+  begin
+     offs := longint(y) * BytesPerLine + x;
+     Case CurrentWriteMode of
+       XorPut:
+         Begin
+           if UseNoSelector then
+             col:=pbyte(LFBPointer+offs+LinearPageOfs)^
+           else
+             seg_move(WinWriteSeg,offs+LinearPageOfs,get_ds,longint(@col),1);
+           col := col xor byte(CurrentColor);
+         End;
+       AndPut:
+         Begin
+           if UseNoSelector then
+             col:=pbyte(LFBPointer+offs+LinearPageOfs)^
+           else
+             seg_move(WinWriteSeg,offs+LinearPageOfs,get_ds,longint(@col),1);
+           col := col and byte(CurrentColor);
+         End;
+       OrPut:
+         Begin
+           if UseNoSelector then
+             col:=pbyte(LFBPointer+offs+LinearPageOfs)^
+           else
+             seg_move(WinWriteSeg,offs+LinearPageOfs,get_ds,longint(@col),1);
+           col := col or byte(CurrentColor);
+         End
+       else
+         Begin
+           If CurrentWriteMode <> NotPut then
+             col := Byte(CurrentColor)
+           else col := Not(Byte(CurrentColor));
+         End
+     End;
+     if UseNoSelector then
+       pbyte(LFBPointer+offs+LinearPageOfs)^:=col
+     else
+       seg_move(get_ds,longint(@col),WinWriteSeg,offs+LinearPageOfs,1);
+  end;
+
+  procedure PutPixVESA256Linear(x, y : smallint; color : word); {$ifndef fpc}far;{$endif fpc}
+  var
+     offs : longint;
+  begin
+     X:= X + StartXViewPort;
+     Y:= Y + StartYViewPort;
+     { convert to absolute coordinates and then verify clipping...}
+     if ClipPixels then
+     Begin
+       if (X < StartXViewPort) or (X > (StartXViewPort + ViewWidth)) then
+         exit;
+       if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then
+         exit;
+     end;
+     offs := longint(y) * BytesPerLine + x;
+     {$ifdef logging}
+     logln('putpix offset: '+hexstr(offs,8)+', color: '+strf(color)+', lpo: $'+
+       hexstr(LinearPageOfs,8));
+     {$endif logging}
+     if UseNoSelector then
+       pbyte(LFBPointer+offs+LinearPageOfs)^:=byte(color)
+     else
+       seg_move(get_ds,longint(@color),WinWriteSeg,offs+LinearPageOfs,1);
+  end;
+
+  function GetPixVESA256Linear(x, y : smallint): word; {$ifndef fpc}far;{$endif fpc}
+  var
+     offs : longint;
+     col : byte;
+  begin
+     X:= X + StartXViewPort;
+     Y:= Y + StartYViewPort;
+     offs := longint(y) * BytesPerLine + x;
+     {$ifdef logging}
+     logln('getpix offset: '+hexstr(offs,8)+', lpo: $'+
+       hexstr(LinearPageOfs,8));
+     {$endif logging}
+     if UseNoSelector then
+       col:=pbyte(LFBPointer+offs+LinearPageOfs)^
+     else
+       seg_move(WinWriteSeg,offs+LinearPageOfs,get_ds,longint(@col),1);
+     GetPixVESA256Linear:=col;
+  end;
+(*
+function SetVESADisplayStart(PageNum : word;x,y : smallint):Boolean;
+var
+  dregs : registers;
+begin
+  if PageNum>VesaModeInfo.NumberOfPages then
+    PageNum:=0;
+{$ifdef DEBUG}
+  if PageNum>0 then
+    writeln(stderr,'Setting Display Page ',PageNum);
+{$endif DEBUG}
+  dregs.RealEBX:=0{ $80 for Wait for retrace };
+  dregs.RealECX:=x;
+  dregs.RealEDX:=y+PageNum*maxy;
+  dregs.RealSP:=0;
+  dregs.RealSS:=0;
+  dregs.RealEAX:=$4F07; RealIntr($10,dregs);
+  { idem as above !!! }
+  if (dregs.RealEAX and $1FF) <> $4F then
+    begin
+{$ifdef DEBUG}
+       writeln(stderr,'Set Display start error');
+{$endif DEBUG}
+       SetVESADisplayStart:=false;
+    end
+  else
+    SetVESADisplayStart:=true;
+end;
+*)
+{$endif FPC}
+
+
+ {************************************************************************}
+ {*                    15/16bit pixels VESA mode routines                *}
+ {************************************************************************}
+
+  procedure PutPixVESA32kOr64k(x, y : smallint; color : word); {$ifndef fpc}far;{$endif fpc}
+  var
+     offs : longint;
+     place: word;
+     bank : shortint;
+
+  begin
+{$ifdef logging}
+     logln('putpixvesa32kor64k('+strf(x)+','+strf(y)+')');
+{$endif logging}
+     X:= X + StartXViewPort;
+     Y:= Y + StartYViewPort;
+     { convert to absolute coordinates and then verify clipping...}
+     if ClipPixels then
+     Begin
+       if (X < StartXViewPort) or (X > (StartXViewPort + ViewWidth)) then
+         exit;
+       if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then
+         exit;
+     end;
+     Y := Y + YOffset; { adjust pixel for correct virtual page }
+     offs := longint(y) * BytesPerLine + 2*x;
+     bank := offs div 65536;
+     place:= offs mod 65536;
+     SetWriteBank(bank);
+
+{$ifdef logging}
+     logln('putpixvesa32kor64k offset: '+strf(word(offs)));
+{$endif logging}
+     memW[WinWriteSeg : place] := color;
+  end;
+
+  function GetPixVESA32kOr64k(x, y : smallint): word; {$ifndef fpc}far;{$endif fpc}
+  var
+     offs : longint;
+  begin
+     X:= X + StartXViewPort;
+     Y:= Y + StartYViewPort + YOffset;
+     offs := longint(y) * BytesPerLine + 2*x;
+     SetReadBank(smallint(offs shr 16));
+     GetPixVESA32kOr64k:=memW[WinReadSeg : word(offs)];
+  end;
+
+  procedure DirectPutPixVESA32kOr64k(x, y : smallint); {$ifndef fpc}far;{$endif fpc}
+  var
+     offs : longint;
+     bank : smallint;
+     place,col : word;
+  begin
+{$ifdef logging}
+     logln('directputpixvesa32kor64k('+strf(x)+','+strf(y)+')');
+{$endif logging}
+     y:= Y + YOffset;
+
+     offs := longint(y) * BytesPerLine + 2*x;
+     bank:=offs div 65536;
+     place:=offs mod 65536;
+
+     SetWriteBank(bank and $FF); // unknown why this and $FF is here.
+     Case CurrentWriteMode of
+       XorPut:
+         Begin
+           SetReadBank(bank);
+           memW[WinWriteSeg : place] := memW[WinReadSeg : place] xor currentcolor;
+         End;
+       AndPut:
+         Begin
+           SetReadBank(bank);
+           memW[WinWriteSeg : place] := memW[WinReadSeg : place] And currentcolor;
+         End;
+       OrPut:
+         Begin
+           SetReadBank(bank);
+           memW[WinWriteSeg : place] := memW[WinReadSeg : place] or currentcolor;
+         End
+       else
+         Begin
+           If CurrentWriteMode <> NotPut Then
+             col := CurrentColor
+           Else col := Not(CurrentColor);
+{$ifdef logging}
+           logln('directputpixvesa32kor64k offset: '+strf(word(offs)));
+{$endif logging}
+           memW[WinWriteSeg : place] := Col;
+         End
+     End;
+  end;
+
+{$ifdef FPC}
+ {************************************************************************}
+ {*                    15/16bit pixels VESA mode routines  Linear mode   *}
+ {************************************************************************}
+
+  procedure PutPixVESA32kor64kLinear(x, y : smallint; color : word); {$ifndef fpc}far;{$endif fpc}
+  var
+     offs : longint;
+  begin
+     X:= X + StartXViewPort;
+     Y:= Y + StartYViewPort;
+     { convert to absolute coordinates and then verify clipping...}
+     if ClipPixels then
+     Begin
+       if (X < StartXViewPort) or (X > (StartXViewPort + ViewWidth)) then
+         exit;
+       if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then
+         exit;
+     end;
+     offs := longint(y) * BytesPerLine + 2*x;
+     if UseNoSelector then
+       pword(LFBPointer+offs+LinearPageOfs)^:=color
+     else
+       seg_move(get_ds,longint(@color),WinWriteSeg,offs+LinearPageOfs,2);
+  end;
+
+  function GetPixVESA32kor64kLinear(x, y : smallint): word; {$ifndef fpc}far;{$endif fpc}
+  var
+     offs : longint;
+     color : word;
+  begin
+     X:= X + StartXViewPort;
+     Y:= Y + StartYViewPort;
+     offs := longint(y) * BytesPerLine + 2*x;
+     if UseNoSelector then
+       color:=pword(LFBPointer+offs+LinearPageOfs)^
+     else
+       seg_move(WinWriteSeg,offs+LinearPageOfs,get_ds,longint(@color),2);
+     GetPixVESA32kor64kLinear:=color;
+  end;
+
+  procedure DirectPutPixVESA32kor64kLinear(x, y : smallint); {$ifndef fpc}far;{$endif fpc}
+  var
+     offs : longint;
+     col : word;
+  begin
+     offs := longint(y) * BytesPerLine + 2*x;
+     Case CurrentWriteMode of
+       XorPut:
+         Begin
+           if UseNoSelector then
+             col:=pword(LFBPointer+offs+LinearPageOfs)^
+           else
+             seg_move(WinWriteSeg,offs+LinearPageOfs,get_ds,longint(@col),2);
+           col := col xor currentcolor;
+         End;
+       AndPut:
+         Begin
+           if UseNoSelector then
+             col:=pword(LFBPointer+offs+LinearPageOfs)^
+           else
+             seg_move(WinWriteSeg,offs+LinearPageOfs,get_ds,longint(@col),2);
+           col := col and currentcolor;
+         End;
+       OrPut:
+         Begin
+           if UseNoSelector then
+             col:=pword(LFBPointer+offs+LinearPageOfs)^
+           else
+             seg_move(WinWriteSeg,offs+LinearPageOfs,get_ds,longint(@col),2);
+           col := col or currentcolor;
+         End
+       else
+         Begin
+           If CurrentWriteMode <> NotPut Then
+             col := CurrentColor
+           Else col := Not(CurrentColor);
+         End
+     End;
+     if UseNoSelector then
+       pword(LFBPointer+offs+LinearPageOfs)^:=col
+     else
+       seg_move(get_ds,longint(@col),WinWriteSeg,offs+LinearPageOfs,2);
+  end;
+
+{$endif FPC}
+
+ {************************************************************************}
+ {*                     4-bit pixels VESA mode routines                  *}
+ {************************************************************************}
+
+  procedure PutPixVESA16(x, y : smallint; color : word); {$ifndef fpc}far;{$endif fpc}
+    var
+     offs : longint;
+     dummy : byte;
+  begin
+     X:= X + StartXViewPort;
+     Y:= Y + StartYViewPort;
+     { convert to absolute coordinates and then verify clipping...}
+    if ClipPixels then
+     Begin
+       if (X < StartXViewPort) or (X > (StartXViewPort + ViewWidth)) then
+         exit;
+       if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then
+         exit;
+     end;
+     Y := Y + YOffset; { adjust pixel for correct virtual page }
+     { }
+     offs := longint(y) * BytesPerLine + (x div 8);
+     SetReadBank(smallint(offs shr 16));
+     SetWriteBank(smallint(offs shr 16));
+
+     PortW[$3ce] := $0f01;       { Index 01 : Enable ops on all 4 planes }
+     PortW[$3ce] := color shl 8; { Index 00 : Enable correct plane and write color }
+
+     { Index 08 : Bitmask register.          }
+     PortW[$3ce] := ($8000 shr (x and $7)) or 8; { Select correct bits to modify }
+
+     dummy := Mem[WinReadSeg: word(offs)];  { Latch the data into host space.  }
+     Mem[WinWriteSeg: word(offs)] := dummy;  { Write the data into video memory }
+     PortW[$3ce] := $ff08;         { Enable all bit planes.           }
+     PortW[$3ce] := $0001;         { Index 01 : Disable ops on all four planes.         }
+     { }
+  end;
+
+
+ Function GetPixVESA16(X,Y: smallint):word; {$ifndef fpc}far;{$endif fpc}
+ Var dummy: Word;
+     offset: longint;
+     shift: byte;
+  Begin
+    X:= X + StartXViewPort;
+    Y:= Y + StartYViewPort + YOffset;
+    offset := longint(Y) * BytesPerLine + (x div 8);
+    SetReadBank(smallint(offset shr 16));
+    PortW[$3ce] := $0004;
+    shift := 7 - (X and 7);
+    dummy := (Mem[WinReadSeg:word(offset)] shr shift) and 1;
+    Port[$3cf] := 1;
+    dummy := dummy or (((Mem[WinReadSeg:word(offset)] shr shift) and 1) shl 1);
+    Port[$3cf] := 2;
+    dummy := dummy or (((Mem[WinReadSeg:word(offset)] shr shift) and 1) shl 2);
+    Port[$3cf] := 3;
+    dummy := dummy or (((Mem[WinReadSeg:word(offset)] shr shift) and 1) shl 3);
+    GetPixVESA16 := dummy;
+  end;
+
+
+  procedure DirectPutPixVESA16(x, y : smallint); {$ifndef fpc}far;{$endif fpc}
+    var
+     offs : longint;
+     dummy : byte;
+     Color : word;
+  begin
+     If CurrentWriteMode <> NotPut Then
+       Color := CurrentColor
+     else Color := not CurrentColor;
+
+     case CurrentWriteMode of
+        XORPut:
+          PortW[$3ce]:=((3 shl 3) shl 8) or 3;
+        ANDPut:
+          PortW[$3ce]:=((1 shl 3) shl 8) or 3;
+        ORPut:
+          PortW[$3ce]:=((2 shl 3) shl 8) or 3;
+        {not needed, this is the default state (e.g. PutPixel16 requires it)}
+        {NormalPut, NotPut:
+          PortW[$3ce]:=$0003
+        else
+          PortW[$3ce]:=$0003}
+     end;
+
+     Y := Y + YOffset;
+     offs := longint(y) * BytesPerLine + (x div 8);
+     SetReadBank(smallint(offs shr 16));
+     SetWriteBank(smallint(offs shr 16));
+     PortW[$3ce] := $0f01;       { Index 01 : Enable ops on all 4 planes }
+     PortW[$3ce] := color shl 8; { Index 00 : Enable correct plane and write color }
+
+     { Index 08 : Bitmask register.          }
+     PortW[$3ce] := ($8000 shr (x and $7)) or 8; { Select correct bits to modify }
+
+     dummy := Mem[WinReadSeg: word(offs)];  { Latch the data into host space.  }
+     Mem[WinWriteSeg: word(offs)] := dummy;  { Write the data into video memory }
+     PortW[$3ce] := $ff08;         { Enable all bit planes.           }
+     PortW[$3ce] := $0001;         { Index 01 : Disable ops on all four planes.         }
+     if (CurrentWriteMode = XORPut) or
+        (CurrentWriteMode = ANDPut) or
+        (CurrentWriteMode = ORPut) then
+       PortW[$3ce] := $0003;
+  end;
+
+
+  procedure HLineVESA16(x,x2,y: smallint); {$ifndef fpc}far;{$endif fpc}
+  var
+      xtmp: smallint;
+      ScrOfs, BankRest: longint;
+      HLength : word;
+      LMask,RMask : byte;
+  begin
+
+    { must we swap the values? }
+    if x > x2 then
+      Begin
+        xtmp := x2;
+        x2 := x;
+        x:= xtmp;
+      end;
+    { First convert to global coordinates }
+    X   := X + StartXViewPort;
+    X2  := X2 + StartXViewPort;
+    Y   := Y + StartYViewPort;
+    if ClipPixels then
+      Begin
+         if LineClipped(x,y,x2,y,StartXViewPort,StartYViewPort,
+                StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
+            exit;
+      end;
+    Y := Y + YOffset;
+    ScrOfs := longint(y) * BytesPerLine + (x div 8);
+    SetReadBank(smallint(ScrOfs shr 16));
+    SetWriteBank(smallint(ScrOfs shr 16));
+    HLength:=x2 div 8-x div 8;
+    LMask:=$ff shr (x and 7);
+{$push}
+{$r-}
+{$q-}
+    RMask:=$ff shl (7-(x2 and 7));
+{$pop}
+    if HLength=0 then
+      LMask:=LMask and RMask;
+    If CurrentWriteMode <> NotPut Then
+      PortW[$3ce]:= CurrentColor shl 8
+    else PortW[$3ce]:= (not CurrentColor) shl 8;
+    PortW[$3ce]:=$0f01;
+    case CurrentWriteMode of
+       XORPut:
+         PortW[$3ce]:=((3 shl 3) shl 8) or 3;
+       ANDPut:
+         PortW[$3ce]:=((1 shl 3) shl 8) or 3;
+       ORPut:
+         PortW[$3ce]:=((2 shl 3) shl 8) or 3;
+       NormalPut, NotPut:
+         PortW[$3ce]:=$0003
+       else
+         PortW[$3ce]:=$0003
+    end;
+
+    PortW[$3ce]:=(LMask shl 8) or 8;
+{$push}
+{$r-}
+{$q-}
+    Mem[WinWriteSeg:word(ScrOfs)]:=Mem[WinReadSeg:word(ScrOfs)]+1;
+{$pop}
+    {Port[$3ce]:=8;}{not needed, the register is already selected}
+    if HLength>0 then
+      begin
+         dec(HLength);
+         inc(ScrOfs);
+         while (HLength>0) do
+           begin
+              SetReadBank(smallint(ScrOfs shr 16));
+              SetWriteBank(smallint(ScrOfs shr 16));
+              Port[$3cf]:=$ff;
+              if HLength <= ($10000-(ScrOfs and $ffff)) Then
+                 BankRest := HLength
+              else {the rest won't fit anymore in the current window }
+                BankRest := $10000 - (ScrOfs and $ffff);
+{$ifndef tp}
+              seg_bytemove(dosmemselector,(WinReadSeg shl 4)+word(ScrOfs),dosmemselector,(WinWriteSeg shl 4)+word(ScrOfs),BankRest);
+{$else}
+              move(Ptr(WinReadSeg,word(ScrOfs))^, Ptr(WinWriteSeg,word(ScrOfs))^, BankRest);
+{$endif}
+              ScrOfs := ScrOfs + BankRest;
+              HLength := HLength - BankRest;
+           end;
+         SetReadBank(smallint(ScrOfs shr 16));
+         SetWriteBank(smallint(ScrOfs shr 16));
+         Port[$3cf]:=RMask;
+{$push}
+{$r-}
+{$q-}
+         Mem[WinWriteSeg:word(ScrOfs)]:=Mem[WinReadSeg:word(ScrOfs)]+1;
+{$pop}
+      end;
+    { clean up }
+    {Port[$3cf]:=0;}{not needed, the register is reset by the next operation:}
+    PortW[$3ce]:=$ff08;
+    PortW[$3ce]:=$0001;
+    PortW[$3ce]:=$0003;
+   end;
+
+
+
+
+ {************************************************************************}
+ {*                     VESA Palette entries                             *}
+ {************************************************************************}
+
+
+{$IFDEF DPMI}
+{$ifdef fpc}
+   Procedure SetVESARGBAllPalette(const Palette:PaletteType);
+    var
+     pal: array[0..255] of palrec;
+     regs: Registers;
+     c, Ptr: longint;
+     RealSeg: word;
+     FunctionNr : byte;   { use blankbit or normal RAMDAC programming? }
+    begin
+      if DirectColor then
+        Begin
+          _GraphResult := grError;
+          exit;
+        end;
+      { use the set/get palette function }
+      if VESAInfo.Version >= $0200 then
+        Begin
+          { check if blanking bit must be set when programming }
+          { the RAMDAC.                                        }
+          if (VESAInfo.caps and attrSnowCheck) <> 0 then
+            FunctionNr := $80
+          else
+            FunctionNr := $00;
+
+          fillChar(pal,sizeof(pal),0);
+          { Convert to vesa format }
+          for c := 0 to 255 do
+            begin
+              pal[c].red := byte(palette.colors[c].red);
+              pal[c].green := byte(palette.colors[c].green);
+              pal[c].blue := byte(palette.colors[c].blue);
+            end;
+
+        { Alllocate real mode buffer }
+          Ptr:=Global_Dos_Alloc(sizeof(pal));
+          {get the segment value}
+          RealSeg := word(Ptr shr 16);
+          { setup interrupt registers }
+          FillChar(regs, sizeof(regs), #0);
+          { copy palette values to real mode buffer }
+          DosMemPut(RealSeg,0,pal,sizeof(pal));
+          regs.eax := $4F09;
+          regs.ebx := FunctionNr;
+          regs.ecx := 256;
+          regs.edx := 0;
+          regs.es  := RealSeg;
+          regs.edi := 0;         { offset is always zero }
+          RealIntr($10, regs);
+
+          { free real mode memory  }
+          If not Global_Dos_Free(word(Ptr and $ffff)) then
+            RunError(216);
+
+          if word(regs.eax) <> $004F then
+            begin
+              _GraphResult := grError;
+              exit;
+            end;
+        end
+      else
+        { assume it's fully VGA compatible palette-wise. }
+        Begin
+          SetVGARGBAllPalette(palette);
+        end;
+      setallpalettedefault(palette);
+    end;
+{$endif fpc}
+
+   Procedure SetVESARGBPalette(ColorNum, RedValue, GreenValue,
+      BlueValue : smallint);
+    var
+     pal: palrec;
+     regs: Registers;
+     Ptr: longint;
+{$ifndef fpc}
+     PalPtr : ^PalRec;
+{$endif fpc}
+     RealSeg: word;
+     FunctionNr : byte;   { use blankbit or normal RAMDAC programming? }
+    begin
+      if DirectColor then
+        Begin
+{$ifdef logging}
+          logln('setvesargbpalette called with directcolor = true');
+{$endif logging}
+          _GraphResult := grError;
+          exit;
+        end;
+        pal.align := 0;
+        pal.red := byte(RedValue) shr 2;
+        pal.green := byte(GreenValue) shr 2;
+        pal.blue := byte(BlueValue) shr 2;
+        { use the set/get palette function }
+        if VESAInfo.Version >= $0200 then
+          Begin
+            { check if blanking bit must be set when programming }
+            { the RAMDAC.                                        }
+            if (VESAInfo.caps and attrSnowCheck) <> 0 then
+              FunctionNr := $80
+            else
+              FunctionNr := $00;
+
+            { Alllocate real mode buffer }
+{$ifndef fpc}
+            Ptr:=GlobalDosAlloc(sizeof(palrec));
+            { get the selector values }
+            PalPtr := pointer(Ptr shl 16);
+            if not assigned(PalPtr) then
+               RunError(203);
+{$else fpc}
+            Ptr:=Global_Dos_Alloc(sizeof(palrec));
+{$endif fpc}
+            {get the segment value}
+            RealSeg := word(Ptr shr 16);
+            { setup interrupt registers }
+            FillChar(regs, sizeof(regs), #0);
+            { copy palette values to real mode buffer }
+{$ifndef fpc}
+            move(pal, palptr^, sizeof(pal));
+{$else fpc}
+            DosMemPut(RealSeg,0,pal,sizeof(pal));
+{$endif fpc}
+            regs.eax := $4F09;
+            regs.ebx := FunctionNr;
+            regs.ecx := $01;
+            regs.edx := ColorNum;
+            regs.es  := RealSeg;
+            regs.edi := 0;         { offset is always zero }
+            RealIntr($10, regs);
+
+            { free real mode memory  }
+{$ifndef fpc}
+            GlobalDosFree(word(Ptr and $ffff));
+{$else fpc}
+            If not Global_Dos_Free(word(Ptr and $ffff)) then
+              RunError(216);
+{$endif fpc}
+
+            if word(regs.eax) <> $004F then
+              begin
+{$ifdef logging}
+                logln('setvesargbpalette failed while directcolor = false!');
+{$endif logging}
+                _GraphResult := grError;
+                exit;
+              end;
+          end
+        else
+          { assume it's fully VGA compatible palette-wise. }
+          Begin
+            SetVGARGBPalette(ColorNum, RedValue, GreenValue, BlueValue);
+          end;
+    end;
+
+
+  Procedure GetVESARGBPalette(ColorNum: smallint; Var
+      RedValue, GreenValue, BlueValue : smallint);
+   var
+    pal: PalRec;
+{$ifndef fpc}
+    palptr : ^PalRec;
+{$endif fpc}
+    regs : Registers;
+    RealSeg: word;
+    ptr: longint;
+   begin
+      if DirectColor then
+        Begin
+{$ifdef logging}
+         logln('getvesargbpalette called with directcolor = true');
+{$endif logging}
+          _GraphResult := grError;
+          exit;
+        end;
+        { use the set/get palette function }
+        if VESAInfo.Version >= $0200 then
+          Begin
+            { Alllocate real mode buffer }
+{$ifndef fpc}
+            Ptr:=GlobalDosAlloc(sizeof(palrec));
+            { get the selector value }
+            PalPtr := pointer(longint(Ptr and $0000ffff) shl 16);
+            if not assigned(PalPtr) then
+               RunError(203);
+{$else fpc}
+            Ptr:=Global_Dos_Alloc(sizeof(palrec));
+{$endif fpc}
+            { get the segment value }
+            RealSeg := word(Ptr shr 16);
+            { setup interrupt registers }
+            FillChar(regs, sizeof(regs), #0);
+
+            regs.eax := $4F09;
+            regs.ebx := $01;       { get palette data      }
+            regs.ecx := $01;
+            regs.edx := ColorNum;
+            regs.es  := RealSeg;
+            regs.edi := 0;         { offset is always zero }
+            RealIntr($10, regs);
+
+           { copy to protected mode buffer ... }
+{$ifndef fpc}
+           Move(PalPtr^, Pal, sizeof(pal));
+{$else fpc}
+           DosMemGet(RealSeg,0,Pal,sizeof(pal));
+{$endif fpc}
+           { free real mode memory  }
+{$ifndef fpc}
+           GlobalDosFree(word(Ptr and $ffff));
+{$else fpc}
+           If not Global_Dos_Free(word(Ptr and $ffff)) then
+             RunError(216);
+{$endif fpc}
+
+            if word(regs.eax) <> $004F then
+              begin
+{$ifdef logging}
+                logln('getvesargbpalette failed while directcolor = false!');
+{$endif logging}
+                _GraphResult := grError;
+                exit;
+              end
+            else
+              begin
+                RedValue := smallint(pal.Red);
+                GreenValue := smallint(pal.Green);
+                BlueValue := smallint(pal.Blue);
+              end;
+          end
+        else
+            GetVGARGBPalette(ColorNum, RedValue, GreenValue, BlueValue);
+   end;
+{$ELSE}
+
+   Procedure SetVESARGBPalette(ColorNum, RedValue, GreenValue,
+      BlueValue : smallint); far;
+    var
+     FunctionNr : byte;   { use blankbit or normal RAMDAC programming? }
+     pal: ^palrec;
+     Error : boolean;     { VBE call error                             }
+    begin
+      if DirectColor then
+        Begin
+          _GraphResult := grError;
+          exit;
+        end;
+        Error := FALSE;
+        new(pal);
+        if not assigned(pal) then RunError(203);
+        pal^.align := 0;
+        pal^.red := byte(RedValue);
+        pal^.green := byte(GreenValue);
+        pal^.blue := byte(BlueValue);
+        { use the set/get palette function }
+        if VESAInfo.Version >= $0200 then
+          Begin
+            { check if blanking bit must be set when programming }
+            { the RAMDAC.                                        }
+            if (VESAInfo.caps and attrSnowCheck) <> 0 then
+              FunctionNr := $80
+            else
+              FunctionNr := $00;
+            asm
+              mov  ax, 4F09h         { Set/Get Palette data    }
+              mov  bl, [FunctionNr]  { Set palette data        }
+              mov  cx, 01h           { update one palette reg. }
+              mov  dx, [ColorNum]    { register number to update }
+              les  di, [pal]         { get palette address     }
+              int  10h
+              cmp  ax, 004Fh         { check if success        }
+              jz   @noerror
+              mov  [Error], TRUE
+             @noerror:
+            end;
+            if not Error then
+                Dispose(pal)
+            else
+              begin
+                _GraphResult := grError;
+                exit;
+              end;
+          end
+        else
+          { assume it's fully VGA compatible palette-wise. }
+          Begin
+            SetVGARGBPalette(ColorNum, RedValue, GreenValue, BlueValue);
+          end;
+    end;
+
+
+
+
+  Procedure GetVESARGBPalette(ColorNum: smallint; Var RedValue, GreenValue,
+              BlueValue : smallint); far;
+   var
+    Error: boolean;
+    pal: ^palrec;
+   begin
+      if DirectColor then
+        Begin
+          _GraphResult := grError;
+          exit;
+        end;
+      Error := FALSE;
+      new(pal);
+      if not assigned(pal) then RunError(203);
+      FillChar(pal^, sizeof(palrec), #0);
+      { use the set/get palette function }
+      if VESAInfo.Version >= $0200 then
+        Begin
+          asm
+            mov  ax, 4F09h         { Set/Get Palette data    }
+            mov  bl, 01h           { Set palette data        }
+            mov  cx, 01h           { update one palette reg. }
+            mov  dx, [ColorNum]    { register number to update }
+            les  di, [pal]         { get palette address     }
+            int  10h
+            cmp  ax, 004Fh         { check if success        }
+            jz   @noerror
+            mov  [Error], TRUE
+          @noerror:
+          end;
+          if not Error then
+            begin
+              RedValue := smallint(pal^.Red);
+              GreenValue := smallint(pal^.Green);
+              BlueValue := smallint(pal^.Blue);
+              Dispose(pal);
+            end
+          else
+            begin
+              _GraphResult := grError;
+              exit;
+            end;
+        end
+        else
+            GetVGARGBPalette(ColorNum, RedValue, GreenValue, BlueValue);
+
+   end;
+{$ENDIF}
+
+
+(*
+type
+  heaperrorproc=function(size:longint):smallint;
+
+Const
+  HeapErrorIsHooked : boolean = false;
+  OldHeapError : HeapErrorProc = nil;
+  DsLimit : dword = 0;
+
+  function NewHeapError(size : longint) : smallint;
+    begin
+      set_segment_limit(get_ds,DsLimit);
+      NewHeapError:=OldHeapError(size);
+      DsLimit:=get_segment_limit(get_ds);
+      { The base of ds can be changed
+        we need to compute the address again PM }
+      LFBPointer:=pointer(FrameBufferLinearAddress-get_segment_base_address(get_ds));
+      if dword(LFBPointer)+dword(VESAInfo.TotalMem shl 16)-1 > DsLimit then
+        set_segment_limit(get_ds,dword(LFBPointer)+dword(VESAInfo.TotalMem shl 16)-1);
+    end;
+
+  procedure HookHeapError;
+    begin
+      if HeapErrorIsHooked then
+        exit;
+      DsLimit:=get_segment_limit(get_ds);
+      OldHeapError:=HeapErrorProc(HeapError);
+      HeapError:=@NewHeapError;
+      HeapErrorIsHooked:=true;
+    end;
+
+  procedure UnHookHeapError;
+    begin
+      if not HeapErrorIsHooked then
+        exit;
+      LFBPointer:=nil;
+      set_segment_limit(get_ds,DsLimit);
+      HeapError:=OldHeapError;
+      HeapErrorIsHooked:=false;
+    end;
+*)
+
+  function SetupLinear(var ModeInfo: TVESAModeInfo;mode : word) : boolean;
+   begin
+     SetUpLinear:=false;
+
+     if VESAInfo.Version >= $0300 then
+       BytesPerLine := VESAModeInfo.LinBytesPerScanLine
+     else
+       BytesPerLine := VESAModeInfo.BytesPerScanLine;
+
+{$ifdef FPC}
+     case mode of
+       m320x200x32k,
+       m320x200x64k,
+       m640x480x32k,
+       m640x480x64k,
+       m800x600x32k,
+       m800x600x64k,
+       m1024x768x32k,
+       m1024x768x64k,
+       m1280x1024x32k,
+       m1280x1024x64k :
+         begin
+           DirectPutPixel:=@DirectPutPixVESA32kor64kLinear;
+           PutPixel:=@PutPixVESA32kor64kLinear;
+           GetPixel:=@GetPixVESA32kor64kLinear;
+           { linear mode for lines not yet implemented PM }
+           HLine:=@HLineDefault;
+           VLine:=@VLineDefault;
+           GetScanLine := @GetScanLineDefault;
+           PatternLine := @PatternLineDefault;
+         end;
+       m640x400x256,
+       m640x480x256,
+       m800x600x256,
+       m1024x768x256,
+       m1280x1024x256:
+         begin
+           DirectPutPixel:=@DirectPutPixVESA256Linear;
+           PutPixel:=@PutPixVESA256Linear;
+           GetPixel:=@GetPixVESA256Linear;
+           { linear mode for lines not yet implemented PM }
+           HLine:=@HLineDefault;
+           VLine:=@VLineDefault;
+           GetScanLine := @GetScanLineDefault;
+           PatternLine := @PatternLineDefault;
+         end;
+     else
+       exit;
+     end;
+     FrameBufferLinearAddress:=Get_linear_addr(VESAModeInfo.PhysAddress and $FFFF0000,
+       VESAInfo.TotalMem shl 16);
+{$ifdef logging}
+     logln('framebuffer linear address: '+hexstr(FrameBufferLinearAddress div (1024*1024),8));
+     logln('total mem shl 16: '+strf(vesainfo.totalmem shl 16));
+{$endif logging}
+     if int31error<>0 then
+       begin
+{$ifdef logging}
+         logln('Unable to get linear address for '+hexstr(VESAModeInfo.PhysAddress,8));
+{$endif logging}
+         writeln(stderr,'Unable to get linear address for ',hexstr(VESAModeInfo.PhysAddress,8));
+         exit;
+       end;
+     if UseNoSelector then
+       begin
+{         HookHeapError; }
+         LFBPointer:=pointer(FrameBufferLinearAddress-get_segment_base_address(get_ds));
+         if dword(LFBPointer)+dword(VESAInfo.TotalMem shl 16)-1 > dword(get_segment_limit(get_ds)) then
+           set_segment_limit(get_ds,dword(LFBPointer)+dword(VESAInfo.TotalMem shl 16)-1);
+       end
+     else
+       begin
+         WinWriteSeg:=allocate_ldt_descriptors(1);
+{$ifdef logging}
+         logln('writeseg1: '+hexstr(winwriteseg,8));
+{$endif logging}
+         set_segment_base_address(WinWriteSeg,FrameBufferLinearAddress);
+         set_segment_limit(WinWriteSeg,(VESAInfo.TotalMem shl 16)-1);
+         lock_linear_region(FrameBufferLinearAddress,(VESAInfo.TotalMem shl 16));
+         if int31error<>0 then
+           begin
+{$ifdef logging}
+             logln('Error in linear memory selectors creation');
+{$endif logging}
+             writeln(stderr,'Error in linear memory selectors creation');
+             exit;
+           end;
+       end;
+     LinearPageOfs := 0;
+     InLinear:=true;
+     SetUpLinear:=true;
+     { WinSize:=(VGAInfo.TotalMem shl 16);
+     WinLoMask:=(VGAInfo.TotalMem shl 16)-1;
+     WinShift:=15;
+     Temp:=VGAInfo.TotalMem;
+     while Temp>0 do
+       begin
+         inc(WinShift);
+         Temp:=Temp shr 1;
+       end; }
+{$endif FPC}
+   end;
+
+  procedure SetupWindows(var ModeInfo: TVESAModeInfo);
+   begin
+     InLinear:=false;
+
+     BytesPerLine := VESAModeInfo.BytesPerScanLine;
+
+     { now we check the windowing scheme ...}
+     if (ModeInfo.WinAAttr and WinSupported) <> 0 then
+       { is this window supported ... }
+       begin
+         { now check if the window is R/W }
+         if (ModeInfo.WinAAttr and WinReadable) <> 0 then
+         begin
+           ReadWindow := 0;
+           WinReadSeg := ModeInfo.WinASeg;
+         end;
+         if (ModeInfo.WinAAttr and WinWritable) <> 0 then
+         begin
+           WriteWindow := 0;
+           WinWriteSeg := ModeInfo.WinASeg;
+         end;
+       end;
+     if (ModeInfo.WinBAttr and WinSupported) <> 0 then
+       { is this window supported ... }
+       begin
+
+         { OPTIMIZATION ... }
+         { if window A supports both read/write, then we try to optimize }
+         { everything, by using a different window for Read and/or write.}
+         if (WinReadSeg <> 0) and (WinWriteSeg <> 0) then
+           begin
+              { check if winB supports read }
+              if (ModeInfo.WinBAttr and winReadable) <> 0 then
+                begin
+                  WinReadSeg := ModeInfo.WinBSeg;
+                  ReadWindow := 1;
+                end
+              else
+              { check if WinB supports write }
+              if (ModeInfo.WinBAttr and WinWritable) <> 0 then
+                begin
+                  WinWriteSeg := ModeInfo.WinBSeg;
+                  WriteWindow := 1;
+                end;
+           end
+         else
+         { Window A only supported Read OR Write, no we have to make }
+         { sure that window B supports the other mode.               }
+         if (WinReadSeg = 0) and (WinWriteSeg<>0) then
+           begin
+              if (ModeInfo.WinBAttr and WinReadable <> 0) then
+                begin
+                  ReadWindow := 1;
+                  WinReadSeg := ModeInfo.WinBSeg;
+                end
+              else
+                { impossible, this VESA mode is WRITE only! }
+                begin
+                  WriteLn('Invalid VESA Window attribute.');
+                  Halt(255);
+                end;
+           end
+         else
+         if (winWriteSeg = 0) and (WinReadSeg<>0) then
+           begin
+             if (ModeInfo.WinBAttr and WinWritable) <> 0 then
+               begin
+                 WriteWindow := 1;
+                 WinWriteSeg := ModeInfo.WinBSeg;
+               end
+             else
+               { impossible, this VESA mode is READ only! }
+               begin
+                  WriteLn('Invalid VESA Window attribute.');
+                  Halt(255);
+               end;
+           end
+         else
+         if (winReadSeg = 0) and (winWriteSeg = 0) then
+         { no read/write in this mode! }
+           begin
+                  WriteLn('Invalid VESA Window attribute.');
+                  Halt(255);
+           end;
+         YOffset := 0;
+       end;
+
+     { if both windows are not supported, then we can assume }
+     { that there is ONE single NON relocatable window.      }
+     if (WinWriteSeg = 0) and (WinReadSeg = 0) then
+       begin
+         WinWriteSeg := ModeInfo.WinASeg;
+         WinReadSeg := ModeInfo.WinASeg;
+       end;
+
+    { 16-bit Protected mode checking code...  }
+    { change segment values to protected mode }
+    { selectors.                              }
+    if WinReadSeg = $A000 then
+      WinReadSeg := SegA000
+    else
+    if WinReadSeg = $B000 then
+      WinReadSeg := SegB000
+    else
+    if WinReadSeg = $B800 then
+      WinReadSeg := SegB800
+    else
+      begin
+        WriteLn('Invalid segment address.');
+        Halt(255);
+      end;
+    if WinWriteSeg = $A000 then
+      WinWriteSeg := SegA000
+    else
+    if WinWriteSeg = $B000 then
+      WinWriteSeg := SegB000
+    else
+    if WinWriteSeg = $B800 then
+      WinWriteSeg := SegB800
+    else
+      begin
+        WriteLn('Invalid segment address.');
+        Halt(255);
+      end;
+
+   end;
+
+
+
+  function setVESAMode(mode:word):boolean;
+    var i:word;
+        res: boolean;
+  begin
+   { Init mode information, for compatibility with VBE < 1.1 }
+   FillChar(VESAModeInfo, sizeof(TVESAModeInfo), #0);
+   { get the video mode information }
+   if getVESAModeInfo(VESAmodeinfo, mode) then
+   begin
+     { checks if the hardware supports the video mode. }
+     if (VESAModeInfo.attr and modeAvail) = 0 then
+       begin
+         SetVESAmode := FALSE;
+{$ifdef logging}
+         logln('  vesa mode '+strf(mode)+' not supported!!!');
+{$endif logging}
+         _GraphResult := grError;
+         exit;
+       end;
+
+     SetVESAMode := TRUE;
+     BankShift := 0;
+     while (64 shr BankShift) <> VESAModeInfo.WinGranularity do
+        Inc(BankShift);
+     CurrentWriteBank := -1;
+     CurrentReadBank := -1;
+{    nickysn: setting BytesPerLine moved to SetupLinear and SetupWindowed
+     BytesPerLine := VESAModeInfo.BytesPerScanLine;}
+
+     { These are the window adresses ... }
+     WinWriteSeg := 0;  { This is the segment to use for writes }
+     WinReadSeg := 0;   { This is the segment to use for reads  }
+     ReadWindow := 0;
+     WriteWindow := 0;
+
+     { VBE 2.0 and higher supports >= non VGA linear buffer types...}
+     { this is backward compatible.                                 }
+     if (((VESAModeInfo.Attr and ModeNoWindowed) <> 0) or UseLFB) and
+          ((VESAModeInfo.Attr and ModeLinearBuffer) <> 0) then
+        begin
+          if not SetupLinear(VESAModeInfo,mode) then
+            SetUpWindows(VESAModeInfo);
+        end
+     else
+     { if linear and windowed is supported, then use windowed }
+     { method.                                                }
+        SetUpWindows(VESAModeInfo);
+
+{$ifdef logging}
+  LogLn('Entering vesa mode '+strf(mode));
+  LogLn('Read segment: $'+hexstr(winreadseg,4));
+  LogLn('Write segment: $'+hexstr(winwriteseg,4));
+  LogLn('Window granularity: '+strf(VESAModeInfo.WinGranularity)+'kb');
+  LogLn('Window size: '+strf(VESAModeInfo.winSize)+'kb');
+  LogLn('Bytes per line: '+strf(bytesperline));
+{$endif logging}
+   { Select the correct mode number if we're going to use linear access! }
+   if InLinear then
+     inc(mode,$4000);
+
+   asm
+    mov ax,4F02h
+    mov bx,mode
+{$ifdef fpc}
+    push ebp
+    push esi
+    push edi
+    push ebx
+{$endif fpc}
+    int 10h
+{$ifdef fpc}
+    pop ebx
+    pop edi
+    pop esi
+    pop ebp
+{$endif fpc}
+    sub ax,004Fh
+    cmp ax,1
+    sbb al,al
+    mov res,al
+   end ['EBX','EAX'];
+   if not res then
+     _GraphResult := GrNotDetected
+   else _GraphResult := grOk;
+  end;
+ end;
+
+(*
+ function getVESAMode:word;assembler;
+   asm  {return -1 if error}
+    mov ax,4F03h
+{$ifdef fpc}
+    push ebx
+    push ebp
+    push esi
+    push edi
+{$endif fpc}
+    int 10h
+{$ifdef fpc}
+    pop edi
+    pop esi
+    pop ebp
+{$endif fpc}
+    cmp ax,004Fh
+    je @@OK
+    mov ax,-1
+    jmp @@X
+  @@OK:
+    mov ax,bx
+  @@X:
+{$ifdef fpc}
+    pop ebx
+{$endif fpc}
+   end ['EAX'];
+*)
+
+
+
+ {************************************************************************}
+ {*                     VESA Modes inits                                 *}
+ {************************************************************************}
+
+{$IFDEF DPMI}
+
+  {******************************************************** }
+  { Function GetMaxScanLines()                              }
+  {-------------------------------------------------------- }
+  { This routine returns the maximum number of scan lines   }
+  { possible for this mode. This is done using the Get      }
+  { Scan Line length VBE function.                          }
+  {******************************************************** }
+  function GetMaxScanLines: word;
+   var
+    regs : Registers;
+   begin
+     FillChar(regs, sizeof(regs), #0);
+     { play it safe, call the real mode int, the 32-bit entry point }
+     { may not be defined as stated in VBE v3.0                     }
+     regs.eax := $4f06; {_ setup function      }
+     regs.ebx := $0001; { get scan line length }
+     RealIntr($10, regs);
+     GetMaxScanLines := (regs.edx and $0000ffff);
+   end;
+
+{$ELSE}
+
+  function GetMaxScanLines: word; assembler;
+     asm
+      mov ax, 4f06h
+      mov bx, 0001h
+      int 10h
+      mov ax, dx
+   end;
+
+{$ENDIF}
+
+ procedure Init1280x1024x64k; {$ifndef fpc}far;{$endif fpc}
+  begin
+    SetVesaMode(m1280x1024x64k);
+    { Get maximum number of scanlines for page flipping }
+    ScanLines := GetMaxScanLines;
+  end;
+
+ procedure Init1280x1024x32k; {$ifndef fpc}far;{$endif fpc}
+  begin
+    SetVESAMode(m1280x1024x32k);
+    { Get maximum number of scanlines for page flipping }
+    ScanLines := GetMaxScanLines;
+  end;
+
+ procedure Init1280x1024x256; {$ifndef fpc}far;{$endif fpc}
+  begin
+    SetVESAMode(m1280x1024x256);
+    { Get maximum number of scanlines for page flipping }
+    ScanLines := GetMaxScanLines;
+  end;
+
+
+ procedure Init1280x1024x16; {$ifndef fpc}far;{$endif fpc}
+  begin
+    SetVESAMode(m1280x1024x16);
+    { Get maximum number of scanlines for page flipping }
+    ScanLines := GetMaxScanLines;
+  end;
+
+ procedure Init1024x768x64k; {$ifndef fpc}far;{$endif fpc}
+  begin
+    SetVESAMode(m1024x768x64k);
+    { Get maximum number of scanlines for page flipping }
+    ScanLines := GetMaxScanLines;
+  end;
+
+ procedure Init1024x768x32k; {$ifndef fpc}far;{$endif fpc}
+  begin
+    SetVESAMode(m1024x768x32k);
+    { Get maximum number of scanlines for page flipping }
+    ScanLines := GetMaxScanLines;
+  end;
+
+ procedure Init1024x768x256; {$ifndef fpc}far;{$endif fpc}
+  begin
+    SetVESAMode(m1024x768x256);
+    { Get maximum number of scanlines for page flipping }
+    ScanLines := GetMaxScanLines;
+  end;
+
+ procedure Init1024x768x16; {$ifndef fpc}far;{$endif fpc}
+  begin
+    SetVESAMode(m1024x768x16);
+    { Get maximum number of scanlines for page flipping }
+    ScanLines := GetMaxScanLines;
+  end;
+
+ procedure Init800x600x64k; {$ifndef fpc}far;{$endif fpc}
+  begin
+    SetVESAMode(m800x600x64k);
+    { Get maximum number of scanlines for page flipping }
+    ScanLines := GetMaxScanLines;
+  end;
+
+ procedure Init800x600x32k; {$ifndef fpc}far;{$endif fpc}
+  begin
+    SetVESAMode(m800x600x32k);
+    { Get maximum number of scanlines for page flipping }
+    ScanLines := GetMaxScanLines;
+  end;
+
+ procedure Init800x600x256; {$ifndef fpc}far;{$endif fpc}
+  begin
+    SetVESAMode(m800x600x256);
+    { Get maximum number of scanlines for page flipping }
+    ScanLines := GetMaxScanLines;
+  end;
+
+ procedure Init800x600x16; {$ifndef fpc}far;{$endif fpc}
+  begin
+    SetVesaMode(m800x600x16);
+    { Get maximum number of scanlines for page flipping }
+    ScanLines := GetMaxScanLines;
+  end;
+
+ procedure Init640x480x64k; {$ifndef fpc}far;{$endif fpc}
+  begin
+    SetVESAMode(m640x480x64k);
+    { Get maximum number of scanlines for page flipping }
+    ScanLines := GetMaxScanLines;
+  end;
+
+ procedure Init640x480x32k; {$ifndef fpc}far;{$endif fpc}
+  begin
+    SetVESAMode(m640x480x32k);
+    { Get maximum number of scanlines for page flipping }
+    ScanLines := GetMaxScanLines;
+  end;
+
+ procedure Init640x480x256; {$ifndef fpc}far;{$endif fpc}
+  begin
+    SetVESAMode(m640x480x256);
+    { Get maximum number of scanlines for page flipping }
+    ScanLines := GetMaxScanLines;
+  end;
+
+ procedure Init640x400x256; {$ifndef fpc}far;{$endif fpc}
+  begin
+    SetVESAMode(m640x400x256);
+    { Get maximum number of scanlines for page flipping }
+    ScanLines := GetMaxScanLines;
+  end;
+
+ procedure Init320x200x64k; {$ifndef fpc}far;{$endif fpc}
+  begin
+    SetVESAMode(m320x200x64k);
+    { Get maximum number of scanlines for page flipping }
+    ScanLines := GetMaxScanLines;
+  end;
+
+ procedure Init320x200x32k; {$ifndef fpc}far;{$endif fpc}
+  begin
+    SetVESAMode(m320x200x32k);
+    { Get maximum number of scanlines for page flipping }
+    ScanLines := GetMaxScanLines;
+  end;
+
+
+{$IFDEF DPMI}
+
+ Procedure SaveStateVESA; {$ifndef fpc}far;{$endif fpc}
+ var
+  PtrLong: longint;
+  regs: Registers;
+  begin
+    SaveSupported := FALSE;
+    SavePtr := nil;
+{$ifdef logging}
+        LogLn('Get the video mode...');
+{$endif logging}
+    { Get the video mode }
+    asm
+      mov  ah,0fh
+{$ifdef fpc}
+      push ebp
+      push esi
+      push edi
+      push ebx
+{$endif fpc}
+      int  10h
+{$ifdef fpc}
+      pop ebx
+      pop edi
+      pop esi
+      pop ebp
+{$endif fpc}
+      mov  [VideoMode], al
+    end ['EAX'];
+    { saving/restoring video state screws up Windows (JM) }
+    if inWindows then
+      exit;
+{$ifdef logging}
+        LogLn('Prepare to save VESA video state');
+{$endif logging}
+    { Prepare to save video state...}
+    asm
+      mov  ax, 4F04h       { get buffer size to save state }
+      mov  dx, 00h
+      mov  cx, 00001111b   { Save DAC / Data areas / Hardware states }
+{$ifdef fpc}
+      push ebx
+      push ebp
+      push esi
+      push edi
+{$endif fpc}
+      int  10h
+{$ifdef fpc}
+      pop edi
+      pop esi
+      pop ebp
+{$endif fpc}
+      mov  [StateSize], bx
+{$ifdef fpc}
+      pop ebx
+{$endif fpc}
+      cmp  al,04fh
+      jnz  @notok
+      mov  [SaveSupported],TRUE
+     @notok:
+    end ['EDX','ECX','EAX'];
+    regs.eax := $4f04;
+    regs.edx := $0000;
+    regs.ecx := $000F;
+    RealIntr($10, regs);
+    StateSize := word(regs.ebx);
+    if byte(regs.eax) = $4f then
+      SaveSupported := TRUE;
+    if SaveSupported then
+      begin
+{$ifdef logging}
+        LogLn('allocating VESA save buffer of '+strf(64*StateSize));
+{$endif logging}
+{$ifndef fpc}
+        PtrLong:=GlobalDosAlloc(64*StateSize);  { values returned in 64-byte blocks }
+{$else fpc}
+        PtrLong:=Global_Dos_Alloc(64*StateSize);  { values returned in 64-byte blocks }
+{$endif fpc}
+        if PtrLong = 0 then
+           RunError(203);
+        SavePtr := pointer(longint(PtrLong and $0000ffff) shl 16);
+{$ifndef fpc}
+        { In FPC mode, we can't do anything with this (no far pointers)  }
+        { However, we still need to keep it to be able to free the       }
+        { memory afterwards. Since this data is not accessed in PM code, }
+        { there's no need to save it in a seperate buffer (JM)           }
+        if not assigned(SavePtr) then
+           RunError(203);
+{$endif fpc}
+        RealStateSeg := word(PtrLong shr 16);
+
+        FillChar(regs, sizeof(regs), #0);
+        { call the real mode interrupt ... }
+        regs.eax := $4F04;      { save the state buffer                   }
+        regs.ecx := $0F;        { Save DAC / Data areas / Hardware states }
+        regs.edx := $01;        { save state                              }
+        regs.es := RealStateSeg;
+        regs.ebx := 0;
+        RealIntr($10,regs);
+        FillChar(regs, sizeof(regs), #0);
+        { restore state, according to Ralph Brown Interrupt list }
+        { some BIOS corrupt the hardware after a save...         }
+        regs.eax := $4F04;      { restore the state buffer                }
+        regs.ecx := $0F;        { rest DAC / Data areas / Hardware states }
+        regs.edx := $02;
+        regs.es := RealStateSeg;
+        regs.ebx := 0;
+        RealIntr($10,regs);
+      end;
+  end;
+
+ procedure RestoreStateVESA; {$ifndef fpc}far;{$endif fpc}
+  var
+   regs:Registers;
+  begin
+     { go back to the old video mode...}
+     asm
+      mov  ah,00
+      mov  al,[VideoMode]
+{$ifdef fpc}
+      push ebp
+      push esi
+      push edi
+      push ebx
+{$endif fpc}
+      int  10h
+{$ifdef fpc}
+      pop ebx
+      pop edi
+      pop esi
+      pop ebp
+{$endif fpc}
+     end ['EAX'];
+     { then restore all state information }
+{$ifndef fpc}
+     if assigned(SavePtr) and (SaveSupported=TRUE) then
+{$else fpc}
+     { No far pointer support, so it's possible that that assigned(SavePtr) }
+     { would return false under FPC. Just check if it's different from nil. }
+     if (SavePtr <> nil) and (SaveSupported=TRUE) then
+{$endif fpc}
+       begin
+        FillChar(regs, sizeof(regs), #0);
+        { restore state, according to Ralph Brown Interrupt list }
+        { some BIOS corrupt the hardware after a save...         }
+         regs.eax := $4F04;      { restore the state buffer                }
+         regs.ecx := $0F;        { rest DAC / Data areas / Hardware states }
+         regs.edx := $02;        { restore state                           }
+         regs.es := RealStateSeg;
+         regs.ebx := 0;
+         RealIntr($10,regs);
+{$ifndef fpc}
+         if GlobalDosFree(longint(SavePtr) shr 16)<>0 then
+{$else fpc}
+         if Not(Global_Dos_Free(longint(SavePtr) shr 16)) then
+{$endif fpc}
+          RunError(216);
+         SavePtr := nil;
+       end;
+  end;
+
+{$ELSE}
+
+      {**************************************************************}
+      {*                     Real mode routines                     *}
+      {**************************************************************}
+
+ Procedure SaveStateVESA; far;
+  begin
+    SavePtr := nil;
+    SaveSupported := FALSE;
+    { Get the video mode }
+    asm
+      mov  ah,0fh
+      int  10h
+      mov  [VideoMode], al
+    end;
+    { Prepare to save video state...}
+    asm
+      mov  ax, 4f04h       { get buffer size to save state }
+      mov  cx, 00001111b   { Save DAC / Data areas / Hardware states }
+      mov  dx, 00h
+      int  10h
+      mov  [StateSize], bx
+      cmp  al,04fh
+      jnz  @notok
+      mov  [SaveSupported],TRUE
+     @notok:
+    end;
+    if SaveSupported then
+      Begin
+        GetMem(SavePtr, 64*StateSize); { values returned in 64-byte blocks }
+        if not assigned(SavePtr) then
+           RunError(203);
+        asm
+         mov  ax, 4F04h       { save the state buffer                   }
+         mov  cx, 00001111b   { Save DAC / Data areas / Hardware states }
+         mov  dx, 01h
+         mov  es, WORD PTR [SavePtr+2]
+         mov  bx, WORD PTR [SavePtr]
+         int  10h
+        end;
+        { restore state, according to Ralph Brown Interrupt list }
+        { some BIOS corrupt the hardware after a save...         }
+        asm
+         mov  ax, 4F04h       { save the state buffer                   }
+         mov  cx, 00001111b   { Save DAC / Data areas / Hardware states }
+         mov  dx, 02h
+         mov  es, WORD PTR [SavePtr+2]
+         mov  bx, WORD PTR [SavePtr]
+         int  10h
+        end;
+      end;
+  end;
+
+ procedure RestoreStateVESA; far;
+  begin
+     { go back to the old video mode...}
+     asm
+      mov  ah,00
+      mov  al,[VideoMode]
+      int  10h
+     end;
+
+     { then restore all state information }
+     if assigned(SavePtr) and (SaveSupported=TRUE) then
+       begin
+         { restore state, according to Ralph Brown Interrupt list }
+         asm
+           mov  ax, 4F04h       { save the state buffer                   }
+           mov  cx, 00001111b   { Save DAC / Data areas / Hardware states }
+           mov  dx, 02h         { restore state                           }
+           mov  es, WORD PTR [SavePtr+2]
+           mov  bx, WORD PTR [SavePtr]
+           int  10h
+         end;
+         FreeMem(SavePtr, 64*StateSize);
+         SavePtr := nil;
+       end;
+  end;
+{$ENDIF DPMI}
+
+ {************************************************************************}
+ {*                     VESA Page flipping routines                      *}
+ {************************************************************************}
+ { Note: These routines, according  to the VBE3 specification, will NOT   }
+ { work with the 24 bpp modes, because of the alignment.                  }
+ {************************************************************************}
+
+  {******************************************************** }
+  { Procedure SetVisualVESA()                               }
+  {-------------------------------------------------------- }
+  { This routine changes the page which will be displayed   }
+  { on the screen, since the method has changed somewhat    }
+  { between VBE versions , we will use the old method where }
+  { the new pixel offset is used to display different pages }
+  {******************************************************** }
+ procedure SetVisualVESA(page: word); {$ifndef fpc}far;{$endif fpc}
+  var
+   newStartVisible : word;
+  begin
+    if page > HardwarePages then
+      begin
+        _graphresult := grError;
+        exit;
+      end;
+    newStartVisible := (MaxY+1)*page;
+    if newStartVisible > ScanLines then
+      begin
+        _graphresult := grError;
+        exit;
+      end;
+    asm
+      mov ax, 4f07h
+      mov bx, 0000h   { set display start }
+      mov cx, 0000h   { pixel zero !      }
+      mov dx, [NewStartVisible]  { new scanline }
+{$ifdef fpc}
+      push    ebp
+      push    esi
+      push    edi
+      push    ebx
+{$endif}
+      int     10h
+{$ifdef fpc}
+      pop     ebx
+      pop     edi
+      pop     esi
+      pop     ebp
+{$endif}
+    end ['EDX','ECX','EBX','EAX'];
+  end;
+
+ procedure SetActiveVESA(page: word); {$ifndef fpc}far;{$endif fpc}
+  begin
+    { video offset is in pixels under VESA VBE! }
+    { This value is reset after a mode set to page ZERO = YOffset = 0 ) }
+    if page > HardwarePages then
+      begin
+        _graphresult := grError;
+        exit;
+      end;
+    YOffset := (MaxY+1)*page;
+    LinearPageOfs := YOffset*(MaxX+1);
+  end;
+

packages/graph/src/msdos/vesah.inc

@@ -0,0 +1,110 @@
+{
+
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by Carl Eric Codere
+
+    This include implements VESA basic access.
+
+    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.
+
+ **********************************************************************}
+
+
+TYPE
+
+  pModeList = ^tModeList;
+  tModeList = Array [0..255] of word; {list of modes terminated by -1}
+                                      {VESA modes are >=100h}
+
+  TVESAinfo = packed record  { VESA Information request }
+    signature : array [1..4] of char;     { This should be VESA   }
+    version   : word;                     { VESA revision         }
+    str       : pChar;                    { pointer to OEM string }
+    caps      : longint;                  { video capabilities    }
+    modeList  : pModeList;                { pointer to SVGA modes }
+(*    pad       : array [18..260] of byte;  { extra padding more then   }
+  end;                             { VESA standard because of bugs on }
+                                   { some video cards.                }
+  *)
+  { VESA 1.1 }
+    TotalMem     : word;
+  { VESA 2.0 }
+    OEMversion   : word;
+    VendorPtr    : longint;
+    ProductPtr   : longint;
+    RevisionPtr  : longint;
+    filler       : Array[1..478]of Byte;
+  end;
+
+  TVESAModeInfo = packed record
+    attr           : word;             { mode attributes   (1.0)    }
+    winAAttr,
+    winBAttr       : byte;             { window attributes (1.0)    }
+    winGranularity : word;  {in K}     { Window granularity (1.0)   }
+    winSize        : word;  {in K}     { window size       (1.0)    }
+    winASeg,                           { Window A Segment address (1.0) }
+    winBSeg        : word;             { Window B Segment address (1.0) }
+    winFunct       : procedure;        { Function to swtich bank    }
+    BytesPerScanLine: word;            {bytes per scan line (1.0)   }
+    { extended information }
+    xRes, yRes : word;    {pixels}
+    xCharSize,
+    yCharSize  : byte;
+    planes     : byte;
+    bitsPixel  : byte;
+    banks      : byte;
+    memModel   : byte;
+    bankSize   : byte;  {in K}
+    NumberOfPages: byte;
+(*
+    pad : array [29..260] of byte; { always put some more space then required}
+  end; *)
+    reserved       : byte; { pos $1E }
+    rm_size        : byte; { pos $1F }
+    rf_pos         : byte; { pos $20 }
+    gm_size        : byte; { pos $21 }
+    gf_pos         : byte; { pos $22 }
+    bm_size        : byte; { pos $23 }
+    bf_pos         : byte; { pos $24 }
+    (* res_mask       : word; { pos $25 }
+      here there was an alignment problem !!
+      with default alignment
+      res_mask was shifted to $26
+      and after PhysAddress to $2A !!! PM *)
+    res_size       : byte;
+    res_pos        : byte;
+    DirectColorInfo: byte; { pos $27 }
+  { VESA 2.0 }
+    PhysAddress    : longint; { pos $28 }
+    OffscreenPtr   : longint; { pos $2C }
+    OffscreenMem   : word; { pos $30 }
+  { VESA 3.0 }
+    LinBytesPerScanLine: Word;   {bytes per scan line for linear modes}
+    BnkNumberOfImagePages: Byte; {number of images for banked modes}
+    LinNumberOfImagePages: Byte; {number of images for linear modes}
+    LinRedMaskSize: Byte;        {size of direct color red mask (linear modes)}
+    LinRedFieldPosition: Byte;   {bit position of lsb of red mask (linear modes)}
+    LinGreenMaskSize: Byte;      {size of direct color green mask (linear modes)}
+    LinGreenFieldPosition: Byte; {bit position of lsb of green mask (linear modes)}
+    LinBlueMaskSize: Byte;       {size of direct color blue mask (linear modes)}
+    LinBlueFieldPosition: Byte;  {bit position of lsb of blue mask (linear modes)}
+    LinRsvdMaskSize: Byte;       {size of direct color reserved mask (linear modes)}
+    LinRsvdFieldPosition: Byte;  {bit position of lsb of reserved mask (linear modes)}
+    MaxPixelClock: longint;      {maximum pixel clock (in Hz) for graphics mode}
+
+    reserved2: array [1..189] of Byte; {remainder of ModeInfoBlock}
+   end;
+
+
+
+
+var
+  VESAInfo    : TVESAInfo;         { VESA Driver information  }
+  VESAModeInfo    : TVESAModeInfo;     { Current Mode information }
+  hasVesa: Boolean;       { true if we have a VESA compatible graphics card}
+                          { initialized in QueryAdapterInfo in graph.inc }