|
|
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.