home *** CD-ROM | disk | FTP | other *** search
/ PC Attack UltraDisc 4 / pc-attack-ultradisc-4.iso / vesa / samples / vesabox.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-01-11  |  15.4 KB  |  574 lines
  1. {-----------------------------------------------------------------------}
  2. {VESABOX                        GL:01/05/90    }
  3. {-----------------------------------------------------------------------}
  4. {Program for viewing current screen characteristics in a VESA kind of    }
  5. {manner.                                }
  6. {-----------------------------------------------------------------------}
  7. {The following program is written to loosely conform to the VESA     }
  8. {Super VGA BIOS Extension document VS891001.  The program is intended    }
  9. {as a demonstration and is not intended to be an example of a         }
  10. {high-performance implementations of the VESA standard.            }
  11. {If you find any omissions or errors, please report them to me on the     }
  12. {Everex Systems BBS at (415) 683-2984.                    }
  13. {                        Gary Lorensen        }
  14. {                        Everex Systems, Inc.    }
  15. {                        48571 Milmont Dr. B3    }
  16. {                        Fremont, CA   94538    }
  17. {-----------------------------------------------------------------------}
  18.  
  19. uses
  20.     dos;
  21.  
  22. {-----------------------------------------------------------------------}
  23.  
  24. const
  25.   ULCorner = #218;  {Line drawing characters}
  26.   URCorner = #191;
  27.   LLCorner = #192;
  28.   LRCorner = #217;
  29.   VertBar  = #179;
  30.   HorzBar  = #196;
  31.  
  32.   rSequAddr = $3C4;
  33.  
  34. {-----------------------------------------------------------------------}
  35.  
  36. type
  37.     s80 = string[80];
  38.     s8  = string[8];
  39.  
  40.     CharString = array [$00..$03] of char;
  41.  
  42.     ModeListType = array [$00..$00] of word;
  43.  
  44.     PageFuncPtrType = pointer;
  45.  
  46.     VgaInfoBlockType = record
  47.         VESASignature    : CharString;
  48.     VESAVersion     : word;
  49.     OEMStringPtr    : ^CharString;
  50.     Capabilities    : array [$00..$03] of byte;
  51.     VideoModePtr    : ^ModeListType;
  52.     reserved    : array [$00..$ED] of byte;    {Pad to 256}
  53.     end;
  54.  
  55.     ModeInfoBlockType = record
  56.                      {mandatory information}
  57.     ModeAttributes    : word;
  58.     WinAAttributes    : byte;
  59.     WinBAttributes    : byte;
  60.     WinGranularity    : word;
  61.     WinSize        : word;
  62.     WinASegment    : word;
  63.     WinBSegment    : word;
  64.     WinFuncPtr    : PageFuncPtrType;
  65.     BytesPerScanLine : word;
  66.  
  67.                     {optional information}
  68.     XResolution    : word;
  69.     YResolution    : word;
  70.     XCharSize    : byte;
  71.     YCharSize    : byte;
  72.     NumberOfPlanes    : byte;
  73.     BitsPerPixel    : byte;
  74.     NumberOfBanks    : byte;
  75.     MemoryModel    : byte;
  76.     BankSize    : byte;
  77.     reserved    : array [$00..$E2] of byte;    {Pad to 256}
  78.     end;
  79.  
  80.     ScrCharType = record
  81.         ch   : char;
  82.     attr : byte;
  83.     end;
  84.  
  85.     ScrTextPtrType = ^ScrTextType;
  86.     ScrTextType = array [$0000..$0000] of ScrCharType;
  87.     ScrGrfxPtrType = ^ScrGrfxType;
  88.     ScrGrfxType = array [$0000..$0000] of byte;
  89.  
  90. {-----------------------------------------------------------------------}
  91. {-----------------------------------------------------------------------}
  92.  
  93. var
  94.     reg : Registers;
  95.     VesaVgaInfo : VgaInfoBlockType;
  96.     VesaModeInfo : ModeInfoBlockType;
  97.     i : word;
  98.     VesaMode    : word;
  99.     error : boolean;
  100.     textscr : ScrTextPtrType;
  101.     grfxscr : ScrGrfxPtrType;
  102.     pixofs  : longint;
  103.     pixbank : byte;
  104.     prevbank : byte;
  105.     x,y     : word;
  106.  
  107. {-----------------------------------------------------------------------}
  108. {-----------------------------------------------------------------------}
  109.  
  110. function decval(ch : char) : byte;
  111.  
  112. begin
  113.     decval := 0;
  114.     if ((ch>='0') and (ch<='9')) then
  115.         decval := ord(ch)-ord('0');
  116.     if ((ch>='A') and (ch<='F')) then
  117.         decval := ord(ch)-ord('A')+$0A;
  118.     if ((ch>='a') and (ch<='f')) then
  119.         decval := ord(ch)-ord('a')+$0A;
  120. end;
  121.  
  122. function hex2dec(s : s80) : word;
  123.  
  124. var
  125.     i     : byte;
  126.     tmp   : word;
  127.     place : word;
  128.     error : boolean;
  129.  
  130. begin
  131.     i := ord(s[0]);
  132.     error := false;
  133.     place := 1;
  134.     tmp := 0;
  135.     while (i>0) and not(error) do begin
  136.         error := not(((s[i]>='0')and(s[i]<='9')) 
  137.         or ((s[i]>='a')and(s[i]<='f'))
  138.         or ((s[i]>='A')and(s[i]<='F')));
  139.         tmp := tmp+place*decval(s[i]);
  140.     i:=i-1;
  141.     place := place*$10;
  142.     end;
  143.     if (error) then
  144.         hex2dec := $FFFF
  145.     else
  146.         hex2dec := tmp;
  147. end;
  148.  
  149. {-----------------------------------------------------------------------}
  150.  
  151. function hexval(x : byte) : char;
  152.  
  153. begin
  154.     hexval := '0';
  155.     if ((x>=0) and (x<=9)) then
  156.         hexval := chr(x+ord('0'));
  157.     if ((x>=10) and (x<=15)) then
  158.         hexval := chr(x-10+ord('A'));
  159. end;
  160.  
  161. function dec2hex(x : word) : s8;
  162.  
  163. var
  164.     tmp   : s8;
  165.     place : word;
  166.  
  167. begin
  168. {    tmp   := '0';}
  169.     tmp := ' ';
  170.     if (x>=$100) then
  171.         place := $1000
  172.     else
  173.         place := $10;
  174.  
  175.     repeat
  176.         tmp := tmp+hexval(x div place);
  177.     x := x mod place;
  178.     place := place div $10;
  179.     until (place=$0000);
  180.  
  181.     dec2hex := tmp+'h';
  182. end;
  183.  
  184.  
  185. function hex(x : word) : s8;
  186.  
  187. var
  188.     tmp   : s8;
  189.     place : word;
  190.  
  191. begin
  192.     tmp := '0';
  193.     if (x>=$100) then
  194.         place := $1000
  195.     else
  196.         place := $10;
  197.  
  198.     repeat
  199.         tmp := tmp+hexval(x div place);
  200.     x := x mod place;
  201.     place := place div $10;
  202.     until (place=$0000);
  203.  
  204.     hex := tmp+'h';
  205. end;
  206.  
  207. function addrhex(x : word) : s8;
  208.  
  209. var
  210.     tmp   : s8;
  211.     place : word;
  212.  
  213. begin
  214.     tmp := '';
  215.     place := $1000;
  216.  
  217.     repeat
  218.         tmp := tmp+hexval(x div place);
  219.     x := x mod place;
  220.     place := place div $10;
  221.     until (place=$0000);
  222.  
  223.     addrhex := tmp;
  224. end;
  225.  
  226. {-----------------------------------------------------------------------}
  227.  
  228. procedure SetVesaBank(win  : byte;
  229.                       bank : byte);
  230.  
  231. var
  232.     reg : Registers;
  233.  
  234. begin
  235.     reg.AX := $4F05;
  236.     reg.BH := $00;
  237.     reg.BL := win;
  238.     reg.DX := bank;
  239.     intr($10,reg);
  240. end;
  241.  
  242. {-----------------------------------------------------------------------}
  243.  
  244. procedure GetVesaBank(win  : byte;
  245.                       var bank : byte);
  246.  
  247. var
  248.     reg : Registers;
  249.  
  250. begin
  251.     reg.AX := $4F05;
  252.     reg.BH := $01;
  253.     reg.BL := win;
  254.     intr($10,reg);
  255.     bank := reg.DX;
  256. end;
  257.  
  258. {-----------------------------------------------------------------------}
  259. {-----------------------------------------------------------------------}
  260.  
  261. begin
  262.     error := false;
  263.  
  264.     writeln('VESA BIOS Extensions BOX program');
  265.     writeln('1990 Everex Systems, Inc.');
  266.  
  267.     reg.AX := $4F00;
  268.     reg.ES := Seg(VesaVgaInfo);
  269.     reg.DI := Ofs(VesaVgaInfo);
  270.     intr($10,reg);
  271.  
  272.     if (reg.AL<>$4F) then begin
  273.         writeln('ERROR: VESA Function 00h: Return Super VGA Information not supported.');
  274.     error := true;
  275.     end;
  276.  
  277.     if (reg.AH<>$00) then begin
  278.         writeln('ERROR: VESA Function 00h: Return Super VGA Information failed.');
  279.     error := true;
  280.     end;
  281.  
  282.     if not(error) then begin
  283.  
  284.         reg.AX := $4F03;
  285.     intr($10,reg);
  286.  
  287.     if (reg.al<>$4F) then
  288.         error := true;
  289.  
  290.         if (reg.AH<>$00) then
  291.         error := true;
  292.  
  293.     if not(error) then begin
  294.         VesaMode := reg.BX;
  295.  
  296.         reg.AX := $4F01;
  297.         reg.CX := VesaMode;
  298.         reg.ES := Seg(VesaModeInfo);
  299.         reg.DI := Ofs(VesaModeInfo);
  300.             intr($10,reg);
  301.  
  302.             if (reg.AL<>$4F) then
  303.             error := true;
  304.  
  305.         if (reg.AH<>$00) then
  306.             error := true
  307.  
  308.         else if ((error) or ((VesaModeInfo.ModeAttributes and $02)=$00)) then
  309.             error := true
  310.  
  311.         else begin
  312.             write(VesaModeInfo.XResolution:4,'x',VesaModeInfo.YResolution:3);
  313.             if ((VesaModeInfo.ModeAttributes and $10)=$10) then
  314.                 write('x',VesaModeInfo.NumberOfPlanes:1)
  315.             else
  316.                 write('  ');
  317.             write(' ',VesaModeInfo.BitsPerPixel:1,'bpp');
  318.             write(' ',VesaModeInfo.XCharSize:2,'x',VesaModeInfo.YCharSize:2);
  319.             write(' ');
  320.  
  321.             if ((VesaModeInfo.ModeAttributes and $08)=$08) then
  322.                 write('Color ')
  323.             else
  324.                 write('Mono  ');
  325.  
  326.             if (VesaModeInfo.BankSize>0) then 
  327.                 write(' ',VesaModeInfo.BankSize:2,'Kx',VesaModeInfo.NumberOfBanks:1);
  328.  
  329.             if ((VesaModeInfo.WinAAttributes and $01)=$01) then begin
  330.                 write('A:',addrhex(VesaModeInfo.WinASegment),' ');
  331.             if ((VesaModeInfo.WinAAttributes and $02)=$02) then
  332.                 write('R')
  333.             else 
  334.                 write(' ');
  335.             if ((VesaModeInfo.WinAAttributes and $04)=$04) then
  336.                 write('W')
  337.             else 
  338.                 write(' ');
  339.             end else
  340.                 write('         ');
  341.  
  342.             if ((VesaModeInfo.WinBAttributes and $01)=$01) then begin
  343.                 write('B:',addrhex(VesaModeInfo.WinBSegment),' ');
  344.             if ((VesaModeInfo.WinBAttributes and $02)=$02) then
  345.                 write('R')
  346.             else 
  347.                 write(' ');
  348.             if ((VesaModeInfo.WinBAttributes and $04)=$04) then
  349.                 write('W')
  350.             else 
  351.                 write(' ');
  352.             end else
  353.                 write('         ');
  354.  
  355.             case (VesaModeInfo.MemoryModel) of
  356.                 $00 : write('Text');
  357.                 $01 : write('CGA Grfx');
  358.                 $02 : write('HGC Grfx');
  359.                 $03 : write('16 Grfx');
  360.                 $04 : write('Packed Pixel Grfx');
  361.                 $05 : write('Sequ 256 Grfx');
  362.                 $06,$07,$08,$09,$0A,$0B,$0C,$0D,$0E,$0F
  363.                 : write('reserved for VESA');
  364.             else
  365.             write('OEM memory model');
  366.             end;
  367.             writeln;
  368.  
  369.             write('            ');
  370.             if ((VesaModeInfo.ModeAttributes and $01)=$01) then
  371.                 write('Present.      ')
  372.             else
  373.                 write('Not present.  ');
  374.  
  375.             if ((VesaModeInfo.ModeAttributes and $04)=$04) then
  376.                 write('BIOS')
  377.             else
  378.                 write('    ');
  379.  
  380.             write('  ',VesaModeInfo.BytesPerScanLine:3,' raster.  ');
  381.  
  382.             write('Win: ');
  383.             write(VesaModeInfo.WinSize:2,'Kx');
  384.             write(VesaModeInfo.WinSize:2,'K  ');
  385.             write('WinFunc: ',addrhex(Seg(VesaModeInfo.WinFuncPtr^)));
  386.             write(':',addrhex(Ofs(VesaModeInfo.WinFuncPtr^)));
  387.  
  388.             writeln;
  389.  
  390.         with VesaModeInfo do begin
  391.  
  392.                 case (MemoryModel) of
  393.                     $00 : begin
  394.                     textscr := Ptr(WinASegment,$0000);
  395.                 textscr^[0].ch := ULCorner;
  396.                 textscr^[BytesPerScanLine div 2*(YResolution-1)].ch 
  397.                     := LLCorner;
  398.                 for i := 1 to XResolution-2 do begin
  399.                     textscr^[i].ch := HorzBar;
  400.                     textscr^[BytesPerScanLine div 2*(YResolution-1)+i].ch 
  401.                         := HorzBar;
  402.                 end;
  403.                 textscr^[XResolution-1].ch := URCorner;
  404.                 textscr^[BytesPerScanLine div 2*(YResolution-1)+XResolution-1].ch 
  405.                     := LRCorner;
  406.                 for i := 1 to YResolution-2 do begin
  407.                     textscr^[BytesPerScanLine div 2*i].ch 
  408.                         := VertBar;
  409.                     textscr^[BytesPerScanLine div 2*i+XResolution-1].ch 
  410.                         := VertBar;
  411.                 end;
  412.                 end;
  413.                     $01 : write('CGA Grfx');
  414.                     $02 : write('HGC Grfx');
  415.                     $03 : begin
  416.  
  417.                 Port[rSequAddr  ] := $02;
  418.                 Port[rSequAddr+1] := $07;
  419.  
  420.                     grfxscr := Ptr(WinASegment,$0000);
  421.  
  422.                 GetVesaBank(0,prevbank);
  423.  
  424.                 SetVesaBank(0,0);
  425.                 for x := 0 to BytesPerScanLine-1 do
  426.                     grfxscr^[x] := grfxscr^[x] or $FF;
  427.  
  428.                 x := 0;
  429.                 y := YResolution-1;
  430.                 pixofs  := longint(y)*BytesPerScanLine + x;
  431.                 pixbank := pixofs div (longint(WinGranularity)*1024);
  432.                 pixofs  := pixofs mod (longint(WinGranularity)*1024);
  433.  
  434.                 SetVesaBank(0,pixbank);
  435.                 if ((longint(WinSize)*1024-pixofs)>BytesPerScanLine) then begin
  436.                     for x := 0 to BytesPerScanLine-1 do
  437.                         grfxscr^[pixofs+x] := grfxscr^[pixofs+x] or $FF;
  438.                 end else begin
  439.                     for x := 0 to (longint(WinSize)*1024-pixofs)-1 do
  440.                         grfxscr^[pixofs+x] := grfxscr^[pixofs+x] or $FF;
  441.                     SetVesaBank(0,pixbank+1);
  442.                 pixofs := 0;
  443.                     for x := 0 to BytesPerScanLine-x-1 do
  444.                         grfxscr^[pixofs+x] := grfxscr^[pixofs+x] or $FF;
  445.                 end;
  446.  
  447.                 x := 0;
  448.                 y := 0;
  449.                 pixofs  := longint(y)*BytesPerScanLine + x;
  450.                 pixbank := pixofs div (longint(WinGranularity)*1024);
  451.                 pixofs  := pixofs mod (longint(WinGranularity)*1024);
  452.  
  453.                 SetVesaBank(0,pixbank);
  454.                 repeat
  455.                     grfxscr^[pixofs] := grfxscr^[pixofs] or $80;
  456.                 pixofs := pixofs + BytesPerScanLine;
  457.                 if (pixofs>longint(WinSize)*1024) then begin
  458.                     pixofs := pixofs mod (longint(WinSize)*1024);
  459.                     pixbank := pixbank+1;
  460.                         SetVesaBank(0,pixbank);
  461.                 end;
  462.                 y := y+1;
  463.                 until (y=YResolution-1);
  464.  
  465.                 x := BytesPerScanLine-1;
  466.                 y := 0;
  467.                 pixofs  := longint(y)*BytesPerScanLine + x;
  468.                 pixbank := pixofs div (longint(WinGranularity)*1024);
  469.                 pixofs  := pixofs mod (longint(WinGranularity)*1024);
  470.  
  471.                 SetVesaBank(0,pixbank);
  472.                 repeat
  473.                     grfxscr^[pixofs] := grfxscr^[pixofs] or $01;
  474.                 pixofs := pixofs + BytesPerScanLine;
  475.                 if (pixofs>longint(WinSize)*1024) then begin
  476.                     pixofs := pixofs mod (longint(WinSize)*1024);
  477.                     pixbank := pixbank+1;
  478.                         SetVesaBank(0,pixbank);
  479.                 end;
  480.                 y := y+1;
  481.                 until (y=YResolution);
  482.  
  483.                 Port[rSequAddr  ] := $02;
  484.                 Port[rSequAddr+1] := $0F;
  485.  
  486.                 SetVesaBank(0,prevbank);
  487.                 end;
  488.                     $04 : if (BitsPerPixel=8) then begin
  489.                     grfxscr := Ptr(WinASegment,$0000);
  490.  
  491.                 GetVesaBank(0,prevbank);
  492.  
  493.                 SetVesaBank(0,0);
  494.                 for x := 0 to BytesPerScanLine-1 do
  495.                     grfxscr^[x] := $07;
  496.  
  497.                 x := 0;
  498.                 y := YResolution-1;
  499.                 pixofs  := longint(y)*BytesPerScanLine + x;
  500.                 pixbank := pixofs div (longint(WinGranularity)*1024);
  501.                 pixofs  := pixofs mod (longint(WinGranularity)*1024);
  502.  
  503.                 SetVesaBank(0,pixbank);
  504.                 if ((longint(WinSize)*1024-pixofs)>BytesPerScanLine) then begin
  505.                     for x := 0 to BytesPerScanLine-1 do
  506.                         grfxscr^[pixofs+x] := $07;
  507.                 end else begin
  508.                     for x := 0 to (longint(WinSize)*1024-pixofs)-1 do
  509.                         grfxscr^[pixofs+x] := $07;
  510.                     SetVesaBank(0,pixbank+1);
  511.                 pixofs := 0;
  512.                     for x := 0 to BytesPerScanLine-x-1 do
  513.                         grfxscr^[pixofs+x] := $07;
  514.                 end;
  515.  
  516.                 x := 0;
  517.                 y := 0;
  518.                 pixofs  := longint(y)*BytesPerScanLine + x;
  519.                 pixbank := pixofs div (longint(WinGranularity)*1024);
  520.                 pixofs  := pixofs mod (longint(WinGranularity)*1024);
  521.  
  522.                 SetVesaBank(0,pixbank);
  523.                 repeat
  524.                     grfxscr^[pixofs] := $07;
  525.                 pixofs := pixofs + BytesPerScanLine;
  526.                 if (pixofs>longint(WinSize)*1024) then begin
  527.                     pixofs := pixofs mod (longint(WinSize)*1024);
  528.                     pixbank := pixbank+1;
  529.                         SetVesaBank(0,pixbank);
  530.                 end;
  531.                 y := y+1;
  532.                 until (y=YResolution);
  533.  
  534.                 x := XResolution-1;
  535.                 y := 0;
  536.                 pixofs  := longint(y)*BytesPerScanLine + x;
  537.                 pixbank := pixofs div (longint(WinGranularity)*1024);
  538.                 pixofs  := pixofs mod (longint(WinGranularity)*1024);
  539.  
  540.                 SetVesaBank(0,pixbank);
  541.                 repeat
  542.                     grfxscr^[pixofs] := $07;
  543.                 pixofs := pixofs + BytesPerScanLine;
  544.                 if (pixofs>longint(WinSize)*1024) then begin
  545.                     pixofs := pixofs mod (longint(WinSize)*1024);
  546.                     pixbank := pixbank+1;
  547.                         SetVesaBank(0,pixbank);
  548.                 end;
  549.                 y := y+1;
  550.                 until (y=YResolution);
  551.  
  552.                 SetVesaBank(0,prevbank);
  553.                 end;
  554.                     $05 : write('Sequ 256 Grfx');
  555.                     $06,$07,$08,$09,$0A,$0B,$0C,$0D,$0E,$0F
  556.                     : write('reserved for VESA');
  557.                 else
  558.                 write('OEM memory model');
  559.                 end;
  560.  
  561.         end;
  562.  
  563.         end;    
  564.         end;
  565.  
  566.     end;
  567.  
  568. end.
  569.  
  570. {-----------------------------------------------------------------------}
  571. {-----------------------------------------------------------------------}
  572.  
  573.  
  574.