💾 Archived View for spam.works › mirrors › textfiles › internet › muf.exa captured on 2023-06-16 at 18:50:26.
-=-=-=-=-=-=-
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)