{
Here's some VESA routines. The drawing stuff is quite limited right now
(to pixels and horizontal lines in 256-color linear modes only) but it
detects/sets/describes most everything else. Also no save/restore video
state yet. It uses direct VESA function calls instead of interrupts, and
tries to optimize where it puts the window based on what the routines
will be used for . . .
}

{VESA1.PAS}
{by Sean Palmer}
{with help from Ferraro and Olaf Bartlett}

type
  pModeList = ^tModeList;
  tModeList = Array [0..255] of word; {list of modes terminated by -1}
                                      {VESA modes are >=100h}

  modeAttrBits = (modeAvail,
                  modeExtendInfo,
                  modeBIOSsupport,
                  modeColor,
                  modeGraphics,
                  modeBit5,
                  modeBit6,
                  modeBit7,
                  modeBit8);

  winAttrBits  = (winSupported,
                  winReadable,
                  winWriteable);

  tMemModel    = (modelText,
                  modelCGA,
                  modelHerc,
                  model4Plane,
                  modelPacked,
                  modelModeX,
                  modelRGB);


var
  VESAinfo : record
    signature : array [1..4] of char;
    version   : word;
    str       : pChar;
    caps      : longint;
    modeList  : pModeList;
    pad       : array [18..255] of byte;
  end;

  modeInfo : record
    attr           : set of modeAttrBits;
    winAAttr,
    winBAttr       : set of winAttrBits;
    winGranularity : word;  {in K}
    winSize        : word;         {in K}
    winASeg,
    winBSeg        : word; {segment to access window with}
    winFunct       : procedure;
    scanBytes      : word;       {bytes per scan line}
    extendedInfo   : record
      xRes, yRes : word;    {pixels}
      xCharSize,
      yCharSize  : byte;
      planes     : byte;
      bitsPixel  : byte;
      banks      : byte;
      memModel   : tMemModel;
      bankSize   : byte;  {in K}
    end;

    pad : array [29..255] of byte;
  end;

  xSize,
  ySize,
  xBytes     : word;
  bits       : byte;
  model      : tMemModel;
  window     : byte;
  winSeg     : word;
  granShifts : byte;
  winLo,
  winHi,
  winBytes,
  granMask   : longint;
  funct      : procedure;

  m, i : word;



function getVESAInfo : boolean; assembler;
asm
  mov ax,4F00h
  push ds
  pop es
  mov di,offset 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 getModeInfo(mode:word):boolean;assembler;asm
 mov ax,4F01h
 mov cx,mode
 push ds
 pop es
 mov di,offset modeInfo
 int 10h
 sub ax,004Fh   {make sure it's 004Fh}
 cmp ax,1
 sbb al,al
 end;


{if the VESA driver supports info on the regular VGA modes, add them to list}
procedure includeStandardVGAModes;var p:^word;begin
 p:=pointer(VESAInfo.modeList);
 while p^<>$FFFF do inc(p);
 if getModeInfo($10) then begin p^:=$10; inc(p);end;
 if getModeInfo($12) then begin p^:=$12; inc(p);end;
 if getModeInfo($13) then begin p^:=$13; inc(p);end;
 p^:=$FFFF;
 end;


function setMode(mode:word):boolean;var i:word;begin
 if getModeInfo(mode) then begin
  with modeInfo do begin
   if winSupported in winAAttr then begin window:=0; winSeg:=winASeg;end
   else if winSupported in winBAttr then begin window:=1; winSeg:=winBSeg;end
   else exit;  {you call this a VESA mode?}
   with extendedInfo do begin
    xSize:=xRes; ySize:=yRes; xBytes:=scanBytes; bits:=bitsPixel;
    model:=memModel;
    end;
   winBytes:=longint(winSize)*1024;  {wraps to 0 if 64k}
   winLo:=0; winHi:=winBytes;
   i:=winGranularity;
   granShifts:=10; {for 1K}
   while not odd(i) do begin
    i:=i shr 1;
    inc(granShifts);
    end;
   if i<>1 then begin setMode:=false;exit;end;  {granularity not power of 2}
   granMask:=(longint(1)shl granShifts)-1;
   funct:=winFunct;
   end;
  asm
   mov ax,4F02h
   mov bx,mode
   int 10h
   sub ax,004Fh
   cmp ax,1
   sbb al,al
   mov @RESULT,al
   end;
  end;
 end;

function getMode:word;assembler;asm  {return -1 if error}
 mov ax,4F03h
 int 10h
 cmp ax,004Fh
 je @@OK
 mov ax,-1
 jmp @@X
@@OK: mov ax,bx
@@X:
 end;


procedure plot(x, y : word; c : byte);
var
  bank : word;
  offs : longint;
begin
  offs := longint(y) * xBytes + x;
  if (offs < winLo) or (offs >= winHi) then
  begin
    winLo := (offs - (winBytes shr 1)) and not granMask;
    winHi := winLo + winBytes;
    bank  := winLo shr granShifts;
    asm
      mov bl, window
      mov dx, bank
      call [funct]
    end;
  end;
  mem[winSeg : word(offs) - word(winLo)] := c;
end;

procedure hLin(x,x2,y:word;c:byte);
var bank,w:word; offs:longint;
begin
  w:=x2-x;
  offs:=longint(y)*xBytes+x;
  if (offs<winLo)or(offs+w>=winHi) then begin
   winLo:=offs and not granMask;
   winHi:=winLo+winBytes;
   bank:=winLo shr granShifts;
   asm
    mov bl,window
    mov dx,bank
    call [funct]
    end;
   end;
  fillChar(mem[winSeg:word(offs)-word(winLo)],w,c);
  end;

function scrn(x,y:word):byte;
var bank:word; offs:longint;
begin
  offs:=longint(y)*xBytes+x;
  if (offs<winLo)or(offs>=winHi) then begin
   winLo:=(offs-(winBytes shr 1))and not granMask;
   winHi:=winLo+winBytes;
bank:=winLo shr granShifts;
   asm
    mov bl,window
    mov dx,bank
    call [funct]
    end;
   end;
  scrn:=mem[winSeg:word(offs)-word(winLo)];
  end;

{will find a color graphics mode that matches parms}
{if parm is 0, finds best mode for that parm}
function findMode(x,y:word;model:tMemModel;nBits,nPlanes,nBanks:byte):word;
var p:^word; m:word; gx,gy,gb,lp,lb:word;
begin
 gx:=0;gy:=0;gb:=0;lp:=255;lb:=255;
 p:=pointer(VESAInfo.modeList);
 m:=$FFFF;
 while p^<>$FFFF do begin
  if getModeInfo(p^) then
   with modeInfo do
    if attr+[modeAvail,modeExtendInfo,modeColor,modeGraphics]=attr then
     with extendedInfo do
if ((xRes=x)or((x=0)and(gx<=xRes)))
      and((yRes=y)or((y=0)and(gy<=yRes)))
      and(memModel=model)
      and((bitsPixel=nBits)or((nBits=0)and(gb<=bitsPixel)))
      and((planes=nPlanes)or((nPlanes=0)and(lp>=planes)))
      and((banks=nBanks)or((nBanks=0)and(lb>=banks)))
      then begin
       gx:=xRes;gy:=yRes;gb:=bitsPixel;lp:=planes;lb:=banks;
       m:=p^;
       end;
  inc(p);
  end;
 if m<>$FFFF then getModeInfo(m);
 findMode:=m;  {0FFFFh if not found. Try a standard mode number then.}
 end;


procedure displayVESAInfo;

type
  string2=string[2];
  string4=string[4];
  string8=string[8];
const
  modelStr : array[tMemModel]of pChar=
    ('Text','CGA','Hercules','EGA','Linear','mode X','RGB');
var
  p:^word;

  function hexB(n:byte):string2; assembler;asm
   les di,@RESULT;                    {adr of function result}
  cld; mov al,2; stosb;              {set len}
   mov al,n; mov ah,al;               {save it}
   shr al,1; shr al,1; shr al,1; shr al,1; {high nibble}
   add al,$90; daa; adc al,$40; daa;  {convert hex nibble to ASCII}
   stosb;
   mov al,ah; and al,$F;              {low nibble}
   add al,$90; daa; adc al,$40; daa;
   stosb;
   end;

  function hexW(n:word):string4;
  begin
    hexW:=hexB(hi(n))+hexB(lo(n));
  end;

  function hexL(n:longint):string8;
  begin
    hexL:=hexW(n shr 16)+hexW(n);
  end;

begin
 if getVESAInfo then
  with VESAinfo do begin
   includeStandardVGAModes;
   writeln(signature,' Version ',hexB(hi(version)),'.',hexB(version));
   writeln(str);
   writeln('Capabilities: $',hexL(caps));
   p:=pointer(modeList);
while p^<>$FFFF do begin
    write('Mode $',hexW(p^),' = ');
    if getModeInfo(p^) then
     with modeInfo do begin
      if not(modeAvail in attr) then write('Unavailable-');
      if modeColor in attr then write('Color ') else write('Mono ');
      if modeGraphics in attr then write('Graphics') else write('Text');
      if modeBIOSSupport in attr then write('-BIOSsupport');
      writeln;
      if modeExtendInfo in attr then
       with extendedInfo do begin
        write('  ',xRes,'x',yRes,', ',bitsPixel,' bits, ',modelStr[memModel],
                ', ',scanBytes,' bytes per row');
        if not (modeGraphics in attr) then
         write(^M^J'  Character size ',xCharSize,'x',yCharSize);
        if planes>1 then write(', ',planes,' planes');
        if banks>1 then write(', ',banks,' banks of ',bankSize,'K');
        writeln;
        end
      else write('  No extended info available');
      if winSupported in winAAttr then begin
       write('  Window A: ');
       if winReadable in winAAttr then write('R');
if winWriteable in winAAttr then write('W');
       writeln(' at segment $',hexW(winASeg),', ',winSize,'K, granular by '
               ,winGranularity,'K, function at $',hexL(longint(@winFunct)));
       end;
      if winSupported in winBAttr then begin
       write('  Window B: ');
       if winReadable in winBAttr then write('R');
       if winWriteable in winBAttr then write('W');
       writeln(' at segment $',hexW(winBSeg),', ',winSize,'K, granular by '
               ,winGranularity,'K, function at $',hexL(longint(@winFunct)));
       end;
      end
    else writeln('ERROR');
    inc(p);
    end;
   end
 else writeln('No VESA driver found');
 end;

begin
  writeln;
  displayVESAInfo;
  readln;
  m := findMode(0, 0, modelPacked, 8, 1, 1);
  getModeInfo(m);
  if m <> $FFFF then
  with modeInfo.extendedInfo do
    writeln('Found ', xRes, 'x', yRes, 'x',
            longint(1) shl bitsPixel, ' mode ', m)
  else
    exit;

  setMode(m);
  for i := 1 to 10000 do
    plot(random(xSize), random(ySize), random(256));

  readln;

  for i := 1 to 200 do
    hlin(random(xSize shr 1), random(xSize shr 1) + xSize shr 1,
                random(ySize), random(256));
  readln;

  asm
    mov ax, 3h
    int 10h
  end;
end.