{-----------------------------------------------------------------------}
{VESALIST						GL:12/18/89	}
{-----------------------------------------------------------------------}
{-----------------------------------------------------------------------}
{The following program is written to loosely conform to the VESA 	}
{Super VGA BIOS Extension document VS891001.  The program is intended	}
{as a demonstration and is not intended to be an example of a 		}
{high-performance implementations of the VESA standard.			}
{If you find any omissions or errors, please report them to me on the 	}
{Everex Systems BBS at (415) 683-2984.					}
{						Gary Lorensen		}
{						Everex Systems, Inc.	}
{						48571 Milmont Dr. B3	}
{						Fremont, CA   94538	}
{-----------------------------------------------------------------------}

uses
    dos;

{-----------------------------------------------------------------------}
{-----------------------------------------------------------------------}

type
    s80 = string[80];
    s8  = string[8];

    CharString = array [$00..$03] of char;

    ModeListType = array [$00..$00] of word;

    PageFuncPtrType = pointer;

    VgaInfoBlockType = record
        VESASignature	: CharString;
	VESAVersion     : word;
	OEMStringPtr	: ^CharString;
	Capabilities	: array [$00..$03] of byte;
	VideoModePtr    : ^ModeListType;
	reserved	: array [$00..$ED] of byte;	{Pad to 256}
    end;

    ModeInfoBlockType = record
	 				{mandatory information}
	ModeAttributes	: word;
	WinAAttributes	: byte;
	WinBAttributes	: byte;
	WinGranularity	: word;
	WinSize		: word;
	WinASegment	: word;
	WinBSegment	: word;
	WinFuncPtr	: PageFuncPtrType;
	BytesPerScanLine : word;

					{optional information}
	XResolution	: word;
	YResolution	: word;
	XCharSize	: byte;
	YCharSize	: byte;
	NumberOfPlanes	: byte;
	BitsPerPixel	: byte;
	NumberOfBanks	: byte;
	MemoryModel	: byte;
	BankSize	: byte;
	reserved	: array [$00..$E2] of byte;	{Pad to 256}
    end;

{-----------------------------------------------------------------------}
{-----------------------------------------------------------------------}

var
    reg : Registers;
    VesaVgaInfo : VgaInfoBlockType;
    VesaModeInfo : ModeInfoBlockType;
    i,j : word;
    displayall : boolean;
    verbose    : boolean;
    skipmode   : boolean;

{-----------------------------------------------------------------------}
{-----------------------------------------------------------------------}

function decval(ch : char) : byte;

begin
    decval := 0;
    if ((ch>='0') and (ch<='9')) then
        decval := ord(ch)-ord('0');
    if ((ch>='A') and (ch<='F')) then
        decval := ord(ch)-ord('A')+$0A;
    if ((ch>='a') and (ch<='f')) then
        decval := ord(ch)-ord('a')+$0A;
end;

function hex2dec(s : s80) : word;

var
    i     : byte;
    tmp   : word;
    place : word;

begin
    i := ord(s[0]);
    place := 1;
    tmp := 0;
    while (i>0) do begin
        tmp := tmp+place*decval(s[i]);
	i:=i-1;
	place := place*$10;
    end;
    hex2dec := tmp;
{    writeln('hex2dec(',s,') = ',tmp);}
end;

{-----------------------------------------------------------------------}

function hexval(x : byte) : char;

begin
    hexval := '0';
    if ((x>=0) and (x<=9)) then
        hexval := chr(x+ord('0'));
    if ((x>=10) and (x<=15)) then
        hexval := chr(x-10+ord('A'));
end;

function dec2hex(x : word) : s8;

var
    tmp   : s8;
    place : word;

begin
{    tmp   := '0';}
    tmp := ' ';
    if (x>=$100) then
        place := $1000
    else
        place := $10;

    repeat
        tmp := tmp+hexval(x div place);
	x := x mod place;
	place := place div $10;
    until (place=$0000);

    dec2hex := tmp+'h';
end;


function hex(x : word) : s8;

var
    tmp   : s8;
    place : word;

begin
    tmp := '0';
    if (x>=$100) then
        place := $1000
    else
        place := $10;

    repeat
        tmp := tmp+hexval(x div place);
	x := x mod place;
	place := place div $10;
    until (place=$0000);

    hex := tmp+'h';
end;

function addrhex(x : word) : s8;

var
    tmp   : s8;
    place : word;

begin
    tmp := '';
    place := $1000;

    repeat
        tmp := tmp+hexval(x div place);
	x := x mod place;
	place := place div $10;
    until (place=$0000);

    addrhex := tmp;
end;

{-----------------------------------------------------------------------}
{-----------------------------------------------------------------------}

begin
    writeln;
    writeln('VESALIST -- List modes supported by VESA BIOS Extension');
    writeln;

    displayall := false;
    verbose    := false;
    if (ParamCount>0) then begin
        displayall := ((ParamStr(1)='ALL') or (ParamStr(1)='all'));
        verbose    := ((ParamStr(1)='VERBOSE') or (ParamStr(1)='verbose'));
        if (ParamCount>1) then begin
            displayall := displayall or ((ParamStr(2)='ALL') or (ParamStr(2)='all'));
            verbose    := verbose or ((ParamStr(2)='VERBOSE') or (ParamStr(2)='verbose'));
	end;
    end;

    reg.AX := $4F00;
    reg.ES := Seg(VesaVgaInfo);
    reg.DI := Ofs(VesaVgaInfo);
    intr($10,reg);

    if (reg.AL<>$4F) then begin
        writeln('ERROR: VESA Function 00h: Return Super VGA Information not supported.');
	halt(1);
    end;

    if (reg.AH<>$00) then begin
        writeln('ERROR: VESA Function 00h: Return Super VGA Information failed.');
	halt(2);
    end;

    writeln('---------------------------------------');
    writeln;

    writeln('VESA VGA Information:');

    write('    VESA Signature: ');
    writeln(VesaVgaInfo.VesaSignature);

    write('    VESA Version  : v');
    write(VesaVgaInfo.VesaVersion div $100);
    write('.');
    write(VesaVgaInfo.VesaVersion mod $100);
    writeln;

    write('    OEM String    : ');
    i := $00;
    while (VesaVgaInfo.OEMStringPtr^[i]<>#00) do begin
        write(VesaVgaInfo.OEMStringPtr^[i]);
	i:=i+1;
    end;
    writeln;

    if (verbose) then begin
        write('    Capabilities  : ');
        for j := $00 to $03 do
            for i := $00 to $07 do
	        if ((VesaVgaInfo.Capabilities[j] and ($80 shr i))=$00) then
	            write('0')
	        else
	            write('1');
        writeln;

        write  ('    Modes         : ');
        i := $00;
        while (VesaVgaInfo.VideoModePtr^[i]<>$FFFF) do begin
            if ((i mod 8)=0) then begin
	        writeln;
	        write('        ');
	    end;
            write(addrhex(VesaVgaInfo.VideoModePtr^[i]),'h ');
	    i:=i+1;
        end;
        writeln;
    end; {verbose}

    writeln('---------------------------------------');
    writeln;

    writeln('Mode Information:');

    i := $00;
    while (VesaVgaInfo.VideoModePtr^[i]<>$FFFF) do begin

        skipmode := true;

        reg.AX := $4F01;
	reg.CX := VesaVgaInfo.VideoModePtr^[i];
        reg.ES := Seg(VesaModeInfo);
        reg.DI := Ofs(VesaModeInfo);
        intr($10,reg);

        if (reg.AL<>$4F) then begin
            write('    ',addrhex(VesaVgaInfo.VideoModePtr^[i]),'h  ');
            writeln('WARNING: Return Super VGA Mode Information not supported.');
	end else if (reg.AH<>$00) then begin
            write('    ',addrhex(VesaVgaInfo.VideoModePtr^[i]),'h  ');
            writeln('WARNING: Return Super VGA Mode Information failed.');
	end else begin

	    if ((VesaModeInfo.ModeAttributes and $02)=$00) then begin

                VesaModeInfo.XCharSize := $00;
                VesaModeInfo.YCharSize := $00;

	        if ((VesaVgaInfo.VideoModePtr^[i] = $100)
		    or (VesaVgaInfo.VideoModePtr^[i] = $101)
		    or (VesaVgaInfo.VideoModePtr^[i] = $103)
		    or (VesaVgaInfo.VideoModePtr^[i] = $105)
		    or (VesaVgaInfo.VideoModePtr^[i] = $107)) then begin

                    VesaModeInfo.NumberOfPlanes := $01;
                    VesaModeInfo.BitsPerPixel   := $08;
                    VesaModeInfo.NumberOfBanks  := $01;
                    VesaModeInfo.BankSize       := $00;
                    VesaModeInfo.MemoryModel    := $04;
		end else if ((VesaVgaInfo.VideoModePtr^[i] = $102)
		    or (VesaVgaInfo.VideoModePtr^[i] = $104)
		    or (VesaVgaInfo.VideoModePtr^[i] = $106)) then begin

                    VesaModeInfo.NumberOfPlanes := $04;
                    VesaModeInfo.BitsPerPixel   := $04;
                    VesaModeInfo.NumberOfBanks  := $01;
                    VesaModeInfo.BankSize       := $00;
                    VesaModeInfo.MemoryModel    := $03;
		end else begin

                    VesaModeInfo.NumberOfPlanes := $00;
                    VesaModeInfo.BitsPerPixel   := $00;
                    VesaModeInfo.NumberOfBanks  := $00;
                    VesaModeInfo.BankSize       := $00;
                    VesaModeInfo.MemoryModel    := $FF;
		end;

	        case VesaVgaInfo.VideoModePtr^[i] of
		    $100 : begin
                        VesaModeInfo.XResolution := 640;
                        VesaModeInfo.YResolution := 400;
		    end;
		    $101 : begin
                        VesaModeInfo.XResolution := 640;
                        VesaModeInfo.YResolution := 480;
		    end;
		    $102,$103 : begin
                        VesaModeInfo.XResolution := 800;
                        VesaModeInfo.YResolution := 600;
		    end;
		    $104,$105 : begin
                        VesaModeInfo.XResolution := 1024;
                        VesaModeInfo.YResolution := 768;
		    end;
		    $106,$107 : begin
                        VesaModeInfo.XResolution := 1280;
                        VesaModeInfo.YResolution := 1024;
		    end;
		end;
	    end;

	    if ((displayall) or ((VesaModeInfo.ModeAttributes and $01)=$01)) then begin

	        if ((VesaModeInfo.MemoryModel=$04)
	            and (VesaModeInfo.NumberOfPlanes=1)
	            and (VesaModeInfo.BitsPerPixel=8)
	            and (VesaModeInfo.NumberOfBanks<=1)
	            and (VesaModeInfo.BankSize=0)
		    ) then begin
                    write('VESA256-> ',addrhex(VesaVgaInfo.VideoModePtr^[i]),'h  ');
		    skipmode := false;
	        end else if ((VesaModeInfo.MemoryModel=$05)
	            and (VesaModeInfo.NumberOfPlanes=1)
	            and (VesaModeInfo.BitsPerPixel=8)
	            and (VesaModeInfo.NumberOfBanks<=1)
	            and (VesaModeInfo.BankSize=0)
		    ) then begin
                    write('SEQU256->',addrhex(VesaVgaInfo.VideoModePtr^[i]),'h  ');
		    skipmode := false;
	        end else if ((VesaModeInfo.MemoryModel=$03)
	            and (VesaModeInfo.NumberOfPlanes=4)
	            and (VesaModeInfo.BitsPerPixel=4)
	            and (VesaModeInfo.NumberOfBanks<=1)
	            and (VesaModeInfo.BankSize=0)
		    ) then begin
                    write('VESA16 -> ',addrhex(VesaVgaInfo.VideoModePtr^[i]),'h  ');
		    skipmode := false;
	        end else begin
	            if (displayall) then
                        write('          ',addrhex(VesaVgaInfo.VideoModePtr^[i]),'h  ');
	        end;

	        if (displayall) or not(skipmode) then begin
	            write(VesaModeInfo.XResolution:4,'x',VesaModeInfo.YResolution:3);
	            if ((VesaModeInfo.ModeAttributes and $10)=$10) then
	                write('x',VesaModeInfo.NumberOfPlanes:1)
	            else
	                write('  ');
	            write(' ',VesaModeInfo.BitsPerPixel:1,'bpp');
	            write(VesaModeInfo.XCharSize:2,'x',VesaModeInfo.YCharSize:2);
	            write(' ');

	            if ((VesaModeInfo.ModeAttributes and $08)=$08) then
	                write('Color ')
	            else
	                write('Mono  ');

		    if (verbose) then begin
	                if (VesaModeInfo.BankSize>0) then 
	                    write(' ',VesaModeInfo.BankSize:2,'Kx',VesaModeInfo.NumberOfBanks:1);

	                if ((VesaModeInfo.WinAAttributes and $01)=$01) then begin
	                    write('A:',addrhex(VesaModeInfo.WinASegment),' ');
		            if ((VesaModeInfo.WinAAttributes and $02)=$02) then
		                write('R')
		            else 
		                write(' ');
		            if ((VesaModeInfo.WinAAttributes and $04)=$04) then
		                write('W')
		            else 
		                write(' ');
	                end else
	                    write('         ');

	                if ((VesaModeInfo.WinBAttributes and $01)=$01) then begin
	                    write('B:',addrhex(VesaModeInfo.WinBSegment),' ');
		            if ((VesaModeInfo.WinBAttributes and $02)=$02) then
		                write('R')
		            else 
		                write(' ');
		            if ((VesaModeInfo.WinBAttributes and $04)=$04) then
		                write('W')
		            else 
		                write(' ');
	                end else
	                    write('         ');
		    end; {verbose}

	            case (VesaModeInfo.MemoryModel) of
	                $00 : write('Text');
	                $01 : write('CGA Grfx');
	                $02 : write('HGC Grfx');
	                $03 : write('16 Grfx');
	                $04 : write('Packed Pixel Grfx');
	                $05 : write('Sequ 256 Grfx');
	                $06,$07,$08,$09,$0A,$0B,$0C,$0D,$0E,$0F
		            : write('reserved for VESA');
	            else
		        write('OEM memory model');
	            end;
	            writeln;

		    if (verbose) then begin
	                write('          ');
	                if ((VesaModeInfo.ModeAttributes and $01)=$01) then
	                    write('Present.     ')
	                else
	                    write('Not present. ');

	                if ((VesaModeInfo.ModeAttributes and $04)=$04) then
	                    write('BIOS.')
	                else
	                    write('     ');

	                write(' ',VesaModeInfo.BytesPerScanLine:3,' raster. ');

	                write('Win:');
	                write(VesaModeInfo.WinSize:2,'Kx');
	                write(VesaModeInfo.WinSize:2,'K  ');
	                write('WinFunc: ',addrhex(Seg(VesaModeInfo.WinFuncPtr^)));
	                write(':',addrhex(Ofs(VesaModeInfo.WinFuncPtr^)));

	                writeln;
		    end; {verbose}
	        end; {displayall}
	    end; {displayall}
	end;
	i:=i+1;
    end;
end.

{-----------------------------------------------------------------------}
{-----------------------------------------------------------------------}