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