fl

{
Device(mouse,keyboard,TV) I/F  for PropForth
    PropForth 4.0a compatible
    SPI communication 
          master(protoboard)             slave(demoboard)
                 P8    ----- 220ohm ----- P0
                 P9    ----- 220ohm ----- P1
                 P10   ----- 220ohm ----- P2
                 P11   ----- 220ohm ----- P3
          
08/05/2011 11:40:11          
}


: variable lockdict create $C_a_dovarl w, 0 l, forthentry freedict ; 
0 _crf W!

: .long dup 10 rshift .word .word ;
: _sttop 2e _cv ;
: _stptr 5 _cv ;  
: st? ." ST: " _stptr COG@ 2+ dup _sttop < if _sttop swap - 0 do _sttop 2- i -  COG@ .long space loop else drop then cr ;

: msg c" May the FORTH be with you" ;
: kb c" Keyboard is " ;
: ms c" Mouse is " ;
: msg1 c" not connected" ;
: msg2 c" connected" ;
: mouse1 c" 2-button mouse" ;
: mouse2 c" 3-button mouse" ;
: mouse3 c" 5-button mouse" ;
: button c" button status" ;
: mouse4 c" left center right" ;
: mouse5 c" deltax deltay deltaz" ;
: on c" ON " ;
: off c" OFF" ;


8 wconstant _mosi        \ master --> slave
9 wconstant _sclk        \ master --> slave
a wconstant _cs          \ master --> slave
b wconstant _miso        \ master <-- slave  

1 _miso lshift constant _misom
{
1 _mosi lshift constant _mosim 
1 _sclk lshift constant _sclkm
1 _cs lshift constant _csm
1 _miso lshift constant _misom

: _mosi_out_l _mosim _maskoutlo ;
: _mosi_out_h _mosim _maskouthi ;
: _sclk_out_l _sclkm _maskoutlo ;
: _sclk_out_h _sclkm _maskouthi ;
: _cs_out_l _csm _maskoutlo ;
: _cs_out_h _csm _maskouthi ;
}
: _mosi_out_l _mosi pinlo ;
: _mosi_out_h _mosi pinhi ;
: _sclk_out_l _sclk pinlo ;
: _sclk_out_h _sclk pinhi ;
: _cs_out_l _cs pinlo ;
: _cs_out_h _cs pinhi ;

: sub_shift_out      \ ( n -- ) send 1byte to slave(DemonBoard) 
8 0 do
     dup 1 7 i - lshift and  
     0> if _mosi_out_h else _mosi_out_l then
\     0 <> if ." 1" _mosi_out_h else ." 0" _mosi_out_l then     
     _sclk_out_l 1 delms _sclk_out_h 
loop
drop
;

: sub_shift_in       \ ( -- n) receive 1byte from slave(DemoBoard)
0
8 0 do     
     1 lshift   
     _sclk_out_l 2 delms _sclk_out_h                      
     ina COG@ _misom and 0> if 1+ then
\     ina COG@ _misom and dup . 0> if 1+ then
loop   cr
; 

: sub_shift_out_delay sub_shift_out 1 delms ;

\ status for keyboard and mouse
\    upper 4bit 0:no keyboard   f:keyboard connected
\    lower 4bit 0:no mouse 1:2-button mouse 2:3-button mouse  4:5-button mouse

: sub_init  \ ( -- n ) n:status for mouse/keyboard existance     
_mosi 3 0 do dup pinout 1+ loop drop
_miso pinin
_sclk_out_h _cs_out_h

_cs_out_l
5 \ sub_shift_out   
\ 1 delms
sub_shift_out_delay
sub_shift_in 
_cs_out_h
1 delms  
;

\ get mouse data
\     n1:delta-z
\     n2:delta-y
\     n3:delta-x
\     n4:botton status bit0:Left bit1:Right bit2:Center bit3:Left-side bit4:Right-side
: get_mouse     \ ( -- n1 n2 n3 n4 )                             
_cs_out_l
a \ sub_shift_out   
\ 1 delms
sub_shift_out_delay
4 0 do sub_shift_in loop
_cs_out_h
;

\ get key code from keyboard
: get_kb       \ ( -- n ) n:key code
_cs_out_l
14 \ sub_shift_out   
\ 1 delms
sub_shift_out_delay
sub_shift_in 
_cs_out_h
;

\ print charcter-string
: tv_string       \ ( n -- )  n:address of string
_cs_out_l 
1e \ sub_shift_out 
\ 1 delms
sub_shift_out_delay
dup C@ swap 1+ dup rot bounds do C@++ sub_shift_out 1 delms loop drop
0 sub_shift_out
_cs_out_h   
a delms
;


\ print spaces to tv-screen
: tv_spaces    \ ( n -- ) n:number of space
_cs_out_l 
1e \ sub_shift_out  
\ 1 delms
sub_shift_out_delay
0 do 20 sub_shift_out 1 delms loop 
0 sub_shift_out
_cs_out_h
a delms
;

\ print decimal
: tv_dec       \ ( n -- )  n:decimal
_cs_out_l 
1f \ sub_shift_out  
\ 1 delms
sub_shift_out_delay
sub_shift_out 1 delms 
0 sub_shift_out
_cs_out_h

;

\ print hex
: tv_hex       \ ( n1 n2 -- )  n1:hex  n2:digits
_cs_out_l 
20 \ sub_shift_out  
\ 1 delms
sub_shift_out_delay
sub_shift_out 1 delms
sub_shift_out 1 delms 
0 sub_shift_out
_cs_out_h
;

\ print binary
: tv_bin       \ ( n1 n2 -- )  n1:binary  n2:digits
_cs_out_l 
21 \ sub_shift_out  
\ 1 delms
sub_shift_out_delay
sub_shift_out 1 delms
sub_shift_out 1 delms 
0 sub_shift_out
_cs_out_h
;

\ tv command
: tv_com
_cs_out_l 
sub_shift_out   
_cs_out_h
a delms
;
: tv_com2
_cs_out_l 
sub_shift_out 1 delms
sub_shift_out  
_cs_out_h
a delms 
;

 
\ clear screen      ( -- )
: tv_clear 22 tv_com ;
 
\ home              ( -- )
: tv_home 23 tv_com ;

\ backspace        ( -- )
: tv_bs 24 tv_com ;

\ tab              ( -- )
: tv_tab 25 tv_com ;

\ x position       ( n -- )   n:x-position  from 0x0 to 0x27
: tv_x 26 tv_com2 ;

\ y position       ( n -- )   n:y-position  from 0x0 to 0xc
: tv_y 27 tv_com2 ;

\ move x and y position
\ ( n1 n2 -- )   n1:x-position  from 0x0 to 0x27
\                n2:y-position  from 0x0 to 0xc
: tv_move 27 tv_com2 26 tv_com2 ;                   
                   
\ set color       ( n -- )   n:color
: tv_c 28 tv_com tv_com ;

\ return       ( -- )   
: tv_cr 29 tv_com ;

\ print character        ( n -- ) n:character code
: tv_char 2a tv_com2 ;


 
wvariable status
fl
: demo
sub_init
tv_clear
status W!
msg tv_string  
0 2 tv_move 
kb tv_string  
status W@ f0 and 0= if msg1 else msg2 then tv_string
tv_cr
ms tv_string 
status W@ f and dup 0=
if drop msg1  
else dup 1 = if drop mouse1 
            else dup 2 = if drop mouse2
                        else mouse3
thens
tv_string
tv_cr

0 5 tv_move button tv_string
0 6 tv_move mouse4 tv_string
0 8 tv_move mouse5 tv_string
80 0 do 
get_mouse 1 delms       
0 7 tv_move dup 1 and 0= if off tv_string
                    else on tv_string
                    then
5 7 tv_move  dup 4 and 0= if off tv_string
                     else on tv_string
                     then
c 7 tv_move  2 and 0= if off tv_string
                 else on tv_string
                 then
                    
0 9 tv_move 11 tv_spaces 
3 9 tv_move 3 tv_hex \ tv_dec    
a 9 tv_move 3 tv_hex \ tv_dec    
11 9 tv_move 3 tv_hex \ tv_dec   
 
loop

;