@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