[Back to EGAVGA SWAG index] [Back to Main SWAG index] [Original]

    {
    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.

[Back to EGAVGA SWAG index] [Back to Main SWAG index] [Original]