PROGRAM TestVESA;   { by ¯The FakerŽ in 1993 }
USES
    Crt;
TYPE
    String0=ARRAY[0..65534] OF Char;
    String0Ptr=^String0;
    VESABlock=RECORD
                    VESASignature:ARRAY[0..3] OF Char;
                    VESAVersion:Word;
                    OEMStringPtr:String0Ptr;
                    Capabilities:ARRAY[0..3] OF Byte;
                    VideoModePtr:String0Ptr;
              END;
    ModeBlock=RECORD
                    ModeAttr:Word;
                    WinAAttr:Byte;
                    WinBAttr:Byte;
                    WinGranularity:Word;
                    WinSize:Word;
                    WinASegment:Word;
                    WinBSegment:Word;
                    WinFuncPtr:Pointer;
                    BytesPerScanLine:Word;
                    XRes:Word;
                    YRes:Word;
                    XCharSize:Byte;
                    YCharSize:Byte;
                    NumberOfPlanes:Byte;
                    BitsPerPixel:Byte;
                    NumberOfBanks:Byte;
                    MemoryModel:Byte;
                    BankSize:Byte;
              END;
VAR
   Block:^VESABlock;
   Status:Word;
   Mode:ARRAY[0..255] OF RECORD
                               Nr:Word;
                               Info:^ModeBlock;
                         END;
   Modes:Byte;

PROCEDURE WriteStr0(S:String0Ptr);
VAR
   I:Byte;
BEGIN
     I:=0;
     WHILE S^[I]<>#0 DO
     BEGIN
          Write(S^[I]);
          Inc(I);
     END;
     WriteLn;
     WriteLn;
END;

FUNCTION Hex(B:Byte):String;
CONST
     HexTable:ARRAY[0..15] OF Char=('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F');
BEGIN
     Hex:=HexTable[B SHR 4]+HexTable[B AND 15];
END;

PROCEDURE WriteList(S:String0Ptr);
VAR
   I:Byte;
   P:Pointer;
   ModeNr:Word;
BEGIN
     I:=0;
     Modes:=0;
     WHILE Ord(S^[I])+Ord(S^[I+1]) SHL 8<>$FFFF DO
     BEGIN
          ClrScr;
          ModeNr:=Ord(S^[I])+Ord(S^[I+1]) SHL 8;
          Mode[Modes].Nr:=ModeNr;
          GetMem(Mode[Modes].Info,256);
          P:=Mode[Modes].Info;
          ASM
             les di,p
             mov cx,modenr
             mov ax,$4f01
             int $10
          END;
          WriteLn('Mode Nr: ',Hex(Ord(S^[I+1])),Hex(Ord(S^[I])));
          WriteLn('Mode Information:');
          WITH Mode[Modes].Info^ DO
          BEGIN
               IF ModeAttr AND 1=1 THEN
                  WriteLn('Mode can be initialled in present video configuration.')
               ELSE WriteLn('Mode can not be initialled in present video configuration.');
               IF ModeAttr AND 2=2 THEN
                  WriteLn('Extended Mode Information is available, as seen below.')
               ELSE WriteLn('Extended Mode Information is not available, as seen below.');
               IF ModeAttr AND 4=4 THEN
                  WriteLn('BIOS support for output functions.')
               ELSE WriteLn('No BIOS support for output functions.');
               IF ModeAttr AND 8=8 THEN
                  Write('Mode is a color')
               ELSE Write('Mode is a monochrome');
               IF ModeAttr AND 16=16 THEN
                  WriteLn(' graphics mode.')
               ELSE WriteLn(' text mode.');
               WriteLn;
               WriteLn('The granularity of a window is ',WinGranularity,' KBytes.');
               WriteLn('The size of a window is ',WinSize,' KBytes.');
               IF WinAAttr AND 1=1 THEN
               BEGIN
                    IF WinAAttr AND 2=2 THEN
                       WriteLn('Window A is readable.')
                    ELSE WriteLn('Window A is not readable.');
                    IF WinAAttr AND 4=4 THEN
                       WriteLn('Window A is writeable.')
                    ELSE WriteLn('Window A is not writeable.');
                    WriteLn('Window A is located at ',Hex(Hi(WinASegment)),Hex(Lo(WinASegment)),'hex in host address space.');
               END
               ELSE WriteLn('Window A is not supported.');
               WriteLn;
               IF WinBAttr AND 1=1 THEN
               BEGIN
                    IF WinBAttr AND 2=2 THEN
                       WriteLn('Window B is readable.')
                    ELSE WriteLn('Window B is not readable.');
                    IF WinBAttr AND 4=4 THEN
                       WriteLn('Window B is writeable.')
                    ELSE WriteLn('Window B is not writeable.');
                    WriteLn('Window B is located at ',Hex(Hi(WinASegment)),Hex(Lo(WinASegment)),'hex in host address space.');
               END
               ELSE WriteLn('Window B is not supported.');
               IF WinFuncPtr<>NIL THEN
                  WriteLn('Windowing procedure exists.')
               ELSE WriteLn('Windowing procedure does not exist.');
               WriteLn;
               WriteLn('Bytes per scan line: ',BytesPerScanLine);
               IF ModeAttr AND 2=2 THEN
               BEGIN
                    WriteLn('Resolution: ',XRes,' x ',YRes);
                    WriteLn('Character cell: ',XCharSize,' x ',YCharSize);
                    WriteLn('Number of memory planes: ',NumberOfPlanes,'.');
                    WriteLn('Bits per pixel: ',BitsPerPixel,'.');
                    WriteLn('Number of Banks: ',NumberOfBanks,'.');
                    Write('Memory model: ');
                    CASE MemoryModel OF
                         0:WriteLn('Text mode.');
                         1:WriteLn('CGA mode.');
                         2:WriteLn('Hercules mode.');
                         3:WriteLn('4 plane planar mode.');
                         4:WriteLn('Packed pixel mode.');
                         5:WriteLn('Non-chain 4, 256 color mode.');
                         6:WriteLn('Hi-Color / True-Color mode.');
                         7..15:WriteLn('Not defined yet by the VESA standard. Nr=',MemoryModel);
                         16..255:WriteLn('Special mode of the chip or card.');
                    END;
                    WriteLn('Bank size: ',BankSize,' KBytes.');
               END;
          END;
          ReadLn;
          Inc(I,2);
          Inc(Modes);
     END;
END;

BEGIN
     ClrScr;
     GetMem(Block,256);
     ASM
        mov di,word ptr block
        mov es,word ptr block+2
        mov ax,$4f00
        int $10
        mov status,ax
     END;
     IF Status<>$4F THEN
     BEGIN
          WriteLn('VESA BIOS Extension not installed!');
          Halt(1);
     END;
     WITH Block^ DO
     BEGIN
          IF VESASignature<>'VESA' THEN
          BEGIN
               WriteLn('VESA Information Structure Block not identified!');
               Halt(2);
          END;
          WriteLn('VESA Version: ',Hi(VESAVersion),'.',Lo(VESAVersion));
          WriteStr0(OEMStringPtr);
          ReadLn;
          WriteList(VideoModePtr);
     END;
END.