{-----------------------------------------------------------------------}
{VESAMODE						GL:01/04/90	}
{-----------------------------------------------------------------------}
{Program for setting VESA modes through VESA BIOS Extension		}
{implementations.							}
{-----------------------------------------------------------------------}
{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 : word;
    VesaMode    : word;
    VesaModeStr : s80;

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

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;
    error : boolean;

begin
    i := ord(s[0]);
    error := false;
    place := 1;
    tmp := 0;
    while (i>0) and not(error) do begin
        error := not(((s[i]>='0')and(s[i]<='9')) 
	    or ((s[i]>='a')and(s[i]<='f'))
	    or ((s[i]>='A')and(s[i]<='F')));
        tmp := tmp+place*decval(s[i]);
	i:=i-1;
	place := place*$10;
    end;
    if (error) then
        hex2dec := $FFFF
    else
        hex2dec := 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('VESA BIOS Extensions Set Mode program');
    writeln('1990 Everex Systems, Inc.');
    writeln;

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

    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;

    VesaModeStr := '';
    VesaMode    := $FFFF;
    if (ParamCount>0) then begin
        VesaModeStr := ParamStr(1);
	VesaMode := hex2dec(VesaModeStr);
    end;
        
    if (VesaMode=$FFFF) then begin

        write  ('VESA 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 else begin
        reg.AX := $4F02;
	reg.BX := VesaMode;
	intr($10,reg);

	if (reg.al<>$4F) then begin
            writeln('ERROR: VESA Function 02h: Set Super VGA Mode not supported.');
	    halt(1);
        end;

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

        reg.AX := $4F03;
	intr($10,reg);

	if (reg.al<>$4F) then begin
            writeln('ERROR: VESA Function 03h: Get Super VGA Mode not supported.');
	    halt(1);
        end;

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

	VesaMode := reg.BX;

	reg.AX := $4F01;
	reg.CX := VesaMode;
	reg.ES := Seg(VesaModeInfo);
	reg.DI := Ofs(VesaModeInfo);
        intr($10,reg);

        if (reg.AL<>$4F) then
            writeln('WARNING: Return Super VGA Mode Information not supported.')

	else if (reg.AH<>$00) then
            writeln('WARNING: Return Super VGA Mode Information failed.')

	else if ((VesaModeInfo.ModeAttributes and $02)=$00) then
            writeln('WARNING: VESA Mode extended mode information not present.')
	else 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 (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('         ');

	    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;

	    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;

    end;

end.

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