fl

{
Device(mouse,keyboard,TV) I/F  for PropForth
    PropForth 4.0a compatible
    serial communication 
          master(protoboard)             slave(demoboard)
                 P8 Tx  ------ 220ohm ----->  P0 Rx
                 P9 Rx  <----- 220ohm ------  P1 Tx
22/05/2011 13:42:43          
          
}


: 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" ;
wvariable inchar 100 inchar W!

\ 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 )                             
a emit 
4 0 do  
          100 0 do inchar W@ 100 and 0=                          
               if inchar W@ 100 inchar W! leave 
               then 
          loop
          
loop
;

\ wait reply[0xF0] from Demoboard(slave_work_0.3.spin)
: ack     \ ( -- )
1000 0 do inchar W@ f0 =                          
          if 100 inchar W! leave 
          then 
     loop
;

\ (n1 n2 -- )
: emit2 emit emit ack ;

\ print charcter-string
: tv_string       \ ( n -- )  n:address of string
1e emit
dup C@ swap 1+ dup rot bounds do C@++ emit loop drop
0 emit ack
;

\ print spaces to tv-screen
: tv_spaces    \ ( n -- ) n:number of space
1e emit
0 do 20 emit loop 
0 emit ack
;

\ print decimal
: tv_dec       \ ( n -- )  n:decimal
1f emit 
emit ack
;

\ print hex
: tv_hex       \ ( n1 n2 -- )  n1:hex  n2:digits
20 emit 
emit2
;

\ print binary
: tv_bin       \ ( n1 n2 -- )  n1:binary  n2:digits
21 emit  
emit2
;
 
\ clear screen      ( -- )
: tv_clear 22 emit ack ;
 
\ home              ( -- )
: tv_home 23 emit ack ;

\ backspace        ( -- )
: tv_bs 24 emit ack ;

\ tab              ( -- )
: tv_tab 25 emit ack ;

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

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

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

\ return       ( -- )   
: tv_cr 29 emit ack ;

\ print character        ( n -- ) n:character code
: tv_char 2a emit2 ;
 
 
wvariable status 
: demo
8 9 e100 5 startserialcog          \ 57600 baud
20 delms

5 cogio 2+ W@
inchar 5 cogio 2+ W!
io 2+ W@
5 cogio io 2+ W!

tv_clear    \ clear TV-screen
tv_home     \ move to screen-home
msg tv_string   \ print "May the FORTH be with you."

0 2 tv_move     \ move to x=0 y=2
kb tv_string    \ print "Keyboard is "

  
5 emit          \ send command(0x5) to get mouse/keyboard's status 
100 0 do inchar W@ 100 and 0= 
          if inchar W@ 100 inchar W! ack leave 
          then                                                       
loop
status W!       \ save mouse/keyboard's status
status W@ f0 and 0= if msg1 else msg2 then tv_string    \ keyboard's result
tv_cr
ms tv_string    \ print "mouse"
 
\ mouse's result
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    \ print "button status"
0 6 tv_move mouse4 tv_string    \ print "left center right"
0 8 tv_move mouse5 tv_string    \ print "deltax deltay deltaz"

1000 0 do

a emit    \ send command(0xa) to get mouse's data
\ get mouse data
4 0 do  
          100 0 do inchar W@ 100 and 0=                          
               if inchar W@ 100 inchar W! leave 
               then 
          loop
loop          
\ print each button-status"ON or OFF"
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
\ print x/y/z   
0 9 tv_move \ 14 tv_spaces
3 9 tv_move 3 tv_hex
a 9 tv_move 3 tv_hex    
11 9 tv_move 3 tv_hex   
  
loop 

 io 2+ W!
5 cogio 2+ W!
;






  







: transmit_test    \ Only transmission
8 9 e100 5 startserialcog          \ 57600 baud
10 delms

5 cogio 2+ W@
inchar 5 cogio 2+ W!
io 2+ W@
5 cogio io 2+ W!

 tv_clear
 on tv_string  

io 2+ W!
5 cogio 2+ W!
;
   
: receive_test      \ Only receiving
8 9 e100 5 startserialcog          \ 57600 baud
10 delms

5 cogio 2+ W@
inchar 5 cogio 2+ W!
io 2+ W@
\ 5 cogio io 2+ W!

begin inchar W@ 100 and 0= if 100 inchar W! 1 else 0 then until
64 0 do i . 100 0 do inchar W@ 100 and 0= 
                      if inchar W@ 100 inchar W! . leave then 
                   loop
          cr
     loop


\ io 2+ W!
5 cogio 2+ W!
;