{* Non-Finished Direct Keyboard Unit - by Michael Goddard (cgoddard@ozemail.com.au) *}
Unit Key_Unit;

Interface

Type Key_StatType = Array[0..255] of boolean;
Var {- Status Variables, if true the key is pressed -}
 Key_Stat : ^Key_StatType;
 Key_lShift, Key_rShift, Key_Alt, Key_Ctrl: Boolean;

{ Use these to disable-enable IRQ1 capturing }
Procedure Key_IRQInit;
Procedure Key_IRQDone;

implementation
Uses Dos; {- DOS unit contains Get/SecIntVec procedures -}

var
  Kbd_OIntVec : Procedure; {- Old IRQ1 Handler -}
  OExitProc : Pointer; {- Old ExitProc handler -}

{$F+}
Procedure KeyBoard_IRQ;interrupt; {- IRQ1 Handler -}
Var i : byte;
Begin
 Asm Cli;End; {- Stop interrupt from disturbing us -}
{- Update vars with keyboard input -}
i:=Port[$60];
if i < $80 then {- Key was pressed -}
  Key_Stat^[i]:=True;
if i > $7F then {- Key was released -}
  Key_Stat^[i-$80]:=False;

  inline ($9C); { PUSHF -- Push flags }
  { Call old ISR using saved vector }
  Kbd_OIntVec;

{- Update special vars like Ctrl/Alt/Shifts etc. -}

 if Key_Stat^[42] then Key_lShift := True else Key_lShift := False;
 if Key_Stat^[54] then Key_rShift := True else Key_rShift := False;
 if Key_Stat^[56] then Key_Alt := True else Key_Alt := False;
 if Key_Stat^[29] then Key_Ctrl := True else Key_Ctrl := False;

 Asm Sti;End; {- Start interrupts again -}
End;

Procedure Exit_Proc; {- Restore old IRQ1 on exit and continue with exit procs -}
Begin
  Key_IRQDone;
  ExitProc:=OExitProc;
{  Dispose(Key_Stat);}
End;

Procedure Key_IRQInit; {- Setup IRQ1 Handler -}
begin
  GetIntVec($9,@Kbd_OIntVec);
  SetIntVec($9,Addr(KeyBoard_IRQ));
end;

Procedure Key_IRQDone; {- Restore old IRQ1 Handler -}
begin
  SetIntVec($9,Addr(Kbd_OIntVec));
end;

Begin
  New(Key_Stat);Fillchar(Key_Stat^, 256, 0);
  {- Preset Variables -}
  Key_lShift := False;
  Key_rShift := False;
  Key_Alt := False;
  Key_Ctrl := False;
  {- Insert ISR into keyboard chain -}
  Key_IRQInit;
  {- Insert exit procedure into chain -}
  OExitProc:=ExitProc;
  ExitProc:=@Exit_Proc;
End.
