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)