175 lines
5.8 KiB
Plaintext
175 lines
5.8 KiB
Plaintext
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)
|
|
|