amforth 3.0 mFC 1.0 ATmega32 
> amforth 3.0 mFC 1.0 ATmega32 
> words
<lcd> <mpc> <bit> ms false true assembler forth vocabulary definitions headcur h
eadcon current context b> >b b!- b!+ nb! b! b@- b@+ nb@ b@ a> >a a!- a!+ na! a! 
a@- a@+ na@ a@ cmove spirw sleep wdr -wdt -jtag d2/ s>d up! up@ 0 1ms >< cmove> 
i! i@ unloop i sp! sp@ rp! rp@ +! rshift lshift 1- 1+ xor or and 2* 2/ invert um
* um/mod m* + - log2 d< d> u> u< 0> 0< > < 0= = <> r@ >r r> rot drop over swap ?
dup dup c@ c! ! @ e@ e! execute exit -int +int end-code code abort abort" [char]
 immediate recurse user constant variable [ ] ; :noname : does> create ?do leave
 +loop loop do again until repeat while begin then else if literal int! applturn
key is Rdefer Edefer words s" ." .s u. dinvert d- d+ d2* dnegate dabs d>s >usart
0 +usart0 baud0 tx0? tx0 rx0? rx0 mpc_ID j * defer@ defer! icompare (find) find 
to value unused noop ver interpret depth rp0 sp sp0 cold pause quit place word /
string source cscan parse number char refill accept cskip throw catch handler ' 
type count spaces space cr icount itype s, digit ud/mod ud.r ud. . d. .r d.r sig
n #> #s # <# hold hld max min abs mod / negate u/mod */ /mod */mod turnkey heap 
edp bl hex decimal ['] , compile ( \ allot here head /key key? key emit? emit pa
d tibsize tib #tib >in cell+ cells base state f_cpu (antic) >antic antic -antic 
+antic crc crctest -crc +crc -echo +echo echo  ok
> +crc
 ok
> 
 ok
> forth definitions
9A84 ok
> vocabulary <kbd>   \ vocabulary kbd
37DB ok
> <kbd> definitions
A054 ok
> \ Keyboard PS/2 - Lubos Pekny, www.forth.cz
33C6 ok
> \ Library for amforth 3.0 mFC 1.0
FDD7 ok
> 
 ok
> \ V.1.2v, 29.01.2009, add vocabulary
BFBE ok
> 
 ok
> \ V.1.2, 14.01.2009, tested on atmega32, amforth 3.0
11A8 ok
> \ - add err bit in kbd_FLGR
DD25 ok
> \ - add sync to kbd_ekey?
A4BA ok
> 
 ok
> \ V.1.1, 06.07.2008, tested on atmega32, amforth 2.7
E705 ok
> \ - changes in key->ps2, kbd_ascii, kbd_sync, appl_kbdlcd
84A0 ok
> \ - optimalized restart and clk-sync
FF83 ok
> 
 ok
> \ V.1.0, 03.07.2008, tested on atmega32, amforth 2.7
429D ok
> \ - used INT2 + 1 pin
D37B ok
> \ - kbd_init  kbd_char  kbd_ekey?  kbd_ekey
D7DF ok
> \ - ekey?  ekey  ekey>char  ekey>fkey  key?  key
0C59 ok
> 
 ok
> \ a = char a $61
C430 ok
> \ shift+a = char A $41
D1CB ok
> \ ctrl+a = no char, events $401C
8CE3 ok
> \ ctrl+shift+a = char $01
BBB5 ok
> \ alt+char = $80+char
4634 ok
> \ alt+ctrl+shift+a = char $81
55DC ok
> 
 ok
> \ Convert tab for Keyboard.frt - Lubos Pekny, www.forth.cz
9A83 ok
> \ V.1.0, 26.05.2008
DF90 ok
> \ keyboard scan code->ascii char, 128 words, Hi:Lo byte (Hi is with shift)
A667 ok
> 
 ok
> create kbd_CHARTAB
9D2F ok
> \ ascii key char char^
3002 ok
> 0000 , \ 00
290E ok
> 0000 , \ 01  F9
9816 ok
> 0000 , \ 02
E88F ok
> 0000 , \ 03  F5
5D6F ok
> 0000 , \ 04  F3
9F5A ok
> 0000 , \ 05  F1
9EE6 ok
> 0000 , \ 06  F2
9FE2 ok
> 0000 , \ 07  F12
BD9F ok
> 0000 , \ 08
EF0F ok
> 0000 , \ 09  F10
521F ok
> 0000 , \ 0A  F8
9396 ok
> 0000 , \ 0B  F6
5753 ok
> 0000 , \ 0C  F4
56EF ok
> 0909 , \ 0D  TAB
50C4 ok
> 7E60 , \ 0E  ` ~
1288 ok
> 0000 , \ 0F
CF8F ok
> 0000 , \ 10
B90F ok
> 0000 , \ 11  ALT
A09F ok
> 0000 , \ 12  Left SHIFT
4ED0 ok
> 0000 , \ 13
B84F ok
> 0000 , \ 14  Ctrl
502F ok
> 5171 , \ 15  q Q
3D75 ok
> 2131 , \ 16  1 !
C832 ok
> 0000 , \ 17
7B4E ok
> 0000 , \ 18
7F0E ok
> 0000 , \ 19
BFCF ok
> 5A7A , \ 1A  z Z
9880 ok
> 5373 , \ 1B  s S
F8DA ok
> 4161 , \ 1C  a A
33BF ok
> 5777 , \ 1D  w W
1B90 ok
> 4032 , \ 1E  2 @
424F ok
> 0000 , \ 1F
5F8E ok
> 0000 , \ 20
490F ok
> 4363 , \ 21  c C
A323 ok
> 5878 , \ 22  x X
4183 ok
> 4464 , \ 23  d D
079E ok
> 4565 , \ 24  e E
31CC ok
> 2434 , \ 25  4 $
FF18 ok
> 2333 , \ 26  3 #
8AA4 ok
> 0000 , \ 27
8B4E ok
> 0000 , \ 28
8F0E ok
> 2020 , \ 29  Space
8110 ok
> 5676 , \ 2A  v V
CFF0 ok
> 4666 , \ 2B  f F
A431 ok
> 5474 , \ 2C  t T
6F54 ok
> 5272 , \ 2D  r R
1FBA ok
> 2535 , \ 2E  5 %
4E40 ok
> 0000 , \ 2F
AF8E ok
> 0000 , \ 30
D90E ok
> 4E6E , \ 31  n N
B523 ok
> 4262 , \ 32  b B
D160 ok
> 4868 , \ 33  h H
0853 ok
> 4767 , \ 34  g G
B379 ok
> 5979 , \ 35  y Y
B7C1 ok
> 5E36 , \ 36  6 ^
7BDC ok
> 0000 , \ 37
1B4F ok
> 0000 , \ 38
1F0F ok
> 0000 , \ 39
DFCE ok
> 4D6D , \ 3A  m M
055B ok
> 4A6A , \ 3B  j J
3362 ok
> 5575 , \ 3C  u U
2E17 ok
> 2637 , \ 3D  7 &
DDF4 ok
> 2A38 , \ 3E  8 *
23E6 ok
> 0000 , \ 3F
3F8F ok
> 0000 , \ 40
E90C ok
> 3C2C , \ 41  , <
76BD ok
> 4B6B , \ 42  k K
01C9 ok
> 4969 , \ 43  i I
4976 ok
> 4F6F , \ 44  o O
E283 ok
> 2930 , \ 45  0 )
7A3D ok
> 2839 , \ 46  9 (
42F0 ok
> 0000 , \ 47
2B4D ok
> 0000 , \ 48
2F0D ok
> 3E2E , \ 49  . >
FB13 ok
> 3F2F , \ 4A  / ?
41CF ok
> 4C6C , \ 4B  l L
B3F1 ok
> 3A3B , \ 4C  ; :
E307 ok
> 5070 , \ 4D  p P
5D79 ok
> 5F2D , \ 4E  - _
CDEB ok
> 0000 , \ 4F
0F8D ok
> 0000 , \ 50
790D ok
> 0000 , \ 51
B9CC ok
> 2227 , \ 52  ' "
4F9D ok
> 0000 , \ 53
784D ok
> 7B5B , \ 54  [ {
4E9A ok
> 2B3D , \ 55  = +
2FB7 ok
> 0000 , \ 56
7B8D ok
> 0000 , \ 57
BB4C ok
> 0000 , \ 58  Caps Lock
9BF4 ok
> 0000 , \ 59  Right Shift
FCB9 ok
> 0D0D , \ 5A  Enter
561E ok
> 7D5D , \ 5B  ] }
DF7E ok
> 0000 , \ 5C
9C4C ok
> 7C5C , \ 5D  \ |
FCA2 ok
> 0000 , \ 5E
9ECC ok
> 0000 , \ 5F
9F8C ok
> 0000 , \ 60
890D ok
> 0000 , \ 61
49CC ok
> 0000 , \ 62
488C ok
> 0000 , \ 63
884D ok
> 0000 , \ 64
4A0C ok
> 0000 , \ 65
8ACD ok
> 0808 , \ 66  Backspace
7437 ok
> 0000 , \ 67
4B4C ok
> 0000 , \ 68
4F0C ok
> 3100 , \ 69  END,  NUM 1
9BE2 ok
> 0000 , \ 6A
ADCD ok
> 3400 , \ 6B  LEFT, NUM 4
172A ok
> 3700 , \ 6C  HOME, NUM 7
D2B8 ok
> 0000 , \ 6D
AE0D ok
> 0000 , \ 6E
6ECC ok
> 0000 , \ 6F
6F8C ok
> 3000 , \ 70  INS,  NUM 0
6EF2 ok
> 2E00 , \ 71  DEL,  NUM .
0275 ok
> 3200 , \ 72  DOWN, NUM 2
4CFA ok
> 3500 , \ 73      , NUM 5
B0C1 ok
> 3600 , \ 74  RIGHT,NUM 6
0CD0 ok
> 3800 , \ 75  UP,   NUM 8
9CBE ok
> 1B1B , \ 76  ESC
EE7A ok
> 0000 , \ 77  NUM LOCK
93BD ok
> 0000 , \ 78  F11
83A9 ok
> 2B2B , \ 79  NUM +
8CCE ok
> 3300 , \ 7A  PgDwn,NUM 3
553D ok
> 2D2D , \ 7B  NUM -
BA6D ok
> 2A2A , \ 7C  NUM *
E63B ok
> 3900 , \ 7D  PgUp, NUM 9
F6A5 ok
> 0000 , \ 7E  SCROLL LOCK
874F ok
> 0000 , \ 7F
FF8D ok
> \        83  F7
08AA ok
> 
 ok
> hex
6EDB ok
> 
 ok
> forth
E9B7 ok
> <bit> definitions     \ into vocabulary <bit>
57F2 ok
> 
 ok
> 38 constant PORTB     \ Atmega32, PB.2 (INT2)<-clk, PB.1 (in)<-data out
CFA5 ok
> 
 ok
> forth
E9B7 ok
> <kbd> definitions     \ into vocabulary <kbd>
35C3 ok
> 
 ok
> variable PENDING-CHAR \ for key?, key
8CFD ok
> variable kbd_CNTR     \ r4:w4:b8, 8bit+2x4b circular buf counters
CDA7 ok
> variable kbd_ROTR     \ received bits from keyboard
923F ok
> variable kbd_FLGR     \ flags, final hi=|alt|ctrl|shift|num|releas|extend|0|er
r|
39BD ok
>                       \ work lo=|altL|altR|ctrlL|ctrlR|shiftL|shiftR|caps|num|

EDA8 ok
> variable kbd_SKEY     \ keyboard scan code+flags
C733 ok
>   8 cells allot       \ 8 events buf
26E4 ok
> 
 ok
> 8000 constant K-ALT-MASK
B539 ok
> 4000 constant K-CTRL-MASK
AC94 ok
> 2000 constant K-SHIFT-MASK
06AA ok
> 1000 constant K-NUM-MASK
4249 ok
> 0800 constant K-RELEAS-MASK
B37E ok
> 0400 constant K-EXTEND-MASK
0FD9 ok
> 0100 constant K-EVENTS-MASK
3F9C ok
> 
 ok
> 
 ok
>   \ interrupt, keyboard clock 
5AD2 ok
> code kbd_clk
1BD4 ok
>   R18 push,
57B1 ok
>   R18 3F in,          \ SREG 0x3F(0x5F)
0787 ok
>   R18 push,
57B1 ok
>   R17 push, R16 push,
A14A ok
>   ZH  push, ZL  push,
CD08 ok
> 
 ok
> \ --- Receive bits --
C880 ok
>   R16 kbd_ROTR lds,   \ received bits reg
E344 ok
>   R17 kbd_ROTR 1+ lds,
0824 ok
>   clc,                \ CY=0
754A ok
>   <bit> PORTB assembler
734F ok
>   22 - 1 sbic,        \ PinB.1=1 then CY=1
EEDA ok
>   sec,
0AA5 ok
>   R17 ror, R16 ror,   \ CY->R17.7->R16, rotate
9BF1 ok
>   kbd_ROTR 1+ R17 sts,
EB2F ok
>   kbd_ROTR R16 sts,   \ update variable kbd_ROTR
7522 ok
> 
 ok
>   R18 kbd_CNTR lds,   \ bit counter reg
6677 ok
>   R18 0F andi,
6CC3 ok
>   R18 00 cpi,         \ =0 then 0B
5ED5 ok
>  adr> brne,
2392 ok
>   R18 0B ldi,
8A5A ok
>  <labelb
FAA9 ok
>   R18 0B cpi,         \ >=0B then 0B
9AF1 ok
>  adr> brcs,
800D ok
>   R18 0B ldi,
8A5A ok
>  <labelb
FAA9 ok
>   R18 dec,            \ dec bit counter, 0A..00
D65F ok
>   kbd_CNTR R18 sts,   \ update variable kbd_CNTR
D8DB ok
>  adr> brne,   0 >lbl  \ all 8+3 bits? else end
A944 ok
> 
 ok
>   R16 rol,
63CF ok
>   R17 rol,            \ CY=stopbit
8A74 ok
>  adr> brcc,   1 >lbl  \ CY=0 then error end
A713 ok
>   R16 rol,
63CF ok
>   R17 rol,            \ CY=parity, data
DA58 ok
>   R16 rol,            \ CY=startbit
F41F ok
>  adr> brcs,   2 >lbl  \ CY=1? then error end
FA1E ok
> 
 ok
> \ --- Entry point, R17-scan code
3B4F ok
> 
 ok
>   ZL kbd_FLGR lds,    \ work flags
FB9D ok
>   ZH kbd_FLGR 1+ lds, \ final flags
167E ok
> 
 ok
>   R18 kbd_CNTR 1+ lds, \ buf counters
305F ok
>   R16 R18 mov,        \ read:write counter
7979 ok
>   R16 swap,
2AB1 ok
>   R18 inc,            \ wr+1, next position
BCE2 ok
>   R18 07 andi,        \ 3b counters
9758 ok
>   R16 0F andi,
99A2 ok
>   R16 R18 cp,         \ rd=wr+1? ->no overwrite buf
D171 ok
>  adr> breq,   3 >lbl  \ end
E4CF ok
> 
 ok
>   R16 swap,
2AB1 ok
>   R16 R18 or,         \ rd:wr+1, update counter
3406 ok
> 
 ok
>   R17 E0 cpi,         \ data>=E0 then no update
2ABF ok
>  adr> brcc,   4 >lbl  \ skip for EXTEND or RELEAS
8CF7 ok
> 
 ok
>   kbd_CNTR 1+ R16 sts, \ update position
8770 ok
> 
 ok
> \ --- Flags ---
A18B ok
>  adr> rcall,  5 >lbl  \ make work flags
F831 ok
>  adr> rcall,  6 >lbl  \ make final flags
232D ok
> 
 ok
> \ --- Write to the buf ---
3898 ok
>   R16 clr,            \ write to the kbd_SKEY buf
B760 ok
>   R18 lsl,            \ 2*(wr+1)
B99A ok
>   ZL  kbd_SKEY ldi,   \ addr buf
3A9C ok
>   ZH  kbd_SKEY >< ldi,
73C9 ok
>   ZL  R18 add,
048B ok
>   ZH  R16 adc,        \ ZH:ZL+0:R18
DC41 ok
>   Z+  R17 st,         \ scan code->lo(kbd_SKEY+wr)
D175 ok
>   R17 kbd_FLGR 1+ lds,
E6EA ok
>   Z+  R17 st,         \ flags->hi(kbd_SKEY+wr)
DD03 ok
>   kbd_FLGR 1+ R16 sts, \ clear final flags
469A ok
>   R16 R16 cpse,       \ end
50B3 ok
> 
 ok
> \ --- EXTEND or RELEAS ---
1FC9 ok
>  4 <lbl <labelb
B50D ok
>  adr> rcall,  7 >lbl  \ set flag EXTEND or RELEAS
0AEC ok
> 
 ok
> \ --- End ---
7BBB ok
>  3 <lbl <labelb       \ from No everwrite
0888 ok
>  0 <lbl <labelb       \ from No all bits
425F ok
>  label>               \ from Set err
8042 ok
>   ZL  pop, ZH  pop,
4697 ok
>   R16 pop, R17 pop,
BD8D ok
>   R18 pop, 3F R18 out,
FD19 ok
>   R18 pop,
35C7 ok
>   reti,
F274 ok
> 
 ok
> \ --- Set err ---
B2B4 ok
>  2 <lbl <labelb
B30B ok
>  1 <lbl <labelb
B008 ok
>   R17 kbd_FLGR 1+ lds,
E6EA ok
>   R17 1 ori,
33C1 ok
>   kbd_FLGR 1+ R17 sts, \ set err in final flags
87D5 ok
>  <radr rjmp,           \ jump to end
98A8 ok
> 
 ok
> 
 ok
> \ --- Subroutines ---
AB75 ok
> 
 ok
> \ Set flag EXTEND or RELEAS (E0 or F0)
028E ok
>  7 <lbl <labelr       \ ZH-final flags
1987 ok
>   R17 F0 cpi,         \ R17-scan code
ED06 ok
>  adr> brcc,           \ >=F0 
59BF ok
>   ZH  K-EXTEND-MASK >< ori,
9B64 ok
>   ZH  ZH cpse,
EA85 ok
>  <labelb
FAA9 ok
>   ZH  K-RELEAS-MASK >< ori,
5251 ok
>   kbd_FLGR 1+ ZH sts, \ update final flags
E316 ok
>   ret,                
B6DB ok
> 
 ok
> 
 ok
> \ Make work flags, Caps, LShift, RShift, etc.
D087 ok
>  5 <lbl <labelr    \ R17-scan code, ZL-work flags 
008E ok
>   R16 clr,
FF33 ok
>   R17 77 cpi,      \ num
BCC5 ok
>   1   brne,
8578 ok
>   R16 01 ldi,
E91D ok
>   R17 58 cpi,      \ caps
E13C ok
>   1   brne,
8578 ok
>   R16 02 ldi,
DA1D ok
>   R17 59 cpi,      \ Rshift
5B5C ok
>   1   brne,
8578 ok
>   R16 04 ldi,
BC1D ok
>   R17 12 cpi,      \ Lshift
1BBF ok
>   1   brne,
8578 ok
>   R16 08 ldi,
701D ok
> 
 ok
>   ZH  02 sbrc,     \ E0?
AFB4 ok
>  adr> rjmp,        \ jmp EXTEND
2529 ok
> 
 ok
>   R17 14 cpi,      \ ctrl no EXTEND
592F ok
>   1   brne,
8578 ok
>   R16 10 ldi,
F80C ok
>   R17 11 cpi,      \ alt
CD3C ok
>   1   brne,
8578 ok
>   R16 40 ldi,
F859 ok
>  adr> rjmp,        \ jmp test F0
A29A ok
> 
 ok
>  swap <labelr      \ yes EXTEND
EFC6 ok
>   R17 14 cpi,      \ ctrl
EE5F ok
>   1   brne,
8578 ok
>   R16 20 ldi,
F83F ok
>   R17 11 cpi,      \ alt
CD3C ok
>   1   brne,
8578 ok
>   R16 80 ldi,
F895 ok
> 
 ok
>  <labelr           \ test F0
E557 ok
>   R16 4 cpi,       \ <4
3EBC ok
>  adr> brcs,        \ jmp num or caps
412B ok
>   ZH  03 sbrs,     \ F0?
C0D4 ok
>  adr> rjmp,        \ jmp no RELEAS
6292 ok
>   R16 com,
CFCB ok
>   ZL  R16 and,     \ clear flag
9CC0 ok
>   ZL  ZL cpse,     \ skip
BC41 ok
>  <labelr           \ no RELEAS
C086 ok
>   ZL  R16 or,      \ set flag
C85D ok
>   kbd_FLGR ZL sts, \ update work flags
C78C ok
>   ret,
06AB ok
> 
 ok
>  <labelb           \ num or caps
38F4 ok
>   ZH  03 sbrc,     \ F0?  
9856 ok
>   ret,             \ yes F0
D12C ok
>   ZL  R16 eor,     \ no F0, then flip
FDCE ok
>   kbd_FLGR ZL sts, \ update work flags
C78C ok
>   ret,
06AB ok
> 
 ok
> 
 ok
> \ Make final flags, SHIFT=CAPS xor (LShift or RShift)
E4F0 ok
>  6 <lbl <labelr
BB0F ok
>   R16 K-SHIFT-MASK >< ldi,
32BB ok
>   ZL 7 sbrc,            \ test work flags
91C3 ok
>   ZH K-ALT-MASK >< ori, \ set final flags
71C2 ok
>   ZL 6 sbrc,
E1C9 ok
>   ZH K-ALT-MASK >< ori,
CFC8 ok
>   ZL 5 sbrc,
E1FA ok
>   ZH K-CTRL-MASK >< ori,
2EA7 ok
>   ZL 4 sbrc,
21EA ok
>   ZH K-CTRL-MASK >< ori,
2EA7 ok
>   ZL 3 sbrc,
E19C ok
>   ZH K-SHIFT-MASK >< ori,
8D3F ok
>   ZL 2 sbrc,
218C ok
>   ZH K-SHIFT-MASK >< ori,
8D3F ok
>   ZL 1 sbrc,
21BF ok
>   ZH R16 eor,
C9EC ok
>   ZL 0 sbrc,
E1AF ok
>   ZH K-NUM-MASK >< ori,
E84C ok
>   kbd_FLGR 1+ ZH sts,   \ update final flags
959C ok
>   ret, 
6746 ok
> end-code
4A69 ok
> 
 ok
> 
 ok
> 940C 0006 i! ' kbd_clk i@ 0007 i!  \ Set INT2 vector
E5B5 ok
> 
 ok
>   \ INT2 enabled, clear buf
A833 ok
> : kbd_init ( -- )
7DD9 ok    <bit>
FA8E ok    -int drop
07C7 ok    PORTB c@ 06 or PORTB c!         \ pull-up
B6E0 ok    PORTB 1- c@ F9 and PORTB 1- c!  \ DDRB, PB.1,2 in
3763 ok    54 c@ BF and 54 c!   \ MCUCSR.ISC2=0, 0x34(0x54).6, fall
908F ok    5B c@ 20 or  5B c!   \ GICR.INT2=1,   0x3B(0x5B).5, enable
8C0E ok    +int
C910 ok    0 kbd_CNTR ! 0 kbd_ROTR ! 1 kbd_FLGR ! \ all reset, set num
5140 ok    10 0 do 0 kbd_SKEY i + c! loop  \ clear buffer
D872 ok    -1 PENDING-CHAR ! ;
DB80 ok
> 
 ok
> 
 ok
>   \ convert scan code to visible char
830C ok
> : kbd_char ( u -- char ) \ u=|alt|ctrl|shift|num|releas|extend|0|0|:|8b code|
6198 ok    dup 7F and dup            \ -- u c c
421F ok    kbd_CHARTAB + i@          \ -- u c 2char
41F8 ok    swap                      \ -- u 2char c
5DDB ok    dup 68 > swap 7E < and    \ c=69..7D then num else shift
6BA8 ok    if                        \ -- u 2char
42C1 ok      swap K-NUM-MASK and     \ num?
4197 ok    else
BCDE ok      swap K-SHIFT-MASK and   \ shift?
A8A5 ok    then
E6D5 ok    if >< then                \ swap byte in 2char, Hi->Lo
BB17 ok    FF and ;                  \ -- char
AA81 ok
> 
 ok
> 
 ok
>   \ convert scan code to ascii,+ctrl+alt
9EEB ok
> : kbd_ascii ( u -- char )
E57D ok    dup 0C00 and              \ releas,extend?
247F ok    if drop 00 exit then      \ event, char 00
2075 ok    dup kbd_char              \ -- u char
26CF ok    dup 0=
4280 ok    if swap drop exit then    \ -- 00, isn't visible char
A4A8 ok    over K-CTRL-MASK and      \ -- u char, ctrl?
1FFE ok    if 
C14D ok      dup 3F > over 60 < and  \ 64<=char<96
B814 ok      if
0641 ok        40 -                  \ -- char-64
CE2B ok      else
1B76 ok        drop drop 00 exit     \ event, char 00
EAB6 ok      then
417D ok    then
E6D5 ok    swap K-ALT-MASK and       \ alt?
ABEE ok    if 80 + then ;            \ -- char+128    
3A26 ok
> 
 ok
> 
 ok
>   \ int-, set b7 in kbd_CNTR, int+
8B77 ok
> code kbd_b7set 
B31E ok
>   R18 push,
57B1 ok
>   R18 3F in,          \ SREG 0x3F(0x5F)
0787 ok
>   R18 push,
57B1 ok
>   cli,
6877 ok
>   R18 kbd_CNTR lds,   \ bit counter reg
6677 ok
>   R18 80 ori,         \ set b7
B544 ok
>   kbd_CNTR R18 sts,
820A ok
>   sei,
AAA3 ok
>   R18 pop, 3F R18 out,
FD19 ok
>   R18 pop,
35C7 ok
> end-code
4A69 ok
> 
 ok
> 
 ok
>   \ int-, b7=1? then clear kbd_CNTR, int+
C394 ok
> code kbd_b7tst 
03FE ok
>   R18 push,
57B1 ok
>   R18 3F in,          \ SREG 0x3F(0x5F)
0787 ok
>   R18 push,
57B1 ok
>   cli,
6877 ok
> 
 ok
>   R18 kbd_CNTR lds,   \ bit counter reg
6677 ok
>   R18 rol,
4DCE ok
>  adr> brcc,           \ b7=0? then end
8EC0 ok
>   R18 clr,
D132 ok
>   kbd_CNTR R18 sts,   \ clear bits counter
44E0 ok
> 
 ok
>  <labelb
FAA9 ok
>   sei,
AAA3 ok
>   R18 pop, 3F R18 out,
FD19 ok
>   R18 pop,
35C7 ok
> end-code
4A69 ok
> 
 ok
> 
 ok
>   \ sync clk - set bit, wait, int2 clear this bit
F8D1 ok
> : kbd_sync ( -- )     \ v.1.1 15ms->3ms, int-, int+
F320 ok    kbd_b7set         \ set b7 in kbd_CNTR
AD63 ok    3 ms
8D86 ok    kbd_b7tst ;       \ b7=1? then clear bits counter
E291 ok
> 
 ok
> 
 ok
>   \ keyboard events?, rd<>wr counter
10A5 ok
> : kbd_ekey? ( -- flag )
2ABE ok    kbd_FLGR 1+ c@ 1 and      \ flag err is set in kbd_clk
A49F ok    if
CC22 ok      kbd_FLGR 1+ dup c@      \ -- addr c
AC0C ok      FE and swap c!          \ clear err
82E7 ok      3 ms 0 kbd_CNTR c!      \ if err then sync
CA02 ok    then
E6D5 ok    kbd_CNTR 1+ c@            \ -- rd:wr, 3b counters
76BA ok    dup 4 lshift F0 and       \ -- rd:wr wr:0
2880 ok    swap F0 and xor ;         \ wr=rd?, 0 is false
3881 ok
> 
 ok
> 
 ok
>   \ Read event, scan code from buffer
F9CB ok
> : kbd_ekey ( -- u )  \ |alt|ctrl|shift|num|releas|extend|0|0|:|8b code|
F849 ok    begin kbd_ekey? until     \ events?
BD01 ok    kbd_CNTR 1+ dup c@ dup    \ -- addr addr rd:wr rd:wr
D840 ok    4 rshift 1+ 07 and        \ -- addr addr rd:wr 0:rd+1
B414 ok    >r 0F and r@ 4 lshift or  \ -- addr addr rd+1:wr 
1269 ok    swap c!                   \ -- addr, update counter rd
84C7 ok    r> 2* kbd_SKEY + @        \ kbd_SKEY+2*(rd+1) @
AD3B ok    kbd_sync ;                \ sync after stopbit
9768 ok
> 
 ok
> 
 ok
>   \ convert num '/','enter' to char
EB02 ok
> : kbd_numchar ( u -- u|char )
A5E1 ok    dup 0FFF and dup     \ -- u1 u2 u2
FC3C ok    054A = swap 55A = or \ -- u1 flag
7BE3 ok    if
CC22 ok      F0FF and kbd_ascii \ num '/','enter'
9B5E ok    then ;
0987 ok
> 
 ok
> 
 ok
> : ekey? ( -- flag )
9BEA ok    kbd_ekey? ;
E119 ok
> 
 ok
> 
 ok
>   \ Ascii char or u scan code
C8F1 ok
> : ekey ( -- char|u )
BA67 ok    kbd_ekey dup kbd_ascii  \ -- u char
7588 ok    ?dup 0=
A0B3 ok    if
CC22 ok      K-EVENTS-MASK or      \ -- u+256
E658 ok      K-NUM-MASK invert and \ clear num
A73D ok    else
BCDE ok      swap drop             \ -- char
4413 ok    then
E6D5 ok    kbd_numchar ;           \ '/','enter'
AEDD ok
> 
 ok
> 
 ok
> : ekey>char ( u -- u false|char true)
6F19 ok    dup FF u>
ED46 ok    if false else true then ;
27E4 ok
> 
 ok
> 
 ok
> : ekey>fkey ( u1 -- u2 flag )
973F ok    dup ekey>char swap drop 0= ;
833E ok
> 
 ok
> 
 ok
> : ps2key?  ( -- flag )
BD1E ok    PENDING-CHAR @ 0<
DA56 ok    if
CC22 ok      begin
52E8 ok        ekey?
56C9 ok      while
69C4 ok        ekey ekey>char
687F ok        if
A1E9 ok          PENDING-CHAR ! true exit
784B ok        then drop
135A ok      repeat false exit
390A ok    then true ;
B6D3 ok
> 
 ok
> 
 ok
> : ps2key  ( -- char )
37E6 ok    PENDING-CHAR @ 0<
DA56 ok    if
CC22 ok      begin
52E8 ok        ekey ekey>char 0=
03CA ok      while
69C4 ok        drop
94E0 ok      repeat exit
50D5 ok    then
E6D5 ok    PENDING-CHAR @ -1 PENDING-CHAR ! ;
F555 ok
> 
 ok
> 
 ok
>   \ Switch key to ps2 keyboard
3DC2 ok
> : key->ps2 ( -- )
B006 ok    ['] ps2key  ['] key  defer!
6941 ok    ['] ps2key? ['] key? defer!
1338 ok    ['] noop    ['] /key defer! ; \ v.1.1 add /key
D150 ok
> 
 ok
> 
 ok
>   \ Switch key to serial port
0B12 ok
> : key->rx0 ( -- )
9355 ok    ['] rx0  ['] key  defer!
EA47 ok    ['] rx0? ['] key? defer! ;
1F48 ok
> 
 ok
> -crc
DF9D ok
> 
 ok
> words
key->rx0 key->ps2 ps2key ps2key? ekey>fkey ekey>char ekey ekey? kbd_numchar kbd_
ekey kbd_ekey? kbd_sync kbd_b7tst kbd_b7set kbd_ascii kbd_char kbd_init kbd_clk 
K-EVENTS-MASK K-EXTEND-MASK K-RELEAS-MASK K-NUM-MASK K-SHIFT-MASK K-CTRL-MASK K-
ALT-MASK kbd_SKEY kbd_FLGR kbd_ROTR kbd_CNTR PENDING-CHAR kbd_CHARTAB <kbd> <lcd
> <mpc> <bit> ms false true assembler forth vocabulary definitions headcur headc
on current context b> >b b!- b!+ nb! b! b@- b@+ nb@ b@ a> >a a!- a!+ na! a! a@- 
a@+ na@ a@ cmove spirw sleep wdr -wdt -jtag d2/ s>d up! up@ 0 1ms >< cmove> i! i
@ unloop i sp! sp@ rp! rp@ +! rshift lshift 1- 1+ xor or and 2* 2/ invert um* um
/mod m* + - log2 d< d> u> u< 0> 0< > < 0= = <> r@ >r r> rot drop over swap ?dup 
dup c@ c! ! @ e@ e! execute exit -int +int end-code code abort abort" [char] imm
ediate recurse user constant variable [ ] ; :noname : does> create ?do leave +lo
op loop do again until repeat while begin then else if literal int! applturnkey 
is Rdefer Edefer words s" ." .s u. dinvert d- d+ d2* dnegate dabs d>s >usart0 +u
sart0 baud0 tx0? tx0 rx0? rx0 mpc_ID j * defer@ defer! icompare (find) find to v
alue unused noop ver interpret depth rp0 sp sp0 cold pause quit place word /stri
ng source cscan parse number char refill accept cskip throw catch handler ' type
 count spaces space cr icount itype s, digit ud/mod ud.r ud. . d. .r d.r sign #>
 #s # <# hold hld max min abs mod / negate u/mod */ /mod */mod turnkey heap edp 
bl hex decimal ['] , compile ( \ allot here head /key key? key emit? emit pad ti
bsize tib #tib >in cell+ cells base state f_cpu (antic) >antic antic -antic +ant
ic crc crctest -crc +crc -echo +echo echo  ok
> <bit>
 ok
> words
PORTB PORTC UCSRC UCSRB UCSRA PORTD toggle pin@ pin_low? pin_high? pin_input pin
_output pin! is_high? is_low? pulse low high bitmask: portpin: <bit> ms false tr
ue assembler forth vocabulary definitions headcur headcon current context b> >b 
b!- b!+ nb! b! b@- b@+ nb@ b@ a> >a a!- a!+ na! a! a@- a@+ na@ a@ cmove spirw sl
eep wdr -wdt -jtag d2/ s>d up! up@ 0 1ms >< cmove> i! i@ unloop i sp! sp@ rp! rp
@ +! rshift lshift 1- 1+ xor or and 2* 2/ invert um* um/mod m* + - log2 d< d> u>
 u< 0> 0< > < 0= = <> r@ >r r> rot drop over swap ?dup dup c@ c! ! @ e@ e! execu
te exit -int +int end-code code abort abort" [char] immediate recurse user const
ant variable [ ] ; :noname : does> create ?do leave +loop loop do again until re
peat while begin then else if literal int! applturnkey is Rdefer Edefer words s"
 ." .s u. dinvert d- d+ d2* dnegate dabs d>s >usart0 +usart0 baud0 tx0? tx0 rx0?
 rx0 mpc_ID j * defer@ defer! icompare (find) find to value unused noop ver inte
rpret depth rp0 sp sp0 cold pause quit place word /string source cscan parse num
ber char refill accept cskip throw catch handler ' type count spaces space cr ic
ount itype s, digit ud/mod ud.r ud. . d. .r d.r sign #> #s # <# hold hld max min
 abs mod / negate u/mod */ /mod */mod turnkey heap edp bl hex decimal ['] , comp
ile ( \ allot here head /key key? key emit? emit pad tibsize tib #tib >in cell+ 
cells base state f_cpu (antic) >antic antic -antic +antic crc crctest -crc +crc 
-echo +echo echo  ok
> forth
 ok
> words
<kbd> <lcd> <mpc> <bit> ms false true assembler forth vocabulary definitions hea
dcur headcon current context b> >b b!- b!+ nb! b! b@- b@+ nb@ b@ a> >a a!- a!+ n
a! a! a@- a@+ na@ a@ cmove spirw sleep wdr -wdt -jtag d2/ s>d up! up@ 0 1ms >< c
move> i! i@ unloop i sp! sp@ rp! rp@ +! rshift lshift 1- 1+ xor or and 2* 2/ inv
ert um* um/mod m* + - log2 d< d> u> u< 0> 0< > < 0= = <> r@ >r r> rot drop over 
swap ?dup dup c@ c! ! @ e@ e! execute exit -int +int end-code code abort abort" 
[char] immediate recurse user constant variable [ ] ; :noname : does> create ?do
 leave +loop loop do again until repeat while begin then else if literal int! ap
plturnkey is Rdefer Edefer words s" ." .s u. dinvert d- d+ d2* dnegate dabs d>s 
>usart0 +usart0 baud0 tx0? tx0 rx0? rx0 mpc_ID j * defer@ defer! icompare (find)
 find to value unused noop ver interpret depth rp0 sp sp0 cold pause quit place 
word /string source cscan parse number char refill accept cskip throw catch hand
ler ' type count spaces space cr icount itype s, digit ud/mod ud.r ud. . d. .r d
.r sign #> #s # <# hold hld max min abs mod / negate u/mod */ /mod */mod turnkey
 heap edp bl hex decimal ['] , compile ( \ allot here head /key key? key emit? e
mit pad tibsize tib #tib >in cell+ cells base state f_cpu (antic) >antic antic -
antic +antic crc crctest -crc +crc -echo +echo echo  ok
>