[Back to DOS SWAG index] [Back to Main SWAG index] [Original]

    program BIOS;
    { Compile in real mode only }
    uses
      Dos, Crt;

    const
      Coms:array[0..3] of String= ('Com1: ', 'Com2: ', 'Com3: ', 'Com4: ');
      Lpts:array[0..2] of String= ('Lpt1: ', 'Lpt2: ', 'Lpt3: ');

    type
      PBios = ^TBios;
      TBios = Record
        SerialPortAdd    : Array [0..3] of Word;
        ParallelPortAdd  : Array [0..3] of Word;
        EqptFlags        : Word;
        MfgrTestFlags    : Byte;
        MainMem,
        ExpRam,
        KbdStat          : Word;
        KeyPad           : Byte;
        KbdBuffHead,
        KbdBuffTail      : Word;
        KbdBuff          : Array [0..31] of Char;
        SeekStatus,
        MortotStatus,
        MortoCnt,
        DiskError        : Byte;
        NECStatus        : Array [0..6] of Byte;
        VideoMode        : Byte;
        ScrnWidth,
        VideoBufferSize,
        VideoBufferOfs   : Word;
        CursorPos        : Array [0..7,0..1] of Byte;
        CursorBottom,
        CursorTop,
        ActiveDisplayPage : Byte;
        ActiveDisplayPort : Word;
        CRTModeReg,
        Palette           : Byte;
        DataEdgeTimeCount,
        CRCReg            : Word;
        LastCharInput     : Char;
        Tick              : Word;
        Hour              : Integer;
        TimerOverFlow,
        BrkStatus         : Byte;
        ResetFlag         : Word;
        HardDiskStatus    : LongInt;
        ParallelTimeout,
        SerialTimeout     : Array[0..3] of Byte;
        KbdBufferOfs,
        KbdBufferEnd      : Word;
      End;
      AtBios = Record
        Name : Array[0..164] of Char;
      End;

    var
      SaveAttr: Byte;

    procedure FlushKeyBuffer;
    var
      Recpack : registers;
    begin
      with recpack do begin
        Ax := ($0c shl 8) or 6;
        Dx := $00ff;
      end;
      Intr($21,recpack);
    end;

    Procedure CursorOff; assembler;
    asm
      mov AH, $01;
      mov CH, $20;
      mov CL, $20;
      int $10;
    End;

    procedure CursorSmall;
    Begin
      if LastMode <> CO80 then asm
        mov AH, $01;
        mov CH, 12;
        mov CL, 13;
        int $10;
      end else asm;
        mov AH, $01;
        mov CH, $06;
        mov CL, $07;
        int $10;
      end;
    end;

    function GetHexWord(w: Word): String;
    const
     hexChars: array [0..$F] of Char =
       '0123456789ABCDEF';
    begin
     GetHexWord := hexChars[Hi(w) shr 4] + hexChars[Hi(w) and $F] +
                   hexChars[Lo(w) shr 4] + hexChars[Lo(w) and $F];
    end;

    procedure WriteXY(X, Y: Integer; S: String);
    begin
      GotoXY(X, Y);
      Write(S);
    end;

    procedure WriteXY2(X, Y: Integer; S: String; W: Word);
    begin
      GotoXY(X, Y);
      Write(S);
      Write(W);
    end;

    procedure WriteXY3(X, Y: Integer; S: String; B: Boolean);
    begin
      GotoXY(X, Y);
      Write(S);
      Write(B);
      ClrEOL;
    end;

    procedure WriteData(Ticks: PBios);
    var
      SaveAttr, i: Integer;

    begin
      for i := 0 to 3 do
        WriteXY(1, 1 + i, Coms[i] + GetHexWord(Ticks^.SerialPortAdd[i]));
      for i := 0 to 2 do
        WriteXY(1, 6 + i, Lpts[i] + GetHexWord(Ticks^.ParallelPortAdd[i]));
      WriteLn;
      WriteXY2(1, 10, 'VideoMode: ', Ticks^.VideoMode);
      WriteXY2(1, 11, 'Dos Mem: ', Ticks^.MainMem);
      WriteXY(1, 12, 'Video Card Port Addresss: ' + GetHexWord(Ticks^.ActiveDisplayPort));
      WriteXY2(1, 13, 'Tick: ', Ticks^.Tick);
      WriteXY2(1, 14, 'Hour: ', Ticks^.Hour);
      WriteXY2(1, 15, 'Break Status: ', Ticks^.BrkStatus);
      WriteXY2(1, 16, 'Palette: ', Ticks^.Palette);
      WriteXY3(1, 18, 'Right Shift: ', 0 <> Ticks^.KbdStat and 1);
      WriteXY3(1, 19, 'Left Shift: ', 0 <> Ticks^.KbdStat and 2);
      WriteXY3(1, 20, 'Ctrl : ', 0 <> Ticks^.KbdStat and 4);
      WriteXY3(1, 21, 'Alt: ', 0 <> Ticks^.KbdStat and 8);
      WriteXY3(1, 22, 'Scroll Lock: ', 0 <> Ticks^.KbdStat and 16);
      WriteXY3(1, 23, 'Num Lock: ', 0 <> Ticks^.KbdStat and 32);
      WriteXY3(1, 24, 'Caps Lock: ', 0 <> Ticks^.KbdStat and 64);
    {  WriteXY3(1, 24, 'Insert: ', 0 <> Ticks^.KbdStat and 128); }
      GotoXY(1,25);
      SaveAttr := TextAttr;
      TextAttr := 0 + 7 * 16;
      Write('  Press Shift, Alt, Caps Lock, etc, to see status of keys' +
            '-- Any key to exit    ');
      TextAttr := SaveAttr;
    end;

    procedure Opening;
    begin
      SaveAttr := TextAttr;
      TextAttr := 7 + 1 * 16;
      ClrScr;
      GotoXY(1,25);
      TextAttr := 0 + 7 * 16;
      ClrEOL;
      TextAttr := 11 + 1 * 16;
      CursorOff;
    end;

    var
      Sel : Word;
      Ticks: PBios;
    {  Ticks : TBios Absolute Seg0040; }
    begin
      Opening;
      Ticks := Ptr($0000, $0400);
      repeat
        WriteData(Ticks);
      until KeyPressed;
      CursorSmall;
      FlushKeyBuffer;
      TextAttr := SaveAttr;
    end.

[Back to DOS SWAG index] [Back to Main SWAG index] [Original]