@q
@program NickNack.muf
1 99999 d
i
( NickNack.muf    v.1.0    Jessy @ FurryMUCK   12/97
  
  NickNack is a word game, based on Boggle<tm>, by Parker. The object 
  is to connect letters within a 4 x 4 grid to form words. Complete 
  rules are given in the program's #help function.
  
  INSTALLATION:
  
  Link an action called 'NickNack;shake;start;score;board;status;join;
  leave;reset;terse;reduce;oust' to the program. If you'd rather not type
  all that, link an action with a short name to the program, and type
  '<action> #install'. Installing this way will also describe the trigger
  action such that it displays #help info when someone looks at it and
  set the @view prop. You may want to attach the command to an object 
  called something like 'NickNack board' or 'NickNack game', so that 
  it can be carried around.
  
  NickNack.muf requires lib-reflist, which should be available on any
  established MUCK. The program needs to be set M3.
  
  USE:
    
    <cmd> #help ...... Show general help screen
    <cmd> #commands .. Show command-list help screen
    <cmd> #rules ..... Show rules help screen
    <cmd> #q ......... Show help screen for handling Q's
    join ............. Enter the NickNack game 
    shake ............ Shake the letters to start a new round 
    start ............ View the board and start entering words 
    score ............ Show scoring for last round 
    status ........... Show total scores and player status 
    board ............ Display board 
    reset ............ Clear all players & scores; reset game 
    terse ............ Toggle: show or don't show words as they are 
                         entered 
    reduce <number> .. Reduce your score by <number> points: useful for
                         removing points awarded for invalid words
    oust <player> .... Remove sleeping or absent player from game
    leave ............ Leave the game
    
  NickNack.muf may be freely ported. Please comment any changes.
)
 
$include $lib/reflist
                        (* buncha variables... mostly self-explanatory, 
                          except for ourCounter & ourString, which
                          I use for whatever... scratch-space vars   *)
lvar ourBoolean
lvar ourString
lvar ourCounter
lvar ourDieCounter
lvar ourRowCounter
lvar ourIndexCounter
lvar ourWord
lvar ourLetter
lvar ourUsedLetters
 
: Install  (  --  ) (* install: rename and desc trigger to show help *)
   
   trig me @ controls if
      trig "NickNack;shake;start;score;board;status;"
      "join;leave;reset;terse;reduce;oust" strcat setname
      trig "_/de" "{null:{muf:#" prog intostr strcat "," 
      strcat "#help}}" 
      strcat setprop
      prog "_docs" "@list #" prog intostr strcat "=1-42" strcat setprop
      ">>  Installed." .tell
   else
      ">>  Sorry, you have to be the owner of the "
      "trigger action to install." strcat .tell
   then
;
 
: Help  (  --  )                         (* display general help screen *)
   
   " " .tell
   "NickNack.muf(#" prog intostr strcat ")" strcat .tell
   " " .tell
   
   "NickNack is a word game, based on Boggle(tm), by Parker. "
   "The object is to connect letters within a 4 x 4 grid to form words. "
   "Contiguous letters may be joined horizontally, vertically, or dia"
   "gonally, but you cannot use the same letter more than once. For "
   "example: " strcat strcat strcat strcat .tell " " .tell
   
   "                           M A R A" .tell
   "                           R T E P" .tell
   "                           P E T N" .tell
   "                           I U Q I" .tell " " .tell
   
   "Using the first three letters in the top two rows -- M, A, R, R, T, "
   "and E -- you could make 'Art', 'Mart', 'Tram', 'Rat', 'Mate', and "
   "so on. You could not make 'Matter', because this would require "
   "using the T more than once." strcat strcat strcat .tell " " .tell
   
   "For a listing of NickNack commands, type 'nicknack #commands'. For "
   "a more complete discussion of the rules, type 'nicknack #rules.' To "
   "view information on the special case of 'Q' and 'Qu', type 'nick"
   "nack #q'" strcat strcat strcat .tell
;
 
: Commands  (  --  )          (* display command-listing help screen *)
   
   " " .tell
   "NickNack Commands: " .tell
   " " .tell
   
   "  join ............. Enter the NickNack game" .tell
   "  shake ............ Shake the letters to start a new round" .tell
   "  start ............ View the board and start entering words" .tell
   "  score ............ Show scoring for last round" .tell
   "  status ........... Show total scores and player status" .tell
   "  board ............ Display board" .tell
   "  reset ............ Clear all players & scores; reset game" .tell
   "  terse ............ Toggle: show or don't show words as they are"
   .tell
   "                       entered" .tell
   "  reduce <number> .. Reduce your score by <number> points: useful for "
   .tell
   "                       removing points awarded for invalid words" 
   .tell
   "  leave ............ Leave the NickNack game" .tell
   "  oust <player> .... Remove sleeping or absent player from game"
   .tell
   " " .tell
   "You can talk and pose while you are entering words, but cannot use "
   "other MUCK commands." strcat .tell
;
 
: Rules  (  --  )               (* display rules-listing help screen *)
   
   " " .tell
   "NickNack Rules:" .tell " " .tell
   
   "Words are formed by joining adjacent letters horizontally, "
   "vertically, or diagonally. You can only use a letter once. "
   "You have three minutes per round to find and enter words."
   strcat strcat .tell " " .tell
   
   "Words must be at least three letters long. Proper nouns, abbrevi"
   "ations, and words that include punctuation are not allowed. The "
   "game program checks to see if entered words can be made from the "
   "current letters, but does not check to insure that they are "
   "valid 'dictionary words'. If you enter a word that is later "
   "determined to be invalid, use the 'reduce' command to reduce "
   "your score by the appropriate amount." 
   strcat strcat strcat strcat strcat strcat .tell " " .tell
   
   "You only score for words that you alone enter: words that "
   "are entered by more than one player do not count toward scores. "
   "You receive 1 point for each word. Five-letter words receive a "
   "1-point bonus. Six-letter words receive a 2-point bonus. Seven-"
   "letter words recieve a 4-point bonus. Eight-letter or longer "
   "words receive an 8-point bonus. Scoring for the current round "
   "will be shown automatically when time is up for the last player."
   strcat strcat strcat strcat strcat strcat .tell 
;
 
: QRules  (  --  )                 (* display Q-handling help screen *)
   
   " " .tell
   "NickNack: Handling 'Q' and 'Qu':" .tell " " .tell
   
   "The 'Q' should be treated as the string 'Qu'. For example, if "
   "the current letters are..." strcat .tell " " .tell
   
   "                           M A R A" .tell
   "                           R T E P" .tell
   "                           P E T N" .tell
   "                           I U Q I" .tell " " .tell
   
   "... you can make the words 'Quit' and 'Queen'. These can be "
   "entered either with or without the 'u'. That is, you could type "
   "'qit' and 'qeen', or 'quit' and 'queen'. You could not make the "
   "word 'quip', because the 'hidden u' included with the Q would "
   "make the final string into 'Quuip'."
   strcat strcat strcat strcat .tell
;
 
: SayPose  (  -- s )      (* scan keyboard input for poses and says. *)
                           (* emit poses and says; return other vals *)
 
   begin                                (* BEGIN INPUT-SCANNING LOOP *)
         (* does input begin with " or say ? -- say if so & continue *)
      read 
                                (* emit poses and says, and continue *)
      dup "\"" stringpfx
      over "say " stringpfx or if
         dup "say " stringpfx if
            4 strcut
         else
            1 strcut
         then swap pop
         me @ name " says, \"" strcat swap strcat "\"" strcat dup
         loc @ me @ rot notify_except
            
                   (* tack on an 'in program' note for the player    *)
         " (in NickNack)" strcat .tell
         continue        
      then
 
       (* does input begin with : or pose ? -- pose if so & continue *)
      dup ":" stringpfx
      over "pose " stringpfx or if
         dup "pose " stringpfx if
            5 strcut
         else
            1 strcut
         then swap pop
         me @ name
         over "'*" smatch not if
            " " strcat
         then
         swap strcat dup
         loc @ me @ rot notify_except
         " (in NickNack)" strcat .tell
         continue
      then
      exit                           (* it's not a pose or say; exit *)
   repeat                                 (* END INPUT-SCANNING LOOP *)
;
  
: QCheck  (  --  )             (* kill process if user enters .quit, 
                                  .end, or a stringpfx of either     *)
                                 
                                   (* wrap smatch for .q in an if, to )
  dup if                           (  avoid null string match errors *)
      dup ".quit" swap stringpfx 
      over ".end" swap stringpfx or if
         trig "_pids/" me @ intostr strcat remove_prop
         trig "_players/" me @ intostr strcat "waiting" setprop
         trig "_quit" me @ ref-add
         pop ">>  Done." .tell pid kill
      then
   then
;
   
: ReadYesNo  (  -- i )                    (* get user input; return 1 
                                             for 'yes', 0 for 'no    *)
   begin
      SayPose strip QCheck
    
      dup "yes" swap stringpfx if
          pop 1 break
      else
          "no" swap stringpfx if
             0 break
          then
      then
      ">>  Entry not understood." .tell
   repeat
;
 
: remove_dir-r  ( d s --  )     (* remove dir s and s's subdirs from d *)
    
    dup "*/" smatch not if
        "/" strcat
    then
    
    over over nextprop swap pop
    begin
        dup while
        over over nextprop
        3 pick rot remove_prop
    repeat
    pop pop
;
 
: CleanUp  (  --  )                  (* remove in-process data props *)
   
   trig "_pids/"   remove_dir-r
   trig "_words/"  remove_dir-r
   trig "_temp/"   remove_dir-r
   trig "_scores/" remove_dir-r
   trig "_finals/" remove_dir-r
   trig "_quit"    remove_prop
;
 
: Reset  (  --  )             (* remove all data props for this game *)
   
                                                 (* get confirmation *)
   ">>  Please confirm: You wish to reset the game completely?" .tell
   ">> [Enter 'yes' or 'no']" .tell
   ReadYesNo not if
      ">>  Done. Game unchanged." .tell exit
   then
                                                    (* remove stuff! *)
   trig "_players/" remove_dir-r
   trig "_totals/"  remove_dir-r
   trig "_ready?"   remove_prop
   trig "_shaken?"  remove_prop
   trig "_timing?"  remove_prop
   CleanUp
   
   loc @ #-1
   ">>  " me @ name strcat
   " resets the NickNack game." strcat notify_except
;
 
: CanDoScore?  (  -- i )                (* check: can only do score 
                                           after a round is finished *)
   trig "_pids/" nextprop
   trig "_timing?" getprop 
   trig "_shaken?" getprop or or if
      0
   else
      1
   then
;
 
: Status  (  --  ) (* show total scores, and waiting/entering status *)
   
   trig "_players/" nextprop dup if
      begin                            (* BEGIN PLAYER-CHECKING LOOP *)
         dup while
         dup "" "_players/" subst ourCounter !
         ourCounter @ atoi dbref name ", with " strcat
         trig "_totals/" ourCounter @ strcat getprop intostr strcat
         " points, is " strcat
         trig "_pids/" ourCounter @ strcat getprop if
            "entering words." 
         else
            "waiting."
         then
         strcat .tell                               (* output a line *)
         trig swap nextprop
      repeat                             (* END PLAYER-CHECKING LOOP *)
      pop
   else
      ">>  No one is currently playing NickNack." .tell pop
   then
;
 
: ShowResults  (  --  )        (* show results of last round to room *)
                      (* cf ShowScore: this one shows to whole room; 
                         ShowScore shows to one player; I fiddled with
                         it; seemed easier and more efficient to have
                         two different, similar functions            *)
                         
   trig "_finals/" nextprop not if     (* ... if we have any results *)
      ">>  No one entered any words." .tell 
      CleanUp exit
   then
   
   trig "_players/" nextprop dup if
      loc @ #-1 " " notify_except
      begin                            (* BEGIN PLAYER-CHECKING LOOP *)
         dup while
         dup "" "_players/" subst ourCounter !
         ourCounter @ atoi dbref name " (" strcat
         trig "_totals/" ourCounter @ strcat getprop
         intostr strcat "): " strcat
         trig "_finals/" ourCounter @ strcat getprop 
         
         dup not if                       (* check: may have sat out *)
            pop   
            trig swap nextprop
            continue
         then
         
         strcat " = " strcat
         trig "_scores/" ourCounter @ 
         strcat getprop intostr strcat
         loc @ #-1 rot notify_except     (* output one player's data *)
         loc @ #-1 " " notify_except
         trig swap nextprop         
      repeat
      pop
   else
      ">>  No one is currently playing NickNack." .tell pop
   then
;
 
: ShowScore  (  --  )        (* show results of last round to player *)
   
   trig "_finals/" nextprop not if        (* check: get any results? *)
      ">>  No one entered any words." .tell 
      CleanUp exit
   then
   
   trig "_players/" nextprop dup if
      " " .tell
      begin                            (* BEGIN PLAYER-CHECKING LOOP *)
         dup while
         dup "" "_players/" subst ourCounter !
         ourCounter @ atoi dbref name " (" strcat
         trig "_totals/" ourCounter @ strcat getprop
         intostr strcat "): " strcat
         trig "_finals/" ourCounter @ strcat getprop 
         
         dup not if                       (* check: may have sat out *)
            pop 
            trig swap nextprop
            continue
         then
         
         strcat " = " strcat
         trig "_scores/" ourCounter @ 
         strcat getprop intostr strcat .tell
         " " .tell
         trig swap nextprop         
      repeat
      pop
   else
      ">>  No one is currently playing NickNack." .tell pop
   then
;
 
: CalculateScore  (  --  )   (* calculate score from current _words/ *)
   
   (* this func erases word props; don't run if round is in progress *)
   trig "_timing?" getprop if
      ">>  Someone is still entering words. Unable to calculate score."
      .tell exit
   then
                                            (* do we have any words? *)
   trig "_words/" nextprop not if
      exit
   then
   
   begin                                 (* BEGIN WORD-CHECKING LOOP *)
   
      trig "_words/" nextprop dup if 
         dup dup                                (* store word string *)
         "/" strcat ourString !
                                               (* store player dbref *)
         "" "_words/" subst atoi dbref ourCounter !
      else
         pop break
      then
                           (* copy word to _temp/ ; make a reflist of 
                              of  players who got this word          *)
      trig ourString @ nextprop
      begin                               (* BEGIN WORD-COPYING LOOP *)
         dup while
         trig over getpropstr 
         trig swap "_temp/" swap strcat
         over over ourCounter @ ref-add pop pop
         trig swap nextprop
      repeat                                (* END WORD-COPYING LOOP *)
      pop
      trig swap remove_dir-r
   repeat
   
   (* add score for current word to scores of all players in reflist *)
   trig "_temp/" nextprop
   begin                                  (* BEGIN SCORE-ADDING LOOP *)
      dup while
      dup ourString ! 
      
        (* check: more than one player has this word? If so, bracket
           word, no score. Add to word string for players...         *)
      trig over ref-allrefs dup 1 > if
         begin
            dup while
            trig "_finals/" 4 rotate intostr strcat
            over over getpropstr if
               over over getpropstr
               "[" ourString @ "" "_temp/" subst strcat "] " strcat
               strcat setprop
            else
               "[" ourString @ "" "_temp/" subst strcat "] " strcat
               setprop
            then
            1 -
         repeat
         pop
                              (* ... or, if only one player got it, add 
                               to players' score and word string     *)
      else
         pop
         trig "_scores/" rot intostr strcat
         over over over over getprop
         ourString @ "" "_temp/" subst
         dup strlen 3 = if 1 else               (* calculate bonuses *)
         dup strlen 4 = if 1 else
         dup strlen 5 = if 2 else
         dup strlen 6 = if 3 else
         dup strlen 7 = if 5 else
         dup strlen 8 = if 9 else
                           9
         then then then then then then
         swap pop
         dup 1 > if
            ourString @ "" "_temp/" subst "(+" strcat
            over 1 - intostr strcat ") " strcat ourString !
         else
            ourString @ "" "_temp/" subst " " strcat ourString !
         then
         + setprop
         "_finals/" "_scores/" subst over over getpropstr if
             over over getpropstr ourString @ strcat setprop
          else
             ourString @ setprop
          then
      then
      trig swap nextprop
   repeat                                   (* END SCORE-ADDING LOOP *)
   pop
                              (* add scores for this round to totals *)
   trig "_scores/" nextprop
   begin                                (* BEGIN TOTAL-FIGURING LOOP *)
      dup while
      dup "" "_scores/" subst
      trig "_totals/" rot strcat
      over over
      getprop
      trig 5 pick
      getprop + setprop
      trig swap nextprop
   repeat                                 (* END TOTAL-FIGURING LOOP *)
   pop
   
                             (* check for players who sat out: 
                                give them a string so we won't crash *)
   trig "_players/" nextprop
   begin                          (* BEGIN IDLE-PLAYER-CHECKING LOOP *)
      dup while
      dup "" "_players/" subst ourCounter !
      trig "_finals/" ourCounter @ strcat getprop not if
         trig "_finals/" ourCounter @ strcat 
         " [ No words entered ]" setprop
      then
      trig swap nextprop
   repeat                           (* END IDLE-PLAYER-CHECKING LOOP *)
   pop
   
   trig "_temp/" remove_dir-r                    (* remove temp data *)
;
 
: Score  (  --  ) (* see what we need to do to show the score; do it *)
 
                                (* can't while a round is in process *)
   CanDoScore? not if  
      ">>  A round is in process. "
      "Cannot calculate score (try 'status')."
      strcat .tell exit
   then
                                         (* or if we don't have data *)
   trig "_totals/" not if
      ">>  There is no NickNack score yet." .tell exit
   then
                                     (* ok: we can calc score. do it *)
   trig "_scores/" nextprop not if
      CalculateScore
   then
   ShowScore
;
 
: TimerLoop  (  --  )       (* set a timer: 3 minutes per player;
                               go until last active player times out *)
   
   trig "_timing?" "yes" setprop                 (* set control prop *)
   1 ourCounter !
   begin                                         (* START TIMER LOOP *)
      1 sleep
               (* ourBoolean is false while there are active players *)
      0 ourBoolean !
      trig "_players/" nextprop
      begin                            (* BEGIN PLAYER-CHECKING LOOP *)
         dup while
         trig over getprop int? if
            trig over getprop
            systime swap - 180 > if                    (* time's up! *)
               trig over "waiting" setprop
               dup "_pids/" "_players/" subst
               dup "" "_pids/" subst atoi dbref
               ">>  TIME!  Enter any string to continue." notify
               trig swap remove_prop
            else
               1 ourBoolean !
            then
         then
         trig swap nextprop
      repeat                             (* END PLAYER-CHECKING LOOP *)
      pop
                              (* remove round control props and show
                                 results when no more active players *)
      ourBoolean @ not if
         trig "_timing?" remove_prop
         trig "_ready?" remove_prop
         trig "_shaken?" remove_prop
         CalculateScore
         trig "_finals/" nextprop if
            ShowResults
         else
            ">>  No one entered any words. NickNack timed out." .tell
         then
         exit
      then
   repeat
;
 
: InitializeDieArray (  --  )(* transfer prop data into numbered vars *)
   
   trig "_row1" getpropstr 1 strcut 1 strcut 1 strcut
   trig "_row2" getpropstr 1 strcut 1 strcut 1 strcut
   trig "_row3" getpropstr 1 strcut 1 strcut 1 strcut
   trig "_row4" getpropstr 1 strcut 1 strcut 1 strcut
   
   44 ourIndexCounter !
   begin                                      (* BEGIN TRANSFER LOOP *)
      ourIndexCounter @ 10 > while
      ourIndexCounter @ localvar !
      ourIndexCounter @ 1 - 10 % if
         ourIndexCounter @ 1 - ourIndexCounter !
      else
         ourIndexCounter @ 7 - ourIndexCounter !
      then
   repeat                                       (* END TRANSFER LOOP *)
;
 
: ShowRow  (  --  )                       (* show a row of the board *)
   
   "                                " swap
   1 strcut swap " " strcat swap
   1 strcut swap " " strcat swap
   1 strcut swap " " strcat swap
   strcat strcat strcat strcat .tell
;
 
: Board  (  --  )                                  (* show the board *)
   
                                 (* check and make sure we have data *)
   trig "_row1" getprop not if
      ">>  There are no letters on the board. Type 'shake'." .tell exit
   then
                    (* check: player can't study words ahead of time *)
   trig "_players/" me @ intostr strcat getprop dup if
      string?
      trig "_ready?" getprop and if
         ">>  The board has been shaken. Type 'start' to "
         "view and begin." strcat .tell exit
      then
   else
      pop
   then
                                                       (* show board *)
   " " .tell
   trig "_row1" getpropstr ShowRow
   trig "_row2" getpropstr ShowRow
   trig "_row3" getpropstr ShowRow
   trig "_row4" getpropstr ShowRow
   " " .tell
;
   
: ShowTimeLeft  (  --  )   (* tell player how much time she has left *)
   
   trig "_players/" me @ intostr strcat getprop dup if
      dup int?  if
          systime swap - 180 swap -
          dup 60 / intostr " minutes and " strcat
          swap 60 %
          intostr strcat " seconds left." strcat
          ">>  You have " swap strcat .tell
      else
         ">>  Internal program weirdness. Cannot calculate time!"
         .tell pop
      then
   else
      ">>  You don't have any time left this round!" .tell pop
   then
;
 
: RemoveWord  ( s s' -- s )   (* remove a bogus word s' during input *)
                                         (* decrement word counter s *)
   dup strlen 3 > not if
      pop exit
   then                                           (* clean up string *)
   "" "rr " subst strip ourString !
   trig "_words/" me @ intostr strcat "/" strcat nextprop
   begin                                  (* BEGIN WORD-FINDING LOOP *)
      dup while
      trig over getpropstr ourString @ smatch if
      
                             (* found the word to remove... remove it, 
                                and shuffle remaining words down one *)
         ">>  Removing '" ourString @ strcat "'." strcat .tell
         begin                          (* BEGIN PROP-SHUFFLING LOOP *)
            dup while
            trig over nextprop if    (* put nextprop in current slot *)
               trig over nextprop 
               trig swap getpropstr
               trig 3 pick rot setprop
               
            else          (* remove final, currently duplicated prop *)
               trig swap remove_prop break
            then 
            trig swap nextprop
         repeat
         atoi 1 - intostr exit            (* decrement word counter *)
      then
      trig swap nextprop
   repeat
                                        (* woops... didn't find it! *)
   ">>  You haven't entered '" ourString @ strcat "'." strcat .tell
   pop
;
 
: Shake  (  --  )                     (* reset board for a new round *)
   
                 (* check: are we interrupting an in-progress round? *)
   trig "_timing?" getprop if
      ">>  A round is in process. Cannot shake letters at this point."
      .tell exit
   then
   trig "_shaken?" getprop if
      ">>  The letters have already been shaken this round!" .tell exit
   then
                                   (* put 16 'letter cubes' on stack *)
   pop CleanUp
   "ONUDTK" "YIEEHF" "GLYKEU" "PDCMEA" 
   "PINESH" "CASERL" "DANEVZ" "PULETS" 
   "VITENG" "BOXIFR" "CATIOA" "BALITY" 
   "NODEWS" "HOSAMR" "LUWIRG" "QOMAJB"
   
   trig "_shaken?" "yes" setprop           (* initialize some stuff! *)
   "" ourString !
   0  ourDieCounter !
   1  ourRowCounter !
  
   begin                              (* BEGIN LETTER-ASSIGNING LOOP *)
      ourRowCounter @ 5 < while                    (* make four rows *)
                                    (* get a random letter from cube *)
      depth random swap % 1 + rotate  
      random 6 % dup if
         strcut pop
         dup strlen 1 = not if
            dup strlen 1 - strcut swap pop
         then
      else
         pop 1 strcut pop
      then
                                   (* add to row, or start a new row *)
      ourString @ swap strcat ourString !
      ourDieCounter @ 1 + dup 4 % if
         ourDieCounter !
      else
         pop 
         trig "_row" ourRowCounter @ intostr strcat 
         ourString @ setprop
         ourRowCounter @ 1 + ourRowCounter !
         0 ourDieCounter !
         "" ourString !
      then
   repeat                               (* END LETTER-ASSIGNING LOOP *)
  
   loc @ #-1 over over           (* tell room we shook and are ready *)
   ">>  " me @ name strcat
   " shakes the cubes!" strcat notify_except
   ">> [Type 'start' to display and begin]" notify_except
   
        (* delay some before starting timer, to give people a chance 
           to start, but to also time out gracefully if no one plays. 
           Someone needs to 'start' before 60 seconds pass. Others can 
           start as long as there are active players entering words  *)
   trig "_ready?" "yes" setprop
   background
   60 sleep TimerLoop
;
 
: MarkUsedLetters  (  --  )              (* store used letter; used 
                                            by word-checking routine *)
   ourUsedLetters @ 
   ourIndexCounter @ intostr strcat " " strcat 
   ourUsedLetters !
;
 
: GetNextLetter  (   --  )  (* get next letter in word being checked *)
   
   ourString @ strlen 1 = if
      ourString @ ourLetter !
      "" ourString !
   else
      ourString @ if
         ourString @ 1 strcut 
         ourString ! ourLetter !
      else
         1 ourBoolean ! exit
      then
   then
;
 
: CheckNextLetter  (  --  )  (* do tree search through letter grid to
                                see if word can be made from current
      letters. Yeah, this function looks like it should be broken down, 
      cutting repetitive parts, but the recursive call in the middle of 
      each block makes that kinda pointless                          *)
   
   ourBoolean @ if
      exit
   then
                 (* use localvars 11-14, 21-24, 31-34, and 41-44 as a 
                    pseudo-array. Fr'instance, localvar 23 is treated
                    like letters[2,3]. Too bad MUF only gives us 54
                    localvars... more would make it much easier to make
                    Big Boggle, plus avoid having to check 'variable
                    out of range' errors :/                          *)
      
                 (* adding or subtracting 1, 9, 10, and 11 checks all 
                    letters adjacent to letter X. When an adjacent
                    letter matches the next letter we're looking for,
                    put variable data on stack--so we can recover it
                    if we need to partially back out--and advance 
                    search one letter. Use recursive structure to be
                    able to back out in instances where possible good
                    directions don't pan out                         *)
                    
   ourIndexCounter @ 1 - dup 10 > if  (* variable-out-of-range check *)
      ourCounter !                                 (* store position *)
      
      ourCounter @ localvar @   (* get letter POSITION being checked *)
      
                              (* see if there's a letter at position *)
      ourUsedLetters @ ourCounter @ intostr instr not and if
      
                     (* if both are true, smatch against next letter *)
         ourCounter @ localvar @ ourLetter @ smatch if
         
         (* found a match: put current data on stack; advance search *)
            ourString @ if
               ourUsedLetters @ ourLetter @ ourString @ ourIndexCounter @
               ourCounter @ ourIndexCounter !
               MarkUsedLetters GetNextLetter CheckNextLetter
               ourIndexCounter ! ourString ! ourLetter ! ourUsedLetters !
            else
            
            (* ourBoolean becomes true when we reach the end of word *)
               1 ourBoolean ! exit
            then
         then
      then
   else
      pop
   then
   
         (* all the rest are same as above, for a different position *)
   ourIndexCounter @ 1 + dup 50 < if
      ourCounter !
      ourCounter @ localvar @
      ourUsedLetters @ ourCounter @ intostr instr not and if
         ourCounter @ localvar @ ourLetter @ smatch if
            ourString @ if
               ourUsedLetters @ ourLetter @ ourString @ ourIndexCounter @
               ourCounter @ ourIndexCounter !
               MarkUsedLetters GetNextLetter CheckNextLetter
               ourIndexCounter ! ourString ! ourLetter ! ourUsedLetters !
            else
               1 ourBoolean ! exit
            then
         then
      then
   else
      pop
   then
      
   ourIndexCounter @ 10 - dup 10 > if
      ourCounter !
      ourCounter @ localvar @
      ourUsedLetters @ ourCounter @ intostr instr not and if
         ourCounter @ localvar @ ourLetter @ smatch if
            ourString @ if
               ourUsedLetters @ ourLetter @ ourString @ ourIndexCounter @
               ourCounter @ ourIndexCounter !
               MarkUsedLetters GetNextLetter CheckNextLetter
               ourIndexCounter ! ourString ! ourLetter ! ourUsedLetters !
            else
               1 ourBoolean ! exit
            then
         then
      then
   else
      pop
   then
      
   ourIndexCounter @ 10 + dup 50 < if
      ourCounter !
      ourCounter @ localvar @
      ourUsedLetters @ ourCounter @ intostr instr not and if
         ourCounter @ localvar @ ourLetter @ smatch if
            ourString @ if
               ourUsedLetters @ ourLetter @ ourString @ ourIndexCounter @
               ourCounter @ ourIndexCounter !
               MarkUsedLetters GetNextLetter CheckNextLetter
               ourIndexCounter ! ourString ! ourLetter ! ourUsedLetters !
            else
               1 ourBoolean ! exit
            then
         then
      then
   else
      pop
   then
      
   ourIndexCounter @ 11 - dup 10 > if
      ourCounter !
      ourCounter @ localvar @
      ourUsedLetters @ ourCounter @ intostr instr not and if
         ourCounter @ localvar @ ourLetter @ smatch if
            ourString @ if
               ourUsedLetters @ ourLetter @ ourString @ ourIndexCounter @
               ourCounter @ ourIndexCounter !
               MarkUsedLetters GetNextLetter CheckNextLetter
               ourIndexCounter ! ourString ! ourLetter ! ourUsedLetters !
            else
               1 ourBoolean ! exit
            then
         then
      then
   else
      pop
   then
      
   ourIndexCounter @ 9 - dup 10 > if
      ourCounter !
      ourCounter @ localvar @
      ourUsedLetters @ ourCounter @ intostr instr not and if
         ourCounter @ localvar @ ourLetter @ smatch if
            ourString @ if
               ourUsedLetters @ ourLetter @ ourString @ ourIndexCounter @
               ourCounter @ ourIndexCounter !
               MarkUsedLetters GetNextLetter CheckNextLetter
               ourIndexCounter ! ourString ! ourLetter ! ourUsedLetters !
            else
               1 ourBoolean ! exit
            then
         then
      then
   else
      pop
   then
      
   ourIndexCounter @ 9 + dup 50 < if
      ourCounter !
      ourCounter @ localvar @
      ourUsedLetters @ ourCounter @ intostr instr not and if
         ourCounter @ localvar @ ourLetter @ smatch if
            ourString @ if
               ourUsedLetters @ ourLetter @ ourString @ ourIndexCounter @
               ourCounter @ ourIndexCounter !
               MarkUsedLetters GetNextLetter CheckNextLetter
               ourIndexCounter ! ourString ! ourLetter ! ourUsedLetters !
            else
               1 ourBoolean ! exit
            then
         then
      then
   else
      pop
   then
      
   ourIndexCounter @ 11 + dup 50 < if
      ourCounter !
      ourCounter @ localvar @
      ourUsedLetters @ ourCounter @ intostr instr not and if
         ourCounter @ localvar @ ourLetter @ smatch if
            ourString @ if
               ourUsedLetters @ ourLetter @ ourString @ ourIndexCounter @
               ourCounter @ ourIndexCounter !
               MarkUsedLetters GetNextLetter CheckNextLetter
               ourIndexCounter ! ourString ! ourLetter ! ourUsedLetters !
            else
               1 ourBoolean ! exit
            then
         then
      then
   else
      pop
   then
;   
 
: CheckWord  (  --  )(* see if entered word can be made from letters *)
   
   0 ourBoolean !             (* initialize initial initializations! *)
   " " ourUsedLetters !
   ourString @ ourWord !
   ourString @ 1 strcut ourString ! ourLetter !
   44 ourIndexCounter !
   
                    (* find first instance of first letter in word, 
                       then let CheckNextLetter do all the real work *)
   begin  
      ourIndexCounter @ 10 > while
      
      ourIndexCounter @ localvar @ ourLetter @ smatch if
          ourIndexCounter @
          ourUsedLetters @
          over intostr " " strcat strcat 
          ourUsedLetters !
          GetNextLetter CheckNextLetter 
          ourIndexCounter !
          ourBoolean @ if
             1 exit
          else
             " " ourUsedLetters !
             ourWord @ 1 strcut ourString ! ourLetter !
          then
      then
                                 (* decrement: by 7 if all of row 
                                    has been checked; otherwise by 1 *)
      ourIndexCounter @ 1 - 10 % if  
         ourIndexCounter @ 1 - ourIndexCounter !
      else
         ourIndexCounter @ 7 - ourIndexCounter !
      then
      
   repeat
   0
;
 
: CheckDuplicateWords  (  --  ) (* see if player has already used this 
                                   word. Return true if so; otherwise 
                                   return false, by leaving the null 
                                   string from the loop on the stack *)
   
   trig "_words/" me @ intostr strcat "/" strcat nextprop
   begin
      dup while
      trig over getpropstr ourWord @ smatch if
         pop 1 exit   
      then
      trig swap nextprop
   repeat
;
 
: Start  (  --  )          (* show player the board; get input words *)
   
     (* check: board ready? has joined game? hasn't quit this round? *)
   trig "_ready?" getpropstr not if
      ">>  Sorry, the board isn't ready. Someone needs to 'shake'." 
      .tell exit
   then
   
   trig "_players/" me @ intostr strcat getprop not if
      ">>  You need to 'join' the game first!" .tell exit
   then
   
   trig "_quit" getprop if
      trig "_quit" me @ ref-inlist? if
         ">>  Sorry, you quit this round. "
         "Play again after the next shake." strcat .tell exit
      then
   then
                   (* load the letters into our pseudo-array of dice *)
   InitializeDieArray
                          (* set props to enter player in timer loop *)
   trig "_players/" me @ intostr strcat systime setprop
   trig "_pids/" me @ intostr strcat pid setprop
   
                                                       (* show board *)
   Board
                                        (* give minimal instructions *)
   ">>  You may now enter words. You have three minutes." .tell
   ">>  Begin!" .tell
   ">> [Type 'bb' to redisplay board]" .tell
   ">> [Type 'tt' to show time remaining]" .tell
   ">> [Type 'rr <word>' to remove a bad word, or type '.q' to quit]" .tell
   
   "1"               (* use this string for position of word in list *) 
   begin                                         (* BEGIN INPUT LOOP *)
      SayPose strip QCheck              (* get input; check for quit *)
      
               (* exit loop if player has been taken from timer loop *)
      trig "_pids/" me @ intostr strcat getprop not if
         break
      then
              (* check: player wants to see board or time remaining? *)
      dup "bb" smatch if
         Board pop continue
      then
      dup "tt" smatch if 
         ShowTimeLeft pop continue
      then
      dup "rr *" smatch if
         RemoveWord continue
      then
                                      (* check: word is long enough? *)
      dup strlen 3 < if
         ">>  Sorry, words have to be at least three letters." .tell
         pop continue
      then
                                       (* insert a 'u' for 'q' words *)
      "q" "qu" subst
                                      (* go see if it's a valid word *)
      ourString ! CheckWord if
      
                          (* go see if word has been used; say if so *)
         CheckDuplicateWords if
            ">>  You've already used '" ourWord @ strcat 
            "'." strcat .tell
         else
                (* add word for player; output if player isn't terse *)
            trig "_words/" me @ intostr strcat 
            "/" strcat 3 pick strcat 
            ourWord @ "qu" "q" subst
            tolower 1 strcut swap toupper swap strcat
            dup ourWord ! setprop
            trig "_terse/" me @ intostr strcat getprop not if
               ">>  " ourWord @ strcat .tell
            then
            atoi 1 + intostr      (* increment word-position counter *)
         then
      else
         ">>  Sorry, you can't make that word with these letters." 
         .tell
      then
   repeat                                          (* END INPUT LOOP *)
   ">>  Done." .tell
;
 
: Terse  (  --  )     (* set prop: player won't see words as entered *)
   
   trig "_terse/" me @ intostr strcat over over
   getprop if
      remove_prop
      ">>  You will now see NickNack words as you enter them." .tell
   else
      "yes" setprop
      ">>  You will now not see NickNack words as you enter them." .tell
   then
;
 
: ReduceSyntax  (  --  )         (* show syntax for 'reduce' command *)
 
   ">>  <Number> is the amount by which you want to reduce your score."
   ">>  Syntax: 'reduce <number>'" .tell .tell
;
 
: Reduce  ( s --  )   (* reduce user's score by s. For invalid words *)
   
   dup if
      dup number? if              (* check: is s a positive integer? *)
         dup atoi 0 < if 
            ">>  Sorry, you can only *reduce* your score by "
            "a positive number." strcat .tell exit
         then
         dup ourCounter !
         trig "_totals/" me @ intostr strcat 
         over over getprop if
                                                   (* reduce; notify *)
            over over getprop 4 rotate atoi -
            ">>  Your score is now "
            over intostr strcat "." strcat .tell
            loc @ me @ dup ">>  %N reduces %p score by " 
            ourCounter @ strcat "." strcat pronoun_sub 
            notify_except
            setprop
         else
            pop pop pop
            ">>  You don't currently have a score to reduce." .tell
         then
      else
         ReduceSyntax
      then
   else
      ReduceSyntax
   then
;
 
: Join  (  --  )         (* set prop: player joins game. Notify room *)
   
   trig "_players/" me @ intostr strcat "waiting" setprop
   ">>  You join the NickNack game." .tell
   loc @ me @ 
   ">>  " me @ name strcat " joins the game." strcat
   notify_except
;
 
: Oust ( s --  )  (* boot an absent or sleeping player from the game *)
   
   dup not if
      ">>  Syntax: 'oust <player>'" .tell pop exit
   else
      .pmatch dup not if
         ">>  I can't find that player." .tell pop exit
      then
      trig "_players/" 3 pick intostr strcat getprop not if
         ">>  " swap name strcat " isn't playing!" strcat .tell exit
      then
      dup location loc @ dbcmp
      over awake? and if
         ">>  Sorry, you can only oust someone "
         "who has left, or is asleep." strcat .tell pop exit
      then
      trig "_players/" 3 pick intostr strcat remove_prop
      ">>  " me @ name strcat " ousts " strcat 
      swap name strcat " from the game."
      strcat .tell
   then
;
 
: Leave  (  --  ) (* player leaves game: clean up props; notify room *)
   
   trig "_players/" me @ intostr strcat remove_prop
   trig "_pids/"    me @ intostr strcat remove_prop
   trig "_scores/"  me @ intostr strcat remove_prop
   trig "_finals/"  me @ intostr strcat remove_prop
   trig "_totals/"  me @ intostr strcat remove_prop
   ">>  You leave the NickNack game." .tell
   loc @ me @ 
   ">>  " me @ name strcat " leaves the game." strcat
   notify_except
;
 
: main
   
   "me" match me !
   dup if
       command @ "reduce"    smatch if Reduce    else
       command @ "oust"      smatch if Oust      else
      "#help"        over stringpfx if Help      else
      "#commands"    over stringpfx if Commands  else
      "#rules"       over stringpfx if Rules     else
      "#q"           over stringpfx if QRules    else
      "#install"     over stringpfx if Install   else
      ">>  Command or argument not understood." .tell
      then then then then then then then
   else
   
          (* yes, I know this is serious name-space pollution, but
             this will always be a local command, so I think it's ok *)   
      command @ "shake"      smatch if Shake     else
      command @ "start"      smatch if Start     else
      command @ "score"      smatch if Score     else
      command @ "board"      smatch if Board     else
      command @ "status"     smatch if Status    else
      command @ "join"       smatch if Join      else
      command @ "leave"      smatch if Leave     else
      command @ "reset"      smatch if Reset     else
      command @ "terse"      smatch if Terse     else
      command @ "nicknack"   smatch if Help      else
      ">>  Command or argument not understood." .tell                           
      then then then then then
      then then then then then
   then
;
.
c
q