Programmer 7500/MAX_PROGRAMMERS.iso/INFO/ASM/QWIK41.ZIP/QINITEST.PAS

Pascal/Delphi Source File | 1988-05-01 | 5.5 KB | 184 lines

{ Qinitest.pas - tests your system configuration            ver 4.1, 05-01-88 }

program Qinitest;

uses
  Crt, Qwik;

type
  Str9  = string[ 9];
  Str33 = string[33];

var
  CursorMode:     word absolute $0040:$0060;
  b,OldVideoMode: byte;
  Strng:          string;
  Ch:             char;

{ -- Converts any number into a Binary character string -- }
function DecToBin (Number: longint; Bits: byte): str33;
const
  D2B: array[0..1] of char = '01';
var
  BinStr: Str33;
  Bit:    byte;
begin
  BinStr:='b';
  for Bit:=0 to pred(Bits) do
    BinStr:=D2B[(Number shr Bit) and 1] + BinStr;
  DecToBin:=BinStr;
end;

{ -- Converts any number into a Hex character string -- }
function DecToHex (Number: longint; HexChars: byte): str9;
const
  D2H: array[0..$F] of char = '0123456789ABCDEF';
var
  HexStr:       Str9;
  HexChar,Bits: byte;
begin
  HexStr:='';
  for HexChar:=0 to pred(HexChars) do
    begin
      Bits:=HexChar shl 2;
      HexStr:=D2H[(Number shr Bits) and $F] + HexStr;
    end;
  DecToHex:='$' + HexStr;
end;

procedure DisplayDev (DD: byte);
begin
  case DD of
    $00: Strng:='No display';
    $01: Strng:='MDA with 5151 monochrome';
    $02: Strng:='CGA with 5153/4 color';
    $04: Strng:='EGA with 5153/4 color';
    $05: Strng:='EGA with 5151 monochrome';
    $06: Strng:='PGC with 5175 color';
    $07: Strng:='VGA with analog monochrome';
    $08: Strng:='VGA with analog color';
    $0B: Strng:='MCGA with analog monochrome';
    $0C: Strng:='MCGA with analog color';
  else Strng:='Reserved';
  end; { case }
end;

begin
  OldVideoMode:=VideoMode;
  NormVideo;
  Qfill (1,1,CRTrows,CRTcols,TextAttr,' ');
  Qwrite (1,1,-1,'Which text mode [0,1,2,3,7] ? ');
  GotoRC (1,31);
  repeat
    Ch:=readkey;
  until Ch in ['0'..'3','7'];
  b:=ord(Ch)-ord('0');
  if b<>OldVideoMode then
    begin
      TextMode(b);
      Qinit;
    end;
  CheckSnow:=Qsnow;
  Qfill (1,1,25,CRTcols,TextAttr,' ');
  GotoRC (1,1);
  case CpuID of
    Cpu8086:  Strng:='Intel 8086/88';
    Cpu80186: Strng:='Intel 80186/188';
    Cpu80286: Strng:='Intel 80286';
    Cpu80386: Strng:='Intel 80386';
  end;
  writeln ('CPU ident         = ',Strng);
  case SystemID of
    $FF: Strng:='IBM PC';
    $FE: Strng:='IBM PC XT';
    $FD: Strng:='IBM PCjr';
    $FC: case SubModelID of
           $00: Strng:='IBM PC AT (6 MHz)';
           $01: Strng:='IBM PC AT (8 MHz)';
           $02: Strng:='IBM PC XT (286)';
           $04: Strng:='IBM PS/2 Model 50';
           $05: Strng:='IBM PS/2 Model 60';
         else   Strng:='IBM PS/2 VGA type';
         end;
    $FB: Strng:='IBM PC XT (256/640)';
    $FA: case SubModelID of
           $00: Strng:='IBM PS/2 Model 30';
           $01: Strng:='IBM PS/2 Model 25';
         else   Strng:='IBM PS/2 MCGA type';
         end;
    $F9: Strng:='IBM PC convertible';
    $F8: case SubModelID of
           $00: Strng:='IBM PS/2 Model 80 (16 MHz)';
           $01: Strng:='IBM PS/2 Model 80 (20 MHz)';
         else   Strng:='IBM PS/2 Model 70/80 type';
         end;
  else Strng:='Unknown, not an IBM';
  end;  { case }
  writeln ('System ID         = ',DecToHex(SystemID,2));
  writeln ('SubModel ID       = ',SubModelID);
  writeln ('  ',Strng);
  writeln ('Have PS/2 video   = ',HavePS2);
  writeln ('IBM 3270 PC       = ',Have3270);
  writeln ('Prior video mode  = ',OldVideoMode);
  writeln ('Video mode now    = ',VideoMode);
  writeln ('Wait-for-retrace  = ',Qsnow);
  writeln ('Max page #        = ',MaxPage);

  if Have3270 then
    begin
      writeln ('Disp Dev 3270     = ',DecToHex(ActiveDispDev3270,2));
      case ActiveDispDev3270 of
        $00: Strng:='5151 or 5272 display and adapter';
        $01: Strng:='3295 display and adapter';
        $02: Strng:='5151 or 5272, adapter, XGA graphics';
        $03: Strng:='5279 display, 3270 PC G adapter';
        $04: Strng:='5379 C01 display, 3270 PC GX adapter';
        $05: Strng:='5379 M01 display, 3270 PC GX adapter';
        $FF: Strng:='Unknown, not a 3270 PC';
      else Strng:='Reserved';
      end;
      writeln ('  ',Strng);
    end
  else
    begin
      DisplayDev (ActiveDispDev);
      writeln ('Active Disp Dev   = ',DecToHex(ActiveDispDev,2));
      writeln ('  ',Strng);

      if SystemID=$F9 then
        writeln ('Alt Disp Dev PC Conv = ',DecToHex(AltDispDevPCC,4))
      else
        begin
          DisplayDev (AltDispDev);
          writeln ('Alt Disp Dev      = ',DecToHex(AltDispDev,2));
          writeln ('  ',Strng);
        end;

      writeln ('Hercules model    = ',HercModel);
      case HercModel of
        0: Strng:='No Hercules card';
        1: Strng:='Hercules Graphics Card';
        2: Strng:='Hercules Graphics Card Plus';
        3: Strng:='Hercules InColor Card';
      end;
      writeln ('  ',Strng);
    end;

  writeln ('Cursor start      = ',DecToHex(hi(CursorMode),2));
  writeln ('Cursor end        = ',DecToHex(lo(CursorMode),2));
  writeln ('CRT rows          = ',CRTrows);
  writeln ('CRT columns       = ',CRTcols);
  if (ActiveDispDev>=EgaColor) and (ActiveDispDev<=McgaColor) then
    begin
      writeln ('EGA rows          = ',EgaRows);
      writeln ('EGA FontSize      = ',EgaFontSize);
      writeln ('EGA Info          = ',DecToBin(EgaInfo,8));
      writeln ('EGA Switches      = ',DecToBin(EgaSwitches,8));
    end;
  write ('Press any key...');
  repeat
    Ch:=ReadKey;
  until not KeyPressed;
  TextMode (OldVideoMode);
end.