{-----------------------------------------------------------------------}
{VESABOX						GL:01/05/90	}
{-----------------------------------------------------------------------}
{Program for viewing current screen characteristics in a VESA kind of	}
{manner.								}
{-----------------------------------------------------------------------}
{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;

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

const
  ULCorner = #218;  {Line drawing characters}
  URCorner = #191;
  LLCorner = #192;
  LRCorner = #217;
  VertBar  = #179;
  HorzBar  = #196;

  rSequAddr = $3C4;

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

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;

    ScrCharType = record
	ch   : char;
	attr : byte;
    end;

    ScrTextPtrType = ^ScrTextType;
    ScrTextType = array [$0000..$0000] of ScrCharType;
    ScrGrfxPtrType = ^ScrGrfxType;
    ScrGrfxType = array [$0000..$0000] of byte;

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

var
    reg : Registers;
    VesaVgaInfo : VgaInfoBlockType;
    VesaModeInfo : ModeInfoBlockType;
    i : word;
    VesaMode	: word;
    error : boolean;
    textscr : ScrTextPtrType;
    grfxscr : ScrGrfxPtrType;
    pixofs  : longint;
    pixbank : byte;
    prevbank : byte;
    prevbank1: byte; { GENOA }
    x,y     : word;

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

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;

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

procedure SetVesaBank(win  : byte;
		      bank : byte);

var
    reg : Registers;

begin
    reg.AX := $4F05;
    reg.BH := $00;
    reg.BL := win;
    reg.DX := bank;
    intr($10,reg);
end;

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

procedure GetVesaBank(win  : byte;
		      var bank : byte);

var
    reg : Registers;

begin
    reg.AX := $4F05;
    reg.BH := $01;
    reg.BL := win;
    intr($10,reg);
    bank := reg.DX;
end;

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

begin
    error := false;

    writeln('VESA BIOS Extensions BOX program');
    writeln('1990 Everex Systems, Inc.');

    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.');
	error := true;
    end;

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

    if not(error) then begin

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

	if (reg.al<>$4F) then
	    error := true;

	if (reg.AH<>$00) then
	    error := true;

	if not(error) then begin
	    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
		error := true;

	    if (reg.AH<>$00) then
		error := true

	    else if ((error) or ((VesaModeInfo.ModeAttributes and $02)=$00)) then
		error := true

	    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;

		with VesaModeInfo do begin

		    case (MemoryModel) of
			$00 : begin
			    textscr := Ptr(WinASegment,$0000);
			    textscr^[0].ch := ULCorner;
			    textscr^[BytesPerScanLine div 2*(YResolution-1)].ch
				:= LLCorner;
			    for i := 1 to XResolution-2 do begin
				textscr^[i].ch := HorzBar;
				textscr^[BytesPerScanLine div 2*(YResolution-1)+i].ch
				    := HorzBar;
			    end;
			    textscr^[XResolution-1].ch := URCorner;
			    textscr^[BytesPerScanLine div 2*(YResolution-1)+XResolution-1].ch
				:= LRCorner;
			    for i := 1 to YResolution-2 do begin
				textscr^[BytesPerScanLine div 2*i].ch
				    := VertBar;
				textscr^[BytesPerScanLine div 2*i+XResolution-1].ch
				    := VertBar;
			    end;
			end;
			$01 : write('CGA Grfx');
			$02 : write('HGC Grfx');
			$03 : begin

			    Port[rSequAddr  ] := $02;
			    Port[rSequAddr+1] := $07;

			    grfxscr := Ptr(WinASegment,$0000);

			    GetVesaBank(0,prevbank);
			    GetVesaBank(1,prevbank1);  { GENOA }

			    SetVesaBank(0,0);
			    SetVesaBank(1,0); { GENOA }
			    for x := 0 to BytesPerScanLine-1 do
				grfxscr^[x] := grfxscr^[x] or $FF;

			    x := 0;
			    y := YResolution-1;
			    pixofs  := longint(y)*BytesPerScanLine + x;
			    pixbank := pixofs div (longint(WinGranularity)*1024);
			    pixofs  := pixofs mod (longint(WinGranularity)*1024);

			    SetVesaBank(0,pixbank);
			    SetVesaBank(1,pixbank); { GENOA }
			    if ((longint(WinSize)*1024-pixofs)>BytesPerScanLine) then begin
				for x := 0 to BytesPerScanLine-1 do
				    grfxscr^[pixofs+x] := grfxscr^[pixofs+x] or $FF;
			    end else begin
				for x := 0 to (longint(WinSize)*1024-pixofs)-1 do
				    grfxscr^[pixofs+x] := grfxscr^[pixofs+x] or $FF;
				SetVesaBank(0,pixbank+1);
				SetVesaBank(1,pixbank+1); { GENOA }
				pixofs := 0;
				for x := 0 to BytesPerScanLine-x-1 do
				    grfxscr^[pixofs+x] := grfxscr^[pixofs+x] or $FF;
			    end;

			    x := 0;
			    y := 0;
			    pixofs  := longint(y)*BytesPerScanLine + x;
			    pixbank := pixofs div (longint(WinGranularity)*1024);
			    pixofs  := pixofs mod (longint(WinGranularity)*1024);

			    SetVesaBank(0,pixbank);
			    SetVesaBank(1,pixbank); { GENOA }
			    repeat
				grfxscr^[pixofs] := grfxscr^[pixofs] or $80;
				pixofs := pixofs + BytesPerScanLine;
				if (pixofs>longint(WinSize)*1024) then begin
				    pixofs := pixofs mod (longint(WinSize)*1024);
				    pixbank := pixbank+1;
				    SetVesaBank(0,pixbank);
				    SetVesaBank(1,pixbank); { GENOA }
				end;
				y := y+1;
			    until (y=YResolution-1);

			    x := BytesPerScanLine-1;
			    y := 0;
			    pixofs  := longint(y)*BytesPerScanLine + x;
			    pixbank := pixofs div (longint(WinGranularity)*1024);
			    pixofs  := pixofs mod (longint(WinGranularity)*1024);

			    SetVesaBank(0,pixbank);
			    SetVesaBank(1,pixbank); { GENOA }
			    repeat
				grfxscr^[pixofs] := grfxscr^[pixofs] or $01;
				pixofs := pixofs + BytesPerScanLine;
				if (pixofs>longint(WinSize)*1024) then begin
				    pixofs := pixofs mod (longint(WinSize)*1024);
				    pixbank := pixbank+1;
				    SetVesaBank(0,pixbank);
				    SetVesaBank(1,pixbank); { GENOA }
				end;
				y := y+1;
			    until (y=YResolution);

			    Port[rSequAddr  ] := $02;
			    Port[rSequAddr+1] := $0F;

			    SetVesaBank(0,prevbank);
			    SetVesaBank(1,prevbank1); { GENOA }
			end;
			$04 : if (BitsPerPixel=8) then begin
			    grfxscr := Ptr(WinASegment,$0000);

			    GetVesaBank(0,prevbank);
			    GetVesaBank(1,prevbank1); { GENOA }

			    SetVesaBank(0,0);
			    SetVesaBank(1,0); { GENOA }
			    for x := 0 to BytesPerScanLine-1 do
				grfxscr^[x] := $07;

			    x := 0;
			    y := YResolution-1;
			    pixofs  := longint(y)*BytesPerScanLine + x;
			    pixbank := pixofs div (longint(WinGranularity)*1024);
			    pixofs  := pixofs mod (longint(WinGranularity)*1024);

			    SetVesaBank(0,pixbank);
			    SetVesaBank(1,pixbank); { GENOA }
			    if ((longint(WinSize)*1024-pixofs)>BytesPerScanLine) then begin
				for x := 0 to BytesPerScanLine-1 do
				    grfxscr^[pixofs+x] := $07;
			    end else begin
				for x := 0 to (longint(WinSize)*1024-pixofs)-1 do
				    grfxscr^[pixofs+x] := $07;
				SetVesaBank(0,pixbank+1);
				SetVesaBank(1,pixbank+1); { GENOA }
				pixofs := 0;
				for x := 0 to BytesPerScanLine-x-1 do
				    grfxscr^[pixofs+x] := $07;
			    end;

			    x := 0;
			    y := 0;
			    pixofs  := longint(y)*BytesPerScanLine + x;
			    pixbank := pixofs div (longint(WinGranularity)*1024);
			    pixofs  := pixofs mod (longint(WinGranularity)*1024);

			    SetVesaBank(0,pixbank);
			    SetVesaBank(1,pixbank); { GENOA }
			    repeat
				grfxscr^[pixofs] := $07;
				pixofs := pixofs + BytesPerScanLine;
				if (pixofs>longint(WinSize)*1024) then begin
				    pixofs := pixofs mod (longint(WinSize)*1024);
				    pixbank := pixbank+1;
				    SetVesaBank(0,pixbank);
				    SetVesaBank(1,pixbank); { GENOA }
				end;
				y := y+1;
			    until (y=YResolution);

			    x := XResolution-1;
			    y := 0;
			    pixofs  := longint(y)*BytesPerScanLine + x;
			    pixbank := pixofs div (longint(WinGranularity)*1024);
			    pixofs  := pixofs mod (longint(WinGranularity)*1024);

			    SetVesaBank(0,pixbank);
			    SetVesaBank(1,pixbank); { GENOA }
			    repeat
				grfxscr^[pixofs] := $07;
				pixofs := pixofs + BytesPerScanLine;
				if (pixofs>longint(WinSize)*1024) then begin
				    pixofs := pixofs mod (longint(WinSize)*1024);
				    pixbank := pixbank+1;
				    SetVesaBank(0,pixbank);
				    SetVesaBank(1,pixbank); { GENOA }
				end;
				y := y+1;
			    until (y=YResolution);

			    SetVesaBank(0,prevbank);
			    SetVesaBank(1,prevbank1); { GENOA }
			end;
			$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;

		end;

	    end;
	end;

    end;

end.

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