
compiletoflash

: spaces 0 ?do space loop ;
: invert  not  inline 1-foldable ;

: count dup c@ ; ( cstr-addr -- cstr-addr count )

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

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

\ Jetzt geht es mal an die richtig frischen Neuigkeiten auf dem Stellaris:
\ Leitungen wackeln !

$400FE100 constant SYSCTL_RCGC0
$400FE104 constant SYSCTL_RCGC1
$400FE108 constant SYSCTL_RCGC2

$400253FC constant PORTF_DATA ( Ein- und Ausgaberegister )  
$40025400 constant PORTF_DIR  ( Soll der Pin Eingang oder Ausgang sein ? )
$40025500 constant PORTF_DR2R ( 2 mA Treiber )
$40025504 constant PORTF_DR4R ( 4 mA )
$40025508 constant PORTF_DR8R ( 8 mA )
$4002550C constant PORTF_ODR  ( Open Drain )
$40025510 constant PORTF_PUR  ( Pullup Resistor )
$40025514 constant PORTF_PDR  ( Pulldown Resistor )
$40025518 constant PORTF_SLR  ( Slew Rate )
$4002551C constant PORTF_DEN  ( Digital Enable )

decimal

2 constant led-rot
8 constant led-grün
4 constant led-blau

16 constant Knopf1
1  constant Knopf2

: init
  $000001FF SYSCTL_RCGC2 ! ( Alle GPIOs mit Takt versorgen und damit aktivieren )
  \ Ein bisschen müsste ich jetzt warten... Das passiert, während ich weiterkompiliere.
  cr
  Flamingo

  \ PF0 ist auch der NMI-Eingang. Benötige also eine besondere Sequenz, um ihn für den Taster freizuschalten.
  $4C4F434B $40025520 !    ( PORTF_LOCK )
          1 $40025524 bis! ( PORTF_CR )
          0 $40025520 !    ( PORTF_LOCK )

  %11111 portf_den ! \ Alle Leitungen an Port F seien digitale Pins
  %01110 portf_dir ! \ Die Leuchtdiodenanschlüsse seien Ausgänge
  %10001 portf_pur ! \ Hochziehwiderstände für die Taster aktivieren
  cr
  ." Have a nice day !" cr
;

: Knopf1? knopf1 portf_data bit@ not ;
: Knopf2? knopf2 portf_data bit@ not ;

: Zustand begin ." Knopf1: " knopf1? . ."  Knopf2: " knopf2? . cr ?key until ;

: Bunt
  begin
    key
    dup
    case
      [char] r of led-rot  portf_data xor! endof
      [char] g of led-grün portf_data xor! endof
      [char] b of led-blau portf_data xor! endof
    endcase
    27 =
  until
;

: cornerstone ( Name ) ( -- )
  <builds begin here $3FF and while 0 h, repeat
  does>   begin dup  $3FF and while 2+   repeat 
          eraseflashfrom
;

cornerstone Rewind-to-Basis



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

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

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

create> 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,

0 variable column# ( current_offset )
: ones      0 column# ! ;
: tens      2 column# ! ;
: hundreds  4 column# ! ;
: thousands 6 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 ( number -- )
  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

cornerstone Rewind-to-Examples
compiletoram
init

