Topspeed_JPI/TS-V3/SRC/KEYBOARD.LST

Listing:

    1  (* Release 3.10 *)
    2  (*-------------------------------------------------------------------------*
    3  *                                                                          *
    4  *  KEYBOARD.MOD - COMMS Toolkit Keyboard interface                         *
    5  *                                                                          *
    6  *  COPYRIGHT (C) 1988..1992 Clarion Software Corporation.                  *
    7  *  All Rights Reserved                                                     *
    8  *                                                                          *
    9  *--------------------------------------------------------------------------*)
   10  
   11  IMPLEMENTATION MODULE Keyboard;
   12  
   13  (*%F _OS2*)
   14    IMPORT Lib,SYSTEM;
   15  
   16    CONST
   17      KbdDriverInstalled  = FALSE;
   18      KbdInterrupt        = 09H; (* kbd interrupts handler consts *)
   19      KbdDataPort         = 60H;
   20      KbdControlPort      = 61H;
   21      ClrKbdBit           = 7;
   22      KbdQueueSize        = 16;
   23      RightShiftActive    = 0;   (* kbd status word bit numbers *)
   24      LeftShiftActive     = 1;
   25      ControlActive       = 2;
   26      AltActive           = 3;
   27      ScrollLockActive    = 4;
   28      NumLockActive       = 5;
   29      CapsLockActive      = 6;
   30      InsertActive        = 7;
   31      ScrollLockHeld      = 12;
   32      NumLockHeld         = 13;
   33      CapsLockHeld        = 14;
   34      InsertHeld          = 15;
   35      NumLock             = 69; (* SCAN CODES FOR VARIOUS KEYS *)
   36      BreakKey            = 70;
   37      ScrollLock          = 70;
   38      AltKey              = 56;
   39      CtlKey              = 29;
   40      CapsLock            = 58;
   41      LeftShift           = 42;
   42      RightShift          = 54;
   43  
   44    TYPE
   45      Reg                 = RECORD
   46                              CASE : BOOLEAN OF
   47                                TRUE     : X  : CARDINAL;    |
   48                                FALSE    : H  : SHORTCARD;
   49                                           L  : SHORTCARD;   |
   50                              END; (*CASE*)
   51                            END; (*RECORD*)
   52  
   53    VAR (* keyboard stuff *)
   54      KbdFlags [40H:17H]  : BITSET;
   55      (*$W+*)
   56      KbdQueue [40H:1AH]  : RECORD
   57                              rptr,wptr  : CARDINAL;
   58                              Buff       : ARRAY[0..KbdQueueSize-1] OF
   59                                           RECORD
   60                                             key,scan        : CHAR
   61                                           END;
   62                            END;
   63      (*$W-*)
   64      Extended            : BOOLEAN;
   65      OldVect9,OldVect16  : FarADDRESS;
   66      Continue            : PROC;
   67  
   68  (*.............................................*)
   69  
   70    PROCEDURE SetVector(Int:WORD;Addr:FarADDRESS);
   71      VAR
   72        r                 : SYSTEM.Registers;
   73      BEGIN
   74        r.AH := 25H;
   75        r.AL := BYTE(Int);
   76        r.DS := SYSTEM.Seg(Addr^);
   77        r.DX := SYSTEM.Ofs(Addr^);
   78        Lib.Intr(r,21H);     (* DOS Interrupt *)
   79      END SetVector;
   80  
   81  (*.............................................*)
   82  
   83    PROCEDURE GetVector(Int:WORD):FarADDRESS;
   84      VAR
   85        r                 : SYSTEM.Registers;
   86      BEGIN
   87        r.AH := 35H;
   88        r.AL := BYTE(Int);
   89        Lib.Intr(r,21H);      (* DOS Interrupt *)
   90        RETURN [r.ES:r.BX];
   91      END GetVector;
   92  
   93  (*.............................................*)
   94  
   95    PROCEDURE StoreKey(c:CHAR; code:CARDINAL);
   96      VAR
   97        newwptr,capc      : CARDINAL;
   98      BEGIN
   99        WITH KbdQueue DO
  100          newwptr := wptr+2;
  101          IF newwptr=62 THEN
  102            newwptr:=30;
  103          END;
  104          IF newwptr<>rptr THEN
  105            capc := ORD(CAP(c));
  106            IF (ControlActive IN KbdFlags) AND (capc>64) AND (capc<96) THEN
  107              c := CHR(capc-64);
  108            ELSIF (c>='a') AND (c<='z') AND (CapsLockActive IN KbdFlags) THEN
  109              c := CHR(capc)
  110            END;
  111            Buff[(wptr-30)>>1].key := c;
  112            Buff[(wptr-30)>>1].scan := CHR(code);
  113            wptr := newwptr;
  114          ELSE
  115            Lib.Sound(200);
  116            Lib.Delay(50);
  117            Lib.NoSound;
  118          END;
  119        END;
  120      END StoreKey;
  121  
  122  (*.............................................*)
  123  
  124    PROCEDURE Shifted():BOOLEAN;
  125      BEGIN
  126        RETURN KbdFlags*{LeftShiftActive,RightShiftActive}<>{};
  127      END Shifted;
  128  
  129  (*.............................................*)
  130  
  131  (*# save, call(interrupt=>on,reg_saved=>(ax,bx,cx,dx,di,si,ds,es,st1,st2),reg_param=>(),same_ds=>off)*)
  132    (* NB, The interrupt pragma sets up the registers as parameters to the   *)
  133    (*     procedure in the order defined below.  This ollows easy access to *)
  134    (*     the entry registers.                                              *)
  135    PROCEDURE KeyboardInterrupt;
  136      CONST
  137        Row1              = '1234567890-=';
  138        Row1Shifted       = '!"#$%^&*()_+';
  139        Row2              = 'qwertyuiop[]';
  140        Row2Shifted       = 'QWERTYUIOP{}';
  141        Row3              = "asdfghjkl;'`";
  142        Row3Shifted       = 'ASDFGHJKL:@~';
  143        Row4              = '\zxcvbnm,./';
  144        Row4Shifted       = '|ZXCVBNM<>?';
  145        KeyPad            = '789-456+1230.';
  146      VAR
  147        code              : CARDINAL;
  148        ch,resetkb,
  149        kbcontrol         : CHAR;
  150      BEGIN
  151        ch := CHAR(SYSTEM.In(KbdDataPort)); (* read char *)
  152        IF ORD(ch)<128 (* key press *) THEN
  153          code := ORD(ch);
  154          CASE code OF
  155            1             : StoreKey(CHR(27),1);                            |
  156            2..13         : IF AltActive IN KbdFlags THEN
  157                              StoreKey(0C,120+code-2);
  158                            ELSIF Shifted() THEN
  159                              StoreKey(Row1Shifted[code-2],code);
  160                            ELSE
  161                              StoreKey(Row1[code-2],code);
  162                            END;                                            |
  163            14            : IF Shifted() OR (ControlActive IN KbdFlags) THEN
  164                              StoreKey(CHR(127),14)
  165                            ELSE
  166                              StoreKey(CHR(8),14);
  167                            END;                                            |
  168            15            : IF Shifted() THEN
  169                              StoreKey(0C,15)
  170                            ELSE
  171                              StoreKey(CHR(9),15)
  172                            END;                                            |
  173            16..27        : IF AltActive IN KbdFlags THEN
  174                              StoreKey(0C,code)
  175                            ELSIF Shifted() THEN
  176                              StoreKey(Row2Shifted[code-16],code)
  177                            ELSE
  178                              StoreKey(Row2[code-16],code)
  179                            END;                                            |
  180            28            : IF ControlActive IN KbdFlags THEN
  181                              ch := CHR(10)
  182                            ELSE
  183                              ch := CHR(13)
  184                            END;
  185                            StoreKey(ch,28);                                |
  186            CtlKey        : INCL(KbdFlags,ControlActive)                    |
  187            30..41        : IF AltActive IN KbdFlags THEN
  188                              StoreKey(0C,code)
  189                            ELSIF Shifted() THEN
  190                              StoreKey(Row3Shifted[code-30],code)
  191                            ELSE
  192                              StoreKey(Row3[code-30],code)
  193                            END;                                            |
  194            LeftShift     : INCL(KbdFlags,LeftShiftActive);                 |
  195            43..53        : IF AltActive IN KbdFlags THEN
  196                              StoreKey(0C,code)
  197                            ELSIF Shifted() THEN
  198                              StoreKey(Row4Shifted[code-43],code)
  199                            ELSE
  200                              StoreKey(Row4[code-43],code)
  201                            END;                                            |
  202            RightShift    : INCL(KbdFlags,RightShiftActive);                |
  203            55            : StoreKey('*',55);                               |
  204            AltKey        : INCL(KbdFlags,AltActive);                       |
  205            57            : StoreKey(' ',57);                               |
  206            CapsLock      : KbdFlags := KbdFlags/{CapsLockActive};
  207                            INCL(KbdFlags,CapsLockHeld);                    |
  208            59..68        : IF AltActive IN KbdFlags THEN
  209                              StoreKey(0C,code+45)
  210                            ELSIF ControlActive IN KbdFlags THEN
  211                              StoreKey(0C,code+35)
  212                            ELSIF Shifted() THEN
  213                              StoreKey(0C,code+25)
  214                            ELSE
  215                              StoreKey(0C,code);
  216                            END;                                            |
  217            NumLock,
  218            BreakKey      : IF AltActive IN KbdFlags THEN
  219                              StoreKey(0C,code);
  220                            END;                                            |
  221            71..83        : IF KbdFlags*{AltActive,ControlActive}<>{} THEN
  222                              StoreKey(0C,code+62)
  223                            ELSIF Shifted() THEN
  224                              StoreKey(KeyPad[code-71],code)
  225                            ELSE
  226                              IF code=82 THEN
  227                                KbdFlags := KbdFlags/{InsertActive};
  228                                INCL(KbdFlags,InsertHeld);
  229                              END;
  230                              StoreKey(0C,code);
  231                            END;                                            |
  232            ELSE
  233              StoreKey(0C,code);
  234            END
  235          ELSE
  236            ch := CHR(ORD(ch)-128); (* KEY RELEASE *)
  237            CASE ORD(ch) OF
  238              AltKey      : EXCL(KbdFlags,AltActive);                       |
  239              CtlKey      : EXCL(KbdFlags,ControlActive);                   |
  240              LeftShift   : EXCL(KbdFlags,LeftShiftActive);                 |
  241              RightShift  : EXCL(KbdFlags,RightShiftActive);                |
  242              CapsLock    : EXCL(KbdFlags,CapsLockHeld);                    |
  243              82          : EXCL(KbdFlags,InsertHeld);                      |
  244            END;
  245          END;
  246          kbcontrol := CHAR(SYSTEM.In(KbdControlPort));
  247          resetkb := CHR(CARDINAL(BITSET(ORD(kbcontrol))+{ClrKbdBit}));
  248          SYSTEM.Out(KbdControlPort,SHORTCARD(resetkb));
  249          SYSTEM.Out(KbdControlPort,SHORTCARD(kbcontrol));
  250          SYSTEM.Out(20H,20H); (* send EOI to interrupt controller *)
  251        END KeyboardInterrupt;
  252  (*# restore *)
  253  
  254  (*.............................................*)
  255  
  256    PROCEDURE RdKey():CHAR;
  257      VAR
  258        c                 : CHAR;
  259        R                 : SYSTEM.Registers;
  260      BEGIN
  261        IF Extended THEN
  262          c := ScanCode;
  263          Extended:=FALSE
  264        ELSE
  265          IF KbdDriverInstalled THEN
  266            WITH KbdQueue DO
  267              WHILE rptr=wptr DO
  268                (* Wait for keypress *)
  269              END;
  270              WITH Buff[(rptr-30)>>1] DO
  271                c := key;
  272                ScanCode := scan;
  273              END;
  274              rptr := rptr+2;
  275              IF rptr=62 THEN
  276                rptr:=30;
  277              END;
  278            END;
  279          ELSE
  280            R.AH := 0;
  281            Lib.Intr(R,16H);
  282            IF R.AX=0 THEN END; (* break *) (* --- ??? --- *)
  283            c := CHR(R.AL);
  284            ScanCode := CHR(R.AH);
  285          END;
  286        END;
  287        Extended := c=0C;
  288        RETURN c;
  289      END RdKey;
  290  
  291  (*.............................................*)
  292  
  293    PROCEDURE KeyPressed():BOOLEAN;
  294      VAR
  295        R                 : SYSTEM.Registers;
  296      BEGIN
  297        IF Extended THEN
  298          RETURN TRUE;
  299        END;
  300        IF KbdDriverInstalled THEN
  301          RETURN KbdQueue.rptr<>KbdQueue.wptr;
  302        ELSE
  303          R.AH := 1;
  304          Lib.Intr(R,16H);
  305          RETURN NOT (SYSTEM.ZeroFlag IN R.Flags) ;
  306        END;
  307      END KeyPressed;
  308  
  309  (*.............................................*)
  310  
  311  (*# save, call(interrupt=>on,reg_saved=>(ax,bx,cx,dx,di,si,ds,es,st1,st2),reg_param=>(),same_ds=>off)*)
  312    (* NB, The interrupt pragma sets up the registers as parameters to the   *)
  313    (*     procedure in the order defined below.  This ollows easy access to *)
  314    (*     the entry registers.                                              *)
  315    PROCEDURE BiosKbd(Flags:BITSET;CS,IP:CARDINAL;A,C,D,B:Reg;SP,BP,SI,DI,DS,ES:CARDINAL);
  316      BEGIN
  317        SYSTEM.EI;
  318        IF A.H = 0 THEN      (* Read keyboard *)
  319          A.L := SHORTCARD(RdKey());
  320          A.H  := SHORTCARD(ScanCode);
  321          Extended := FALSE;
  322        ELSIF A.H=1 THEN (* Keypressed *)
  323          WITH KbdQueue DO
  324            IF rptr=wptr THEN (* No key ready *)
  325              INCL(Flags,SYSTEM.ZeroFlag);
  326            ELSE
  327              EXCL(Flags,SYSTEM.ZeroFlag);
  328              WITH Buff[(rptr-30)>>1] DO
  329                A.L := SHORTCARD(key);
  330                A.H := SHORTCARD(scan);
  331              END;
  332            END;
  333          END;
  334        ELSIF A.H=2 THEN (* Get Shift Status *)
  335          A.L := SHORTCARD(CARDINAL(KbdFlags) MOD 100H);
  336        END;
  337      END BiosKbd;
  338  (*# restore *)
  339  
  340  (*.............................................*)
  341  
  342    PROCEDURE TermProc;
  343      BEGIN
  344        SYSTEM.DI;
  345        SetVector(KbdInterrupt,OldVect9);
  346        SetVector(16H,OldVect16);
  347        SYSTEM.EI;
  348        Continue();
  349      END TermProc;
  350  
  351  (*.............................................*)
  352  
  353    BEGIN (* KeyBoard *)
  354      Extended := FALSE;
  355      IF KbdDriverInstalled THEN
  356        OldVect9 := GetVector(KbdInterrupt);
  357        OldVect16 := GetVector(16H);
  358        SYSTEM.DI;
  359        SetVector(KbdInterrupt,FarADR(KeyboardInterrupt));
  360        SetVector(16H,FarADR(BiosKbd));
  361        SYSTEM.EI;
  362        Lib.Terminate(TermProc,Continue);
  363      END;
  364    END Keyboard.
  365  (*%E*)
  366  (*%T _OS2*)
  367  (* OS/2 version *)
  368    IMPORT Kbd;
  369  
  370    VAR
  371      Extended            : BOOLEAN;
  372  
  373    PROCEDURE RdKey() : CHAR;
  374      VAR
  375        k                 : Kbd.KEYINFO;
*****                                ^ not supported yet
  376        r                 : CARDINAL;
  377      BEGIN
  378        IF Extended THEN
  379          Extended := FALSE;
  380          RETURN ScanCode;
*****                 ^ undeclared identifier
  381        ELSE
  382          r := Kbd.CharIn(k,Kbd.IO_WAIT,0);
*****               ^ not supported yet
*****                   ^ not supported yet
*****                          ^ not supported yet
*****                            ^ not supported yet
*****                                ^ not supported yet
*****                                         ^ not supported yet
  383          IF (k.char=0C) OR (k.char=CHR(0E0H)) THEN
*****              ^ not supported yet
*****                ^ not supported yet
*****                             ^ not supported yet
*****                               ^ not supported yet
*****                                    ^ undeclared identifier
*****                                            ^ not supported yet
  384            ScanCode := CHAR(k.scan);
*****            ^ undeclared identifier
*****                             ^ not supported yet
*****                               ^ not supported yet
  385            k.char := 0C;
*****            ^ not supported yet
*****              ^ not supported yet
  386            Extended := TRUE;
  387          END;
  388          RETURN (k.char);
*****                  ^ not supported yet
*****                    ^ not supported yet
  389        END;
  390      END RdKey;
*****          ^ not supported yet
  391  
  392    PROCEDURE KeyPressed():BOOLEAN;
  393      VAR
  394        r                 : CARDINAL;
  395        k                 : Kbd.KEYINFO;
*****                                ^ not supported yet
  396      BEGIN
  397        IF Extended THEN
  398          RETURN TRUE;
  399        ELSE
  400          k.char := 0C;
*****          ^ not supported yet
*****            ^ not supported yet
  401          k.scan := 0;
*****          ^ not supported yet
*****            ^ not supported yet
  402          k.nlsShift := 0;
*****          ^ not supported yet
*****            ^ not supported yet
  403          r := Kbd.Peek(k,0);
*****               ^ not supported yet
*****                   ^ not supported yet
*****                        ^ not supported yet
*****                           ^ not supported yet
  404          RETURN (k.scan#0) OR (k.char#0C);
*****                  ^ not supported yet
*****                    ^ not supported yet
*****                                ^ not supported yet
*****                                  ^ not supported yet
  405        END;
  406      END KeyPressed;
*****          ^ not supported yet
  407  
  408    BEGIN
  409      Extended := FALSE;
  410    END Keyboard.
*****        ^ not supported yet
  411  
  412  (*%E*)

   39 errors