aboutsummaryrefslogtreecommitdiff
path: root/amforth-6.5/avr8/lib/hardware/keyboard.frt
blob: 7182f26e961497a3b46e355dca709292cfef7f17 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
\ Keyboard PS/2 - Lubos Pekny, www.forth.cz
\ Library for amforth 3.0 mFC 1.0

\ V.1.2v, 29.01.2009, add vocabulary

\ V.1.2, 14.01.2009, tested on atmega32, amforth 3.0
\ - add err bit in kbd_FLGR
\ - add sync to kbd_ekey?

\ V.1.1, 06.07.2008, tested on atmega32, amforth 2.7
\ - changes in key->ps2, kbd_ascii, kbd_sync, appl_kbdlcd
\ - optimalized restart and clk-sync

\ V.1.0, 03.07.2008, tested on atmega32, amforth 2.7
\ - used INT2 + 1 pin
\ - kbd_init  kbd_char  kbd_ekey?  kbd_ekey
\ - ekey?  ekey  ekey>char  ekey>fkey  key?  key

\ a = char a $61
\ shift+a = char A $41
\ ctrl+a = no char, events $401C
\ ctrl+shift+a = char $01
\ alt+char = $80+char
\ alt+ctrl+shift+a = char $81

#include key2char.frt  \ V 1.0, 26.05.2008

hex

forth
<bit> definitions     \ into vocabulary <bit>

38 constant PORTB     \ Atmega32, PB.2 (INT2)<-clk, PB.1 (in)<-data out

forth
<kbd> definitions     \ into vocabulary <kbd>

variable PENDING-CHAR \ for key?, key
variable kbd_CNTR     \ r4:w4:b8, 8bit+2x4b circular buf counters
variable kbd_ROTR     \ received bits from keyboard
variable kbd_FLGR     \ flags, final hi=|alt|ctrl|shift|num|releas|extend|0|err|
                      \ work lo=|altL|altR|ctrlL|ctrlR|shiftL|shiftR|caps|num|
variable kbd_SKEY     \ keyboard scan code+flags
  8 cells allot       \ 8 events buf

8000 constant K-ALT-MASK
4000 constant K-CTRL-MASK
2000 constant K-SHIFT-MASK
1000 constant K-NUM-MASK
0800 constant K-RELEAS-MASK
0400 constant K-EXTEND-MASK
0100 constant K-EVENTS-MASK


  \ interrupt, keyboard clock 
code kbd_clk
  R18 push,
  R18 3F in,          \ SREG 0x3F(0x5F)
  R18 push,
  R17 push, R16 push,
  ZH  push, ZL  push,

\ --- Receive bits --
  R16 kbd_ROTR lds,   \ received bits reg
  R17 kbd_ROTR 1+ lds,
  clc,                \ CY=0
  <bit> PORTB assembler
  22 - 1 sbic,        \ PinB.1=1 then CY=1
  sec,
  R17 ror, R16 ror,   \ CY->R17.7->R16, rotate
  kbd_ROTR 1+ R17 sts,
  kbd_ROTR R16 sts,   \ update variable kbd_ROTR

  R18 kbd_CNTR lds,   \ bit counter reg
  R18 0F andi,
  R18 00 cpi,         \ =0 then 0B
 adr> brne,
  R18 0B ldi,
 <labelb
  R18 0B cpi,         \ >=0B then 0B
 adr> brcs,
  R18 0B ldi,
 <labelb
  R18 dec,            \ dec bit counter, 0A..00
  kbd_CNTR R18 sts,   \ update variable kbd_CNTR
 adr> brne,   0 >lbl  \ all 8+3 bits? else end

  R16 rol,
  R17 rol,            \ CY=stopbit
 adr> brcc,   1 >lbl  \ CY=0 then error end
  R16 rol,
  R17 rol,            \ CY=parity, data
  R16 rol,            \ CY=startbit
 adr> brcs,   2 >lbl  \ CY=1? then error end

\ --- Entry point, R17-scan code

  ZL kbd_FLGR lds,    \ work flags
  ZH kbd_FLGR 1+ lds, \ final flags

  R18 kbd_CNTR 1+ lds, \ buf counters
  R16 R18 mov,        \ read:write counter
  R16 swap,
  R18 inc,            \ wr+1, next position
  R18 07 andi,        \ 3b counters
  R16 0F andi,
  R16 R18 cp,         \ rd=wr+1? ->no overwrite buf
 adr> breq,   3 >lbl  \ end

  R16 swap,
  R16 R18 or,         \ rd:wr+1, update counter

  R17 E0 cpi,         \ data>=E0 then no update
 adr> brcc,   4 >lbl  \ skip for EXTEND or RELEAS

  kbd_CNTR 1+ R16 sts, \ update position

\ --- Flags ---
 adr> rcall,  5 >lbl  \ make work flags
 adr> rcall,  6 >lbl  \ make final flags

\ --- Write to the buf ---
  R16 clr,            \ write to the kbd_SKEY buf
  R18 lsl,            \ 2*(wr+1)
  ZL  kbd_SKEY ldi,   \ addr buf
  ZH  kbd_SKEY >< ldi,
  ZL  R18 add,
  ZH  R16 adc,        \ ZH:ZL+0:R18
  Z+  R17 st,         \ scan code->lo(kbd_SKEY+wr)
  R17 kbd_FLGR 1+ lds,
  Z+  R17 st,         \ flags->hi(kbd_SKEY+wr)
  kbd_FLGR 1+ R16 sts, \ clear final flags
  R16 R16 cpse,       \ end

\ --- EXTEND or RELEAS ---
 4 <lbl <labelb
 adr> rcall,  7 >lbl  \ set flag EXTEND or RELEAS

\ --- End ---
 3 <lbl <labelb       \ from No everwrite
 0 <lbl <labelb       \ from No all bits
 label>               \ from Set err
  ZL  pop, ZH  pop,
  R16 pop, R17 pop,
  R18 pop, 3F R18 out,
  R18 pop,
  reti,

\ --- Set err ---
 2 <lbl <labelb
 1 <lbl <labelb
  R17 kbd_FLGR 1+ lds,
  R17 1 ori,
  kbd_FLGR 1+ R17 sts, \ set err in final flags
 <radr rjmp,           \ jump to end


\ --- Subroutines ---

\ Set flag EXTEND or RELEAS (E0 or F0)
 7 <lbl <labelr       \ ZH-final flags
  R17 F0 cpi,         \ R17-scan code
 adr> brcc,           \ >=F0 
  ZH  K-EXTEND-MASK >< ori,
  ZH  ZH cpse,
 <labelb
  ZH  K-RELEAS-MASK >< ori,
  kbd_FLGR 1+ ZH sts, \ update final flags
  ret,                


\ Make work flags, Caps, LShift, RShift, etc.
 5 <lbl <labelr    \ R17-scan code, ZL-work flags 
  R16 clr,
  R17 77 cpi,      \ num
  1   brne,
  R16 01 ldi,
  R17 58 cpi,      \ caps
  1   brne,
  R16 02 ldi,
  R17 59 cpi,      \ Rshift
  1   brne,
  R16 04 ldi,
  R17 12 cpi,      \ Lshift
  1   brne,
  R16 08 ldi,

  ZH  02 sbrc,     \ E0?
 adr> rjmp,        \ jmp EXTEND

  R17 14 cpi,      \ ctrl no EXTEND
  1   brne,
  R16 10 ldi,
  R17 11 cpi,      \ alt
  1   brne,
  R16 40 ldi,
 adr> rjmp,        \ jmp test F0

 swap <labelr      \ yes EXTEND
  R17 14 cpi,      \ ctrl
  1   brne,
  R16 20 ldi,
  R17 11 cpi,      \ alt
  1   brne,
  R16 80 ldi,

 <labelr           \ test F0
  R16 4 cpi,       \ <4
 adr> brcs,        \ jmp num or caps
  ZH  03 sbrs,     \ F0?
 adr> rjmp,        \ jmp no RELEAS
  R16 com,
  ZL  R16 and,     \ clear flag
  ZL  ZL cpse,     \ skip
 <labelr           \ no RELEAS
  ZL  R16 or,      \ set flag
  kbd_FLGR ZL sts, \ update work flags
  ret,

 <labelb           \ num or caps
  ZH  03 sbrc,     \ F0?  
  ret,             \ yes F0
  ZL  R16 eor,     \ no F0, then flip
  kbd_FLGR ZL sts, \ update work flags
  ret,


\ Make final flags, SHIFT=CAPS xor (LShift or RShift)
 6 <lbl <labelr
  R16 K-SHIFT-MASK >< ldi,
  ZL 7 sbrc,            \ test work flags
  ZH K-ALT-MASK >< ori, \ set final flags
  ZL 6 sbrc,
  ZH K-ALT-MASK >< ori,
  ZL 5 sbrc,
  ZH K-CTRL-MASK >< ori,
  ZL 4 sbrc,
  ZH K-CTRL-MASK >< ori,
  ZL 3 sbrc,
  ZH K-SHIFT-MASK >< ori,
  ZL 2 sbrc,
  ZH K-SHIFT-MASK >< ori,
  ZL 1 sbrc,
  ZH R16 eor,
  ZL 0 sbrc,
  ZH K-NUM-MASK >< ori,
  kbd_FLGR 1+ ZH sts,   \ update final flags
  ret, 
end-code


940C 0006 i! ' kbd_clk i@ 0007 i!  \ Set INT2 vector

  \ INT2 enabled, clear buf
: kbd_init ( -- )
    <bit>
    -int drop
    PORTB c@ 06 or PORTB c!         \ pull-up
    PORTB 1- c@ F9 and PORTB 1- c!  \ DDRB, PB.1,2 in
    54 c@ BF and 54 c!   \ MCUCSR.ISC2=0, 0x34(0x54).6, fall
    5B c@ 20 or  5B c!   \ GICR.INT2=1,   0x3B(0x5B).5, enable
    +int
    0 kbd_CNTR ! 0 kbd_ROTR ! 1 kbd_FLGR ! \ all reset, set num
    10 0 do 0 kbd_SKEY i + c! loop  \ clear buffer
    -1 PENDING-CHAR ! ;


  \ convert scan code to visible char
: kbd_char ( u -- char ) \ u=|alt|ctrl|shift|num|releas|extend|0|0|:|8b code|
    dup 7F and dup            \ -- u c c
    kbd_CHARTAB + i@          \ -- u c 2char
    swap                      \ -- u 2char c
    dup 68 > swap 7E < and    \ c=69..7D then num else shift
    if                        \ -- u 2char
      swap K-NUM-MASK and     \ num?
    else
      swap K-SHIFT-MASK and   \ shift?
    then
    if >< then                \ swap byte in 2char, Hi->Lo
    FF and ;                  \ -- char


  \ convert scan code to ascii,+ctrl+alt
: kbd_ascii ( u -- char )
    dup 0C00 and              \ releas,extend?
    if drop 00 exit then      \ event, char 00
    dup kbd_char              \ -- u char
    dup 0=
    if swap drop exit then    \ -- 00, isn't visible char
    over K-CTRL-MASK and      \ -- u char, ctrl?
    if 
      dup 3F > over 60 < and  \ 64<=char<96
      if
        40 -                  \ -- char-64
      else
        drop drop 00 exit     \ event, char 00
      then
    then
    swap K-ALT-MASK and       \ alt?
    if 80 + then ;            \ -- char+128    


  \ int-, set b7 in kbd_CNTR, int+
code kbd_b7set 
  R18 push,
  R18 3F in,          \ SREG 0x3F(0x5F)
  R18 push,
  cli,
  R18 kbd_CNTR lds,   \ bit counter reg
  R18 80 ori,         \ set b7
  kbd_CNTR R18 sts,
  sei,
  R18 pop, 3F R18 out,
  R18 pop,
end-code


  \ int-, b7=1? then clear kbd_CNTR, int+
code kbd_b7tst 
  R18 push,
  R18 3F in,          \ SREG 0x3F(0x5F)
  R18 push,
  cli,

  R18 kbd_CNTR lds,   \ bit counter reg
  R18 rol,
 adr> brcc,           \ b7=0? then end
  R18 clr,
  kbd_CNTR R18 sts,   \ clear bits counter

 <labelb
  sei,
  R18 pop, 3F R18 out,
  R18 pop,
end-code


  \ sync clk - set bit, wait, int2 clear this bit
: kbd_sync ( -- )     \ v.1.1 15ms->3ms, int-, int+
    kbd_b7set         \ set b7 in kbd_CNTR
    3 ms
    kbd_b7tst ;       \ b7=1? then clear bits counter


  \ keyboard events?, rd<>wr counter
: kbd_ekey? ( -- flag )
    kbd_FLGR 1+ c@ 1 and      \ flag err is set in kbd_clk
    if
      kbd_FLGR 1+ dup c@      \ -- addr c
      FE and swap c!          \ clear err
      3 ms 0 kbd_CNTR c!      \ if err then sync
    then
    kbd_CNTR 1+ c@            \ -- rd:wr, 3b counters
    dup 4 lshift F0 and       \ -- rd:wr wr:0
    swap F0 and xor ;         \ wr=rd?, 0 is false


  \ Read event, scan code from buffer
: kbd_ekey ( -- u )  \ |alt|ctrl|shift|num|releas|extend|0|0|:|8b code|
    begin kbd_ekey? until     \ events?
    kbd_CNTR 1+ dup c@ dup    \ -- addr addr rd:wr rd:wr
    4 rshift 1+ 07 and        \ -- addr addr rd:wr 0:rd+1
    >r 0F and r@ 4 lshift or  \ -- addr addr rd+1:wr 
    swap c!                   \ -- addr, update counter rd
    r> 2* kbd_SKEY + @        \ kbd_SKEY+2*(rd+1) @
    kbd_sync ;                \ sync after stopbit


  \ convert num '/','enter' to char
: kbd_numchar ( u -- u|char )
    dup 0FFF and dup     \ -- u1 u2 u2
    054A = swap 55A = or \ -- u1 flag
    if
      F0FF and kbd_ascii \ num '/','enter'
    then ;


: ekey? ( -- flag )
    kbd_ekey? ;


  \ Ascii char or u scan code
: ekey ( -- char|u )
    kbd_ekey dup kbd_ascii  \ -- u char
    ?dup 0=
    if
      K-EVENTS-MASK or      \ -- u+256
      K-NUM-MASK invert and \ clear num
    else
      swap drop             \ -- char
    then
    kbd_numchar ;           \ '/','enter'


: ekey>char ( u -- u false|char true)
    dup FF u>
    if false else true then ;


: ekey>fkey ( u1 -- u2 flag )
    dup ekey>char swap drop 0= ;


: ps2key?  ( -- flag )
    PENDING-CHAR @ 0<
    if
      begin
        ekey?
      while
        ekey ekey>char
        if
          PENDING-CHAR ! true exit
        then drop
      repeat false exit
    then true ;


: ps2key  ( -- char )
    PENDING-CHAR @ 0<
    if
      begin
        ekey ekey>char 0=
      while
        drop
      repeat exit
    then
    PENDING-CHAR @ -1 PENDING-CHAR ! ;


  \ Switch key to ps2 keyboard
: key->ps2 ( -- )
    ['] ps2key  ['] key  defer!
    ['] ps2key? ['] key? defer!
    ['] noop    ['] /key defer! ; \ v.1.1 add /key


  \ Switch key to serial port
: key->rx0 ( -- )
    ['] rx0  ['] key  defer!
    ['] rx0? ['] key? defer! ;


  \ Alone system PS2-keyboard+LCD20x4
  \ PS2 keyboard started slowly. To delay amforth abouth 0.5s
  \ +echo or set eeprom $14.0=H if you need view keyboard char
: appl_kbdlcd
    200 ms \ v.1.1, to delay amforth or app restart
    <lcd>
    applturnkey
    kbd_init scr_init
    key->ps2 emit->scr
    ver ;


\ Write to the eeprom appl started after switch on.
\ ' appl_kbdlcd 0A e!   \ PS2+LCD
\ ' applturnkey 0A e!   \ UART0
\ ' appl_mpc 0A e!      \ applturnkey+slave detect


\ ----- Test key -----

  \ info about pressed key, 'Ctrl+c' end loop
: kbd_info ( -- )
    begin
      ekey               \ get char|event
      dup 21             \ 'c'
      K-EVENTS-MASK or   \ event, no ascii
      K-CTRL-MASK or <>  \ ctrl+c?
    while
      dup u. space       \ code
      dup FF u>          \ char
      if drop else emit then
      cr
    repeat drop ;

  \ write text, 'Esc' end loop
: kbd_writer ( -- )
    begin
      ps2key             \ get char
      dup 1B <>          \ Esc?
    while
      emit               \ view char
    repeat drop ;

\ end of file