@prog probe.muf 1 999 d 1 i ( Until Holo's server is updataed to a version with STRSPN... ) ( This isn't a real strspn-alike; it depends on the way this code uses strspn. Specifically, it knows that the first returned value is always ignored, and that the second returned value is used only as a boolean. ) : strspn (s1 s2 -- matching-part rest) swap begin dup while 1 strcut 3 pick rot instr not if pop 1 exit then loop ; : NumInstr (s1 s2 -- i returns the number if times s2 is in s1) (s1 s2 1) 0 BEGIN 3 pick 3 pick instr dup WHILE 4 rotate swap 1 - strcut 1 strcut swap pop strcat -rot 1 + REPEAT swap -4 rotate 3 mpop ; : PointVal (i/pos -- i/val) 5 10 15 15 10 5 5 10 15 15 10 5 13 rotate rotate -12 rotate 11 mpop ; : t@ trigger @ location ; : cset t@ ".CurCharset" getpropstr ; : set-cset t@ ".CurCharset" rot addprop ; : cset-chars ( cset-name -- chars ) dup if t@ ".Charset-chars-" rot strcat getpropstr else pop "ABCDEFGHIJKLMNOPQRSTUVWXYZ" then "*" strcat ; : cset-name ( cset-name -- name ) t@ ".Charset-name-" rot strcat getpropstr ; : cset-casemap ( cset-name -- [multisubst args] ) dup if t@ ".Charset-case-" rot strcat getpropstr else pop "AaBbCcDdEeFfGgHhIiJjKkLlMmNnOoPpQqRrSsTtUuVvWwXxYyZz" then 1 rexplode (the "dup...then" code is being defensive against a mis-set-up prop.) dup 1 & if swap pop 1 - then 2 / ; : upcase cset cset-casemap multisubst ; : validword? ( s -- b ) cset cset-chars strspn swap pop not ; : gaglist ( d -- d1 d2 d3 ... di i ) contents 0 begin over player? if t@ ".Gagged-" 4 pick intostr strcat getpropstr not if over swap 1 + then then swap next dup #-1 dbcmp not while swap repeat pop ; : t-m me @ "(#) " rot strcat notify ; : t-o "(#) " swap strcat me @ location me @ rot notify_except ; : name-to me @ name " " strcat swap strcat t-o ; : t-a "(#) " swap strcat me @ location gaglist dup 2 + rotate BEGIN over WHILE rot over notify swap 1 - swap REPEAT pop pop ; : name-ta me @ name " " strcat swap strcat t-a ; : UpNow t@ ".UpNow" getpropstr ; : playing? (returns 0 if not playing, position number if playing) 0 BEGIN 1 + dup intostr ".Player" swap strcat t@ swap getpropstr atoi dup WHILE dbref me @ dbcmp if intostr exit then REPEAT pop 0 ; : toggle-gag playing? if "You may not change status while playing." t-m exit then t@ ".Gagged-" me @ intostr strcat over over getpropstr "yes" strcmp if "You will not see game output." t-m "yes" addprop "will not see game output." name-to else "You will see game output." t-m remove_prop "will again see game output." name-to then ; : verify? " [Type `Y' to confirm]" strcat t-m read tolower "y" stringcmp not ; : getstatus t@ ".Status" getpropstr ; : gamereset t@ propfirst BEGIN WHILE dup "Gagged" instr over "Charset" instr or not if t@ swap remove_prop else pop then propnext REPEAT t@ ".CurCharset" remove_prop t@ ".Status" "reset" addprop "has issued a game reset." name-ta ; : PPrompt t@ ".UpNow" getpropstr ".Player" swap strcat t@ swap getpropstr atoi dbref name "It is " swap strcat "'s turn." strcat t-a ; : GameStart t@ ".Status" "playing" addprop 0 BEGIN 1 + dup intostr ".Player" swap strcat t@ swap getpropstr WHILE REPEAT 1 - random swap % 1 + t@ ".UpNow" rot intostr addprop PPrompt ; : UpNext UpNow atoi 1 + intostr t@ ".Player" 3 pick strcat getpropstr not if pop "1" then t@ ".UpNow" rot addprop PPrompt ; : display1 (s -- ) "" 0 BEGIN 1 + dup 13 < WHILE t@ ".Tray" 5 pick strcat getpropstr over over strlen over < if pop pop " " else strcut pop dup strlen 1 - strcut swap pop then " " strcat " " swap strcat rot swap strcat swap REPEAT pop "|" swap strcat " | " strcat ".Player" 3 pick strcat t@ swap getpropstr atoi dbref name strcat ": " strcat ".Points" 3 pick strcat t@ swap getpropstr strcat ; : display (s -- ) display1 "+-------------------------------------+" "" t-m t-m t-m "+-------------------------------------+" t-m "| 05 10 15 15 10 05 05 10 15 15 10 05 |" t-m "+-------------------------------------+" t-m ; : maybe-show-cset cset dup if "The character set in use is " swap cset-name "." 3 "" rimplode t-m else pop then ; : Probe.muf command @ tolower dup "status" strcmp not if pop pop getstatus dup "reset" strcmp not if pop "The game is freshly reset. Use `join ' to join." t-m maybe-show-cset exit then 0 BEGIN 1 + ".Player" over intostr strcat t@ swap getpropstr WHILE intostr display1 t-m atoi REPEAT pop maybe-show-cset dup "joining" strcmp not if pop "The game is open to more players." t-m exit then "done" strcmp not if "The game is over." t-m exit then playing? dup not if pop else ".Word" swap strcat t@ swap getpropstr "Your word is: " swap strcat t-m then t@ ".Revealer" getpropstr dup if atoi dbref dup name "We're waiting for " swap strcat " to reveal a card." strcat t-m me @ dbcmp if t@ ".RevealOpt" getpropstr "Your options: " swap strcat t-m exit then exit then "It is " t@ ".Player" UpNow strcat getpropstr atoi dbref name strcat "'s turn to a letter." strcat t-m exit then dup "cset" strcmp not if pop dup not if pop maybe-show-cset exit then dup cset-chars not if pop "Unrecognized character set." t-m exit then dup set-cset "has set the character set to " swap "." 3 "" rimplode name-ta exit then dup "reset" strcmp not if pop pop getstatus dup "reset" strcmp not if pop "The game has already been reset." t-m exit then "playing" strcmp if gamereset else "threatens to issue a game reset..." name-to "There is a game in progress. Are you sure?" verify? if gamereset else "Cancelled." t-m "decides otherwise." name-to then then exit then dup "rules" strcmp not if pop "help" stringcmp if "_rules" else "_fullrules" then #23 call exit then dup "gag" strcmp not if pop pop toggle-gag exit then dup "join" strcmp not if pop dup "/help" stringcmp not if pop "_joinhelp" #23 call exit then getstatus dup "playing" strcmp swap "done" strcmp and not if "You'll need to start a new game first." t-m pop exit then playing? if "You are already playing!" t-m exit then t@ ".Gagged-" me @ intostr strcat getpropstr if "You may not play while `GAG'ged." t-m exit then over not if pop "You must give a word. JOIN /HELP for more." t-m exit then over strlen dup 12 > swap 2 < or if pop pop "Your word must be between 2 and 12 characters." t-m exit then (pl# word) swap upcase dup validword? not if pop pop "Your word contains an invalid character. JOIN /HELP for help." t-m exit then (strip blanks from beginning and end of word) dup BEGIN dup not if 3 mpop "Error: Your word contains no letters." t-m exit then 1 strcut swap dup "*" strcmp not WHILE pop REPEAT swap strcat BEGIN dup strlen 1 - strcut dup "*" strcmp not WHILE pop REPEAT strcat "blanks stripped" pop dup strlen 2 < if "Error: Your word must have at least two letters." t-m pop exit then (pl# word stripped) "*" instr if "Error: Blanks are not permitted between letters!" t-m pop exit then t@ ".Status" "joining" addprop ".Player" 3 pick intostr strcat t@ swap me @ intostr addprop ".-Tray" 3 pick intostr strcat t@ swap 3 pick addprop dup strlen "------------" swap strcut pop t@ ".Tray" 5 pick intostr strcat rot addprop ".Word" rot intostr strcat t@ swap rot addprop "has joined the game with tray showing: " t@ ".Tray" playing? strcat getpropstr strcat name-ta playing? "4" strcmp not if "Critical mass reached; game automatically starting." GameStart then exit then dup "begin" strcmp not if pop pop getstatus "joining" strcmp if "No game pending. Perhaps one's already going on?" t-m exit then playing? not if "You aren't playing!" t-m exit then t@ ".Player2" getpropstr not if "Not enough players." t-m exit then "has started the game." name-ta GameStart exit then dup "guess" strcmp over "probe" strcmp and not if pop getstatus "playing" strcmp if "No game in progress." t-m exit then t@ ".Player" UpNow strcat getpropstr me @ intostr strcmp if "It is not your turn." t-m exit then dup not if pop "Use GUESS /HELP for help." t-m exit then dup "/help" stringcmp not if pop "Use GUESS , where X is a player (use a name)" t-m "and is a letter." t-m exit then " " explode dup 2 > over 1 < or if (wrong # arguments) "Improper format. Use GUESS ." t-m exit then 1 = if t@ ".Player3" getpropstr if "Improper format. Use GUESS /HELP for help." t-m exit then t@ ".Player1" getpropstr atoi dbref me @ dbcmp if ".Player2" else ".Player1" then t@ swap getpropstr atoi dbref name then (letter d-player) t@ ".Revealer" getpropstr if "There is a response pending. Please wait for it." t-m exit then match dup player? not if "I don't know who you mean." t-m pop pop exit then dup me @ dbcmp if "You cannot guess yourself." t-m pop pop exit then (ltr d) (returns 0 if not playing, position number if playing) 0 BEGIN 1 + dup intostr ".Player" swap strcat t@ swap getpropstr atoi dup WHILE dbref 3 pick dbcmp if intostr break then REPEAT dup string? not if pop 0 then (letter d-player pos) dup not if pop pop name " isn't playing." strcat t-m pop exit then 3 pick strlen 1 = not if "Improper format. Use guess /help for help." t-m exit then 3 pick upcase validword? not if 3 mpop "Invalid letter." t-m exit then rot upcase me @ name " probes for '" strcat over strcat "' from " strcat 4 pick name strcat "." strcat t-a (is letter in d-player's -Tray?)(d-pl reqpos ltr) t@ ".-Tray" 4 pick strcat getpropstr dup 3 pick instr not if 3 mpop name " doesn't have it." strcat t-a UpNext exit then (EXTRA CODE: is this the last letter?)(d-pl pos ltr -tray) t@ ".Tray" 5 pick strcat getpropstr "-" NumInstr 1 = if pop pop "It's " 3 pick name "'s last card!" strcat strcat t-a t@ ".Revealer" 4 pick intostr addprop t@ ".Tray" rot strcat getpropstr "-" instr intostr dup "-" strcat "-" swap strcat t@ ".Revealopt" rot addprop "reveal " swap strcat force exit then (END OF EXTRA CODE) "" BEGIN over 4 pick instr dup WHILE dup intostr "-" swap strcat rot swap strcat swap rot swap 1 - strcut 1 strcut swap pop "=" swap strcat strcat swap REPEAT pop "-" strcat swap pop swap pop swap pop t@ ".Revealer" 4 pick intostr addprop over name " must now respond." strcat t-a "(##) You must now type `reveal x' where x is one of: " over strcat rot swap notify t@ ".RevealOpt" rot addprop (d-player pos letter -Tray1 ) exit then dup "trays" strcmp not if pop pop getstatus "reset" strcmp not if "There is no game in progress." t-m exit then 0 BEGIN 1 + dup intostr ".Player" swap strcat t@ swap getpropstr WHILE dup intostr display pop REPEAT pop exit then "reveal" strcmp not if t@ ".Revealer" getpropstr atoi dbref me @ dbcmp not if pop "You have not been asked to reveal a card." t-m exit then t@ ".RevealOpt" getpropstr over "-" strcat "-" swap strcat instr not if pop "That is not a valid choice." t-m exit then t@ ".Revealer" remove_prop playing? t@ ".Word" 3 pick strcat getpropstr "turns over card #" 4 pick strcat "." strcat name-ta t@ ".Tray" 4 pick strcat getpropstr 4 pick atoi 1 - strcut 1 strcut swap pop rot 5 pick atoi 1 - strcut swap pop 1 strcut pop swap strcat strcat t@ ".Tray" 4 pick strcat rot addprop t@ ".-Tray" 3 pick strcat getpropstr 3 pick atoi 1 - strcut 1 strcut swap pop "-" swap strcat strcat ".-Tray" rot strcat t@ swap rot addprop me @ name "'s tray now shows: " strcat t@ ".Tray" playing? strcat getpropstr strcat t-a (still need to add points!) atoi PointVal intostr t@ ".Player" UpNow strcat getpropstr atoi dbref name " picks up " strcat over strcat " points." strcat t-a t@ ".Points" UpNow strcat over over getpropstr 4 rotate atoi swap atoi + intostr addprop t@ ".Tray" playing? strcat getpropstr "-" instr not if (I'm out. Check to see if the game is over.) "is out!" name-ta t@ ".Player" UpNow strcat getpropstr atoi dbref name " takes 20 bonus points for finishing the word." strcat t-a t@ ".Points" UpNow strcat over over getpropstr atoi 20 + intostr addprop "" 0 BEGIN 1 + ".Tray" over intostr strcat t@ swap getpropstr dup WHILE "-" instr IF dup intostr rot swap strcat swap THEN REPEAT pop pop (if len=1, the game is over!) dup strlen 1 = if t@ ".Player" 3 pick strcat getpropstr atoi dbref name dup " is the only one with unexposed cards. The game is over!" strcat t-a (s-winnerpos s-winnername) (calculate point bonus) t@ ".Tray" 4 pick strcat getpropstr 0 1 rot BEGIN 1 strcut swap dup WHILE "-" strcmp not if (add bonus) over PointVal 4 rotate + -rot then swap 1 + swap REPEAT 3 mpop (s-winpos s-winname i-points) (give the winner's word) ".Player" 4 pick strcat t@ swap getpropstr atoi dbref name "'s word was: " strcat ".Word" 5 pick strcat t@ swap getpropstr strcat t-a swap " takes " strcat over intostr strcat " bonus points." strcat t-a t@ ".Points" 4 rotate strcat over over getpropstr atoi 4 rotate + intostr addprop t@ ".Status" "done" addprop exit then then PPrompt exit then "Command not installed; bug JT." t-m ; . c q