retroforth/vm/nga-c-native-x86/x86/keyboard.retro
crc ea8e12d32a finish reorg of main sources
FossilOrigin-Name: 6a7ee82ed6b024ee1d8f7a51a9b91a66a8041cde06b53cce649d6bd383ae9677
2019-11-22 18:30:02 +00:00

36 lines
1.1 KiB
Forth

~~~
0x60 'keyboard:DATA const
0x64 'keyboard:STATUS const
:keyboard:wait
[ keyboard:STATUS pio:in-byte #1 and n:-zero? ] until ;
:keyboard:read
keyboard:DATA pio:in-byte ;
:uuu
keyboard:wait
#0 [ drop keyboard:read 0x7F and dup 0x39 gt? [ drop keyboard:wait #0 ] if dup #0 -eq? ] until ;
'keyboard:Dvorak d:create
#0 , #27 , $1 , $2 , $3 , $4 , $5 , $6 , $7 , $8 , $9 , $0 , $[ , $] , #8 ,
#9 , $' , $, , $. , $p , $y , $f , $g , $c , $r , $l , $/ , $= , #10 ,
#-1 , $a , $o , $e , $u , $i , $d , $h , $t , $n , $s , $- , $` ,
#-1 , $\ , $; , $q , $j , $k , $x , $b , $m , $w , $v , $z ,
#-1 , $* , #0 , #32 , #32 ,
'keyboard:Dvorak:Shifted d:create
#0 , #27 , $! , $@ , $# , $$ , $% , $^ , $& , $* , $( , $) , ${ , $} , #8 ,
#9 , $" , $< , $> , $P , $Y , $F , $G , $C , $R , $L , $? , $+ , #10 ,
#-1 , $A , $O , $E , $U , $I , $D , $H , $T , $N , $S , $_ , $~ ,
#-1 , $| , $: , $Q , $J , $K , $X , $B , $M , $W , $V , $Z ,
#-1 , $* , #0 , #32 , #32 ,
{{
:n &keyboard:Dvorak + fetch ;
:N &keyboard:Dvorak:Shifted + fetch ;
---reveal---
:getc uuu drop uuu n dup #-1 eq? [ drop uuu drop uuu N ] if dup c:put ;
}}
~~~