fl

{
   Direct Parallel Driver for an HD44780 based LCD Character based display
    PropForth 4.0/4.0a compatible
    2011/1/10
  Edit one constant (_rs) below to match your hardware

     LCD(HD44780)   Propeller
     RS            P14   0xe
     E             P15   0xf
     DB4           P16   0x10
     DB5           P17   0x11
     DB6           P18   0x12
     DB7           P19   0x13
}

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 ;
}
\ j ( -- n1 ) the second most current loop counter
: j _rsptr COG@ 5 + COG@ ;
: variable lockdict create $C_a_dovarl w, 0 l, forthentry freedict ; 

e constant _rs           \ need to edit only 1-pin
_rs 1+ constant _enable
_rs 2+ constant _db4     \ assumes RS, E, db4-db7 connected to 6 sequential pins
wvariable char           \ character number for LCD:x           
wvariable line           \ line number for LCD:y
wvariable cur_line       \ current line number

1 _rs lshift constant _rsm
1 _enable lshift constant _em 

: _rs_out_l _rsm _maskoutlo ;
: _rs_out_h _rsm _maskouthi ;
: _e_out_l _em _maskoutlo ;
: _e_out_h _em _maskouthi ;
: set_data _db4 lshift ;
: mask f set_data invert ;  

\ LCD_com - talks to HD44780
: LCD_com
dup 4 rshift set_data outa COG@ mask and or outa COG!
_e_out_h _e_out_l
f and set_data outa COG@ mask and or outa COG!
_e_out_h _e_out_l
5 delms      
;

\ setup propeller pins and initialize HD44780
: LCD_init
\ 8bit mode(only when power up)
\ set from P**(to RS) to P**(to DB7) to output
_rs 6 0 do dup pinout 1+ loop drop
\ set from P14 to P19 to low
_rs 6 0 do dup 1 swap lshift _maskoutlo 1+ loop drop

32 delms       \ wait 50msec
outa COG@ 3 set_data or outa COG!
_e_out_h _e_out_l
5 delms
_e_out_h _e_out_l
1 delms
_e_out_h _e_out_l
5 delms

outa COG@ mask and 2 set_data or outa COG!
_e_out_h _e_out_l

\ 4bit mode
0 1 c 6 1 c 28 7 0 do LCD_com loop
10 char W! 2 line W!          \ defsult setting is 16Charcters & 2Lines
;

\ setup of display construction  (x y -- )
: LCD_setup line W! char W! ;
\ display character ( char -- )
: LCD_char _rs_out_h LCD_com ;
\ display string  ( cstr -- )
: LCD_str C@++ dup if bounds do i C@ LCD_char loop else 2drop then ;
\ clear LCD
: LCD_clear _rs_out_l 1 LCD_com ;

{
x -- horizontal pos  : 0x1 to 0x28 (decimal: 1 to 40Characters)
y -- line number     : 0x1 to 0x4  (decimal: 1 to 4Lines)
( x y -- )
}
: LCD_pos
_rs_out_l 
2 u/mod swap 0= 
if 1 =     \ line is even?
     if 40 else char W@ 10 = if 50 else 54 then then
else 0=
     if 0 else char W@ 10 = if 10 else  14 then then 
then
\ 1- + dup . 80 or LCD_com
1- + 80 or LCD_com
;

\ display decimal number to covert hex (n -- )  n:hex-value
variable tmp
wvariable result
: Dec
0 result W! 3b9aca00 tmp L!
dup 80000000 and if invert 1+ 2d LCD_char then  
a 0 do dup tmp L@ >= if tmp L@ u/mod 30 + LCD_char 1 result W! 
                  else result W@ if 30 LCD_char then
                  then
                  tmp L@ a u/ tmp L! 
    loop
drop
;

\ display hex number  (n1 n2 -- ) n1:hex-value  n2:digits(1 to 8)
: Hex
dup rot2 8 swap - 2 lshift lshift swap
0 do dup f0000000 and 1c rshift dup a < if 30 + else 37 + then LCD_char 4 lshift loop
drop
;
\ display binary number (n1 n2 -- ) n1:hex-value  n2:digits(1 to 10)
: Bin
dup rot2 20 swap - lshift swap  
0 do dup 80000000 and if 31 else 30 then LCD_char 1 lshift loop 
drop
;

\ output cr
: LCD_cr cur_line W@ 1+ dup line W@ > if drop 1 1 LCD_pos 1 cur_line W! else dup 1 swap LCD_pos cur_line W! then ;

\ output spaces
: Blank 0 do 20 LCD_char loop ;

: set_bar_graph
20 40
6 0 do              \ set 6 charcters
       8 0 do       \ set 8 lines for 1 character
              dup _rs_out_l LCD_com     \ command for character to CG-RAM
              swap dup  _rs_out_h LCD_com swap    \ write data
              1+
           loop
           f8 and  
       swap dup 1 rshift or swap
    loop
2drop
;

: demo
LCD_init
10 4 LCD_setup      \ 16characters 4line

\ display char-code [0x20 - 0x7f] & [0xa0 - 0xff]
20
line W@ 2 = if 7 0 else 3 0 then
do
        line W@ 2 = if i 3 = if 4 seti drop a0 then 
                       2 0 
                    else 4 0 
                    then
        do line W@ 4 = if j 1 = if i 2 = if 20 + then then then 
           1 i 1+ LCD_pos 10 0 do dup LCD_char 100 delms 1+ loop loop
    loop  
drop
LCD_clear 
\ display binary, hex, decimal
c" 0x1+0x6 = b" LCD_str 1 6 + 4 Bin

1 2 LCD_pos
c" 0xACE+0xF=0x" LCD_str ace f + 4 Hex
5 delsec

LCD_clear 1 cur_line W!
c" 0x12+0xe0=" LCD_str
12 e0 + Dec c" (D)" LCD_str
LCD_cr
c" 0x0-0x12=" LCD_str
0 12 - Dec c" (D)" LCD_str
5 delsec

set_bar_graph
LCD_clear
c" Bar Graph" LCD_str 
1 
char W@ 0
do 
  0 
  6 0 do dup LCD_char 1+ 64 delms swap dup 2 LCD_pos swap loop drop
  1+ dup 2 LCD_pos 
loop
drop
char W@ 2 LCD_pos
char W@
char W@ 0
do
  5
  6 0 do dup LCD_char 1- 64 delms swap dup 2 LCD_pos swap loop drop
  1- dup 2 LCD_pos 
loop
drop

LCD_clear 1 cur_line W!
c" Demo Finished" LCD_str
LCD_cr
b3 c4 de b6 d8 b1 20 c6 b7 b5 b5 b 0 do LCD_char loop
;