Topspeed_JPI/TS/SRC/KEYBOARD.MOD

(* Release 3.10 *)
(*-------------------------------------------------------------------------*
*                                                                          *
*  KEYBOARD.MOD - COMMS Toolkit Keyboard interface                         *
*                                                                          *
*  COPYRIGHT (C) 1988..1992 Clarion Software Corporation.                  *
*  All Rights Reserved                                                     *
*                                                                          *
*--------------------------------------------------------------------------*)

IMPLEMENTATION MODULE Keyboard;

(*%F _OS2*)
  IMPORT Lib,SYSTEM;

  CONST
    KbdDriverInstalled  = FALSE;
    KbdInterrupt        = 09H; (* kbd interrupts handler consts *)
    KbdDataPort         = 60H;
    KbdControlPort      = 61H;
    ClrKbdBit           = 7;
    KbdQueueSize        = 16;
    RightShiftActive    = 0;   (* kbd status word bit numbers *)
    LeftShiftActive     = 1;
    ControlActive       = 2;
    AltActive           = 3;
    ScrollLockActive    = 4;
    NumLockActive       = 5;
    CapsLockActive      = 6;
    InsertActive        = 7;
    ScrollLockHeld      = 12;
    NumLockHeld         = 13;
    CapsLockHeld        = 14;
    InsertHeld          = 15;
    NumLock             = 69; (* SCAN CODES FOR VARIOUS KEYS *)
    BreakKey            = 70;
    ScrollLock          = 70;
    AltKey              = 56;
    CtlKey              = 29;
    CapsLock            = 58;
    LeftShift           = 42;
    RightShift          = 54;

  TYPE
    Reg                 = RECORD
                            CASE : BOOLEAN OF
                              TRUE     : X  : CARDINAL;    |
                              FALSE    : H  : SHORTCARD;
                                         L  : SHORTCARD;   |
                            END; (*CASE*)
                          END; (*RECORD*)

  VAR (* keyboard stuff *)
    KbdFlags [40H:17H]  : BITSET;
    (*$W+*)
    KbdQueue [40H:1AH]  : RECORD
                            rptr,wptr  : CARDINAL;
                            Buff       : ARRAY[0..KbdQueueSize-1] OF
                                         RECORD
                                           key,scan        : CHAR
                                         END;
                          END;
    (*$W-*)
    Extended            : BOOLEAN;
    OldVect9,OldVect16  : FarADDRESS;
    Continue            : PROC;

(*.............................................*)

  PROCEDURE SetVector(Int:WORD;Addr:FarADDRESS);
    VAR
      r                 : SYSTEM.Registers;
    BEGIN
      r.AH := 25H;
      r.AL := BYTE(Int);
      r.DS := SYSTEM.Seg(Addr^);
      r.DX := SYSTEM.Ofs(Addr^);
      Lib.Intr(r,21H);     (* DOS Interrupt *)
    END SetVector;

(*.............................................*)

  PROCEDURE GetVector(Int:WORD):FarADDRESS;
    VAR
      r                 : SYSTEM.Registers;
    BEGIN
      r.AH := 35H;
      r.AL := BYTE(Int);
      Lib.Intr(r,21H);      (* DOS Interrupt *)
      RETURN [r.ES:r.BX];
    END GetVector;

(*.............................................*)

  PROCEDURE StoreKey(c:CHAR; code:CARDINAL);
    VAR
      newwptr,capc      : CARDINAL;
    BEGIN
      WITH KbdQueue DO
        newwptr := wptr+2;
        IF newwptr=62 THEN
          newwptr:=30;
        END;
        IF newwptr<>rptr THEN
          capc := ORD(CAP(c));
          IF (ControlActive IN KbdFlags) AND (capc>64) AND (capc<96) THEN
            c := CHR(capc-64);
          ELSIF (c>='a') AND (c<='z') AND (CapsLockActive IN KbdFlags) THEN
            c := CHR(capc)
          END;
          Buff[(wptr-30)>>1].key := c;
          Buff[(wptr-30)>>1].scan := CHR(code);
          wptr := newwptr;
        ELSE
          Lib.Sound(200);
          Lib.Delay(50);
          Lib.NoSound;
        END;
      END;
    END StoreKey;

(*.............................................*)

  PROCEDURE Shifted():BOOLEAN;
    BEGIN
      RETURN KbdFlags*{LeftShiftActive,RightShiftActive}<>{};
    END Shifted;

(*.............................................*)

(*# save, call(interrupt=>on,reg_saved=>(ax,bx,cx,dx,di,si,ds,es,st1,st2),reg_param=>(),same_ds=>off)*)
  (* NB, The interrupt pragma sets up the registers as parameters to the   *)
  (*     procedure in the order defined below.  This ollows easy access to *)
  (*     the entry registers.                                              *)
  PROCEDURE KeyboardInterrupt;
    CONST
      Row1              = '1234567890-=';
      Row1Shifted       = '!"#$%^&*()_+';
      Row2              = 'qwertyuiop[]';
      Row2Shifted       = 'QWERTYUIOP{}';
      Row3              = "asdfghjkl;'`";
      Row3Shifted       = 'ASDFGHJKL:@~';
      Row4              = '\zxcvbnm,./';
      Row4Shifted       = '|ZXCVBNM<>?';
      KeyPad            = '789-456+1230.';
    VAR
      code              : CARDINAL;
      ch,resetkb,
      kbcontrol         : CHAR;
    BEGIN
      ch := CHAR(SYSTEM.In(KbdDataPort)); (* read char *)
      IF ORD(ch)<128 (* key press *) THEN
        code := ORD(ch);
        CASE code OF
          1             : StoreKey(CHR(27),1);                            |
          2..13         : IF AltActive IN KbdFlags THEN
                            StoreKey(0C,120+code-2);
                          ELSIF Shifted() THEN
                            StoreKey(Row1Shifted[code-2],code);
                          ELSE
                            StoreKey(Row1[code-2],code);
                          END;                                            |
          14            : IF Shifted() OR (ControlActive IN KbdFlags) THEN
                            StoreKey(CHR(127),14)
                          ELSE
                            StoreKey(CHR(8),14);
                          END;                                            |
          15            : IF Shifted() THEN
                            StoreKey(0C,15)
                          ELSE
                            StoreKey(CHR(9),15)
                          END;                                            |
          16..27        : IF AltActive IN KbdFlags THEN
                            StoreKey(0C,code)
                          ELSIF Shifted() THEN
                            StoreKey(Row2Shifted[code-16],code)
                          ELSE
                            StoreKey(Row2[code-16],code)
                          END;                                            |
          28            : IF ControlActive IN KbdFlags THEN
                            ch := CHR(10)
                          ELSE
                            ch := CHR(13)
                          END;
                          StoreKey(ch,28);                                |
          CtlKey        : INCL(KbdFlags,ControlActive)                    |
          30..41        : IF AltActive IN KbdFlags THEN
                            StoreKey(0C,code)
                          ELSIF Shifted() THEN
                            StoreKey(Row3Shifted[code-30],code)
                          ELSE
                            StoreKey(Row3[code-30],code)
                          END;                                            |
          LeftShift     : INCL(KbdFlags,LeftShiftActive);                 |
          43..53        : IF AltActive IN KbdFlags THEN
                            StoreKey(0C,code)
                          ELSIF Shifted() THEN
                            StoreKey(Row4Shifted[code-43],code)
                          ELSE
                            StoreKey(Row4[code-43],code)
                          END;                                            |
          RightShift    : INCL(KbdFlags,RightShiftActive);                |
          55            : StoreKey('*',55);                               |
          AltKey        : INCL(KbdFlags,AltActive);                       |
          57            : StoreKey(' ',57);                               |
          CapsLock      : KbdFlags := KbdFlags/{CapsLockActive};
                          INCL(KbdFlags,CapsLockHeld);                    |
          59..68        : IF AltActive IN KbdFlags THEN
                            StoreKey(0C,code+45)
                          ELSIF ControlActive IN KbdFlags THEN
                            StoreKey(0C,code+35)
                          ELSIF Shifted() THEN
                            StoreKey(0C,code+25)
                          ELSE
                            StoreKey(0C,code);
                          END;                                            |
          NumLock,
          BreakKey      : IF AltActive IN KbdFlags THEN
                            StoreKey(0C,code);
                          END;                                            |
          71..83        : IF KbdFlags*{AltActive,ControlActive}<>{} THEN
                            StoreKey(0C,code+62)
                          ELSIF Shifted() THEN
                            StoreKey(KeyPad[code-71],code)
                          ELSE
                            IF code=82 THEN
                              KbdFlags := KbdFlags/{InsertActive};
                              INCL(KbdFlags,InsertHeld);
                            END;
                            StoreKey(0C,code);
                          END;                                            |
          ELSE
            StoreKey(0C,code);
          END
        ELSE
          ch := CHR(ORD(ch)-128); (* KEY RELEASE *)
          CASE ORD(ch) OF
            AltKey      : EXCL(KbdFlags,AltActive);                       |
            CtlKey      : EXCL(KbdFlags,ControlActive);                   |
            LeftShift   : EXCL(KbdFlags,LeftShiftActive);                 |
            RightShift  : EXCL(KbdFlags,RightShiftActive);                |
            CapsLock    : EXCL(KbdFlags,CapsLockHeld);                    |
            82          : EXCL(KbdFlags,InsertHeld);                      |
          END;
        END;
        kbcontrol := CHAR(SYSTEM.In(KbdControlPort));
        resetkb := CHR(CARDINAL(BITSET(ORD(kbcontrol))+{ClrKbdBit}));
        SYSTEM.Out(KbdControlPort,SHORTCARD(resetkb));
        SYSTEM.Out(KbdControlPort,SHORTCARD(kbcontrol));
        SYSTEM.Out(20H,20H); (* send EOI to interrupt controller *)
      END KeyboardInterrupt;
(*# restore *)

(*.............................................*)

  PROCEDURE RdKey():CHAR;
    VAR
      c                 : CHAR;
      R                 : SYSTEM.Registers;
    BEGIN
      IF Extended THEN
        c := ScanCode;
        Extended:=FALSE
      ELSE
        IF KbdDriverInstalled THEN
          WITH KbdQueue DO
            WHILE rptr=wptr DO
              (* Wait for keypress *)
            END;
            WITH Buff[(rptr-30)>>1] DO
              c := key;
              ScanCode := scan;
            END;
            rptr := rptr+2;
            IF rptr=62 THEN
              rptr:=30;
            END;
          END;
        ELSE
          R.AH := 0;
          Lib.Intr(R,16H);
          IF R.AX=0 THEN END; (* break *) (* --- ??? --- *)
          c := CHR(R.AL);
          ScanCode := CHR(R.AH);
        END;
      END;
      Extended := c=0C;
      RETURN c;
    END RdKey;

(*.............................................*)

  PROCEDURE KeyPressed():BOOLEAN;
    VAR
      R                 : SYSTEM.Registers;
    BEGIN
      IF Extended THEN
        RETURN TRUE;
      END;
      IF KbdDriverInstalled THEN
        RETURN KbdQueue.rptr<>KbdQueue.wptr;
      ELSE
        R.AH := 1;
        Lib.Intr(R,16H);
        RETURN NOT (SYSTEM.ZeroFlag IN R.Flags) ;
      END;
    END KeyPressed;

(*.............................................*)

(*# save, call(interrupt=>on,reg_saved=>(ax,bx,cx,dx,di,si,ds,es,st1,st2),reg_param=>(),same_ds=>off)*)
  (* NB, The interrupt pragma sets up the registers as parameters to the   *)
  (*     procedure in the order defined below.  This ollows easy access to *)
  (*     the entry registers.                                              *)
  PROCEDURE BiosKbd(Flags:BITSET;CS,IP:CARDINAL;A,C,D,B:Reg;SP,BP,SI,DI,DS,ES:CARDINAL);
    BEGIN
      SYSTEM.EI;
      IF A.H = 0 THEN      (* Read keyboard *)
        A.L := SHORTCARD(RdKey());
        A.H  := SHORTCARD(ScanCode);
        Extended := FALSE;
      ELSIF A.H=1 THEN (* Keypressed *)
        WITH KbdQueue DO
          IF rptr=wptr THEN (* No key ready *)
            INCL(Flags,SYSTEM.ZeroFlag);
          ELSE
            EXCL(Flags,SYSTEM.ZeroFlag);
            WITH Buff[(rptr-30)>>1] DO
              A.L := SHORTCARD(key);
              A.H := SHORTCARD(scan);
            END;
          END;
        END;
      ELSIF A.H=2 THEN (* Get Shift Status *)
        A.L := SHORTCARD(CARDINAL(KbdFlags) MOD 100H);
      END;
    END BiosKbd;
(*# restore *)

(*.............................................*)

  PROCEDURE TermProc;
    BEGIN
      SYSTEM.DI;
      SetVector(KbdInterrupt,OldVect9);
      SetVector(16H,OldVect16);
      SYSTEM.EI;
      Continue();
    END TermProc;

(*.............................................*)

  BEGIN (* KeyBoard *)
    Extended := FALSE;
    IF KbdDriverInstalled THEN
      OldVect9 := GetVector(KbdInterrupt);
      OldVect16 := GetVector(16H);
      SYSTEM.DI;
      SetVector(KbdInterrupt,FarADR(KeyboardInterrupt));
      SetVector(16H,FarADR(BiosKbd));
      SYSTEM.EI;
      Lib.Terminate(TermProc,Continue);
    END;
  END Keyboard.
(*%E*)
(*%T _OS2*)
(* OS/2 version *)
  IMPORT Kbd;

  VAR
    Extended            : BOOLEAN;

  PROCEDURE RdKey() : CHAR;
    VAR
      k                 : Kbd.KEYINFO;
      r                 : CARDINAL;
    BEGIN
      IF Extended THEN
        Extended := FALSE;
        RETURN ScanCode;
      ELSE
        r := Kbd.CharIn(k,Kbd.IO_WAIT,0);
        IF (k.char=0C) OR (k.char=CHR(0E0H)) THEN
          ScanCode := CHAR(k.scan);
          k.char := 0C;
          Extended := TRUE;
        END;
        RETURN (k.char);
      END;
    END RdKey;

  PROCEDURE KeyPressed():BOOLEAN;
    VAR
      r                 : CARDINAL;
      k                 : Kbd.KEYINFO;
    BEGIN
      IF Extended THEN
        RETURN TRUE;
      ELSE
        k.char := 0C;
        k.scan := 0;
        k.nlsShift := 0;
        r := Kbd.Peek(k,0);
        RETURN (k.scan#0) OR (k.char#0C);
      END;
    END KeyPressed;

  BEGIN
    Extended := FALSE;
  END Keyboard.

(*%E*)