\ noForth button OLED demo

\ Generating pseudo random numbers
\ CHOOSE - Make pseudo random number u2 the range of u2 is 0 to u1-1

hex
: /MS           0 ?do  60 0 do loop  loop ;  \ Wait u times 0,1 ms
: MS            0 ?do  1 ms  s2? if  leave  then  loop ;

value RND   \ Work location for pseudo random numbers
\ code RANDOM
\ 8324 ,  4784 ,  0 ,  4217 ,  adr rnd ,
\ 4708 ,  5808 ,  480A ,  F03A ,
\ 8000 ,  5808 ,  F038 ,  8000 ,
\ EA08 ,  6707 ,  4782 ,  adr rnd ,
\ 4F00 ,  end-code
decimal     \ Make pseudo random number ud
: RANDOM        ( -- ud )       rnd 31421 *  6927 +  dup to rnd ;
: CHOOSE        ( u1 -- u2 )    random  um* nip ;
: SETUP-RANDOM  ( -- )          31414 to rnd ;
hex

: STOP      ( -- )
    &page  fat  28 3 xy" Ready" \ Show function stop sign
    400 /ms  begin s2? 0= until ; \ Ready when stop key released

: EGELTJE   ( -- )
    &page                       \ Init. and show Hedgehog
    38 00 do
        80 i 2* - 1 egel
        s2? if  leave then
        >dir<  5 ms
    loop
    80 ms  fat  0 6 xy" Egel project" ;

: BRIGHT    ( -- )      ldr 0A / >power ;   \ Set brightness using LDR
: .LED      ( -- )      &page  fat  18 3 xy" Led demo" ;


: RUNNER    ( -- )          \ Running light in two directions
    bright  .led
    begin
        forward? if  forward
        else    backward
        then
    s2? until  stop ;

: RUN2      ( -- )          \ Opposite running lights
    bright  .led
    begin
        09 to leds 60 ms
        12 to leds 60 ms
        24 to leds 60 ms
    sw? until  stop ;

: FLASH     ( -- )          \ Flashing outside & inner lights
    bright  .led
    begin
        2D to leds 100 ms
        12 to leds 100 ms
    sw? until ;

: LED-DEMO      ( -- )          \ Select one of three demo's
    begin
        runner  run2  flash
    s2? until  0 to leds ;

: .LIPO         ( -- )          \ Show LiPo voltage in decimal
    base @ >r  decimal          \ Uses a 4-digit & space format
    lipo dm 10364 dm 10000 */   \ Convert ADC to voltage
    0 <# # # ch . hold # #>     \ Make string
    &type  r> base !  &"  V " ; \ And print it

: .STATUS       ( -- )
    base @ >r  decimal
    0 0 xy" Unused : " ivecs chere - &u.
    0 2 xy" Free EE: " efree &u.
    0 4 xy" Light: " ldr &u.
    0 6 xy" LiPo: " .lipo  r> base ! ;

: ON/OFF    ( -- )              \ Toggle leds on and off
    s1? if  leds 3F xor to leds  then ;

: FLUCTUATE ( -- )              \ The brightness of the leds
    begin
        dm 70 0 do
            i >power  3 ms
            s2? if leave then
        loop
        on/off
        0 dm 70 do
            i >power  3 ms
            s2? if leave then
        -1 +loop
        on/off  100 ms
    s2? until  0 to leds ;

: .ME       ( -- )
    &page  fat
     3 0 xy" HCC Forth-gg"  graphic
     0 2 xy 80 28 &fill  thin
    28 4 xy" Willem"
    1C 6 xy" Ouwerkerk" ;

: DOT       ( y x -- )      \ Eight character dot
    6 umin >r  70 umin
        dup  r@    xy" Q11P"
             r> 1+ xy" O11N" ;

: ONE       3C 3 dot ;      \ Six sides of a dice
: TWO       24 6 dot  54 0 dot ;
: THREE     one  two ;
: FOUR      two  24 0 dot  54 6 dot ;
: FIVE      one  four ;
: SIX       four 24 3 dot  54 3 dot ;

: DICE      ( +n -- )       \ Print dice
    &page
    dup 1 = if  one     then
    dup 2 = if  two     then
    dup 3 = if  three   then
    dup 4 = if  four    then
    dup 5 = if  five    then
        6 = if  six     then ;

: ROLL          6 choose 1+ ;
: DO-DICE       roll dice ;     \ Print dice randomly
: ROLL-DICE     07 0 do  i 1+ 20 * ms  do-dice  loop ;

: PLAY-DICE     ( -- )
    &page  graphic
    begin
        20 contrast  200 ms
        begin  7 0 do roll drop loop  do-dice  sw? until
        roll-dice  C0 contrast
        begin  sw? until
    s2? until ;

: TEST-DICE     ( -- )
    &page  graphic
    begin
        20 contrast
        20 choose 1+ 0 do  do-dice  C ms  loop
        roll-dice  C0 contrast  800 ms
    s2? until ;

: EGELDEMO      ( -- )      egeltje 800 ms ;

: CLOCK         ( -- )      &page  fat  10 4 xy" Tik Tak " 600 ms ;

: STARS         ( -- )
    begin
        &page
        100 0 do
            80 choose 8 choose  xy
            1 9 choose lshift row  50 ms
            s2? if  leave  then
        loop
    s2? until ;

\ Flying birds
: WAIT          ( +n -- )
    dup 38 <  swap 78 > or if  30 ms  then ;

: EB1   ( x -- )              \ Erase column behind animation
    0B -  dup 0 xy bl g&emit
          dup 2 xy bl g&emit
          dup 4 xy bl g&emit
              6 xy bl g&emit ;

: B1    ( x y -- )
    over eb1
    2dup     xy  bl g&emit    bl g&emit    bl g&emit
    2dup 2 + xy  ch ! g&emit  ch " g&emit  ch # g&emit
    2dup 4 + xy  ch $ g&emit  ch % g&emit  ch & g&emit
         6 + xy  ch ' g&emit  ch ( g&emit  bl g&emit ;

: B2    ( x y -- )
    over eb1
    2dup     xy  bl g&emit    bl g&emit    bl g&emit
    2dup 2 + xy  ch ) g&emit  ch * g&emit  ch + g&emit
    2dup 4 + xy  ch , g&emit  ch - g&emit  ch . g&emit
         6 + xy  bl g&emit    bl g&emit    bl g&emit ;

: B3    ( x y -- )
    over eb1
    2dup     xy  ch / g&emit  ch 0 g&emit  bl g&emit
    2dup 2 + xy  ch 1 g&emit  ch 2 g&emit  ch 3 g&emit
    2dup 4 + xy  ch 4 g&emit  ch 5 g&emit  ch 6 g&emit
         6 + xy  bl g&emit    bl g&emit    bl g&emit ;

value X2  value Y1  value Y2
: BIRDS         ( -- )
    &page  pict
    begin
        5 choose 2 - to y2    \ Fly height bird 2
        3 choose to y1        \ Fly hight bird 1
        30 choose 2C + to x2  \ Distance between birds
        88 x2 + -20 do
            i y1 b1  i x2 - y2 b2  i wait
            i y1 b2  i x2 - y2 b3  i wait
            i y1 b3  i x2 - y2 b1  i wait
            s2? if  leave  then
        8 +loop
    s2? until ;

\ Hack 42 logo's animated...
: H42S      ( x y -- )
    2dup xy ch 7 g&emit ch 8 g&emit bl g&emit
    2 + xy ch 9 g&emit ch : g&emit ch ; g&emit ;

: H42       ( -- )
    &page pict
    2C 1 xy" <=>?"
    2C 3 xy" @ABC"
    2C 5 xy" DEFG"
    48 6 xy thin s" 42" &type ;

: CLARITY   ( -- )
    FF 0 do
        s2? if leave then
        i contrast  20 ms
    10 +loop
    0 FF do
        s2? if leave then
        i contrast  20 ms
    -10 +loop
    C0 contrast ;

: HACK42    ( -- )
    begin
        h42  6 0 do  clarity  loop  &page
        6 0 do
            s2? if leave then
            70 choose 5 choose h42s 100 ms
        loop  600 ms
    s2? until ;

(* 24-hours clock
    The value DAY is added but only used here to add
    a day counter. Any calender function may be built
    upon that. It may be used for alarm functions!
*)

value SECS          \ seconds
value MINS          \ Minutes
value HOURS         \ Hours
value DAYS          \ Day counter

: SET-CLOCK     ( hours minutes -- )
    0 to secs  to mins  to hours ;

: GET-CLOCK     ( -- hours minutes seconds )
    secs  mins  hours ;

routine CLOCK-INT   ( -- addr )
\ E0B2 ,  21 ,  29 ,
5392 ,  adr secs ,  90B2 ,  3C ,
adr secs ,  2014 ,  4382 ,  adr secs ,
5392 ,  adr mins ,  90B2 ,  3C ,
adr mins ,  200C ,  4382 ,  adr mins ,
5392 ,  adr hours ,  90B2 ,  18 ,
adr hours ,  2004 ,  4382 , adr mins ,
5392 ,  adr days ,  1300 ,
end-code

\ Activate 32 kHz XT
: 32KHZ     ( -- )
    000C 0053 c!    \ BCSCTL3   32kHz with 12pF
    begin           \ LFXT osc. running?
        02 002 *bic \ IFG1      Clear bit 2
        noop  noop  \ Wait, Bit 2 remains clear
    02 002 bit* 0= until \ when osc. runs fine!
    ;

\ Timer-A1 compare interrupt off
: CLOCK-OFF     ( -- )  int-off  010 182 **bic ; \ TA1CCTL0

\ Set timer-A1 compare interrupt on with ACLK and init. leds
\ Clock divider=/1, Up mode & Timer A1 clear.
: CLOCK-ON      ( -- )
    int-off  \ 21 02A *bis  \ P2DIR    Set pins with LEDs to output
\   01 029 *bis 20 029 *bic \ P2OUT    Set led on, other led off
    32khz                   \ 32kHz on
    8000 192 !              \ One Second tick
    114 0180 !              \ TA1CTL   Set timer mode to ACLK/2
    010 0182 **bis          \ TA1CCTL0 Enable interrupts on Compare 0
    int-on ;                \ Activate timer

: CLOCK     ( -- )
    &page  thin
    begin
        04 1 xy" 24 hour clock"
        20 4 xy  get-clock &u. &u. &u.
     s2? until ;

clock-int  FFFA vec!        \ Timer-A1 vector


\ Menu structure to select function
value ITEM
: ENTRY     ( n1 n2 -- n1 )
    nip over = if
        ch * &emit &space  fat
    else
        bl &emit &space  thin
    then ;

: .STRING   ( +n -- )
    dup 0A > if  0B -  then
    dup  0= if  0 entry  &" Status   "  exit  then
    dup 1 = if  1 entry  &" Owner    "  exit  then
    dup 2 = if  2 entry  &" Egeltje  "  exit  then
    dup 3 = if  3 entry  &" Play dice"  exit  then
    dup 4 = if  4 entry  &" Dice demo"  exit  then
    dup 5 = if  5 entry  &" Led demo "  exit  then
    dup 6 = if  6 entry  &" Stars    "  exit  then
    dup 7 = if  7 entry  &" Clock    "  exit  then
    dup 8 = if  8 entry  &" Birds    "  exit  then
    dup 9 = if  9 entry  &" Hack42   "  exit  then
    dup A = if  A entry  &" Clock    "  exit  then
    ;

: MENU      ( +n -- )
    2 0 xy  dup .string
    2 2 xy  dup 1+ .string
    2 4 xy  dup 2 + .string
    2 6 xy  dup 3 + .string
    drop ;

: EXEC      ( -- )
    item 0 = if  &page  begin  .status  s2? until  then
    item 1 = if  .me  fluctuate                    then
    item 2 = if  begin  egeldemo  s2? until        then
    item 3 = if  play-dice                         then
    item 4 = if  test-dice                         then
    item 5 = if  led-demo                          then
    item 6 = if  stars                             then
    item 7 = if  clock                             then
    item 8 = if  birds                             then
    item 9 = if  hack42                            then
    item A = if  clock                             then
    200 ms ;

: SELECT    ( -- )
    begin  s2? 0= until     \ Switch released?
    begin
        item menu
        begin
            item
            s1? if  1 +to item  then
            item B = if  0 to item  then
        item <>  s2? or until  ( Leave when S1 or S2 is pressed )
    s2? until ;

: DEMO      ( -- )
    setup-adc  setup-display  setup-random  pwm-on
    -1 to forward?  0 to item  20 >power
    3F to leds  .me  400 ms  0 to leds
    clock-on  0 0 set-clock  decimal
    begin
        &page  thin  select  A00 /ms  exec  stop
    key? until ;

' demo  to app
shield DEMO\  freeze

\ End



