home *** CD-ROM | disk | FTP | other *** search
/ CD-ROM Magazin 1996 March / CD_03_96.BIN / tailchas / genoa / genbox.pas < prev    next >
Pascal/Delphi Source File  |  1990-04-11  |  16KB  |  593 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.     prevbank1: byte; { GENOA }
  106.     x,y     : word;
  107.  
  108. {-----------------------------------------------------------------------}
  109. {-----------------------------------------------------------------------}
  110.  
  111. function decval(ch : char) : byte;
  112.  
  113. begin
  114.     decval := 0;
  115.     if ((ch>='0') and (ch<='9')) then
  116.     decval := ord(ch)-ord('0');
  117.     if ((ch>='A') and (ch<='F')) then
  118.     decval := ord(ch)-ord('A')+$0A;
  119.     if ((ch>='a') and (ch<='f')) then
  120.     decval := ord(ch)-ord('a')+$0A;
  121. end;
  122.  
  123. function hex2dec(s : s80) : word;
  124.  
  125. var
  126.     i      : byte;
  127.     tmp   : word;
  128.     place : word;
  129.     error : boolean;
  130.  
  131. begin
  132.     i := ord(s[0]);
  133.     error := false;
  134.     place := 1;
  135.     tmp := 0;
  136.     while (i>0) and not(error) do begin
  137.     error := not(((s[i]>='0')and(s[i]<='9'))
  138.         or ((s[i]>='a')and(s[i]<='f'))
  139.         or ((s[i]>='A')and(s[i]<='F')));
  140.     tmp := tmp+place*decval(s[i]);
  141.     i:=i-1;
  142.     place := place*$10;
  143.     end;
  144.     if (error) then
  145.     hex2dec := $FFFF
  146.     else
  147.     hex2dec := tmp;
  148. end;
  149.  
  150. {-----------------------------------------------------------------------}
  151.  
  152. function hexval(x : byte) : char;
  153.  
  154. begin
  155.     hexval := '0';
  156.     if ((x>=0) and (x<=9)) then
  157.     hexval := chr(x+ord('0'));
  158.     if ((x>=10) and (x<=15)) then
  159.     hexval := chr(x-10+ord('A'));
  160. end;
  161.  
  162. function dec2hex(x : word) : s8;
  163.  
  164. var
  165.     tmp   : s8;
  166.     place : word;
  167.  
  168. begin
  169. {    tmp   := '0';}
  170.     tmp := ' ';
  171.     if (x>=$100) then
  172.     place := $1000
  173.     else
  174.     place := $10;
  175.  
  176.     repeat
  177.     tmp := tmp+hexval(x div place);
  178.     x := x mod place;
  179.     place := place div $10;
  180.     until (place=$0000);
  181.  
  182.     dec2hex := tmp+'h';
  183. end;
  184.  
  185.  
  186. function hex(x : word) : s8;
  187.  
  188. var
  189.     tmp   : s8;
  190.     place : word;
  191.  
  192. begin
  193.     tmp := '0';
  194.     if (x>=$100) then
  195.     place := $1000
  196.     else
  197.     place := $10;
  198.  
  199.     repeat
  200.     tmp := tmp+hexval(x div place);
  201.     x := x mod place;
  202.     place := place div $10;
  203.     until (place=$0000);
  204.  
  205.     hex := tmp+'h';
  206. end;
  207.  
  208. function addrhex(x : word) : s8;
  209.  
  210. var
  211.     tmp   : s8;
  212.     place : word;
  213.  
  214. begin
  215.     tmp := '';
  216.     place := $1000;
  217.  
  218.     repeat
  219.     tmp := tmp+hexval(x div place);
  220.     x := x mod place;
  221.     place := place div $10;
  222.     until (place=$0000);
  223.  
  224.     addrhex := tmp;
  225. end;
  226.  
  227. {-----------------------------------------------------------------------}
  228.  
  229. procedure SetVesaBank(win  : byte;
  230.               bank : byte);
  231.  
  232. var
  233.     reg : Registers;
  234.  
  235. begin
  236.     reg.AX := $4F05;
  237.     reg.BH := $00;
  238.     reg.BL := win;
  239.     reg.DX := bank;
  240.     intr($10,reg);
  241. end;
  242.  
  243. {-----------------------------------------------------------------------}
  244.  
  245. procedure GetVesaBank(win  : byte;
  246.               var bank : byte);
  247.  
  248. var
  249.     reg : Registers;
  250.  
  251. begin
  252.     reg.AX := $4F05;
  253.     reg.BH := $01;
  254.     reg.BL := win;
  255.     intr($10,reg);
  256.     bank := reg.DX;
  257. end;
  258.  
  259. {-----------------------------------------------------------------------}
  260. {-----------------------------------------------------------------------}
  261.  
  262. begin
  263.     error := false;
  264.  
  265.     writeln('VESA BIOS Extensions BOX program');
  266.     writeln('1990 Everex Systems, Inc.');
  267.  
  268.     reg.AX := $4F00;
  269.     reg.ES := Seg(VesaVgaInfo);
  270.     reg.DI := Ofs(VesaVgaInfo);
  271.     intr($10,reg);
  272.  
  273.     if (reg.AL<>$4F) then begin
  274.     writeln('ERROR: VESA Function 00h: Return Super VGA Information not supported.');
  275.     error := true;
  276.     end;
  277.  
  278.     if (reg.AH<>$00) then begin
  279.     writeln('ERROR: VESA Function 00h: Return Super VGA Information failed.');
  280.     error := true;
  281.     end;
  282.  
  283.     if not(error) then begin
  284.  
  285.     reg.AX := $4F03;
  286.     intr($10,reg);
  287.  
  288.     if (reg.al<>$4F) then
  289.         error := true;
  290.  
  291.     if (reg.AH<>$00) then
  292.         error := true;
  293.  
  294.     if not(error) then begin
  295.         VesaMode := reg.BX;
  296.  
  297.         reg.AX := $4F01;
  298.         reg.CX := VesaMode;
  299.         reg.ES := Seg(VesaModeInfo);
  300.         reg.DI := Ofs(VesaModeInfo);
  301.         intr($10,reg);
  302.  
  303.         if (reg.AL<>$4F) then
  304.         error := true;
  305.  
  306.         if (reg.AH<>$00) then
  307.         error := true
  308.  
  309.         else if ((error) or ((VesaModeInfo.ModeAttributes and $02)=$00)) then
  310.         error := true
  311.  
  312.         else begin
  313.         write(VesaModeInfo.XResolution:4,'x',VesaModeInfo.YResolution:3);
  314.         if ((VesaModeInfo.ModeAttributes and $10)=$10) then
  315.             write('x',VesaModeInfo.NumberOfPlanes:1)
  316.         else
  317.             write('  ');
  318.         write(' ',VesaModeInfo.BitsPerPixel:1,'bpp');
  319.         write(' ',VesaModeInfo.XCharSize:2,'x',VesaModeInfo.YCharSize:2);
  320.         write(' ');
  321.  
  322.         if ((VesaModeInfo.ModeAttributes and $08)=$08) then
  323.             write('Color ')
  324.         else
  325.             write('Mono  ');
  326.  
  327.         if (VesaModeInfo.BankSize>0) then
  328.             write(' ',VesaModeInfo.BankSize:2,'Kx',VesaModeInfo.NumberOfBanks:1);
  329.  
  330.         if ((VesaModeInfo.WinAAttributes and $01)=$01) then begin
  331.             write('A:',addrhex(VesaModeInfo.WinASegment),' ');
  332.             if ((VesaModeInfo.WinAAttributes and $02)=$02) then
  333.             write('R')
  334.             else
  335.             write(' ');
  336.             if ((VesaModeInfo.WinAAttributes and $04)=$04) then
  337.             write('W')
  338.             else
  339.             write(' ');
  340.         end else
  341.             write('         ');
  342.  
  343.         if ((VesaModeInfo.WinBAttributes and $01)=$01) then begin
  344.             write('B:',addrhex(VesaModeInfo.WinBSegment),' ');
  345.             if ((VesaModeInfo.WinBAttributes and $02)=$02) then
  346.             write('R')
  347.             else
  348.             write(' ');
  349.             if ((VesaModeInfo.WinBAttributes and $04)=$04) then
  350.             write('W')
  351.             else
  352.             write(' ');
  353.         end else
  354.             write('         ');
  355.  
  356.         case (VesaModeInfo.MemoryModel) of
  357.             $00 : write('Text');
  358.             $01 : write('CGA Grfx');
  359.             $02 : write('HGC Grfx');
  360.             $03 : write('16 Grfx');
  361.             $04 : write('Packed Pixel Grfx');
  362.             $05 : write('Sequ 256 Grfx');
  363.             $06,$07,$08,$09,$0A,$0B,$0C,$0D,$0E,$0F
  364.             : write('reserved for VESA');
  365.         else
  366.             write('OEM memory model');
  367.         end;
  368.         writeln;
  369.  
  370.         write('            ');
  371.         if ((VesaModeInfo.ModeAttributes and $01)=$01) then
  372.             write('Present.      ')
  373.         else
  374.             write('Not present.  ');
  375.  
  376.         if ((VesaModeInfo.ModeAttributes and $04)=$04) then
  377.             write('BIOS')
  378.         else
  379.             write('    ');
  380.  
  381.         write('  ',VesaModeInfo.BytesPerScanLine:3,' raster.  ');
  382.  
  383.         write('Win: ');
  384.         write(VesaModeInfo.WinSize:2,'Kx');
  385.         write(VesaModeInfo.WinSize:2,'K  ');
  386.         write('WinFunc: ',addrhex(Seg(VesaModeInfo.WinFuncPtr^)));
  387.         write(':',addrhex(Ofs(VesaModeInfo.WinFuncPtr^)));
  388.  
  389.         writeln;
  390.  
  391.         with VesaModeInfo do begin
  392.  
  393.             case (MemoryModel) of
  394.             $00 : begin
  395.                 textscr := Ptr(WinASegment,$0000);
  396.                 textscr^[0].ch := ULCorner;
  397.                 textscr^[BytesPerScanLine div 2*(YResolution-1)].ch
  398.                 := LLCorner;
  399.                 for i := 1 to XResolution-2 do begin
  400.                 textscr^[i].ch := HorzBar;
  401.                 textscr^[BytesPerScanLine div 2*(YResolution-1)+i].ch
  402.                     := HorzBar;
  403.                 end;
  404.                 textscr^[XResolution-1].ch := URCorner;
  405.                 textscr^[BytesPerScanLine div 2*(YResolution-1)+XResolution-1].ch
  406.                 := LRCorner;
  407.                 for i := 1 to YResolution-2 do begin
  408.                 textscr^[BytesPerScanLine div 2*i].ch
  409.                     := VertBar;
  410.                 textscr^[BytesPerScanLine div 2*i+XResolution-1].ch
  411.                     := VertBar;
  412.                 end;
  413.             end;
  414.             $01 : write('CGA Grfx');
  415.             $02 : write('HGC Grfx');
  416.             $03 : begin
  417.  
  418.                 Port[rSequAddr  ] := $02;
  419.                 Port[rSequAddr+1] := $07;
  420.  
  421.                 grfxscr := Ptr(WinASegment,$0000);
  422.  
  423.                 GetVesaBank(0,prevbank);
  424.                 GetVesaBank(1,prevbank1);  { GENOA }
  425.  
  426.                 SetVesaBank(0,0);
  427.                 SetVesaBank(1,0); { GENOA }
  428.                 for x := 0 to BytesPerScanLine-1 do
  429.                 grfxscr^[x] := grfxscr^[x] or $FF;
  430.  
  431.                 x := 0;
  432.                 y := YResolution-1;
  433.                 pixofs  := longint(y)*BytesPerScanLine + x;
  434.                 pixbank := pixofs div (longint(WinGranularity)*1024);
  435.                 pixofs  := pixofs mod (longint(WinGranularity)*1024);
  436.  
  437.                 SetVesaBank(0,pixbank);
  438.                 SetVesaBank(1,pixbank); { GENOA }
  439.                 if ((longint(WinSize)*1024-pixofs)>BytesPerScanLine) then begin
  440.                 for x := 0 to BytesPerScanLine-1 do
  441.                     grfxscr^[pixofs+x] := grfxscr^[pixofs+x] or $FF;
  442.                 end else begin
  443.                 for x := 0 to (longint(WinSize)*1024-pixofs)-1 do
  444.                     grfxscr^[pixofs+x] := grfxscr^[pixofs+x] or $FF;
  445.                 SetVesaBank(0,pixbank+1);
  446.                 SetVesaBank(1,pixbank+1); { GENOA }
  447.                 pixofs := 0;
  448.                 for x := 0 to BytesPerScanLine-x-1 do
  449.                     grfxscr^[pixofs+x] := grfxscr^[pixofs+x] or $FF;
  450.                 end;
  451.  
  452.                 x := 0;
  453.                 y := 0;
  454.                 pixofs  := longint(y)*BytesPerScanLine + x;
  455.                 pixbank := pixofs div (longint(WinGranularity)*1024);
  456.                 pixofs  := pixofs mod (longint(WinGranularity)*1024);
  457.  
  458.                 SetVesaBank(0,pixbank);
  459.                 SetVesaBank(1,pixbank); { GENOA }
  460.                 repeat
  461.                 grfxscr^[pixofs] := grfxscr^[pixofs] or $80;
  462.                 pixofs := pixofs + BytesPerScanLine;
  463.                 if (pixofs>longint(WinSize)*1024) then begin
  464.                     pixofs := pixofs mod (longint(WinSize)*1024);
  465.                     pixbank := pixbank+1;
  466.                     SetVesaBank(0,pixbank);
  467.                     SetVesaBank(1,pixbank); { GENOA }
  468.                 end;
  469.                 y := y+1;
  470.                 until (y=YResolution-1);
  471.  
  472.                 x := BytesPerScanLine-1;
  473.                 y := 0;
  474.                 pixofs  := longint(y)*BytesPerScanLine + x;
  475.                 pixbank := pixofs div (longint(WinGranularity)*1024);
  476.                 pixofs  := pixofs mod (longint(WinGranularity)*1024);
  477.  
  478.                 SetVesaBank(0,pixbank);
  479.                 SetVesaBank(1,pixbank); { GENOA }
  480.                 repeat
  481.                 grfxscr^[pixofs] := grfxscr^[pixofs] or $01;
  482.                 pixofs := pixofs + BytesPerScanLine;
  483.                 if (pixofs>longint(WinSize)*1024) then begin
  484.                     pixofs := pixofs mod (longint(WinSize)*1024);
  485.                     pixbank := pixbank+1;
  486.                     SetVesaBank(0,pixbank);
  487.                     SetVesaBank(1,pixbank); { GENOA }
  488.                 end;
  489.                 y := y+1;
  490.                 until (y=YResolution);
  491.  
  492.                 Port[rSequAddr  ] := $02;
  493.                 Port[rSequAddr+1] := $0F;
  494.  
  495.                 SetVesaBank(0,prevbank);
  496.                 SetVesaBank(1,prevbank1); { GENOA }
  497.             end;
  498.             $04 : if (BitsPerPixel=8) then begin
  499.                 grfxscr := Ptr(WinASegment,$0000);
  500.  
  501.                 GetVesaBank(0,prevbank);
  502.                 GetVesaBank(1,prevbank1); { GENOA }
  503.  
  504.                 SetVesaBank(0,0);
  505.                 SetVesaBank(1,0); { GENOA }
  506.                 for x := 0 to BytesPerScanLine-1 do
  507.                 grfxscr^[x] := $07;
  508.  
  509.                 x := 0;
  510.                 y := YResolution-1;
  511.                 pixofs  := longint(y)*BytesPerScanLine + x;
  512.                 pixbank := pixofs div (longint(WinGranularity)*1024);
  513.                 pixofs  := pixofs mod (longint(WinGranularity)*1024);
  514.  
  515.                 SetVesaBank(0,pixbank);
  516.                 SetVesaBank(1,pixbank); { GENOA }
  517.                 if ((longint(WinSize)*1024-pixofs)>BytesPerScanLine) then begin
  518.                 for x := 0 to BytesPerScanLine-1 do
  519.                     grfxscr^[pixofs+x] := $07;
  520.                 end else begin
  521.                 for x := 0 to (longint(WinSize)*1024-pixofs)-1 do
  522.                     grfxscr^[pixofs+x] := $07;
  523.                 SetVesaBank(0,pixbank+1);
  524.                 SetVesaBank(1,pixbank+1); { GENOA }
  525.                 pixofs := 0;
  526.                 for x := 0 to BytesPerScanLine-x-1 do
  527.                     grfxscr^[pixofs+x] := $07;
  528.                 end;
  529.  
  530.                 x := 0;
  531.                 y := 0;
  532.                 pixofs  := longint(y)*BytesPerScanLine + x;
  533.                 pixbank := pixofs div (longint(WinGranularity)*1024);
  534.                 pixofs  := pixofs mod (longint(WinGranularity)*1024);
  535.  
  536.                 SetVesaBank(0,pixbank);
  537.                 SetVesaBank(1,pixbank); { GENOA }
  538.                 repeat
  539.                 grfxscr^[pixofs] := $07;
  540.                 pixofs := pixofs + BytesPerScanLine;
  541.                 if (pixofs>longint(WinSize)*1024) then begin
  542.                     pixofs := pixofs mod (longint(WinSize)*1024);
  543.                     pixbank := pixbank+1;
  544.                     SetVesaBank(0,pixbank);
  545.                     SetVesaBank(1,pixbank); { GENOA }
  546.                 end;
  547.                 y := y+1;
  548.                 until (y=YResolution);
  549.  
  550.                 x := XResolution-1;
  551.                 y := 0;
  552.                 pixofs  := longint(y)*BytesPerScanLine + x;
  553.                 pixbank := pixofs div (longint(WinGranularity)*1024);
  554.                 pixofs  := pixofs mod (longint(WinGranularity)*1024);
  555.  
  556.                 SetVesaBank(0,pixbank);
  557.                 SetVesaBank(1,pixbank); { GENOA }
  558.                 repeat
  559.                 grfxscr^[pixofs] := $07;
  560.                 pixofs := pixofs + BytesPerScanLine;
  561.                 if (pixofs>longint(WinSize)*1024) then begin
  562.                     pixofs := pixofs mod (longint(WinSize)*1024);
  563.                     pixbank := pixbank+1;
  564.                     SetVesaBank(0,pixbank);
  565.                     SetVesaBank(1,pixbank); { GENOA }
  566.                 end;
  567.                 y := y+1;
  568.                 until (y=YResolution);
  569.  
  570.                 SetVesaBank(0,prevbank);
  571.                 SetVesaBank(1,prevbank1); { GENOA }
  572.             end;
  573.             $05 : write('Sequ 256 Grfx');
  574.             $06,$07,$08,$09,$0A,$0B,$0C,$0D,$0E,$0F
  575.                 : write('reserved for VESA');
  576.             else
  577.             write('OEM memory model');
  578.             end;
  579.  
  580.         end;
  581.  
  582.         end;
  583.     end;
  584.  
  585.     end;
  586.  
  587. end.
  588.  
  589. {-----------------------------------------------------------------------}
  590. {-----------------------------------------------------------------------}
  591.  
  592.  
  593.