This first program checks the contents in a room and assembles a string which is an english description of the contents. For example, for
Contents: a bell a book it would print: a bell, a book, and a candle. a candle
Contents: Huey it would print: Huey and Dewey Dewey
Contents: it would print: an apple an apple
If there is nothing in the room, it will print "nothing."
(english-list) (3 vars) ( list – s ) ( ) ( list is a list of dbrefs with an integer on ) ( top [a la 'contents']; s is an English ) ( string describing said contents. ) ( )
var manysofar var howmany var accumulate : itemprelist
dup 0 = if pop exit then (check to see if we're done. ) swap manysofar @ 1 + manysofar ! (count how many items we've seen.) name ", " manysofar @ howmany @ 1 - = if (separate items with a comma, ) pop ", and " then (unless there are only two or it ) howmany @ 1 = if pop " " then (is the last item in the list. ) howmany @ 2 = if pop " and " then manysofar @ howmany @ = if pop "." then (end with a period. ) strcat accumulate @ swap strcat accumulate ! (add the text to the new string. ) 1 - itemprelist (if not done, loop around. )
; : itemlist
dup howmany ! (howmany is the number of items in the list ) 0 manysofar ! (manysofar is how many we've counted; initialize. ) "" accumulate ! itemprelist (do the loop that concats the item names together.) accumulate @ "" strcmp if (return the value of accumulate, or "nothing' if ) accumulate @ (we didn't find anything in the room. ) then "nothing."
;
(The next part actually puts the above program to use.)
: show-contents-in-English
me @
"In this room, you see "
loc @ contents (get the list to pass to the function. )
itemlist pop
strcat
notify
;
The next two are simple shortcuts to see if a player is male or female.
( male ) ( d – i ) ( d is the player's dbref, i is a boolean. ) ( ) : male
"sex" getpropstr "male" strcmp if 0 exit then 1
;
( female ) ( d – i ) ( d is the player's dbref, i is a boolean. ) ( ) : female
"sex" getpropstr "female" strcmp if 0 exit then 1
;
This next is a little search-and-replace hack.
( search-and-replace ) (3 vars) ( s1 s2 s3 – s ) ( ) ( Searches through s1 for all occurences of ) ( word s3 and replaces them with s2. Only ) ( occurences which stand alone [are bordered ) ( by spaces on both sides] are detected. ) ( Not case sensitive. ) ( Right now it's a bit tacky since it will ) ( miss words ending in punctuation; for this ) ( we need a strncmp primitive. ) ( ) var recurse var old_word var new_word : dostuff
recurse @ 2 < if exit then ( If we're done, exit. ) swap dup old_word @ stringcmp not (If the word we're looking at now matches) if pop new_word @ then (the word we're looking for, pop it and ) " " swap strcat strcat (replace with new_word. ) (Concatenate whatever still happens to be) (there back onto the string we're re- ) (constructing. ) recurse @ 1 - recurse ! (Update our recursion counter. ) dostuff (Loop back and continue. )
; : search-and-replace
old_word ! (Set old_word and new_word to the parameters ) new_word ! (we were passed. ) " " explode (Explode the string we were passed [separate it) recurse ! ( into words] for the loop to use. ) dostuff (Do the loop. )
;
(Written by Stinglai)
The next is an update [more readable, even] of the old one-armed bandit routine.
: abs ( i – i ) (absolute value)
dup 0 < if -1 * then
; : amt ( – i ) (random number between -100 and 100.)
random 21 % 10 - 10 *
; : give ( d – )
me @ swap addpennies (give the player some pennies)
; : msg ( i s – d s )
swap abs intostr " pennies!" (make tail half of the message) strcat strcat me @ swap
; : winlose
dup dup abs = dup (is the number we got = to its absolute ) if pop "win" exit (value? i.e., is it positive? ) then not if "lose" then
; (send the right message accordingly. ) : tell
dup winlose "You " swap (print "You [win/lose] x pennies!" ) strcat " " strcat msg notify
; : announce
dup loc @ swap me @ swap notify (Tell the player what happened. ) loc @ swap me @ swap notify_except (Tell everyone else what happened. )
; : pull
amt tell announce give (Main prog.)
;
(Written by WhiteRabbit)