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
          
          
}


: 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" ;

\ output 1-byte     ( n1 -- )  n1:1byte   
: byte_out
io 2+ W@ swap 5 cogio io 2+ W!
emit
io 2+ W!
;

: byte_out2 byte_out byte_out ;

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

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

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

\ print hex
: tv_hex       \ ( n1 n2 -- )  n1:hex  n2:digits
20 byte_out 
byte_out2
;

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

\ backspace        ( -- )
: tv_bs 24 byte_out ;

\ tab              ( -- )
: tv_tab 25 byte_out ;

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

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

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

\ return       ( -- )   
: tv_cr 29 byte_out ;

\ print character        ( n -- ) n:character code
: tv_char 2a byte_out2 ;
 
 
 
 wvariable status
: demo
8 9 1c200 5 startserialcog     \ Tx:8 Rx:9    BaudRate:115600 cog5
100 delms
0 byte_out
100 delms

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
}
;



: test
8 9 1c200 5 startserialcog     \ Tx:8 Rx:9    BaudRate:115600 cog5

tv_clear
' msg tv_string 
41  tv_char 
;

: test1
 8 9 1c200 5 startserialcog     \ Tx:8 Rx:9    BaudRate:115600 cog5
100 delms
0 byte_out
100 delms

tv_clear
\ status W!
msg tv_string  
\ 0 2 tv_move
tv_cr 
kb tv_string  
\ status W@ f0 and 0= if msg1 else msg2 then tv_string
tv_cr
ms tv_string 

0 5 tv_move button tv_string
0 6 tv_move mouse4 tv_string
0 8 tv_move mouse5 tv_string

;