fl

{
dynamic_drive_LED (Using Cathode Common LED)
    PropForth 4.0/4.0a compatible
    2011/2/21
}

: .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 ;
\ constant ( x -- ) skip blanks parse the next word and create a constant, allocate a long, 4 bytes
: constant lockdict create $C_a_doconl w, l, forthentry freedict ;
0 _crf W!
: variable lockdict create $C_a_dovarl w, 0 l, forthentry freedict ; 


\ waitcnt ( n1 n2 -- n1 ) \ wait until n1, add n2 to n1
: waitcnt _execasm2>1 1F1 _cnip ;

\ fit to your hardware
0 wconstant _led_data           \ pin for data(bit0) of 7segment_LED   P7 - P0(bit7 -- bit0)
c wconstant _digit              \ pin for digit(low) of LED            P14 - P12(high middle low) 3digits
3 wconstant digits              \ numbers of 7Segment_LED
wvariable segment 4 allot       \ segment data for 3-digits


variable waitT                 \ time to display at one digit 
1 _led_data lshift constant _led_datam
1 _digit lshift constant _digitm

\ LED-charcter from "0" to "F"
wvariable led_char 7e c, 30 c, 6d c, 79 c, 33 c, 5b c, 5f c, 70 c, 7f c, 7b c, 77 c, 1f c, 4e c, 3d c, 4f c, 47 c,

\ Set 7Segment's data-port and LED-drive-port to output 
: init_led     
     \ set LED-8bit data from P**(_led_data) to P**(_led_data+7) to output
_led_data 8 0 do dup pinout 1+ loop drop 
     \ set port for digit(low) of LED to output
_digit digits 0 do dup pinout 1+ loop drop
;

: set_data_led _led_data lshift ;
: mask_led ff set_data_led invert ;  

\ set data for 7segment_LED  (n -- ) n:digit of LED  2=left 1=middle 0=right 
: set_seg_data 2 u* segment + W@ outa COG@ mask_led and or outa COG! ;

\ on/off cathode-common-pin  (n -- ) n:number for LED's Cathode Common   2=left 1=middle 0=right
: digit_pin_on _digitm swap lshift _maskouthi ;
: digit_pin_off _digitm swap lshift _maskoutlo ;

\ Display 7segment-data inside segment  ( -- )
: led_drive
init_led
cnt COG@ waitT L@ +
begin
     digits 0 do                  
               i set_seg_data
               i digit_pin_on
               waitT L@ waitcnt
               i digit_pin_off 
     loop
     0
until
;

\ Convert number(from 0 to F) to 7Segment data
: 7seg_conv led_char 2+ + C@ ;

\ save 7segmeny-data(decimal) to variable for 7Seg-LEDs   ( n1 -- n1 )
: set_data
dup dup 3e8 = if 2drop 0 0 then
64 u/mod 7seg_conv segment 4+ W!      \ 3digit
a u/mod 7seg_conv segment 2+ W!    \ 2digit
7seg_conv segment W!         \ 1digit
;

: ddLED1       \ decimal
0
begin
     64 delms
     1+ set_data
0   
until
;

: ddLED2       \ hex
0
begin
     64 delms
     1+ 
     dup f00 and 8 rshift 7seg_conv segment 4+ W!      \ 3digit
     dup f0 and 4 rshift 7seg_conv segment 2+ W!    \ 2digit
     dup f and 7seg_conv segment W!    \ 1digit
0   
until
;

wvariable tmp
wvariable sum
: demo
a3500 waitT L!       
0 set_data c" led_drive" 5 cogx
 c" ddLED1" 4 cogx
\ c" ddLED2" 4 cogx
drop

begin
."  Input dynamic_drive_frequency[Hz](1 - 9999:decimal) > "
0 tmp W!
0 sum W!
begin
     begin
          key dup 30 < if d = if tmp W@ 0> if 1 else 0 then else 0 then
                       else dup 3a > if drop 0
                                     else dup emit tmp W@ 4 = if 5 0 do drop loop
                                                                 0 tmp W!
                                                                 ."  incorect input" cr
                                                                 ."  Input dynamic_drive_frequency[Hz](decimal) > " 0
                                                              else todigit tmp dup W@ 1+ swap W! 0   
                       thens
     until    
     tmp W@ 0 do i 0 > if i 0 do a u* loop then
                    sum W@ + sum W!
                 loop
     sum W@ 0= if ."  incorect input" cr 1 else 1 then                  
until
cr
5 cogreset
clkfreq sum W@ u/ dup waitT L!
." delay count value at WORD[led_drive]:" ." 0x"  . 
c" led_drive" 5 cogx 
cr cr         
0
until
;


\ ------------------------------
\ Hardware check code  (3digits)
\ ------------------------------

\ check each digit for LEDs
: test1 init_led outa COG@ mask_led and ff or outa COG! digits 0 do i digit_pin_on 1 delsec i digit_pin_off loop ;

\ Display "210" on 3digit for 7Segment-LED
: test2   \ ( -- )
300
clkfreq swap u/ dup . waitT L!
7e segment W!
30 segment 2+ W!
6d segment 2+ 2+ W!
led_drive
;

: test
7e segment W!
30 segment 2+ W!
6d segment 2+ 2+ W!
 a3500 waitT L!
\ 3000 waitT L!
led_drive
;