{$IFNDEF gfx}
{$DEFINE gfx}
{$I SYST.INC}
var
  ScrWidth:dword;
  ScrHeight:dword;
  VRAMSIZE:dword;
  vram:dword;
type
  string12=string[12];
const
  gfx_MODE:string12='640x400x8';
  vga_VRAM=$000A0000;
  vbe_VESA=ord('V') or ord('E') shl 8 or ord('S') shl 16 or ord('A') shl 24;
  vbe_VBE2:dword=ord('V') or ord('B') shl 8 or ord('E') shl 16 or ord('2') shl 24;
  vbe_SUPPORTED=$11; {*$13}
type
  TVESAInfo=record
    VBESignature       :dword;
    VBEVersion         :word;
    OemStringPtr       :dword;
    Capabilities       :dword;
    VideoModePtr       :dword;
    TotalMemory        :word;
    OEMSoftwareRev     :word;
    OEMVendorNamePtr   :dword;
    OEMProductNamePtr  :dword;
    OEMProductRevPtr   :dword;
    Reserved           :array[0..221] of byte;
    OEMData            :array[0..255] of byte;
  end;  {TVESAInfo}
  TVESAModeInfo=record
    ModeAttributes     :word;
    WinAAttributes     :byte;
    WinBAttributes     :byte;
    WinGranularity     :word;
    WinSize            :word;
    WinASegment        :word;
    WinBSegment        :word;
    WinFuncPtr         :pointer;
    bytesPerScanLine   :word;
    XResolution        :word;
    YResolution        :word;
    XCharSize          :byte;
    YCharSize          :byte;
    NumberOfPlanes     :byte;
    BitsPerPixel       :byte;
    NumberOfBanks      :byte;
    MemoryModel        :byte;
    BankSize           :byte;
    NumberOfImagePages :byte;
    Reserved           :byte;
    RedMaskSize        :byte;
    RedFieldPosition   :byte;
    GreenMaskSize      :byte;
    GreenFieldPosition :byte;
    BlueMaskSize       :byte;
    BlueFieldPosition  :byte;
    RsvdMaskSize       :byte;
    RsvdFieldPosition  :byte;
    DirectColorModeInfo:byte;
    PhysBasePtr        :dword;
    OffScreenMemOffset :dword;
    OffScreenMemSize   :word;
    Reserved2          :array[0..205] of byte;
  end;  {TVESAModeInfo}

procedure WaitForTrace; assembler;
asm
 mov  dx,03DAh
@1:
 in   al,dx
 test al,8
 jnz  @1
@2:
 in   al,dx
 test al,8
 jz   @2
end;  {WaitForTrace}

PROCEDURE WaitFlicks(n:longint);
var i:longint;
begin
  for i:=1 to n do WaitForTrace;
end;  {WaitFlicks}

function  modeByRes(mode:string12):word;
var
  i:longint;
  VESAModeInfo:TVESAModeInfo;
  regs:TRmRegs;
begin
  result:=0;
  if copy(mode,1,1)='#' then begin
    result:=strToInt(copy(mode,2,255));
    exit;
  end;
  for i:=$100 to $1FF do begin
    with regs do begin
      fillchar(buf_16,0,sizeof(VESAModeInfo));
      ES:=buf_16;
      AX:=$4F01;
      DI:=$0000;
      CX:=i;
    end;
    RealModeInt($10,regs);
    move(pointer(buf_32)^,VESAModeInfo,sizeof(VESAModeInfo));
    if (regs.AX=$004F) and (VESAModeInfo.ModeAttributes and vbe_SUPPORTED=vbe_SUPPORTED) and (VESAModeInfo.PhysBasePtr<>0) then
      if intToStr(VESAModeInfo.XResolution)+'x'+intToStr(VESAModeInfo.YResolution)+'x'+intToStr(VESAModeInfo.BitsPerPixel)=mode then begin
        result:=i;
        break;
      end;
  end;
end;  {modeByRes}

function  vga_Supported:boolean;
var r:TRmRegs;
begin
  ClearRmRegs(r);
  r.AX:=$1A00;
  RealModeInt($10,r);
  result:=(r.AL=$1A) and ((r.BL=7) or (r.BL=8));
end;  {VGASupported}

procedure vga_Open;
var r:TRmRegs;
begin
  if actGFX then exit;
  bioswriteln('Opening graphics..');
  bioswriteln('Detecting VGA..');
  if not vga_Supported then die(errVGANotSupported);
  ClearRmRegs(r);
  r.AX:=$0013;
  RealModeInt($10,r);
  waitflicks(18);
  vram:=vga_VRAM;
  ScrWidth:=320;
  ScrHeight:=200;
  VRAMSIZE:=ScrWidth*ScrHeight;
  actGFX:=true;
end;  {vga_Open}

procedure vga_Close;
begin
  if actGFX=false then exit;
  SetText;
  bioswriteln('Closing graphics..');
  if (vram<>vga_VRAM) and (vram<>0) then FreePhysicalMap(vram);
  actGFX:=false;
end;  {vga_Close}

procedure vbe_Open;
var
  VESAInfo:TVESAInfo;
  VESAModeInfo:TVESAModeInfo;
  regs:TRmRegs;
  vbe_MODE:dword;
begin
  if actGFX then exit;
  bioswriteln('Opening graphics..');
  bioswriteln('Detecting VBE..');
  ClearRmRegs(regs);
  with regs do begin
    dword(ptr(buf_16)^):=vbe_VBE2;
    AX:=$4F00;
    ES:=buf_16;
  end;
  RealModeInt($10,regs); waitflicks(10);
  Move(Pointer(buf_32)^,VESAInfo,sizeof(VESAInfo));
  if (regs.AX<>$004F) or (VESAInfo.VBESignature<>vbe_VESA) then
    die(errVBENotDetected);
  bioswriteln('VESA BIOS EXTENSION Detected');
  bioswriteln('VBE version: '+inttostr(Hi(VESAInfo.VBEVersion))+'.'+inttostr(Lo(VESAInfo.VBEVersion)));
  if VESAInfo.VBEVersion<$0200 then die(errVBE20Needed);
  bioswriteln('Total video memory: '+inttostr(VESAInfo.TotalMemory*64)+' KB');
  if VESAInfo.TotalMemory<$0010 then
    die(errVBECardMemory);
  bioswriteln('Trying to get further information about mode '+gfx_MODE+'..');
  vbe_MODE:=modeByRes(gfx_MODE);
  if vbe_MODE=0 then die(errVBEModeNotSupported);
  ClearRmRegs(regs);
  with regs do begin
    ES:=buf_16;
    AX:=$4F01;
    DI:=$0000;
    CX:=vbe_MODE;
  end;
  RealModeInt($10,regs); waitflicks(10);
  move(pointer(buf_32)^,VESAModeInfo,sizeof(VESAModeInfo));
  if (regs.AX<>$004F) or (VESAModeInfo.ModeAttributes and vbe_SUPPORTED<>vbe_SUPPORTED) or (VESAModeInfo.PhysBasePtr=0) then
    die(errVBEModeNotSupported);
  ScrWidth:=VESAModeInfo.XResolution;
  ScrHeight:=VESAModeInfo.YResolution;
  VRAMSIZE:=((VESAModeInfo.BitsPerPixel+7) shr 3*ScrWidth*ScrHeight+1023) shr 10 shl 10;
  bioswriteln('Resolution: '+inttostr(ScrWidth)+'x'+inttostr(ScrHeight)+'x'+inttostr(VESAModeInfo.BitsPerPixel));
  bioswriteln('Physical videoram address: '+hex(VESAModeInfo.PhysBasePtr));
  bioswriteln('Trying to map physical VRAM to linear..');
  vram:=MapPhysicalToLinear(VESAModeInfo.PhysBasePtr,VRAMSIZE);
  if vram=0 then die(errDPMI800) else actGFX:=true;
  bioswriteln('If you are under Windows, switch to fullscreen.'#13#10
  +'Press Enter to continue or any other key to quit.');
  if readkey<>#13 then die(255);
  ClearRmRegs(regs);
  with regs do begin
    AX:=$4F02;
    BX:=$4000 or vbe_MODE;
  end;
  RealModeInt($10,regs); waitflicks(18);
  if regs.AX<>$004F then die(errVBEModeSet);
end;  {vbe_Open}

procedure vbe_Close;
begin
  if actGFX=false then exit;
  SetText;
  bioswriteln('Closing graphics..');
  bioswriteln('Freeing virtual VRAM at '+hex(vram)+'..');
  FreePhysicalMap(vram);
  actGFX:=false;
end;  {vbe_Close}

function atLine(y:longint):pointer; assembler; {not range-checked!}
asm
  cmp  svga,false
  jz   @vbe
  mov  eax,y
  shl  eax,8
  mov  ebx,eax
  shr  ebx,1
  shr  ebx,1
  add  eax,ebx
  jmp  @finish
@vbe:
  mov  eax,y
  mul  ScrWidth
@finish:
  add  eax,vram
end;  {atLine}

function at(x,y:longint):pointer; assembler; {not range-checked!}
asm
  cmp  svga,false
  jz   @vbe
  mov  eax,vram
  mov  ebx,y
  shl  ebx,8
  add  eax,ebx
  shr  ebx,1
  shr  ebx,1
  add  eax,ebx
  jmp  @finish
@vbe:
  mov  eax,y
  mul  ScrWidth
  add  eax,vram
@finish:
  add  eax,x
end;  {at}

{$ENDIF}