\ *****************************************************************************
\ * Copyright (c) 2004, 2008 IBM Corporation
\ * All rights reserved.
\ * This program and the accompanying materials
\ * are made available under the terms of the BSD License
\ * which accompanies this distribution, and is available at
\ * http://www.opensource.org/licenses/bsd-license.php
\ *
\ * Contributors:
\ *     IBM Corporation - initial implementation
\ ****************************************************************************/


s" keyboard" device-name
s" keyboard" device-type

."   USB Keyboard" cr

3 encode-int s" assigned-addresses" property
1 encode-int s" reg" property
1 encode-int s" configuration#" property
s" EN" encode-string s" language" property

1 constant NumLk
2 constant CapsLk
4 constant ScrLk

TRUE VALUE use-interrupt-transfers?

\ Check whether we're running on QEMU - in this case we disable the
\ interrupt transfers since they are not working very well there yet.
s" model" s" /" find-node get-property 0= IF
   2dup s" qemu" find-substr = TO use-interrupt-transfers?
   drop
THEN


00 value kbd-addr
to kbd-addr                                \ save speed bit

8 value mps-dcp
8 constant DEFAULT-CONTROL-MPS
0 value multi-key
0 value led-state
0 value temp1
0 value temp2
0 value temp3
0 value ret
0 value scancode
0 value kbd-shift
0 value kbd-scan
0 value key-old
0 value expire-ms
0 value mps-int-in
0 value int-in-ep
0 value int-in-toggle

\ Buffers which must be capable of DMA:

STRUCT
   80 FIELD kb>cfg              \ For config descriptors etc, size 0x80
   8  FIELD kb>report           \ For keyboard report, size 8
   8  FIELD kb>setup-packet     \ For setup-packet, size 8
   4  FIELD kb>data             \ Various data, size 4
CONSTANT /kbd-buf

0 VALUE kbd-buf
0 VALUE kbd-buf-dma

: (kbd-buf-init)  ( -- )
   /kbd-buf s" dma-alloc" $call-parent TO kbd-buf
   kbd-buf /kbd-buf 0 s" dma-map-in" $call-parent TO kbd-buf-dma

   s" kbd-buf = " kbd-buf usb-debug-print-val
;

: (kbd-buf-free)  ( -- )
   kbd-buf kbd-buf-dma /kbd-buf s" dma-map-out" $call-parent
   kbd-buf /kbd-buf s" dma-free" $call-parent
   0 TO kbd-buf
   0 TO kbd-buf-dma
;


s" usb-kbd-device-support.fs" included


: control-cls-set-report ( reportvalue FuncAddr -- TRUE|FALSE )
  to temp1
  to temp2
  2109000200000100 kbd-buf kb>setup-packet !
  temp2 kbd-buf kb>data l!-le
  1 kbd-buf kb>data 1 kbd-buf kb>setup-packet
  DEFAULT-CONTROL-MPS temp1 controlxfer
;

: control-cls-get-report ( data-buffer data-len MPS FuncAddr -- TRUE|FALSE )
  to temp1
  to temp2
  to temp3
  a101000100000000 kbd-buf kb>setup-packet !
  temp3 kbd-buf kb>setup-packet 6 + w!-le
  0 swap temp3 kbd-buf kb>setup-packet
  temp2 temp1 controlxfer
;

: int-get-report ( -- )                                     \ get report for interrupt transfer
   0 2 int-in-toggle kbd-buf kb>report 8 mps-int-in
   kbd-addr int-in-ep 7 lshift or rw-endpoint               \ get report
   swap to int-in-toggle IF
      kbd-buf kb>report @
      ff00000000000000 and 38 rshift to kbd-shift           \ store shift status
      kbd-buf kb>report @
      0000ffffffffffff and to kbd-scan                      \ store scan codes
   ELSE
      0 to kbd-shift                                        \ clear shift status
      0 to kbd-scan                                         \ clear scan code buffer
   THEN
;

: ctl-get-report ( -- )                                     \ get report for control transfer
   kbd-buf kb>report 8 8 kbd-addr
   control-cls-get-report IF                                \ get report
      kbd-buf kb>report @
      ff00000000000000 and 38 rshift to kbd-shift           \ store shift status
      kbd-buf kb>report @
      0000ffffffffffff and to kbd-scan                      \ store scan codes
   ELSE
      0 to kbd-shift                                        \ clear shift status
      0 to kbd-scan                                         \ clear scan code buffer
   THEN
;

: kbd-get-report  ( -- )
   use-interrupt-transfers? IF
      int-get-report
   ELSE
      ctl-get-report
   THEN
;


: set-led ( led -- )
  dup to led-state
  kbd-addr control-cls-set-report drop
;

: is-shift ( -- true|false )
    kbd-shift 22 and if
	true
    else
	false
    then
;

: is-alt ( -- true|false )
    kbd-shift 44 and if
	true
    else
	false
    then
;

: is-ctrl ( -- true|false )
    kbd-shift 11 and if
	true
    else
	false
    then
;

: ctrl_alt_del_key ( char -- )
    is-ctrl if                                           \ ctrl is pressed?
	is-alt if                                        \ alt is pressed?
	    4c = if                                      \ del is pressed?
		s" reboot.... " usb-debug-print
		\ reset-all                              \ reboot
		drop false                               \ invalidate del key on top of stack
	    then
	    false                                        \ dummy for last drop
	then
    then
    drop                                                 \ clear stack
;

: get-ukbd-char ( ScanCode -- char|false )
    dup ctrl_alt_del_key                                 \ check ctrl+alt+del
    dup to scancode                                      \ store scan code
    case                                                 \ translate scan code --> char
	 04 of [char] a endof
	 05 of [char] b endof
	 06 of [char] c endof
	 07 of [char] d endof
	 08 of [char] e endof
	 09 of [char] f endof
	 0a of [char] g endof
	 0b of [char] h endof
	 0c of [char] i endof
	 0d of [char] j endof
	 0e of [char] k endof
	 0f of [char] l endof
	 10 of [char] m endof
	 11 of [char] n endof
	 12 of [char] o endof
	 13 of [char] p endof
	 14 of [char] q endof
	 15 of [char] r endof
	 16 of [char] s endof
	 17 of [char] t endof
	 18 of [char] u endof
	 19 of [char] v endof
	 1a of [char] w endof
	 1b of [char] x endof
	 1c of [char] y endof
	 1d of [char] z endof
	 1e of [char] 1 endof
	 1f of [char] 2 endof
	 20 of [char] 3 endof
	 21 of [char] 4 endof
	 22 of [char] 5 endof
	 23 of [char] 6 endof
	 24 of [char] 7 endof
	 25 of [char] 8 endof
	 26 of [char] 9 endof
	 27 of [char] 0 endof
	 28 of 0d endof                            \ Enter
	 29 of 1b endof                            \ ESC
	 2a of 08 endof                            \ Backsace
	 2b of 09 endof                            \ Tab
	 2c of 20 endof                            \ Space
	 2d of [char] - endof
	 2e of [char] = endof
	 2f of [char] [ endof
	 30 of [char] ] endof
	 31 of [char] \ endof
	 33 of [char] ; endof
	 34 of [char] ' endof
	 35 of [char] ` endof
	 36 of [char] , endof
	 37 of [char] . endof
	 38 of [char] / endof
	 39 of led-state CapsLk xor set-led false endof  \ CapsLk
	 3a of 1b 7e31315b to multi-key endof      \ F1
	 3b of 1b 7e32315b to multi-key endof      \ F2
	 3c of 1b 7e33315b to multi-key endof      \ F3
	 3d of 1b 7e34315b to multi-key endof      \ F4
	 3e of 1b 7e35315b to multi-key endof      \ F5
	 3f of 1b 7e37315b to multi-key endof      \ F6
	 40 of 1b 7e38315b to multi-key endof      \ F7
	 41 of 1b 7e39315b to multi-key endof      \ F8
	 42 of 1b 7e30315b to multi-key endof      \ F9
	 43 of 1b 7e31315b to multi-key endof      \ F10
	 44 of 1b 7e33315b to multi-key endof      \ F11
	 45 of 1b 7e34315b to multi-key endof      \ F12
	 47 of led-state ScrLk xor set-led false endof   \ ScrLk
	 49 of 1b 7e315b to multi-key endof        \ Ins
	 4a of 1b 7e325b to multi-key endof        \ Home
	 4b of 1b 7e335b to multi-key endof        \ PgUp
	 4c of 1b 7e345b to multi-key endof        \ Del
	 4d of 1b 7e355b to multi-key endof        \ End
	 4e of 1b 7e365b to multi-key endof        \ PgDn
	 4f of 1b 435b to multi-key endof          \ R-arrow
	 50 of 1b 445b to multi-key endof          \ L-arrow
	 51 of 1b 425b to multi-key endof          \ D-arrow
	 52 of 1b 415b to multi-key endof          \ U-arrow
	 53 of led-state NumLk xor set-led false endof   \ NumLk
	 54 of [char] / endof                      \ keypad /
	 55 of [char] * endof                      \ keypad *
	 56 of [char] - endof                      \ keypad -
	 57 of [char] + endof                      \ keypad +
	 58 of 0d endof                            \ keypad Enter
	 89 of [char] \ endof                      \ japanese yen
	 dup of false endof                        \ other keys are false
     endcase
     to ret                                        \ store char
     led-state CapsLk and 0 <> if                  \ if CapsLk is on
	 scancode 03 > if                          \ from a to z ?
	     scancode 1e < if
		 ret 20 - to ret                   \ to Upper case
	     then
	 then
     then
     is-shift if                                   \ if shift is on
	 scancode 03 > if                          \ from a to z ?
	     scancode 1e < if
		 ret 20 - to ret                   \ to Upper case
	     else
		 scancode
		 case                              \ translate scan code --> char
		     1e of [char] ! endof
		     1f of [char] @ endof
		     20 of [char] # endof
		     21 of [char] $ endof
		     22 of [char] % endof
		     23 of [char] ^ endof
		     24 of [char] & endof
		     25 of [char] * endof
		     26 of [char] ( endof
		     27 of [char] ) endof
		     2d of [char] _ endof
		     2e of [char] + endof
		     2f of [char] { endof
		     30 of [char] } endof
		     31 of [char] | endof
		     33 of [char] : endof
		     34 of [char] " endof
		     35 of [char] ~ endof
		     36 of [char] < endof
		     37 of [char] > endof
		     38 of [char] ? endof
		     dup of ret endof              \ other keys are no change
		 endcase
		 to ret                            \ overwrite new char
	     then
	 then
     then
     led-state NumLk and 0 <> if                   \ if NumLk is on
       scancode
       case                                        \ translate scan code --> char
	 59 of [char] 1 endof
	 5a of [char] 2 endof
	 5b of [char] 3 endof
	 5c of [char] 4 endof
	 5d of [char] 5 endof
	 5e of [char] 6 endof
	 5f of [char] 7 endof
	 60 of [char] 8 endof
	 61 of [char] 9 endof
	 62 of [char] 0 endof
	 63 of [char] . endof                      \ keypad .
	 dup of ret endof                          \ other keys are no change
       endcase
       to ret                                      \ overwrite new char
     then
     ret                                           \ return char
;

: key-available? ( -- true|false )
   multi-key 0 <> IF
      true \ multi scan code key was pressed... so key is available
      EXIT \ done
   THEN
   kbd-scan 0 = IF      \ if no kbd-scan code is currently available
      kbd-get-report    \ check for new scan codes
   THEN
   kbd-scan 0 <>        \ if a kbd-scan is available, report true, else false
;

: usb-kread ( -- char|false )                     \ usb key read for control transfer
   multi-key 0 <> if                              \ if multi scan code key is pressed
      multi-key ff and                            \ read one byte from buffer
      multi-key 8 rshift to multi-key             \ move to next byte
   else                                           \ normal key check
      \ check for new scan code only, if kbd-scan is not set, e.g.
      \ by a previous call to key-available?
      kbd-scan 0 = IF
         kbd-get-report                           \ read scan-code report
      THEN
      kbd-scan 0 <> if                            \ scan code exist?
         begin kbd-scan ff and dup 00 = while     \ get a last scancode in report buffer
            kbd-scan 8 rshift to kbd-scan         \ This algorithm is wrong --> must be fixed!
            drop                                  \ KBD doesn't set scancode in pressed order!!!
         repeat
         ff and dup to kbd-scan                   \ we can only digest one key at a time
         dup key-old <> if                        \ if the scancode is new
            dup to key-old                        \ save current scan code
            get-ukbd-char                         \ translate scan code --> char
            milliseconds fa + to expire-ms        \ set typematic delay 250ms
         else                                     \ scan code is not changed
            milliseconds expire-ms > if           \ if timer is expired ... should be considered timer carry over
               get-ukbd-char                      \ translate scan code --> char
               milliseconds 21 + to expire-ms     \ set typematic rate 30cps
            else                                  \ timer is not expired
               drop false                         \ do nothing
            then
         then
         kbd-scan 8 rshift to kbd-scan            \ handled scan-code
      else
         0 to key-old                             \ clear privious key
         false                                    \ no scan code --> return false
      then
   then
;


: key-read ( -- char )
    0 begin drop usb-kread dup 0 <> until                \ read key input (Interrupt transfer)
;


: read ( addr len -- actual )
   0= IF drop 0 EXIT THEN
   usb-kread ?dup  IF  swap c! 1  ELSE  0 swap c! -2  THEN
;

(kbd-buf-init)
kbd-init                                                 \ keyboard initialize
milliseconds to expire-ms                                \ Timer initialize
0 to multi-key                                           \ multi key buffer clear
7 set-led                                                \ flash leds
250 ms
0 set-led
(kbd-buf-free)

s" keyboard" get-node node>path set-alias

: open ( -- true )
   (kbd-buf-init)
   7 set-led
   100 ms
   3 set-led
   100 ms
   1 set-led
   100 ms
   \ read once from keyboard before actually using it
   usb-kread drop
   0 set-led
   true
;

: close
   (kbd-buf-free)
;


s" Keyboard init done"  usb-debug-print
