\ LED aansturen - Opgave december 2024 - Oplossingen van AN
\ LED LED-S LED2 LED2-S en LED0 voor noForth t
\ Typisch noForth: ch scan goto]

decimal
\ ***** Intro voor alle versies *****
25 bitmask constant BIT25
: INI-LED ( -- ) 5 25 gpio!
                 bit25 hx D000,0020 ( gpio-oe )  **bis ." start " ;
: LED-UIT ( -- ) bit25 hx D000,0010 ( gpio-out ) **bic ." -" ;
: LED-AAN ( -- ) bit25 hx D000,0010 ( gpio-out ) **bis ." +" ;

\ Voor KEY
0 value &
: TOETS ( -- ) key to & ;
: .&    ( -- ) cr & emit ;
: &? ( naam karakter -- ) create char , does> @ & = ;
  &? a? a
  &? i? i
  &? u? u
  &? x? x



\ ***** LED *****
: UIT ( -- ) .& begin toets a? i? or   x? or until ;
: AAN ( -- ) .& LED-AAN begin toets u? i? or   x? or until LED-UIT ;
: KNIPPER ( duur -- duur ) .&
    begin begin LED-AAN dup ms LED-UIT dup ms
          key? until
    toets a? u? or   x? or until ;

: LED ( -- ) INI-LED 300     \ halve knipperduur
    ch u to &
    begin a? if aan then
          u? if uit then
          i? if knipper then
    x? until .& drop ;



\ ***** LED-S - State machine *****
\ Values voor de tokens van AAN UIT en KNIPPER
1 value [UIT
2 value [AAN
3 value [KNIPPER
: GOTO] ( xt -- ) rdrop execute ;   \ Geen weg terug

\ Acties voor de drie toestanden
: UIT ( -- ) .&
    begin toets a? if [aan goto] then
                i? if [knipper goto] then
    x? until ;

: AAN ( -- ) .& LED-AAN
    begin toets u? if LED-UIT [uit goto] then
                i? if LED-UIT dup ms [knipper goto] then
    x? until LED-UIT ;

: KNIPPER ( duur -- duur ) .&
    begin begin LED-AAN dup ms LED-UIT dup ms
          key? until
          toets a? if [aan goto] then
                u? if [uit goto] then
    x? until ;

: LED-S ( -- )  ['] uit     to [uit
                ['] aan     to [aan
                ['] knipper to [knipper
    INI-LED 300     \ halve knipperduur
    ch u to &   uit
    .& drop ;



\ Voor KNIPPER in de luxe versies
  &? s? s
  &? t? t
  &? k? k
  &? l? l



\ ***** LED2 *****
: UIT ( -- ) .& begin toets a? i? or   x? or until ;
: AAN ( -- ) .& LED-AAN begin toets u? i? or   x? or until LED-UIT ;

\ Voor knipper
\ d = DUUR [36..1296]
\ f = FLITS [1..15]  ( 1/16 .. 15/16 )
\ u = uittijd
\ a = aantijd = d * f/16
: .KNIP ( df -- )   swap space . ." ms " 0 .r ." /16 " ;
: UA ( df -- dfua ) 2dup .knip
    2dup 16 */ ( a ) >r   over r@ - ( u ) r> ;
: TRAGER  ( dfua -- *f** ) .& 2drop >r 4 3 */ 1296 umin r> ua ;
: SNELLER ( dfua -- *f** ) .& 2drop >r 3 4 */   36 umax r> ua ;
: LANGER  ( dfua -- d*** ) .& 2drop 1+ 15 umin ua ;
: KORTER  ( dfua -- d*** ) .& 2drop 1-  1 umax ua ;

: KNIPPER ( dfua -- dfua ) .& 2over .knip
    begin begin 2dup LED-AAN ms LED-UIT ms
          key? until
          toets s? if sneller then   t? if trager  then
                l? if langer  then   k? if korter  then
    a? u? or  x? or until ;

: LED2 ( -- )
    500 ( duur ) 8 ( flits ) ua
    INI-LED
    ch u to &
    begin a? if aan then
          u? if uit then
          i? if knipper then
    x? until .& 2drop 2drop ;



\ ***** LED2-S - State machine *****
\ Values voor de tokens van AAN UIT en KNIPPER
1 value [UIT
2 value [AAN
3 value [KNIPPER
: GOTO] ( xt -- ) rdrop execute ;   \ Geen weg terug

\ Acties voor de drie toestanden
: UIT ( -- ) .&
    begin toets a? if [aan goto] then
                i? if [knipper goto] then
    x? until ;

: AAN ( -- ) .& LED-AAN
    begin toets u? if LED-UIT [uit goto] then
                i? if LED-UIT [knipper goto] then
    x? until LED-UIT ;

\ Voor knipper:
\ d = DUUR [36..1296]
\ f = FLITS [1..15]  ( 1/16 .. 15/16 )
\ u = uittijd
\ a = aantijd = d * f/16

: .KNIP ( df -- )   swap space . ." ms " 0 .r ." /16 " ;
: UA ( df -- dfua )
    2dup .knip
    2dup 16 */ ( a ) >r   over r@ - ( u ) r> ;
: TRAGER  ( dfua -- *f** ) .& 2drop >r 4 3 */ 1296 umin r> ua ;
: SNELLER ( dfua -- *f** ) .& 2drop >r 3 4 */   36 umax r> ua ;
: LANGER  ( dfua -- d*** ) .& 2drop 1+ 15 umin ua ;
: KORTER  ( dfua -- d*** ) .& 2drop 1-  1 umax ua ;

: KNIPPER ( dfua -- dfua ) .& 2over .knip
    begin begin 2dup LED-AAN ms LED-UIT ms
          key? until
          toets s? if sneller then   t? if trager  then
                l? if langer  then   k? if korter  then
                a? if [aan goto] then
                u? if [uit goto] then
    x? until ;

: LED2-S ( -- )  ['] uit      to [uit
                 ['] aan      to [aan
                 ['] knipper  to [knipper
    500 ( duur ) 8 ( flits ) ua
    INI-LED
    ch u to & uit
    .& 2drop 2drop ;



\ ***** LED0 - Met INSTRING? en zonder & *****
: INSTRING? ( ch csa  -- vlag ) count bounds rot scan <> ; \ Zit ch in csa ?
: LED0 ( -- ) INI-LED 300 ch u
    begin dup ch u =                    \ Uit
          if   begin drop key dup c" aix" instring? until
          then dup ch a =                 \ Aan
          if   LED-AAN begin drop key dup c" uix" instring? until LED-UIT
          then dup ch i =                 \ Knipper
          if   begin drop
                     begin LED-AAN dup ms LED-UIT dup ms key?
                     until key dup c" aux" instring?
               until
          then dup ch x =
    until 2drop ;

\ ***** einde *****