program VesaStat;

type VesaRec = record
       ModeAtr : word;
       WinAatr : byte;
       WinBatr : byte;
       WinGran : word;
       WinSize : word;
       WinAseg : word;
       WinBseg : word;
       WinFuncPtr : pointer;
       BytesPerLine : word;

       Xres : word;
       Yres : word;
       XcharSize : byte;
       YcharSize : byte;
       NumPlanes : byte;
       BitsPerPixel : byte;
       NumBanks     : byte;
       MemoryModel  : byte;
       BankSize     : byte;
       NumDisplays  : byte;

       spare : array[0..999] of byte;
     end;

type chararray = array[0..255] of char;
     intarray  = array[0..255] of integer;
type VesaIDrec = record
       Signature : array[0..3] of char;
       Version   : word;
       OemPtr    : ^chararray;
       Capable   : longint;
       Modes     : ^intarray;
       TotalMem  : word;
       spare     : array[0..999] of byte;
     end;


var VesaInfo : VesaRec;
    VesaID   : VesaIDrec;
    Pi,P : pointer;
    status : word;
    idstat : word;
    i,mode : word;
    Error : integer;
    s : string;

type string2 = string[2];
     string4 = string[4];
     string8 = string[8];
     string9 = string[9];

const hex : array[0..15] of char = '0123456789ABCDEF';

  function HexB(B:byte):string2;
  begin
    HexB[0] := #2;
    HexB[1] := hex[B shr 4];
    HexB[2] := hex[B and $f];
  end;
  function HexW(W:word):string4;
  begin
    HexW[0] := #4;
    HexW[1] := hex[hi(W) shr 4];
    HexW[2] := hex[hi(W) and $f];
    HexW[3] := hex[lo(W) shr 4];
    HexW[4] := hex[lo(W) and $f];
  end;
  function HexP(P:pointer):string9;
  var T : record B1,B2,B3,B4:byte; end absolute P;
  begin
    HexP[0] := #9;
    HexP[1] := hex[T.B1 shr 4];
    HexP[2] := hex[T.B1 and $f];
    HexP[3] := hex[T.B2 shr 4];
    HexP[4] := hex[T.B2 and $f];
    HexP[5] := ':';
    HexP[6] := hex[T.B3 shr 4];
    HexP[7] := hex[T.B3 and $f];
    HexP[8] := hex[T.B4 shr 4];
    HexP[9] := hex[T.B4 and $f];
  end;
  function HexL(L:longint):string8;
  var T : record B1,B2,B3,B4:byte; end absolute L;
  begin
    HexL[0] := #8;
    HexL[1] := hex[T.B1 shr 4];
    HexL[2] := hex[T.B1 and $f];
    HexL[3] := hex[T.B2 shr 4];
    HexL[4] := hex[T.B2 and $f];
    HexL[5] := hex[T.B3 shr 4];
    HexL[6] := hex[T.B3 and $f];
    HexL[7] := hex[T.B4 shr 4];
    HexL[8] := hex[T.B4 and $f];
  end;

  procedure ShowOEM;
  var i : word;
  begin
    i := 0;
    while VesaID.OEMPtr^[i] <> #0 do
    begin
      write(VesaID.OEMPtr^[i]);
      inc(i);
    end;
  end;

  procedure ShowModes;
  var Vmode : integer;
      I : word;
  begin
    writeln('Available Modes:');
    Vmode := 0;
    I := 0;
    while (Vmode <> -1) and (i < 255) do
    begin
      Vmode := VesaID.Modes^[i];
      if Vmode <> -1 then
      begin
        write(hexw(VesaID.Modes^[i]),' ');
        if i mod 15 = 14 then writeln;
        inc(i);
      end;
    end;
  end;


begin
  MODE := 0;
  ERROR := 0;
  if ParamCount > 0 then
  begin
    s := paramstr(1);
    if s[1] <> '$' then s := '$'+s;
    val(s,mode,error);
  end;
  if (Error <> 0) or (ParamCount = 0) then
  begin
    writeln('Format is "VESASTAT modenumber"');
  end;

  Pi := @VesaID;
  fillchar(pi^,sizeof(pi^),0);
  asm
    mov ax,$4f00
    les di,[pi]
    int $10
    mov [idstat],ax
  end;

  status := $ff4f;
  if Mode <> 0 then
  begin
    p := @VesaInfo;
    fillchar(p^,sizeof(p^),0);
    asm
      mov ax,$4f01
      les di,[p]
      mov cx,[mode]
      int $10
      mov [status],ax
    end;
  end;
  if (status and $ff <> $4F) or (idstat and $ff <> $4F)
     or (VesaID.Signature <> 'VESA') then
  begin
    writeln('This is not a Vesa bios compliant display');
    halt(2);
  end;

  ShowModes;
  writeln;
  s := ''; for i := 1 to 30 do s := s+' ';
  writeln ('--------------------------------------------------------------------------');
  ShowOEM;
  writeln ('  Version:',VesaID.Version);
   write(s,'Capabilities:',hexl(VesaID.Capable),#13);
  writeln ('Memory:',longint(VesaID.TotalMem)*64,'K');

  if status = $014F then
  begin
    writeln('Vesa mode:',Mode,' is not supported by this display');
    halt(3);
  end
  else if (status <> $ff4f) and (status <> $004f) then
  begin
    writeln('Unknown VESA function result:',hexw(status));
    halt(4);
  end
  else if status <> $ff4f then
  begin
    writeln ('-- Vesa information -----  ------ optional -------');
     write(s,'        Xres:',VesaInfo.Xres,#13);
    writeln ('   Vesa mode:',hexw(mode));
     write(s,'        Yres:',VesaInfo.Yres,#13);
    writeln ('  Cmd status:',hexw(Status));
     write(s,'   XcharSize:',VesaInfo.XcharSize,#13);
    writeln ('  Mode Atrib:',hexw(VesaInfo.Modeatr));
     write(s,'   YcharSize:',VesaInfo.YcharSize,#13);
    writeln ('  WinA Atrib:',hexb(VesaInfo.WinAatr));
     write(s,'  Num Planes:',VesaInfo.NumPlanes,#13);
    writeln ('  WinB Atrib:',hexb(VesaInfo.WinBatr));
     write(s,'BitsPerPixel:',VesaInfo.BitsPerPixel,#13);
    writeln ('    Win Gran:',VesaInfo.WinGran,'K');
     write(s,'   Num Banks:',VesaInfo.NumBanks,#13);
    writeln ('    Win Size:',VesaInfo.WinSize,'K');
     write(s,'Memory Model:',VesaInfo.MemoryModel,#13);
    writeln ('    WinA Seg:',hexw(VesaInfo.WinAseg));
     write(s,'   Bank Size:',VesaInfo.BankSize,#13);
    writeln ('    WinB Seg:',hexw(VesaInfo.WinBseg));
     write(s,'Num Displays:',VesaInfo.NumDisplays,#13);
    writeln ('    Func Ptr:',hexP(VesaInfo.WinFuncPtr));
    writeln ('BytesPerLine:',VesaInfo.BytesPerLine);
  end;


end.

