fl

{
3-wire dynamic_drive_7SEG_LED (Using Cathode Common LED)   up to 8digits
    PropForth 4.0a compatible
    2011/04/19 16:50:47
}

: .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 _data               
1 wconstant _clk                
2 wconstant _latch              
 
3 wconstant digits              \ numbers of 7Segment_LED  Up to 8-digits
wvariable segment 2 allot       \ segment data for 4-digits   top address is lowest digit   if 8-digits,modify to 6 allot

\ wvariable cog
variable waitT                 \ time to display at one digit
1 _data lshift constant _datam
1 _clk lshift constant _clkm
1 _latch lshift constant _latchm

: _data_out_l _datam _maskoutlo ;
: _data_out_h _datam _maskouthi ;
: _clk_out_l _clkm _maskoutlo ;
: _clk_out_h _clkm _maskouthi ;
: _latch_out_l _latchm _maskoutlo ;
: _latch_out_h _latchm _maskouthi ;


\ 7seg_LED-charcter from "0" to "F"
 wvariable 7seg_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,

\ Display 7segment-data inside segment  ( -- )
: 7seg_drive
_data 3 0 do dup pinout 1+ loop drop    \ set pins to output
\ cog W@ io io>cog 4 lshift or cog W!

cnt COG@ waitT L@ +
begin
     digits 0 do                  
               i segment + C@                     \ get segment data               
               1 i 8 + lshift                 \ get drive-digits               
            \   or 10 8 digits - + lshift
               or 18 digits - lshift    
            \   b 0 do
               8 digits + 0 do 
                    dup 80000000 i rshift and  
                    0 <> if _data_out_h else _data_out_l then
                    _clk_out_h _clk_out_l
               loop                    
               drop
               _latch_out_h _latch_out_l                 
               waitT L@ waitcnt
     loop
     0
until
;

\ Convert number(from 0 to F) to 7Segment data  ( n1 -- n2 )  n1:0 to F    n2:7Segment data
: 7seg_conv 7seg_char 2+ + C@ ;

: size 1 swap 0 do a u* loop ;
\ save 7segmet-data(decimal) in variables for 7Seg-LEDs   ( n1 -- )
: set_data
dup dup
1 digits size = 
if 2drop 0 0 then
digits 0 do
     digits i 1 + - size u/mod dup . 7seg_conv segment 7 i - C!         
loop

{ 
dup dup 3e8 = if 2drop 0 0 then
64 u/mod 7seg_conv segment 2+ C!      \ 3digit
a u/mod 7seg_conv segment 1+ C!    \ 2digit
7seg_conv segment C!         \ 1digit
}
;

: test 1 4 0 do a u* loop . ;

: dd7seg1       \ decimal
\ io io>cog cog W!
-1
begin
     20 delms
     1+ dup dup      
     1 digits 0 do a u* loop dup >r = if 2drop 0 0 then 
     r> a u/     
     digits 0 do 
                dup rot swap u/mod dup -1 = if drop 0 then      ." 2a"  st?
                7seg_conv                                   \ get 7seg_data
                segment ibound 1- i - + C!       \ store character to display-data-area
                swap a u/              
              loop  
     2drop      
0   
until
;

wvariable tmp
wvariable sum
: demo
a3500 waitT L!       
 c" dd7seg1" 4 cogx
c" 7seg_drive" 5 cogx

a 0 do
."  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[7seg_drive]:" ." 0x"  . 
c" 7seg_drive" 5 cogx 
cr cr         
0
loop

4 cogreset
5 cogreset
;

: test  \ Hardware check for 3-digits 7SEG-LED   display "012"
a3500 waitT L!
6d segment C!
30 segment 1+ C!
7e segment 2+ C!

7seg_drive

;