\ fourtap-game 2001/12/19 KDJ

\ Copyright 2001
\ Kristopher D. Johnson
\ 
\ THIS CODE IS PROVIDED "AS IS"
\ WITHOUT WARRANTY OF ANY KIND.
\ THE AUTHOR SHALL NOT BE LIABLE
\ FOR ANY CLAIM IN CONNECTION
\ WITH THIS CODE.
\ 
\ This code may be used, copied,
\ modified, or distributed for any
\ purpose, provided that the above
\ copyright notice and disclaimer of
\ warranty is retained on all copies.

needs Events
needs condthens

needs appprefs

needs fourtap-util
needs fourtap-resources
needs fourtap-sounds
needs fourtap-buttons
needs fourtap-text
needs fourtap-game-type

.( fourtap-game... )

decimal

100 constant #seq

begin-prefs

  0variable iseq  \ #taps user must do

  0variable itap  \ #taps by user

  0variable wrong \ true if mistap

  0variable playing \ true during game

  0variable lastScore
  0variable highScore
  
  0variable gameType

  0variable #btns

  0variable _unused

  \ Sequence of buttons to be tapped
  create seqarray  #seq chars allot

AppID 2 end-prefs prefs-info

: main-form ( -- )
  frmMain ShowForm ;

: about ( -- )
  altAbout FrmAlert drop ;

create highScoreBuf 6 chars allot
create lastScoreBuf 6 chars allot

: scoreStrings ( -- &high. &last. )
  highScore @ highScoreBuf
  u>zstringbuf
  lastScore @ lastScoreBuf
  u>zstringbuf ;

: start-alert ( -- n )
  zbyte >abs scoreStrings
  altStart FrmCustomAlert ;

: 0tap ( -- )
  0 itap ! ;

: tap++ ( -- )
  1 itap +! ;

: tap@ ( -- )
  itap @ ;

: iseq@ ( -- )
  iseq @ ;

: seq ( n -- cadr )
  chars seqarray + ;
  
: seq@ ( n -- tap )
  seq c@ ;
  
: seq! ( tap n -- )
  seq c! ;

: #btns@ ( -- n )
  #btns @ ;

: #btns! ( n -- )
  #btns ! ;

: update-txtSeq ( u -- )
  iSeq @ txtSeq set-label# ;

: update-txtTap ( u -- )
  tap@ txtTap set-label# ;

: correct-tap ( -- n )
  tap@ seq@ ;
  
: do-good-tap ( -- )
  tap++
  update-txtTap ;

: do-bad-tap ( -- )
  wrong-sound
  correct-tap flash-btn
  wrong on ;

: do-btn-tap ( n -- )
  dup btn-sound
  correct-tap = if
    do-good-tap exit
  then
  do-bad-tap ;

: choose-btn ( -- 1..#btns )
  #btns@ choose 1+ ;

: init-seq ( -- )
  0 iseq !
  rand-seed
  #seq for
    choose-btn i seq!
  next ;

: play-delay ( -- )
  iseq@ 6 < if
    150 ms exit
  then
  100 ms ;

: btn-flash-time ( level -- ms )
  dup 6 < if
    drop 200 exit
  then
  10 < if
    150 exit
  then
  100 ;
  
: set-btn-flash-time ( level -- )
  btn-flash-time flash-time ! ;

: play-seq ( -- )
  iseq@
  dup set-btn-flash-time
  0 do
    play-delay
    i seq@ play-btn
    update-txtSeq
  loop ;

: do-repeat ( -- )
  tap@ if
    error-sound exit
  then
  play-seq ;

: do-cmd ( -- )
  cmd-id
  cond dup btn-id? if
    dup do-btn-tap
  else dup cmdRepeat = if
    do-repeat
  else dup cmdAbout = if
    about
  thens
  drop ;

: cmd-event? ( ekey -- f )
  dup menuEvent = if
    drop true exit
  then
  ctlSelectEvent = ;

: challenge-event ( -- )
  ekey cmd-event? if
    do-cmd
  then ;

: wrong? ( -- f )
  wrong @ ;

: met-challenge? ( -- f )
  iseq@ tap@ = ;

: challenge-over? ( -- f )
  wrong? orif met-challenge? then
;

: challenge-event-loop ( -- )
  begin
    challenge-event
  challenge-over? until ;
  
: challenge ( -- )
  update-txtSeq
  0tap update-txtTap
  play-seq
  drop-pending-events
  challenge-event-loop ;

: next-challenge ( -- )
  1 iseq +! challenge ;

: init-game ( n -- )
  init-game-type #btns!
  init-seq
  wrong off ;

: game-over? ( -- f )
  wrong? orif iseq@ #seq = then ;

: not-game-over? ( -- f )
  game-over? 0= ;

: play-game ( -- )
  playing on
  begin not-game-over? while
    play-delay
    next-challenge
  repeat
  playing off ;

: new-game ( -- )
  start-alert init-game
  drop-pending-events ;

: resume-game ( -- )
  #btns@ restore-game-type
  challenge ;

: update-score ( -- )
  iseq@ 1-
  dup lastScore !
  highScore max! ;

: new-or-resume ( -- )
  playing off? if
    new-game exit
  then
  resume-game ;

: game ( -- )
  new-or-resume play-game
  update-score ;

: game-loop ( -- )
  begin game again ;

: fourtap-game ( -- )
  main-form game-loop ;


