\ noForth button OLED demo

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

hex
: SMS           ( u -- )        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

value FORWARD?
: EMPTY-BAT? ( -- )     lipo dm 290 < if  0 on/off  sleep  then ;
: BRIGHT    ( -- )      ldr 0A / >power ;   \ Set brightness using LDR
: .EGEL     ( -- )      &page  10 1 egel ;
: >DIR<     ( -- )      s1? forward? xor to forward? ;
: DO-LDR    ( -- +n )   ldr 8 / 0A - C0 umin  20 umax ;

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

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


: LEDS-ON?  ( -- )              \ Toggle leds on and off
    s1? if  leds 2D xor to leds  then ;

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

: FORWARD   ( -- )
    bright  do-ldr  6 0 do
        1 i lshift to leds  >dir<
        dup ms
    loop  drop ;

: BACKWARD  ( -- )
    bright  do-ldr  6 0 do
       1 5 i - lshift to leds  >dir<
        dup ms
    loop  drop ;


: RUNNER    ( -- )          \ Running light in two directions
    .egel
    begin
        empty-bat?
        forward? if  forward
        else    backward
        then
    s2? until
    0 to leds ;

: RUN2      ( -- )          \ Opposite running lights
    .egel
    begin
        bright  empty-bat?
        24 to leds 60 sms
        12 to leds 60 sms
        09 to leds 60 sms
    sw? until
    0 to leds ;

: FLASH1    ( -- )          \ Flashing outside & inner lights
    .egel
    begin
        bright  empty-bat?
        2D to leds 100 sms
        12 to leds 100 sms
    sw? until
    0 to leds ;

: FLASH2    ( -- )      .egel  2D to leds  fluctuate ;
: FLASH3    ( -- )      .egel  3F to leds  fluctuate ;

: .LIPO         ( -- )          \ Show LiPo voltage in decimal
    lipo dm 10364 dm 10000 */   \ Convert ADC to voltage
    0 <# # # ch . hold # #>     \ Make string
    &type  &"  V " ;            \ And print it

: .STATUS       ( -- )
    begin
        30 sms  empty-bat?
        base @ >r  decimal  thin
        0 0 xy" Unused : " ivecs chere - &u.
        0 2 xy" Free EE: " efree &u.
        0 4 xy" Light: " ldr drop  ldr &u.
        0 6 xy" LiPo: " lipo drop  .lipo  r> base !
    s2? until ;

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

: 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 * sms  do-dice  loop ;

: PLAY-DICE     ( -- )
    graphic
    begin
        empty-bat?
        10 contrast  200 sms
        begin  7 0 do roll drop loop  do-dice  sw? until
        roll-dice  C0 contrast
        begin  sw? until
    s2? until ;

: TEST-DICE     ( -- )
    graphic
    begin
        empty-bat?
        10 contrast
        20 choose 1+ 0 do  do-dice  C sms  loop
        roll-dice  C0 contrast  800 sms
    s2? until ;

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

\ Flying birds
: WAIT          ( +n -- )
    dup 28 <  swap 78 > or if 14 else 02 then  sms ;

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

: B2    ( x y -- )
    over eb1
    2dup     xy"     "
    2dup 2 + xy"  )*+"
    2dup 4 + xy"  ,-."
         6 + xy"     " ;

: B3    ( x y -- )
    over eb1
    2dup     xy"  /0 "
    2dup 2 + xy"  123"
    2dup 4 + xy"  456"
         6 + xy"     " ;

value X2  value Y1  value Y2
: BIRDS         ( -- )
    pict
    begin
        5 choose 2 - to y2    \ Fly height bird 2
        3 choose to y1        \ Fly height bird 1
        30 choose 2C + to x2  \ Distance between birds
        80 x2 + -30 do
            empty-bat?
            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" 78 "
    2 +  xy" 9:;" ;

: 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 sms
    10 +loop
    0 FF do
        s2? if leave then
        i contrast  20 sms
    -10 +loop
    C0 contrast ;

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

value TEMPI
: MAN1      ( x -- )
    dup 1 xy"  HI "
    dup 3 xy" JK  "
    dup 5 xy" LM  "
        7 xy" XNXX"  tempi sms ;

: MAN2      ( x -- )
    dup 1 xy"  OP "
    dup 3 xy" QRS "
    dup 5 xy" TU  "
        7 xy" VWXX"  tempi sms ;

: MAN3      ( x -- )
    dup 1 xy" YZ[\"
    dup 3 xy" ]^_ "
    dup 5 xy"     "
        7 xy" XXXX"  tempi sms ;

: MAN4      ( x -- )
    dup 1 xy" `a  "
    dup 3 xy" bcd "
    dup 5 xy"     "
        7 xy" XXXX"  tempi sms ;

: MAN5      ( x -- )
    dup 1 xy" efg "
    dup 3 xy" hij "
    dup 5 xy"     "
        7 xy" XXXX"  tempi sms ;

: MAN6      ( x -- )
    dup 1 xy" kl  "
    dup 3 xy" mno "
    dup 5 xy" p   "
        7 xy" XXXX"  tempi sms ;

: MAN7      ( x -- )
    dup 1 xy"     "
    dup 3 xy" qrs "
    dup 5 xy"  tu "
        7 xy" XXXX"  tempi sms ;

: MAN8      ( x -- )
    dup 1 xy"  v  "
    dup 3 xy"  w  "
    dup 5 xy"  x  "
        7 xy" XyXX"  tempi sms ;

: HOP       ( -- )
    48 >r  1C  pict
    begin
        18 choose  5 + to tempi
        dup man8  r@ man8  200 sms
        dup man1  r@ man8
        dup man2  r@ man1
        dup man3  r@ man2
        dup man4  r@ man3
        dup man5  r@ man4
        dup man6  r@ man5
        dup man7  r@ man6
        dup man8  r@ man7
        dup man8  r@ man8
      s2? until
     r> 2drop ;


(* 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

: &CLK.     ( +n -- )   0 <# # # #> &type ;

: CLOCK     ( -- )
    thin
    begin
        empty-bat?
        04 1 xy" 24 hour clock"
        20 4 xy  get-clock
        &clk. ch : &emit  &clk. ch : &emit  &clk. &space
     s2? until ;

clock-int  FFFA vec!        \ Timer-A1 vector


\ Set DCO to 16 MHz, current use of CPU without leds = 5,01mA
\ : 16MHZ     ( -- )
\    10F9 c@ 0057 c! \ BCSCTL1   Set DCO = 16MHz
\    10F8 c@ 0056 c! \ DCOCTL
\    0000 0058 c! ;  \ DCO on

: 32KHZ     ( -- )
    0000 0057 c!    \ BCSCTL1   Switch low freq. mode on
    000C 0053 c!    \ BCSCTL3   32kHz with 12pF
    00C8 0058 c! ;  \ BCSCTL2   LFXT1CLK on SMCLK


: BADGE-ON  ( -- )
    0 on/off  200 ms  32khz     \ Display off, clock to 32 kHz
    begin  s1? until  8mhz     \ Wait for keypress, back to 8MHz
    1 on/off ;                  \ Display on again

\ Bage menu structures and execution tables
ecreate #LED  0 e,      \ Led tables
ecreate LED-XT   10 cells eallot
ecreate LED-TXT  10 0A * eallot

ecreate #MOVIE  0 e,    \ Movie tables
ecreate MOVIE-XT   20 cells eallot
ecreate MOVIE-TXT  20 0A * eallot

ecreate #MENU  0 e,     \ Main menu tables
ecreate MENU-XT    20 cells eallot
ecreate MENU-TXT   20 0A * eallot

value ITEM
: >ENTRY    ( a u eat xt eax ea# -- )
    >r  r@ e@ 2* +  e!      \ Store XT  ( - a u eat )
    r@ e@ 0A * +            \ Calc. text storage space
    09 over ec! 1+          \ Store string length
    dup 9 bounds            \ Fill entry
    do  bl i ec!  loop      \ with spaces
    swap bounds ?do         \ Store string
        count i ec!         \ Copy from a to ea
    loop
    drop  1 r> e+! ;        \ Increase number of used entries

: >LEDS     ( a u xt -- )   \ Make new LED entry
    led-txt swap  led-xt #led >entry ;

: >MOVIE    ( a u xt -- )   \ Make new MOVIE entry
    movie-txt swap  movie-xt #movie >entry ;

: >MENU     ( a u xt -- )   \ Make new MENU entry
    menu-txt swap  menu-xt #menu >entry ;

value #LEN                  \ Hold table length
: .$        ( ea ea# -- )
    e@ to #len              \ Get table length
    item 0A * +  fat        \ Calc top entry
    #len 4 umin 0 do        \ Loop 4 or less times
        0 i 2* xy 2 &spaces \ Place cursor
        dup ec@+ e&type  thin \ Type string
        i 1+ item +  #len = \ End of table reached?
        if
            #len 1- 0A * -  \ Yes, back to start
        else
            0A +    \ No, to next string
        then
    loop  drop ;

: SELECT    ( ea ea# -- )
    &page           \ Clear OLED screen
    begin
        10 ms
    s2? 0= until    \ Start/Stop key released?
    begin
        empty-bat?
        10 ms  2dup .$ \ Print menu entry
        s1? if  incr item  then \ To next entry
        dup e@ item = if  0 to item  then
    s2? until       \ Start/Stop pressed
    2drop ;         \ Remove EE-data

: EXEC      ( ea -- )
   &page  100 ms  item cells + e@ execute  ready ;


\ Filling the menu & execution tables
: LEDMENU   ( -- )
    item >r  0 to item  false   \ Save & reset menu index
    begin
        led-txt #led select     \ Use LED menu
        led-xt exec             \ Exec. LED function, restore index
    dup until
    drop  r> to item ;

s" Chaser-1"  ' runner >leds  \ Fill LED tables

s" Chaser-2"  ' run2   >leds

s" Flash-1"   ' flash1 >leds

s" Flash-2"   ' flash2 >leds

s" Flash-3"   ' flash3 >leds

s" Back"      ' 1-     >leds


: MOVIEMENU ( -- )
    item >r  0 to item  false   \ Save & reset menu index
    begin
        movie-txt #movie select \ Use MOVIE menu
        movie-xt exec   \ Exec. MOVIE function, restore index
    dup until
    drop  r> to item ;

s" Birds"     ' birds     >movie \ Fill MOVIE tables

s" Tumbler"   ' hop       >movie

s" Hack42"    ' hack42    >movie

s" Egel"      ' egeltje   >movie

s" Dice sim"  ' test-dice >movie

s" Stars"     ' stars     >movie

s" Back"      ' 1-        >movie



: MAINMENU  ( -- )
    menu-txt #menu select   \ Use LED menu
    menu-xt exec ;          \ Exec. LED function, restore index

s" Status"    ' .status   >menu  \ Fill MENU tables

s" Owner"     ' .me       >menu

s" Movies"    ' moviemenu >menu

s" Leds"      ' ledmenu   >menu

s" Dice"      ' play-dice >menu

s" Clock"     ' clock     >menu

s" On/Off"    ' badge-on  >menu


: BADGE     ( -- )
    setup-adc  setup-display  setup-random  pwm-on
    -1 to forward?  0 to item  20 >power
    8 adr ok **bis  3F to leds  .egel  400 sms
    0 to leds  clock-on  0 0 set-clock  decimal  0
    begin  .s  mainmenu  key? until  hex  .s ;

' badge  to app
shield BADGE\  freeze

\ End


