compiletoflash

: ( [char] ) parse drop immediate ;  (  Forth-Style-Comment )
: { [char] } parse drop immediate ;  { Pascal-Style-Comment }
: \        0 parse drop immediate ;  \ Comment till end of line 

: 0-foldable $40 setflags immediate ;
: 1-foldable $41 setflags immediate ;
: 2-foldable $42 setflags immediate ;
: 3-foldable $43 setflags immediate ;

32 constant bl
: cr    10 emit ;
: space bl emit ;
: spaces 0 ?do space loop ;

: cell+ 2+ inline 1-foldable ;
: cells 2* inline 1-foldable ; 
: char+ 1+ inline 1-foldable ;
: chars    inline 1-foldable ;

: aligned even inline 1-foldable ;
: invert  not  inline 1-foldable ;

: move 2* cmove ;
: count dup c@ ; ( cstr-addr -- cstr-addr count )
: ['] ' immediate 0-foldable ;

 0 constant false
-1 constant true

: sm/rem m/mod inline 3-foldable ;

: fm/mod  ( d1 n1 -- n2 n3   floored signed div'n courtesy of Ed Smeda )
    dup >r 
      sm/rem 2dup 1 < and 
      if swap r@ + swap 1- then
    r> 
    drop
3-foldable ;

: octal 8 base ! ;
: sqr ( n -- n^2 ) dup * 1-foldable ;
: star 42 emit ;


: Flamingo cr
."      _                                     " cr
."     ^-)                                    " cr
."      (.._          .._                     " cr
."       \`\\        (\`\\        (           " cr
."        |>         ) |>        |)           " cr
." ______/|________ (7 |` ______\|/_______a:f " cr
;

: init Flamingo cr ." Have a nice day !" cr ;

: table   cr 11 1 do
                    11 1 do i j * . loop
                    cr 
                  loop ;
table 
  

( Roman numerals taken from Leo Brodies "Thinking Forth" )

: chartable <builds does> ; 
( In ANS, this would simply be done with "create" )

chartable romans
  (      ones ) char I c,  char V c,
  (      tens ) char X c,  char L c,
  (  hundreds ) char C c,  char D c,
  ( thousands ) char M c,  
                align,

0 variable column# ( current_offset )
: ones      0 column# ! ;
: tens      2 column# ! ;
: hundreds  4 column# ! ;
: thousands 8 column# ! ;

: column ( -- address-of-column ) romans column# @ + ;

: .symbol ( offset -- ) column + c@ emit ;
: oner  0 .symbol ;
: fiver 1 .symbol ;
: tener 2 .symbol ;

: oners ( #-of-oners )
  ?dup if 0 do oner loop then ;

: almost ( quotient-of-5 -- )
  oner if tener else fiver then ;

: romandigit ( digit -- )
  5 /mod over 4 = if almost drop else if fiver then oners then ;

: roman ( numer -- ) 
  1000 /mod thousands romandigit
   100 /mod  hundreds romandigit
    10 /mod      tens romandigit 
                 ones romandigit ;

: mealtime   19 u<= if 
                      ." Fruit salad " 
                    else 
                      ." Green salad " 
                    then 
                    ." would be nice !" ;

: mealsforwholeday cr 25 6 do i dup roman ." : " mealtime cr 2 +loop cr ;
mealsforwholeday

: numbertable  <builds                          
                  0 do 
                      token number 1 <> if ." Constant error." quit then , 
                    loop
               does> swap 2* + @ ;

hex 
10 numbertable e^ka  C90F 76B1 3EB6 1FD5 0FFA 07FF 03FF 01FF 00FF 007F 003F 001F 000F 0007 0003 0001
decimal

: 2rshift 0 ?do d2/ loop ;

: cordic ( f-angle -- f-error f-sine f-cosine ) 
         ( Angle between -Pi/2 and +Pi/2 ! )
  0 0 $9B74 0
  16 0 do    
    2rot dup 0<
    if
      i e^ka 0 d+ 2rot 2rot
            2over i 2rshift 2rot 2rot
      2swap 2over i 2rshift
      d- 2rot 2rot d+
    else
      i e^ka 0 d- 2rot 2rot
            2over i 2rshift 2rot 2rot 
      2swap 2over i 2rshift 
      d+ 2rot 2rot 2swap d-
    then
  loop 
2-foldable ;

: sine   ( f-angle -- f-sine )   cordic 2drop 2nip   2-foldable ;
: cosine ( f-angle -- f-cosine ) cordic 2nip  2nip   2-foldable ;

3,14159 2constant pi 
pi 4,0 f/ cosine f. { Displays cos(Pi/4) }

compiletoram 

\ Ledcomm beginne !

ledcomm-shine
ledcomm-init
' ledcomm-tick irq-timera1 !  ( Timer-IRQ-hook auf ledcomm-tick setzen )
( Timer-IRQ aktivieren, Zeit einstellen, Quarz wählen )
eint

\ Ledcomm sei sinnvoll verbunden !

: einkommendes emit ;
: ausgehendes  ?key if key   dup emit   true else false then ;
: anfang       ." Verbindungsanfang " cr ;
: ende         ." Verbindungsende "   cr ;

' einkommendes ledcomm-rx-hook !
' ausgehendes  ledcomm-tx-hook !
' anfang       ledcomm-connect-hook !
' ende         ledcomm-disconnect-hook !

