home *** CD-ROM | disk | FTP | other *** search
/ PC Gamer 9 / 1995-08_Disc_9.iso / vesa / samples / vesamode.pas < prev    next >
Pascal/Delphi Source File  |  1990-01-11  |  10KB  |  378 lines
  1. {-----------------------------------------------------------------------}
  2. {VESAMODE                        GL:01/04/90    }
  3. {-----------------------------------------------------------------------}
  4. {Program for setting VESA modes through VESA BIOS Extension        }
  5. {implementations.                            }
  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.  
  25. type
  26.     s80 = string[80];
  27.     s8  = string[8];
  28.  
  29.     CharString = array [$00..$03] of char;
  30.  
  31.     ModeListType = array [$00..$00] of word;
  32.  
  33.     PageFuncPtrType = pointer;
  34.  
  35.     VgaInfoBlockType = record
  36.         VESASignature    : CharString;
  37.     VESAVersion     : word;
  38.     OEMStringPtr    : ^CharString;
  39.     Capabilities    : array [$00..$03] of byte;
  40.     VideoModePtr    : ^ModeListType;
  41.     reserved    : array [$00..$ED] of byte;    {Pad to 256}
  42.     end;
  43.  
  44.     ModeInfoBlockType = record
  45.                      {mandatory information}
  46.     ModeAttributes    : word;
  47.     WinAAttributes    : byte;
  48.     WinBAttributes    : byte;
  49.     WinGranularity    : word;
  50.     WinSize        : word;
  51.     WinASegment    : word;
  52.     WinBSegment    : word;
  53.     WinFuncPtr    : PageFuncPtrType;
  54.     BytesPerScanLine : word;
  55.  
  56.                     {optional information}
  57.     XResolution    : word;
  58.     YResolution    : word;
  59.     XCharSize    : byte;
  60.     YCharSize    : byte;
  61.     NumberOfPlanes    : byte;
  62.     BitsPerPixel    : byte;
  63.     NumberOfBanks    : byte;
  64.     MemoryModel    : byte;
  65.     BankSize    : byte;
  66.     reserved    : array [$00..$E2] of byte;    {Pad to 256}
  67.     end;
  68.  
  69. {-----------------------------------------------------------------------}
  70. {-----------------------------------------------------------------------}
  71.  
  72. var
  73.     reg : Registers;
  74.     VesaVgaInfo : VgaInfoBlockType;
  75.     VesaModeInfo : ModeInfoBlockType;
  76.     i : word;
  77.     VesaMode    : word;
  78.     VesaModeStr : s80;
  79.  
  80. {-----------------------------------------------------------------------}
  81. {-----------------------------------------------------------------------}
  82.  
  83. function decval(ch : char) : byte;
  84.  
  85. begin
  86.     decval := 0;
  87.     if ((ch>='0') and (ch<='9')) then
  88.         decval := ord(ch)-ord('0');
  89.     if ((ch>='A') and (ch<='F')) then
  90.         decval := ord(ch)-ord('A')+$0A;
  91.     if ((ch>='a') and (ch<='f')) then
  92.         decval := ord(ch)-ord('a')+$0A;
  93. end;
  94.  
  95. function hex2dec(s : s80) : word;
  96.  
  97. var
  98.     i     : byte;
  99.     tmp   : word;
  100.     place : word;
  101.     error : boolean;
  102.  
  103. begin
  104.     i := ord(s[0]);
  105.     error := false;
  106.     place := 1;
  107.     tmp := 0;
  108.     while (i>0) and not(error) do begin
  109.         error := not(((s[i]>='0')and(s[i]<='9')) 
  110.         or ((s[i]>='a')and(s[i]<='f'))
  111.         or ((s[i]>='A')and(s[i]<='F')));
  112.         tmp := tmp+place*decval(s[i]);
  113.     i:=i-1;
  114.     place := place*$10;
  115.     end;
  116.     if (error) then
  117.         hex2dec := $FFFF
  118.     else
  119.         hex2dec := tmp;
  120. end;
  121.  
  122. {-----------------------------------------------------------------------}
  123.  
  124. function hexval(x : byte) : char;
  125.  
  126. begin
  127.     hexval := '0';
  128.     if ((x>=0) and (x<=9)) then
  129.         hexval := chr(x+ord('0'));
  130.     if ((x>=10) and (x<=15)) then
  131.         hexval := chr(x-10+ord('A'));
  132. end;
  133.  
  134. function dec2hex(x : word) : s8;
  135.  
  136. var
  137.     tmp   : s8;
  138.     place : word;
  139.  
  140. begin
  141. {    tmp   := '0';}
  142.     tmp := ' ';
  143.     if (x>=$100) then
  144.         place := $1000
  145.     else
  146.         place := $10;
  147.  
  148.     repeat
  149.         tmp := tmp+hexval(x div place);
  150.     x := x mod place;
  151.     place := place div $10;
  152.     until (place=$0000);
  153.  
  154.     dec2hex := tmp+'h';
  155. end;
  156.  
  157.  
  158. function hex(x : word) : s8;
  159.  
  160. var
  161.     tmp   : s8;
  162.     place : word;
  163.  
  164. begin
  165.     tmp := '0';
  166.     if (x>=$100) then
  167.         place := $1000
  168.     else
  169.         place := $10;
  170.  
  171.     repeat
  172.         tmp := tmp+hexval(x div place);
  173.     x := x mod place;
  174.     place := place div $10;
  175.     until (place=$0000);
  176.  
  177.     hex := tmp+'h';
  178. end;
  179.  
  180. function addrhex(x : word) : s8;
  181.  
  182. var
  183.     tmp   : s8;
  184.     place : word;
  185.  
  186. begin
  187.     tmp := '';
  188.     place := $1000;
  189.  
  190.     repeat
  191.         tmp := tmp+hexval(x div place);
  192.     x := x mod place;
  193.     place := place div $10;
  194.     until (place=$0000);
  195.  
  196.     addrhex := tmp;
  197. end;
  198.  
  199. {-----------------------------------------------------------------------}
  200. {-----------------------------------------------------------------------}
  201.  
  202. begin
  203.     writeln;
  204.     writeln('VESA BIOS Extensions Set Mode program');
  205.     writeln('1990 Everex Systems, Inc.');
  206.     writeln;
  207.  
  208. {-----------------------------------------------------------------------}
  209.  
  210.     reg.AX := $4F00;
  211.     reg.ES := Seg(VesaVgaInfo);
  212.     reg.DI := Ofs(VesaVgaInfo);
  213.     intr($10,reg);
  214.  
  215.     if (reg.AL<>$4F) then begin
  216.         writeln('ERROR: VESA Function 00h: Return Super VGA Information not supported.');
  217.     halt(1);
  218.     end;
  219.  
  220.     if (reg.AH<>$00) then begin
  221.         writeln('ERROR: VESA Function 00h: Return Super VGA Information failed.');
  222.     halt(2);
  223.     end;
  224.  
  225.     VesaModeStr := '';
  226.     VesaMode    := $FFFF;
  227.     if (ParamCount>0) then begin
  228.         VesaModeStr := ParamStr(1);
  229.     VesaMode := hex2dec(VesaModeStr);
  230.     end;
  231.         
  232.     if (VesaMode=$FFFF) then begin
  233.  
  234.         write  ('VESA Modes:');
  235.         i := $00;
  236.         while (VesaVgaInfo.VideoModePtr^[i]<>$FFFF) do begin
  237.             if ((i mod 8)=0) then begin
  238.             writeln;
  239.             write('        ');
  240.         end;
  241.             write(addrhex(VesaVgaInfo.VideoModePtr^[i]),'h ');
  242.         i:=i+1;
  243.         end;
  244.         writeln;
  245.  
  246.     end else begin
  247.         reg.AX := $4F02;
  248.     reg.BX := VesaMode;
  249.     intr($10,reg);
  250.  
  251.     if (reg.al<>$4F) then begin
  252.             writeln('ERROR: VESA Function 02h: Set Super VGA Mode not supported.');
  253.         halt(1);
  254.         end;
  255.  
  256.         if (reg.AH<>$00) then begin
  257.             writeln('ERROR: VESA Function 02h: Set Super VGA Mode failed.');
  258.         halt(2);
  259.         end;
  260.  
  261.         reg.AX := $4F03;
  262.     intr($10,reg);
  263.  
  264.     if (reg.al<>$4F) then begin
  265.             writeln('ERROR: VESA Function 03h: Get Super VGA Mode not supported.');
  266.         halt(1);
  267.         end;
  268.  
  269.         if (reg.AH<>$00) then begin
  270.             writeln('ERROR: VESA Function 03h: Get Super VGA Mode failed.');
  271.         halt(2);
  272.         end;
  273.  
  274.     VesaMode := reg.BX;
  275.  
  276.     reg.AX := $4F01;
  277.     reg.CX := VesaMode;
  278.     reg.ES := Seg(VesaModeInfo);
  279.     reg.DI := Ofs(VesaModeInfo);
  280.         intr($10,reg);
  281.  
  282.         if (reg.AL<>$4F) then
  283.             writeln('WARNING: Return Super VGA Mode Information not supported.')
  284.  
  285.     else if (reg.AH<>$00) then
  286.             writeln('WARNING: Return Super VGA Mode Information failed.')
  287.  
  288.     else if ((VesaModeInfo.ModeAttributes and $02)=$00) then
  289.             writeln('WARNING: VESA Mode extended mode information not present.')
  290.     else begin
  291.         write(VesaModeInfo.XResolution:4,'x',VesaModeInfo.YResolution:3);
  292.         if ((VesaModeInfo.ModeAttributes and $10)=$10) then
  293.             write('x',VesaModeInfo.NumberOfPlanes:1)
  294.         else
  295.             write('  ');
  296.         write(' ',VesaModeInfo.BitsPerPixel:1,'bpp');
  297.         write(' ',VesaModeInfo.XCharSize:2,'x',VesaModeInfo.YCharSize:2);
  298.         write(' ');
  299.  
  300.         if ((VesaModeInfo.ModeAttributes and $08)=$08) then
  301.             write('Color ')
  302.         else
  303.             write('Mono  ');
  304.  
  305.         if (VesaModeInfo.BankSize>0) then 
  306.             write(' ',VesaModeInfo.BankSize:2,'Kx',VesaModeInfo.NumberOfBanks:1);
  307.  
  308.         if ((VesaModeInfo.WinAAttributes and $01)=$01) then begin
  309.             write('A:',addrhex(VesaModeInfo.WinASegment),' ');
  310.         if ((VesaModeInfo.WinAAttributes and $02)=$02) then
  311.             write('R')
  312.         else 
  313.             write(' ');
  314.         if ((VesaModeInfo.WinAAttributes and $04)=$04) then
  315.             write('W')
  316.         else 
  317.             write(' ');
  318.         end else
  319.             write('         ');
  320.  
  321.         if ((VesaModeInfo.WinBAttributes and $01)=$01) then begin
  322.             write('B:',addrhex(VesaModeInfo.WinBSegment),' ');
  323.         if ((VesaModeInfo.WinBAttributes and $02)=$02) then
  324.             write('R')
  325.         else 
  326.             write(' ');
  327.         if ((VesaModeInfo.WinBAttributes and $04)=$04) then
  328.             write('W')
  329.         else 
  330.             write(' ');
  331.         end else
  332.             write('         ');
  333.  
  334.         case (VesaModeInfo.MemoryModel) of
  335.             $00 : write('Text');
  336.             $01 : write('CGA Grfx');
  337.             $02 : write('HGC Grfx');
  338.             $03 : write('16 Grfx');
  339.             $04 : write('Packed Pixel Grfx');
  340.             $05 : write('Sequ 256 Grfx');
  341.             $06,$07,$08,$09,$0A,$0B,$0C,$0D,$0E,$0F
  342.             : write('reserved for VESA');
  343.         else
  344.         write('OEM memory model');
  345.         end;
  346.         writeln;
  347.  
  348.         write('            ');
  349.         if ((VesaModeInfo.ModeAttributes and $01)=$01) then
  350.             write('Present.      ')
  351.         else
  352.             write('Not present.  ');
  353.  
  354.         if ((VesaModeInfo.ModeAttributes and $04)=$04) then
  355.             write('BIOS')
  356.         else
  357.             write('    ');
  358.  
  359.         write('  ',VesaModeInfo.BytesPerScanLine:3,' raster.  ');
  360.  
  361.         write('Win: ');
  362.         write(VesaModeInfo.WinSize:2,'Kx');
  363.         write(VesaModeInfo.WinSize:2,'K  ');
  364.         write('WinFunc: ',addrhex(Seg(VesaModeInfo.WinFuncPtr^)));
  365.         write(':',addrhex(Ofs(VesaModeInfo.WinFuncPtr^)));
  366.  
  367.         writeln;
  368.             
  369.     end;
  370.  
  371.     end;
  372.  
  373. end.
  374.  
  375. {-----------------------------------------------------------------------}
  376. {-----------------------------------------------------------------------}
  377.  
  378.