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