ps2kb.fs 8.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434
  1. ( PS/2 keyboard handler JCB 18:29 11/21/10)
  2. ================================================================
  3. Keycodes represent raw keypresses. Need to map these to
  4. ASCII characters. Each key can generate several ASCII
  5. codes depending on the state of the SHIFT/CTRL keys.
  6. Could use table giving keycode->ascii, but most keys
  7. generate two codes, so would need word for each.
  8. Keycodes 00-83. Storage 262 bytes.
  9. Table of N ascii codes, each entry specifies a keycode
  10. and shift state
  11. ================================================================
  12. module[ ps2kb"
  13. meta
  14. create asciikb 144 allot
  15. asciikb 144 erase
  16. \ 1 word for each key.
  17. \ if high bit is zero, then
  18. h# 84 constant nscancodes
  19. create scanmap nscancodes cells allot
  20. scanmap nscancodes cells 2constant scanmap_
  21. scanmap_ erase
  22. : scanmap! ( n u -- ) \ write n to cell u in scanmap
  23. cells scanmap + !
  24. ;
  25. \ knowkey plain xx f0xx
  26. \ knowkey-n plain 3x, yy numlock exyy
  27. \ knowkey-h shift mask yy d0yy
  28. \ knowkey-s plain xx, shifted^caps yy xxyy
  29. h# f000 constant plainmask
  30. h# e000 constant numlockmask
  31. h# d000 constant shiftmask
  32. : wordval bl word count evaluate ;
  33. : knowkey
  34. wordval
  35. plainmask or
  36. swap scanmap!
  37. ;
  38. : knowkey-s
  39. \ dup char asciikb + c!
  40. \ 128 or
  41. \ char asciikb + c!
  42. char 8 lshift char or
  43. swap scanmap!
  44. ;
  45. : knowkey-h
  46. wordval shiftmask or
  47. swap scanmap!
  48. ;
  49. : knowkey-n
  50. \ dup char asciikb + c!
  51. \ 128 or
  52. \ char asciikb + c!
  53. char [char] . - 8 lshift wordval or
  54. numlockmask or
  55. swap scanmap!
  56. ;
  57. h# 01 constant SHIFTL
  58. h# 02 constant SHIFTR
  59. h# 04 constant CONTROL
  60. h# 08 constant ALT
  61. char * constant ASTERISK
  62. char - constant MINUS
  63. char + constant PLUS
  64. char 5 constant FIVE
  65. include keycodes.fs
  66. h# 76 knowkey ESC
  67. h# 05 knowkey KF1
  68. h# 06 knowkey KF2
  69. h# 04 knowkey KF3
  70. h# 0c knowkey KF4
  71. h# 03 knowkey KF5
  72. h# 0b knowkey KF6
  73. h# 83 knowkey KF7
  74. h# 0a knowkey KF8
  75. h# 01 knowkey KF9
  76. h# 09 knowkey KF10
  77. h# 78 knowkey KF11
  78. h# 07 knowkey KF12
  79. h# 0e knowkey-s ` ~
  80. h# 16 knowkey-s 1 !
  81. h# 1e knowkey-s 2 @
  82. h# 26 knowkey-s 3 #
  83. h# 25 knowkey-s 4 $
  84. h# 2e knowkey-s 5 %
  85. h# 36 knowkey-s 6 ^
  86. h# 3d knowkey-s 7 &
  87. h# 3e knowkey-s 8 *
  88. h# 46 knowkey-s 9 (
  89. h# 45 knowkey-s 0 )
  90. h# 4e knowkey-s - _
  91. h# 55 knowkey-s = +
  92. h# 5d knowkey-s \ |
  93. h# 66 knowkey KDEL
  94. h# 0d knowkey TAB
  95. h# 15 knowkey-s q Q
  96. h# 1d knowkey-s w W
  97. h# 24 knowkey-s e E
  98. h# 2d knowkey-s r R
  99. h# 2c knowkey-s t T
  100. h# 35 knowkey-s y Y
  101. h# 3c knowkey-s u U
  102. h# 43 knowkey-s i I
  103. h# 44 knowkey-s o O
  104. h# 4d knowkey-s p P
  105. h# 54 knowkey-s [ {
  106. h# 5b knowkey-s ] }
  107. h# 5a knowkey ENTER
  108. h# 58 knowkey -1
  109. h# 1c knowkey-s a A
  110. h# 1b knowkey-s s S
  111. h# 23 knowkey-s d D
  112. h# 2b knowkey-s f F
  113. h# 34 knowkey-s g G
  114. h# 33 knowkey-s h H
  115. h# 3b knowkey-s j J
  116. h# 42 knowkey-s k K
  117. h# 4b knowkey-s l L
  118. h# 4c knowkey-s ; :
  119. h# 52 knowkey-s ' "
  120. h# 1a knowkey-s z Z
  121. h# 22 knowkey-s x X
  122. h# 21 knowkey-s c C
  123. h# 2a knowkey-s v V
  124. h# 32 knowkey-s b B
  125. h# 31 knowkey-s n N
  126. h# 3a knowkey-s m M
  127. h# 41 knowkey-s , <
  128. h# 49 knowkey-s . >
  129. h# 4a knowkey-s / ?
  130. h# 29 knowkey BL
  131. h# 12 knowkey-h SHIFTL
  132. h# 59 knowkey-h SHIFTR
  133. h# 14 knowkey-h CONTROL
  134. h# 11 knowkey-h ALT
  135. h# 70 knowkey-n 0 KINS
  136. h# 71 knowkey-n . KDEL
  137. h# 69 knowkey-n 1 KEND
  138. h# 72 knowkey-n 2 KDOWN
  139. h# 7a knowkey-n 3 KPGDN
  140. h# 6b knowkey-n 4 KLEFT
  141. h# 73 knowkey FIVE
  142. h# 74 knowkey-n 6 KRIGHT
  143. h# 6c knowkey-n 7 KHOME
  144. h# 75 knowkey-n 8 KUP
  145. h# 7d knowkey-n 9 KPGUP
  146. h# 77 knowkey -2
  147. h# 7c knowkey ASTERISK
  148. h# 7b knowkey MINUS
  149. h# 79 knowkey PLUS
  150. : t,c ( c-addr u -- ) \ compile u cells into target memory
  151. 0 do
  152. dup @ t, cell+
  153. loop
  154. drop
  155. ;
  156. target create scanmap meta
  157. scanmap nscancodes t,c
  158. target
  159. include keycodes.fs
  160. : scanmap@ ( u - u ) \ return scanmap entry u
  161. cells scanmap + @ ;
  162. variable kbread \ read ptr into 64-bit KB fifo
  163. variable kbstate \ accumulates 11-bit code
  164. : ps2listening
  165. ps2_clk_dir in
  166. ps2_dat_dir in
  167. ;
  168. : kbfifo@ ( u -- f ) \ read bit u from 64-bit KB fifo
  169. dup d# 4 rshift 2* kbfifo + @
  170. swap d# 15 and rshift d# 1 and
  171. ;
  172. : kbnew ( -- ) \ start accumulating new code
  173. h# 800 kbstate !
  174. ;
  175. : kbfifo-cold
  176. kbfifocount @ kbread !
  177. kbnew
  178. ;
  179. : kbfifo-fullness ( -- u ) \ how many unread bits in the kbfifo
  180. kbfifocount @ kbread @ - h# ff and
  181. ;
  182. variable ps2_clk'
  183. : waitfall \ wait for falling edge on ps2_clk
  184. begin ps2_clk @ ps2_clk' fall? until ;
  185. : ps2-out1 ( u -- ) \ send lsb of u to keyboard
  186. ps2_dat ! waitfall ;
  187. : oddparity ( u1 -- u2 ) \ u2 is odd parity of u1
  188. dup d# 4 rshift xor
  189. dup d# 2 rshift xor
  190. dup 2/ xor
  191. ;
  192. : kb-request
  193. ps2_clk_dir out ps2_clk off \ clock low
  194. d# 60. sleepus
  195. ps2_dat_dir out ps2_dat off \ dat low
  196. ps2_clk_dir in \ release clock
  197. begin ps2_clk @ until
  198. ps2_clk' on
  199. \ bad keyboard hangs here
  200. false ps2-out1 \ start
  201. dup
  202. d# 8 0do
  203. dup ps2-out1 2/
  204. loop
  205. drop
  206. oddparity ps2-out1 \ parity
  207. true ps2-out1 \ stop
  208. ps2listening \ waitfall
  209. kbfifo-cold
  210. ;
  211. : kbbit
  212. d# 11 lshift kbstate @ 2/ or
  213. kbstate !
  214. ;
  215. : rawready? ( -- f) \ is the raw keycode ready?
  216. kbstate @ d# 1 and ;
  217. : kbraw ( -- u ) \ get the current raw keycode
  218. kbstate @ d# 2 rshift h# ff and
  219. kbnew
  220. ;
  221. variable lock
  222. : rawloop
  223. begin
  224. kbfifocount @ lock !
  225. kbfifo-fullness 0<>
  226. rawready? 0= and
  227. while
  228. kbfifo-fullness 1- kbfifo@
  229. kbfifocount @ lock @ = if
  230. kbbit d# 1 kbread +!
  231. else
  232. drop
  233. then
  234. repeat
  235. ;
  236. : oneraw
  237. begin
  238. rawloop
  239. rawready?
  240. until
  241. kbraw
  242. ;
  243. : >leds ( u -- ) \ set keyboard leds (CAPS NUM SCROLL)
  244. h# ed kb-request
  245. oneraw drop
  246. kb-request
  247. ;
  248. ( Decoding JCB 19:25 12/04/10)
  249. variable capslock
  250. variable numlock
  251. variable isrelease \ is this is key release
  252. variable ise0 \ is this an E0-prefix key
  253. 0 value mods \ bitmask of modifier keys
  254. \ RALT RCTRL -- -- LALT LCTRL RSHIFT LSHIFT
  255. : lrshift? ( -- f ) \ is either shift pressed?
  256. mods h# 03 and ;
  257. : lrcontrol?
  258. mods h# 44 and ;
  259. : lralt?
  260. mods h# 88 and ;
  261. variable curkey
  262. : append ( u -- ) \ join u with mods write to curkey
  263. h# ff and mods d# 8 lshift or
  264. curkey !
  265. ;
  266. : shiftmask
  267. h# ff and
  268. ise0 @ if d# 4 lshift then
  269. ;
  270. : shift-press ( u -- ) \ a shift key was pressed
  271. shiftmask mods or to mods ;
  272. : shift-release ( u -- ) \ a shift key was released
  273. shiftmask invert mods and to mods ;
  274. : shiftable-press ( u -- ) \ a shiftable key was pressed
  275. mods d# 3 and 0= capslock @ xor if
  276. d# 8 rshift
  277. then
  278. append
  279. ;
  280. : ignore drop ;
  281. : myleds \ compute led values from caps/numlock, send to KB
  282. numlock @ d# 2 and
  283. capslock @ d# 4 and
  284. or
  285. >leds
  286. ;
  287. : toggle ( a -- ) \ invert cell at a
  288. dup @ invert swap ! ;
  289. : plain-press ( u -- )
  290. dup d# -1 = if
  291. drop capslock toggle myleds
  292. else
  293. dup d# -2 = if
  294. drop numlock toggle myleds
  295. else
  296. append
  297. then
  298. then
  299. ;
  300. : num-press
  301. \ if e0 prefix, low code, else hi code or 30
  302. \ e0 numlock
  303. \ 0 0 cursor
  304. \ 0 1 num
  305. \ 1 0 cursor
  306. \ 1 1 cursor
  307. ise0 @ 0= numlock @ and if
  308. d# 8 rshift h# f and [char] . +
  309. then
  310. append
  311. ;
  312. jumptable keyhandler
  313. \ PRESS RELEASE
  314. ( 0 ) | shiftable-press | ignore
  315. ( d ) | shift-press | shift-release
  316. ( e ) | num-press | ignore
  317. ( f ) | plain-press | ignore
  318. : handle-raw ( u -- )
  319. dup h# e0 = if
  320. drop ise0 on
  321. else
  322. dup h# f0 = if
  323. drop isrelease on
  324. else
  325. dup h# 84 < if
  326. scanmap@
  327. \ hi 4 bits,
  328. \ 1100 -> 0
  329. \ 1101 -> 1
  330. \ 1110 -> 2
  331. \ 1111 -> 3
  332. \
  333. dup d# 12 rshift d# 12 - d# 0 max
  334. 2* isrelease @ + keyhandler execute
  335. isrelease off
  336. ise0 off
  337. else
  338. drop
  339. then
  340. then
  341. then
  342. ;
  343. ( kb: high-level keyboard JCB 19:45 12/04/10)
  344. : kb-cold
  345. ps2listening kbfifo-cold
  346. h# 7 >leds
  347. sleep.1
  348. h# 0 >leds
  349. numlock off
  350. capslock off
  351. curkey off
  352. ;
  353. : kbfifo-proc
  354. rawloop
  355. rawready? if
  356. kbraw handle-raw
  357. then
  358. ;
  359. : key? ( -- flag )
  360. kbfifo-proc
  361. curkey @ 0<> ;
  362. : key ( -- u )
  363. begin key? until
  364. curkey @ curkey off ;
  365. ]module