Category : Pascal Source Code
Archive   : INFOS155.ZIP
Filename : PAGE_05.PAS

unit page_05;

interface

uses crt, graph, ifpglobl, ifpcomon, ifpextrn;

procedure page05;

implementation

procedure page05;
const
vidmodes: array [$00..$13] of string[36] = (
'(40 x 25 b/w text)',
'(40 x 25 color text)',
'(80 x 25 b/w text)',
'(80 x 25 color text)',
'(320 x 200 4 colors)',
'(320 x 200 4 colors, no color burst)',
'(640 x 200 2 colors)',
'(MDA text)',
'(160 x 200 16 colors)',
'(320 x 200 16 colors)',
'(640 x 200 4 colors)',
'(reserved)',
'(reserved)',
'(320 x 200 16 colors)',
'(640 x 200 16 colors)',
'(640 x 350 monochrome)',
'(640 x 350 16 colors)',
'(640 x 480 2 colors)',
'(640 x 480 16 colors)',
'(320 x 200 256 colors)');


var
i : byte;
xbyte : byte;
xint1 : integer;
xint2 : integer;
xword : word;
mono2: boolean;

procedure showdisp(a : string; b : byte);
const
dispmons: array [0..$0C] of string[25] = (
'(none)',
'MDA + 5151',
'CGA + 5153/5154',
'(reserved)',
'EGA + 5153/5154',
'EGA 5151',
'PGA + 5175',
'VGA + analog monochrome',
'VGA + analog color',
'(reserved)',
'MCGA + digital color',
'MCGA + digital monochrome',
'MCGA + analog color');

begin
caption2(a);
case b of
$00..$0C: Writeln(dispmons[b]);
$0D..$FE: Writeln('(reserved)');
$FF: dontknow
end;
end; {showdisp}

procedure showcolor(a : byte);
const
colors: array[black..white] of string[13] = (
'black', 'blue', 'green', 'cyan', 'red', 'magenta', 'brown',
'light gray', 'dark gray', 'light blue', 'light green',
'light cyan', 'light red', 'light magenta', 'yellow', 'white');

begin
if a <= white then
Write(colors[a])
else
unknown('color', a, 2)
end; {showcolor}

begin (* procedure page_05 *)
with regs do
begin
AX:=$1A00;
intr($10, regs);
if AL = $1A then
begin
showdisp('Active video subsystem ', BL);
showdisp('Inactive video subsystem', BH)
end
end;
caption2('Initial video mode');
case equip and $0030 of
$0000 : writeln('No display');
$0010 : writeln('40 x 25 color');
$0020 : writeln('80 x 25 color');
$0030 : writeln('80 x 25 monochrome')
end;
caption2('Current video mode');
xbyte:=lo(lastmode);
Write(xbyte, ' ');
if xbyte <= $13 then
Writeln(vidmodes[xbyte])
else
unknown('video mode', xbyte, 2);
caption2('Current display page');
writeln(vidpg);
caption2('Graphics modes');
getmoderange(graphdriver, xint1, xint2);
if graphresult = grok then
writeln(xint2 + 1 - xint1)
else
writeln(0);
caption2('Video buffer (offset)');
writeln(hex(memw[BIOSdseg : $004E], 4));
caption2('Video buffer size (bytes)');
writeln(memw[BIOSdseg : $004C]);
caption2('Active display port');
xword:=memw[BIOSdseg : $0063];
write('$', hex(xword, 3), ' ');
if xword = $03B4 then
writeln('(monochrome)')
else
if xword = $03D4 then
writeln('(color)')
else
dontknow;
caption2('CRT mode register');
writeln('$', hex(mem[BIOSdseg : $0065], 2));
caption2('Current palette');
writeln('$', hex(mem[BIOSdseg : $0066], 2));
caption2('Colors');
caption1('ú');
mono2:=mono;
mono:=false;
for i:=black to white do
begin
textcolor(i);
write('Û')
end;
mono:=mono2;
caption1('ú');
writeln;
caption2('Current colors');
if (attrsave and $80) = $80 then
write('blinking ');
showcolor(attrsave and $0F);
write(' on ');
showcolor(attrsave and $70 shr 4);
writeln;
caption2('Text rows');
writeln(tlength);
caption2('Text columns');
writeln(twidth);
if graphdriver in [EGA, MCGA, VGA] then
begin
caption2('Scan lines/character');
with regs do
begin
AX:=$1130;
BH:=$00;
intr($10, regs);
writeln(CX)
end
end;
caption2('Cursor scan lines');
with regs do
begin
AH:=$03;
BH:=vidpg;
intr($10, regs);
writeln(CH, '-', CL)
end
end;
end.