@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