|
|
1.1 ! root 1: \ ***************************************************************************** ! 2: \ * Copyright (c) 2004, 2008 IBM Corporation ! 3: \ * All rights reserved. ! 4: \ * This program and the accompanying materials ! 5: \ * are made available under the terms of the BSD License ! 6: \ * which accompanies this distribution, and is available at ! 7: \ * http://www.opensource.org/licenses/bsd-license.php ! 8: \ * ! 9: \ * Contributors: ! 10: \ * IBM Corporation - initial implementation ! 11: \ ****************************************************************************/ ! 12: ! 13: ! 14: s" keyboard" device-name ! 15: s" keyboard" device-type ! 16: ! 17: ." USB Keyboard" cr ! 18: ! 19: 3 encode-int s" assigned-addresses" property ! 20: 1 encode-int s" reg" property ! 21: 1 encode-int s" configuration#" property ! 22: s" EN" encode-string s" language" property ! 23: ! 24: 1 constant NumLk ! 25: 2 constant CapsLk ! 26: 4 constant ScrLk ! 27: ! 28: 00 value kbd-addr ! 29: to kbd-addr \ save speed bit ! 30: 8 value mps-dcp ! 31: 8 constant DEFAULT-CONTROL-MPS ! 32: 8 chars alloc-mem value setup-packet ! 33: 8 chars alloc-mem value kbd-report ! 34: 4 chars alloc-mem value multi-key ! 35: 0 value cfg-buffer ! 36: 0 value led-state ! 37: 0 value temp1 ! 38: 0 value temp2 ! 39: 0 value temp3 ! 40: 0 value ret ! 41: 0 value scancode ! 42: 0 value kbd-shift ! 43: 0 value kbd-scan ! 44: 0 value key-old ! 45: 0 value expire-ms ! 46: 0 value mps-int-in ! 47: 0 value int-in-ep ! 48: 0 value int-in-toggle ! 49: ! 50: kbd-addr \ give speed bit to include file ! 51: s" usb-kbd-device-support.fs" included ! 52: ! 53: : control-cls-set-report ( reportvalue FuncAddr -- TRUE|FALSE ) ! 54: to temp1 ! 55: to temp2 ! 56: 2109000200000100 setup-packet ! ! 57: temp2 kbd-data l!-le ! 58: 1 kbd-data 1 setup-packet DEFAULT-CONTROL-MPS temp1 controlxfer ! 59: ; ! 60: ! 61: : control-cls-get-report ( data-buffer data-len MPS FuncAddr -- TRUE|FALSE ) ! 62: to temp1 ! 63: to temp2 ! 64: to temp3 ! 65: a101000100000000 setup-packet ! ! 66: temp3 setup-packet 6 + w!-le ! 67: 0 swap temp3 setup-packet temp2 temp1 controlxfer ! 68: ; ! 69: ! 70: : int-get-report ( -- ) \ get report for interrupt transfer ! 71: 0 2 int-in-toggle kbd-report 8 mps-int-in ! 72: kbd-addr int-in-ep 7 lshift or rw-endpoint \ get report ! 73: swap to int-in-toggle if ! 74: kbd-report @ ff00000000000000 and 38 rshift to kbd-shift \ store shift status ! 75: kbd-report @ 0000ffffffffffff and to kbd-scan \ store scan codes ! 76: else ! 77: 0 to kbd-shift \ clear shift status ! 78: 0 to kbd-scan \ clear scan code buffer ! 79: then ! 80: ; ! 81: ! 82: : ctl-get-report ( -- ) \ get report for control transfer ! 83: kbd-report 8 8 kbd-addr control-cls-get-report if \ get report ! 84: kbd-report @ ff00000000000000 and 38 rshift to kbd-shift \ store shift status ! 85: kbd-report @ 0000ffffffffffff and to kbd-scan \ store scan codes ! 86: else ! 87: 0 to kbd-shift \ clear shift status ! 88: 0 to kbd-scan \ clear scan code buffer ! 89: then ! 90: ; ! 91: ! 92: : set-led ( led -- ) ! 93: dup to led-state ! 94: kbd-addr control-cls-set-report drop ! 95: ; ! 96: ! 97: : is-shift ( -- true|false ) ! 98: kbd-shift 22 and if ! 99: true ! 100: else ! 101: false ! 102: then ! 103: ; ! 104: ! 105: : is-alt ( -- true|false ) ! 106: kbd-shift 44 and if ! 107: true ! 108: else ! 109: false ! 110: then ! 111: ; ! 112: ! 113: : is-ctrl ( -- true|false ) ! 114: kbd-shift 11 and if ! 115: true ! 116: else ! 117: false ! 118: then ! 119: ; ! 120: ! 121: : ctrl_alt_del_key ( char -- ) ! 122: is-ctrl if \ ctrl is pressed? ! 123: is-alt if \ alt is pressed? ! 124: 4c = if \ del is pressed? ! 125: s" reboot.... " usb-debug-print ! 126: \ reset-all \ reboot ! 127: drop false \ invalidate del key on top of stack ! 128: then ! 129: false \ dummy for last drop ! 130: then ! 131: then ! 132: drop \ clear stack ! 133: ; ! 134: ! 135: : get-ukbd-char ( ScanCode -- char|false ) ! 136: dup ctrl_alt_del_key \ check ctrl+alt+del ! 137: dup to scancode \ store scan code ! 138: case \ translate scan code --> char ! 139: 04 of [char] a endof ! 140: 05 of [char] b endof ! 141: 06 of [char] c endof ! 142: 07 of [char] d endof ! 143: 08 of [char] e endof ! 144: 09 of [char] f endof ! 145: 0a of [char] g endof ! 146: 0b of [char] h endof ! 147: 0c of [char] i endof ! 148: 0d of [char] j endof ! 149: 0e of [char] k endof ! 150: 0f of [char] l endof ! 151: 10 of [char] m endof ! 152: 11 of [char] n endof ! 153: 12 of [char] o endof ! 154: 13 of [char] p endof ! 155: 14 of [char] q endof ! 156: 15 of [char] r endof ! 157: 16 of [char] s endof ! 158: 17 of [char] t endof ! 159: 18 of [char] u endof ! 160: 19 of [char] v endof ! 161: 1a of [char] w endof ! 162: 1b of [char] x endof ! 163: 1c of [char] y endof ! 164: 1d of [char] z endof ! 165: 1e of [char] 1 endof ! 166: 1f of [char] 2 endof ! 167: 20 of [char] 3 endof ! 168: 21 of [char] 4 endof ! 169: 22 of [char] 5 endof ! 170: 23 of [char] 6 endof ! 171: 24 of [char] 7 endof ! 172: 25 of [char] 8 endof ! 173: 26 of [char] 9 endof ! 174: 27 of [char] 0 endof ! 175: 28 of 0d endof \ Enter ! 176: 29 of 1b endof \ ESC ! 177: 2a of 08 endof \ Backsace ! 178: 2b of 09 endof \ Tab ! 179: 2c of 20 endof \ Space ! 180: 2d of [char] - endof ! 181: 2e of [char] = endof ! 182: 2f of [char] [ endof ! 183: 30 of [char] ] endof ! 184: 31 of [char] \ endof ! 185: 33 of [char] ; endof ! 186: 34 of [char] ' endof ! 187: 35 of [char] ` endof ! 188: 36 of [char] , endof ! 189: 37 of [char] . endof ! 190: 38 of [char] / endof ! 191: 39 of led-state CapsLk xor set-led false endof \ CapsLk ! 192: 3a of 1b 7e31315b to multi-key endof \ F1 ! 193: 3b of 1b 7e32315b to multi-key endof \ F2 ! 194: 3c of 1b 7e33315b to multi-key endof \ F3 ! 195: 3d of 1b 7e34315b to multi-key endof \ F4 ! 196: 3e of 1b 7e35315b to multi-key endof \ F5 ! 197: 3f of 1b 7e37315b to multi-key endof \ F6 ! 198: 40 of 1b 7e38315b to multi-key endof \ F7 ! 199: 41 of 1b 7e39315b to multi-key endof \ F8 ! 200: 42 of 1b 7e30315b to multi-key endof \ F9 ! 201: 43 of 1b 7e31315b to multi-key endof \ F10 ! 202: 44 of 1b 7e33315b to multi-key endof \ F11 ! 203: 45 of 1b 7e34315b to multi-key endof \ F12 ! 204: 47 of led-state ScrLk xor set-led false endof \ ScrLk ! 205: 49 of 1b 7e315b to multi-key endof \ Ins ! 206: 4a of 1b 7e325b to multi-key endof \ Home ! 207: 4b of 1b 7e335b to multi-key endof \ PgUp ! 208: 4c of 1b 7e345b to multi-key endof \ Del ! 209: 4d of 1b 7e355b to multi-key endof \ End ! 210: 4e of 1b 7e365b to multi-key endof \ PgDn ! 211: 4f of 1b 435b to multi-key endof \ R-arrow ! 212: 50 of 1b 445b to multi-key endof \ L-arrow ! 213: 51 of 1b 425b to multi-key endof \ D-arrow ! 214: 52 of 1b 415b to multi-key endof \ U-arrow ! 215: 53 of led-state NumLk xor set-led false endof \ NumLk ! 216: 54 of [char] / endof \ keypad / ! 217: 55 of [char] * endof \ keypad * ! 218: 56 of [char] - endof \ keypad - ! 219: 57 of [char] + endof \ keypad + ! 220: 58 of 0d endof \ keypad Enter ! 221: 89 of [char] \ endof \ japanese yen ! 222: dup of false endof \ other keys are false ! 223: endcase ! 224: to ret \ store char ! 225: led-state CapsLk and 0 <> if \ if CapsLk is on ! 226: scancode 03 > if \ from a to z ? ! 227: scancode 1e < if ! 228: ret 20 - to ret \ to Upper case ! 229: then ! 230: then ! 231: then ! 232: is-shift if \ if shift is on ! 233: scancode 03 > if \ from a to z ? ! 234: scancode 1e < if ! 235: ret 20 - to ret \ to Upper case ! 236: else ! 237: scancode ! 238: case \ translate scan code --> char ! 239: 1e of [char] ! endof ! 240: 1f of [char] @ endof ! 241: 20 of [char] # endof ! 242: 21 of [char] $ endof ! 243: 22 of [char] % endof ! 244: 23 of [char] ^ endof ! 245: 24 of [char] & endof ! 246: 25 of [char] * endof ! 247: 26 of [char] ( endof ! 248: 27 of [char] ) endof ! 249: 2d of [char] _ endof ! 250: 2e of [char] + endof ! 251: 2f of [char] { endof ! 252: 30 of [char] } endof ! 253: 31 of [char] | endof ! 254: 33 of [char] : endof ! 255: 34 of [char] " endof ! 256: 35 of [char] ~ endof ! 257: 36 of [char] < endof ! 258: 37 of [char] > endof ! 259: 38 of [char] ? endof ! 260: dup of ret endof \ other keys are no change ! 261: endcase ! 262: to ret \ overwrite new char ! 263: then ! 264: then ! 265: then ! 266: led-state NumLk and 0 <> if \ if NumLk is on ! 267: scancode ! 268: case \ translate scan code --> char ! 269: 59 of [char] 1 endof ! 270: 5a of [char] 2 endof ! 271: 5b of [char] 3 endof ! 272: 5c of [char] 4 endof ! 273: 5d of [char] 5 endof ! 274: 5e of [char] 6 endof ! 275: 5f of [char] 7 endof ! 276: 60 of [char] 8 endof ! 277: 61 of [char] 9 endof ! 278: 62 of [char] 0 endof ! 279: 63 of [char] . endof \ keypad . ! 280: dup of ret endof \ other keys are no change ! 281: endcase ! 282: to ret \ overwirte new char ! 283: then ! 284: ret \ return char ! 285: ; ! 286: ! 287: : key-available? ( -- true|false ) ! 288: multi-key 0 <> IF ! 289: true \ multi scan code key was pressed... so key is available ! 290: EXIT \ done ! 291: THEN ! 292: kbd-scan 0 = IF \ if no kbd-scan code is currently available ! 293: int-get-report \ check for one using int-get-report ! 294: THEN ! 295: kbd-scan 0 <> \ if a kbd-scan is available, report true, else false ! 296: ; ! 297: ! 298: : usb-kread ( -- char|false ) \ usb key read for control transfer ! 299: multi-key 0 <> if \ if multi scan code key is pressed ! 300: multi-key ff and \ read one byte from buffer ! 301: multi-key 8 rshift to multi-key \ move to next byte ! 302: else \ normal key check ! 303: \ check for new scan code only, if kbd-scan is not set, e.g. ! 304: \ by a previous call to key-available? ! 305: kbd-scan 0 = IF ! 306: \ if interrupt transfer ! 307: int-get-report \ read report (interrupt transfer) ! 308: \ else control transfer ! 309: \ ctl-get-report \ read report (control transfer) ! 310: \ end of interrupt/control switch ! 311: THEN ! 312: kbd-scan 0 <> if \ scan code exist? ! 313: begin kbd-scan ff and dup 00 = while \ get a last scancode in report buffer ! 314: kbd-scan 8 rshift to kbd-scan \ This algorithm is wrong --> must be fixed! ! 315: drop \ KBD doesn't set scancode in pressed order!!! ! 316: repeat ! 317: dup key-old <> if \ if the scancode is new ! 318: dup to key-old \ save current scan code ! 319: get-ukbd-char \ translate scan code --> char ! 320: milliseconds fa + to expire-ms \ set typematic delay 250ms ! 321: else \ scan code is not changed ! 322: milliseconds expire-ms > if \ if timer is expired ... should be considered timer carry over ! 323: get-ukbd-char \ translate scan code --> char ! 324: milliseconds 21 + to expire-ms \ set typematic rate 30cps ! 325: else \ timer is not expired ! 326: drop false \ do nothing ! 327: then ! 328: then ! 329: kbd-scan 8 rshift to kbd-scan \ handled scan-code ! 330: else ! 331: 0 to key-old \ clear privious key ! 332: false \ no scan code --> return false ! 333: then ! 334: then ! 335: ; ! 336: ! 337: ! 338: : key-read ( -- char ) ! 339: 0 begin drop usb-kread dup 0 <> until \ read key input (Interrupt transfer) ! 340: ; ! 341: ! 342: ! 343: : read ( addr len -- actual ) ! 344: 0= IF drop 0 EXIT THEN ! 345: usb-kread ?dup IF swap c! 1 ELSE 0 swap c! -2 THEN ! 346: ; ! 347: ! 348: ! 349: kbd-init \ keyboard initialize ! 350: milliseconds to expire-ms \ Timer initialize ! 351: 0 to multi-key \ multi key buffer clear ! 352: 7 set-led \ flash leds ! 353: 250 ms ! 354: 0 set-led ! 355: ! 356: s" keyboard" get-node node>path set-alias ! 357: ! 358: : open ( -- true ) ! 359: 7 set-led ! 360: 100 ms ! 361: 3 set-led ! 362: 100 ms ! 363: 1 set-led ! 364: 100 ms ! 365: \ read once from keyboard before actually using it ! 366: usb-kread drop ! 367: 0 set-led ! 368: true ! 369: ; ! 370: ! 371: : close ;
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.