home *** CD-ROM | disk | FTP | other *** search
/ Frostbyte's 1980s DOS Shareware Collection / floppyshareware.zip / floppyshareware / DOOG / INFOP131.ZIP / PAGE_05.INC < prev    next >
Text File  |  1990-09-04  |  5KB  |  173 lines
  1. procedure page_05;
  2.  
  3. var
  4.   i : byte;
  5.   xbyte : byte;
  6.   xint1 : integer;
  7.   xint2 : integer;
  8.   xword : word;
  9.   mono2: boolean;
  10.  
  11. procedure showdisp(a : string; b : byte);
  12.  
  13. begin
  14.   caption2(a);
  15.   case b of
  16.     $00 : writeln('(none)');
  17.     $01 : writeln('MDA + 5151');
  18.     $02 : writeln('CGA + 5153/5154');
  19.     $03 : writeln('(reserved)');
  20.     $04 : writeln('EGA + 5153/5154');
  21.     $05 : writeln('EGA 5151');
  22.     $06 : writeln('PGA + 5175');
  23.     $07 : writeln('VGA + analog monochrome');
  24.     $08 : writeln('VGA + analog color');
  25.     $09 : writeln('(reserved)');
  26.     $0A : writeln('MCGA + digital color');
  27.     $0B : writeln('MCGA + digital monochrome');
  28.     $0C : writeln('MCGA + analog color');
  29.     $0D..$FE : writeln('(reserved)');
  30.     $FF : dontknow
  31.   end
  32. end;
  33.  
  34. procedure showcolor(a : byte);
  35.  
  36. begin
  37.   case(a) of
  38.     black     : write('black');
  39.     blue      : write('blue');
  40.     green     : write('green');
  41.     cyan      : write('cyan');
  42.     red       : write('red');
  43.     magenta   : write('magenta');
  44.     brown     : write('brown');
  45.     lightgray : write('light gray');
  46.     darkgray  : write('dark gray');
  47.     lightblue : write('light blue');
  48.     lightgreen: write('light green');
  49.     lightcyan : write('light cyan');
  50.     lightred  : write('light red');
  51.     lightmagenta: write('light magenta');
  52.     yellow    : write('yellow');
  53.     white     : write('white')
  54.     else
  55.       unknown('color', a, 2)
  56.   end
  57. end;
  58.  
  59. begin (* procedure page_05 *)
  60.   with regs do begin
  61.     AX:=$1A00;
  62.     intr($10, regs);
  63.     if AL = $1A then begin
  64.       showdisp('Active video subsystem  ', BL);
  65.       showdisp('Inactive video subsystem', BH)
  66.     end
  67.   end;
  68.   caption2('Initial video mode');
  69.   case equip and $0030 of
  70.     $0000 : writeln('No display');
  71.     $0010 : writeln('40 x 25 color');
  72.     $0020 : writeln('80 x 25 color');
  73.     $0030 : writeln('80 x 25 monochrome')
  74.   end;
  75.   caption2('Current video mode');
  76.   xbyte:=lo(lastmode);
  77.   write(xbyte, ' ');
  78.   case xbyte of
  79.     $00 : writeln('(40 x 25 b/w text)');
  80.     $01 : writeln('(40 x 25 color text)');
  81.     $02 : writeln('(80 x 25 b/w text)');
  82.     $03 : writeln('(80 x 25 color text)');
  83.     $04 : writeln('(320 x 200 4 colors)');
  84.     $05 : writeln('(320 x 200 4 colors, no color burst)');
  85.     $06 : writeln('(640 x 200 2 colors)');
  86.     $07 : writeln('(MDA text)');
  87.     $08 : writeln('(160 x 200 16 colors)');
  88.     $09 : writeln('(320 x 200 16 colors)');
  89.     $0A : writeln('(640 x 200 4 colors)');
  90.     $0D : writeln('(320 x 200 16 colors)');
  91.     $0E : writeln('(640 x 200 16 colors)');
  92.     $0F : writeln('(640 x 350 monochrome)');
  93.     $10 : writeln('(640 x 350 16 colors)');
  94.     $11 : writeln('(640 x 480 2 colors)');
  95.     $12 : writeln('(640 x 480 16 colors)');
  96.     $13 : writeln('(320 x 200 256 colors)');
  97.     $54 : Writeln('(132 x 43 color text [Paradise])');
  98.     $55 : Writeln('(132 x 25 color text [Paradise])');
  99.     $56 : Writeln('(132 x 43 b/w text [Paradise])');
  100.     $57 : Writeln('(132 x 25 b/w text [Paradise])');
  101.     $58 : Writeln('(800 x 600 16 colors [Paradise])');
  102.     $59 : Writeln('(800 x 600 2 colors [Paradise])');
  103.     $5E : Writeln('(640 x 400 256 colors [Paradise])');
  104.     $5F : Writeln('(640 x 480 256 colors [Paradise])');
  105.     else
  106.       unknown('video mode', xbyte, 2)
  107.   end;
  108.   caption2('Current display page');
  109.   writeln(vidpg);
  110.   caption2('Graphics modes');
  111.   getmoderange(graphdriver, xint1, xint2);
  112.   if graphresult = grok then
  113.     writeln(xint2 + 1 - xint1)
  114.   else
  115.     writeln(0);
  116.   caption2('Video buffer (offset)');
  117.   writeln(hex(memw[BIOSdseg : $004E], 4));
  118.   caption2('Video buffer size (bytes)');
  119.   writeln(memw[BIOSdseg : $004C]);
  120.   caption2('Active display port');
  121.   xword:=memw[BIOSdseg : $0063];
  122.   write('$', hex(xword, 3), ' ');
  123.   if xword = $03B4 then
  124.     writeln('(monochrome)')
  125.   else if xword = $03D4 then
  126.     writeln('(color)')
  127.   else
  128.     dontknow;
  129.   caption2('CRT mode register');
  130.   writeln('$', hex(mem[BIOSdseg : $0065], 2));
  131.   caption2('Current palette');
  132.   writeln('$', hex(mem[BIOSdseg : $0066], 2));
  133.   caption2('Colors');
  134.   caption1('·');
  135.   mono2:=mono;
  136.   mono:=false;
  137.   for i:=black to white do
  138.     begin
  139.     textcolor(i);
  140.     write('█')
  141.     end;
  142.   mono:=mono2;
  143.   caption1('·');
  144.   writeln;
  145.   caption2('Current colors');
  146.   if (attrsave and $80) = $80 then
  147.     write('blinking ');
  148.   showcolor(attrsave and $0F);
  149.   write(' on ');
  150.   showcolor(attrsave and $70 shr 4);
  151.   writeln;
  152.   caption2('Text rows');
  153.   writeln(tlength);
  154.   caption2('Text columns');
  155.   writeln(twidth);
  156.   if graphdriver in [EGA, MCGA, VGA] then begin
  157.     caption2('Scan lines/character');
  158.     with regs do begin
  159.       AX:=$1130;
  160.       BH:=$00;
  161.       intr($10, regs);
  162.       writeln(CX)
  163.     end
  164.   end;
  165.   caption2('Cursor scan lines');
  166.   with regs do begin
  167.     AH:=$03;
  168.     BH:=vidpg;
  169.     intr($10, regs);
  170.     writeln(CH, '-', CL)
  171.   end
  172. end;
  173.