@q
@program route.muf
1 99999 d
i
( route.muf    v1.0    Jessy @ FurryMUCK    9/99
  
  Route.muf allows users to configure exits such that the destination
  varies depending on conditions. Destinations can be programs, rooms,
  random groups of rooms or programs, or sequential groups of rooms
  or programs. The condition can be based on how many times the exit
  has been used, or on whether the user -- or something carried by the
  user -- has or does not have a specified property, or on whether the
  user has -- or is carrying something that has -- a specified object.
  
  INSTALLATION:
  
  Set route.muf Link_OK. Route.muf requires lib-reflist and lib-
  mucktools. It will run at M3, but will need to be set Wizard 
  if any exits will be based on wizard properties.
  
  USE:
  
  Link an exit to route.muf and type `<exit> #configure' to enter a
  prompt-driven interface that will configure the exit for use with
  route.muf
  
  Route.muf may be freely ported. Please comment any changes.
)
  
(2345678901234567890123456789012345678901234567890123456789012345678901)
  
$include $lib/reflist
$include $lib/mucktools
  
$define Tell me @ swap notify $enddef
$define NukeStack begin depth while pop repeat $enddef
  
lvar ourString
lvar ourCounter
  
: DoHelp  ( s --  )                            (* display help screen *)
  
  pop
  "Route.muf (#" prog intostr strcat ")" strcat " " Tell Tell " " Tell
  
  "Route.muf allows exits to be configured such that the destination "
  "varies, depending on whether a specified condition is met. "
  "Destinations can be rooms or programs, as with normal exits, or "
  "they can be groups of rooms or programs that will be selected "
  "either sequentially or randomly, or the destination can be `nowhere'. " 
  "The condition controlling the exit's destination can be the number "
  "of times the exit has been used, or it can be based on a recursive "
  "search for a specified property or object. That is, if either the "
  "user or something the user is carrying has the specified property "
  "or object, the condition will be met." 
  strcat strcat strcat strcat strcat strcat strcat strcat strcat 
  Tell " " Tell
  
  "To configure an exit for use with route.muf, link it to this "
  "program and type `<exit> #configure'." strcat Tell " " Tell
  
  "  <exit> #reset ....... Reset exit's usecount" Tell
  "  <exit> #sequence .... Define group of dest's to be accessed "
  "sequentially" strcat Tell
  "  <exit> #group ....... Define group of dest's to be accessed "
  "randomly" strcat Tell
  "  <exit> #configure ... Configure <exit> for use with route.muf" Tell
;
 
: DoDressProp  ( d s -- s' )   (* parse s for MPI and do pronoun subs *)
  
  ParseThis me @ swap pronoun_sub
;
  
: DoMatchLink  ( s -- d i )   (* match s; return dbref and true|false *)
  
  match 
  dup #-1 dbcmp if 
    ">>  Destination not found." Tell 0 exit
  then
  dup #-2 dbcmp if
    ">>  Ambiguous. I don't know which one you mean." Tell 0 exit
  then
  1
;
  
: DoCanLink?  ( d -- i )         (* return true if user can link to d *)
  
  me @ over controls
  over "L" flag? or if
    1
  else
    ">>  Permission denied." Tell 0
  then
;
  
: DoCheckContents  ( d -- i ) 
   (* return true if d or something contained by d has prop ourString *)
  
  dup contents
  begin                                   (* begin prop-checking loop *)
    dup while
    dup ourString @ getpropstr if        (* return true if d has prop *)
      pop pop 1 exit
    then
    dup contents if               (* recurse if d holds other objects *)
      dup DoCheckContents if
        pop pop 1 exit
      then
      dup ourString @ getpropstr if
        pop pop 1 exit
      else
        next
      then
    else
      dup ourString @ getpropstr if
        pop pop 1 exit
      then
      next
    then
  repeat                                   (* end prop-checking loop *)
  pop pop 0              (* exhausted recursive search: return false *)
;
   
: DoCheckObjects  ( d -- i )
(* return true if d or something contained by d has dbref ourCounter *)
  
  dup contents
  begin
    dup while
    dup ourCounter @ dbcmp if
      pop pop 1 exit
    then
    dup contents if
      dup DoCheckObjects if
        pop pop 1 exit
      then
      dup ourCounter @ dbcmp if
        pop pop 1 exit
      else
        next
      then
    else
      dup ourCounter @ dbcmp if
        pop pop 1 exit
      then
      next
    then
  repeat
  pop pop 0
;
  
: DoObjectConfig  (  --  )       (* configure exit for object-control *)
        
  begin                                         (* get control object *)
    ">>  What object controls this exit?" Tell
    ">> [Enter object by dbref, name, or regname, or .q to quit]" Tell
    ReadLine strip QCheck 
    dup match not if
      ">>  Object not found." Tell pop continue
    then
    trig "_tmp/object" 3 pick setprop
    ">>  Configuring exit to be controled by object `<obj>'..."
    swap "" "#" subst atoi dbref name "<obj>" subst Tell break
  repeat
                                             (* get `has object' data *)
  begin 
    ">>  Where does this exit lead if the user *has* the object?"
    Tell
    ">> [Enter destination as dbref, regname, list or "
    "`nowhere', or .q to quit]" strcat Tell ReadLine strip QCheck
    dup "nowhere" smatch if
      pop "#-1" break
    then
    trig "_sequence/" 3 pick strcat getpropstr if
      break
    then
    trig "_random/" 3 pick strcat getpropstr if
      break
    then
    DoMatchLink not if
      pop continue
    then
    DoCanLink? not if
      pop continue
    then
    break
  repeat
  trig "_tmp/obj" rot setprop 
   
  ">> [Enter @succ, or .n for `none', or .q to quit]"
  ">>  What is the @succ message if the user has the object?"
  Tell Tell ReadLine strip QCheck
  dup ".n" smatch if
    pop
  else
    trig "_tmp/obj_succ" rot setprop
  then
     
  ">> [Enter @osucc, or .n for `none', or .q to quit]"
  ">>  What is the @osucc message if the user has the object?"
  Tell Tell ReadLine strip QCheck
  dup ".n" smatch if
    pop
  else
    trig "_tmp/obj_osucc" rot setprop
  then
  
  ">> [Enter @odrop, or .n for `none', or .q to quit]"
  ">>  What is the @odrop message if the user has the object?"
  Tell Tell ReadLine strip QCheck
  dup ".n" smatch if
    pop
  else
    trig "_tmp/obj_odrop" rot setprop
  then
     
  ">>  @fail and @ofail are triggered when the destination is `nowhere'."
  Tell
  ">> [Enter @fail, or .n for `none', or .q to quit]"
  ">>  What is the @fail message if the user has the object?"
  Tell Tell ReadLine strip QCheck
  dup ".n" smatch if
    pop
  else
    trig "_tmp/obj_fail" rot setprop
  then
  
  ">> [Enter @ofail, or .n for `none', or .q to quit]"
  ">>  What is the @ofail message if the user has the object?"
  Tell Tell ReadLine strip QCheck
  dup ".n" smatch if
    pop
  else
    trig "_tmp/obj_ofail" rot setprop
  then
                                          (* get `does not have' data *)
  begin 
    ">>  Where does this exit lead if the user "
    "*does not have* the object?"
    strcat Tell
    ">> [Enter destination as dbref, regname, list or "
    "`nowhere', or .q to quit]" strcat Tell ReadLine strip QCheck
    dup "nowhere" smatch if
      pop "#-1" break
    then
    trig "_sequence/" 3 pick strcat getpropstr if
      break
    then
    trig "_random/" 3 pick strcat getpropstr if
      break
    then
    DoMatchLink not if
      pop continue
    then
    DoCanLink? not if
      pop continue
    then
    break
  repeat
  trig "_tmp/objno" rot setprop 
   
  ">> [Enter @succ, or .n for `none', or .q to quit]"
  ">>  What is the @succ message if the user does not have the object?"
  Tell Tell ReadLine strip QCheck
  dup ".n" smatch if
    pop
  else
    trig "_tmp/objno_succ" rot setprop
  then
     
  ">> [Enter @osucc, or .n for `none', or .q to quit]"
  ">>  What is the @osucc message if the user does not have the object?"
  Tell Tell ReadLine strip QCheck
  dup ".n" smatch if
    pop
  else
    trig "_tmp/objno_osucc" rot setprop
  then
  
  ">> [Enter @odrop, or .n for `none', or .q to quit]"
  ">>  What is the @odrop message if the user does not have the object?"
  Tell Tell ReadLine strip QCheck
  dup ".n" smatch if
    pop
  else
    trig "_tmp/objno_odrop" rot setprop
  then
     
  ">>  @fail and @ofail are triggered when the destination is `nowhere'."
  Tell
  ">> [Enter @fail, or .n for `none', or .q to quit]"
  ">>  What is the @fail message if the user does not have the object?"
  Tell Tell ReadLine strip QCheck
  dup ".n" smatch if
    pop
  else
    trig "_tmp/objno_fail" rot setprop
  then
  
  ">> [Enter @ofail, or .n for `none', or .q to quit]"
  ">>  What is the @ofail message if the user does not have the object?"
  Tell Tell ReadLine strip QCheck
  dup ".n" smatch if
    pop
  else
    trig "_tmp/objno_ofail" rot setprop
  then
                                (* copy from temp dir to actual props *)
  trig "_type" "object" setprop
  trig "_obj"         trig "_tmp/obj"         getpropstr setprop
  trig "_obj_succ"    trig "_tmp/obj_succ"    getpropstr setprop
  trig "_obj_osucc"   trig "_tmp/obj_osucc"   getpropstr setprop
  trig "_obj_odrop"   trig "_tmp/obj_odrop"   getpropstr setprop
  trig "_obj_fail"    trig "_tmp/obj_fail"    getpropstr setprop
  trig "_obj_ofail"   trig "_tmp/obj_ofail"   getpropstr setprop
  trig "_object"      trig "_tmp/object"      getpropstr setprop
  trig "_objno"       trig "_tmp/objno"       getpropstr setprop
  trig "_objno_succ"  trig "_tmp/objno_succ"  getpropstr setprop
  trig "_objno_osucc" trig "_tmp/objno_osucc" getpropstr setprop
  trig "_objno_odrop" trig "_tmp/objno_odrop" getpropstr setprop
  trig "_objno_fail"  trig "_tmp/objno_fail"  getpropstr setprop
  trig "_objno_ofail" trig "_tmp/objno_ofail" getpropstr setprop
;
  
: DoPropConfig  (  --  )           (* configure exit for prop-control *)
  
                                                  (* get control prop *)
  ">>  What property controls this exit?" Tell
  ">> [Enter property, or .q to quit]" Tell
  ReadLine strip QCheck 
  trig "_tmp/prop" 3 pick setprop
  ">>  Configuring exit to be controled by prop `<prop>'..."
  swap "<prop>" subst Tell
                                               (* get `has prop' data *)
  begin 
    ">>  Where does this exit lead if the user *has* the property?"
    Tell
    ">> [Enter destination as dbref, regname, list or "
    "`nowhere', or .q to quit]" strcat Tell ReadLine strip QCheck
    dup "nowhere" smatch if
      pop "#-1" break
    then
    trig "_sequence/" 3 pick strcat getpropstr if
      break
    then
    trig "_random/" 3 pick strcat getpropstr if
      break
    then
    DoMatchLink not if
      pop continue
    then
    DoCanLink? not if
      pop continue
    then
    break
  repeat
  trig "_tmp/has" rot setprop 
   
  ">> [Enter @succ, or .n for `none', or .q to quit]"
  ">>  What is the @succ message if the user has the property?"
  Tell Tell ReadLine strip QCheck
  dup ".n" smatch if
    pop
  else
    trig "_tmp/has_succ" rot setprop
  then
     
  ">> [Enter @osucc, or .n for `none', or .q to quit]"
  ">>  What is the @osucc message if the user has the property?"
  Tell Tell ReadLine strip QCheck
  dup ".n" smatch if
    pop
  else
    trig "_tmp/has_osucc" rot setprop
  then
  
  ">> [Enter @odrop, or .n for `none', or .q to quit]"
  ">>  What is the @odrop message if the user has the property?"
  Tell Tell ReadLine strip QCheck
  dup ".n" smatch if
    pop
  else
    trig "_tmp/has_odrop" rot setprop
  then
     
  ">>  @fail and @ofail are triggered when the destination is `nowhere'."
  Tell
  ">> [Enter @fail, or .n for `none', or .q to quit]"
  ">>  What is the @fail message if the user has the property?"
  Tell Tell ReadLine strip QCheck
  dup ".n" smatch if
    pop
  else
    trig "_tmp/has_fail" rot setprop
  then
  
  ">> [Enter @ofail, or .n for `none', or .q to quit]"
  ">>  What is the @ofail message if the user has the property?"
  Tell Tell ReadLine strip QCheck
  dup ".n" smatch if
    pop
  else
    trig "_tmp/has_ofail" rot setprop
  then
                                     (* get `does not have prop' data *)
  begin 
    ">>  Where does this exit lead if the user "
    "*does not have* the property?"
    strcat Tell
    ">> [Enter destination as dbref, regname, list or "
    "`nowhere', or .q to quit]" strcat Tell ReadLine strip QCheck
    dup "nowhere" smatch if
      pop "#-1" break
    then
    trig "_sequence/" 3 pick strcat getpropstr if
      break
    then
    trig "_random/" 3 pick strcat getpropstr if
      break
    then
    DoMatchLink not if
      pop continue
    then
    DoCanLink? not if
      pop continue
    then
    break
  repeat
  trig "_tmp/hasnot" rot setprop 
   
  ">> [Enter @succ, or .n for `none', or .q to quit]"
  ">>  What is the @succ message if the user does not have the property?"
  Tell Tell ReadLine strip QCheck
  dup ".n" smatch if
    pop
  else
    trig "_tmp/hasnot_succ" rot setprop
  then
     
  ">> [Enter @osucc, or .n for `none', or .q to quit]"
  ">>  What is the @osucc message if the user does not have the property?"
  Tell Tell ReadLine strip QCheck
  dup ".n" smatch if
    pop
  else
    trig "_tmp/hasnot_osucc" rot setprop
  then
  
  ">> [Enter @odrop, or .n for `none', or .q to quit]"
  ">>  What is the @odrop message if the user does not have the property?"
  Tell Tell ReadLine strip QCheck
  dup ".n" smatch if
    pop
  else
    trig "_tmp/hasnot_odrop" rot setprop
  then
     
  ">>  @fail and @ofail are triggered when the destination is `nowhere'."
  Tell
  ">> [Enter @fail, or .n for `none', or .q to quit]"
  ">>  What is the @fail message if the user does not have the property?"
  Tell Tell ReadLine strip QCheck
  dup ".n" smatch if
    pop
  else
    trig "_tmp/hasnot_fail" rot setprop
  then
  
  ">> [Enter @ofail, or .n for `none', or .q to quit]"
  ">>  What is the @ofail message if the user does not have the property?"
  Tell Tell ReadLine strip QCheck
  dup ".n" smatch if
    pop
  else
    trig "_tmp/hasnot_ofail" rot setprop
  then
                           (* copy data from temp dir to actual props *)
  trig "_type" "prop" setprop
  trig "_has"           trig "_tmp/has"          getpropstr setprop
  trig "_has_succ"      trig "_tmp/has_succ"     getpropstr setprop
  trig "_has_osucc"     trig "_tmp/has_osucc"    getpropstr setprop
  trig "_has_odrop"     trig "_tmp/has_odrop"    getpropstr setprop
  trig "_has_fail"      trig "_tmp/has_fail"     getpropstr setprop
  trig "_has_ofail"     trig "_tmp/has_ofail"    getpropstr setprop
  trig "_prop"          trig "_tmp/prop"         getpropstr setprop
  trig "_hasnot"        trig "_tmp/hasnot"       getpropstr setprop
  trig "_hasnot_succ"   trig "_tmp/hasnot_succ"  getpropstr setprop
  trig "_hasnot_osucc"  trig "_tmp/hasnot_osucc" getpropstr setprop
  trig "_hasnot_odrop"  trig "_tmp/hasnot_odrop" getpropstr setprop
  trig "_hasnot_fail"   trig "_tmp/hasnot_fail"  getpropstr setprop
  trig "_hasnot_ofail"  trig "_tmp/hasnot_ofail" getpropstr setprop
;
  
: DoUseConfig  (  --  )        (* configure exit for usecount-control *)
  
                                (* get `before count is reached' data *)
  begin 
    ">>  Where does this exit lead to *before* its usecount is reached?"
    Tell
    ">> [Enter destination as dbref, regname, list or "
    "`nowhere', or .q to quit]" strcat Tell ReadLine strip QCheck
    dup "nowhere" smatch if
      pop "#-1" break
    then
    trig "_sequence/" 3 pick strcat getpropstr if
      break
    then
    trig "_random/" 3 pick strcat getpropstr if
      break
    then
    DoMatchLink not if
      pop continue
    then
    DoCanLink? not if
      pop continue
    then
    break
  repeat
  trig "_tmp/before" rot setprop 
  
  ">> [Enter @succ, or .n for `none', or .q to quit]"
  ">>  What is the @succ message before the exit's usecount is reached?"
  Tell Tell ReadLine strip QCheck
  dup ".n" smatch if
    pop
  else
    trig "_tmp/before_succ" rot setprop
  then
     
  ">> [Enter @osucc, or .n for `none', or .q to quit]"
  ">>  What is the @osucc message before the exit's usecount is reached?"
  Tell Tell ReadLine strip QCheck
  dup ".n" smatch if
    pop
  else
    trig "_tmp/before_osucc" rot setprop
  then
  
  ">> [Enter @odrop, or .n for `none', or .q to quit]"
  ">>  What is the @odrop message before the exit's usecount is reached?"
  Tell Tell ReadLine strip QCheck
  dup ".n" smatch if
    pop
  else
    trig "_tmp/before_odrop" rot setprop
  then
     
  ">>  @fail and @ofail are triggered when the destination is `nowhere'."
  Tell
  ">> [Enter @fail, or .n for `none', or .q to quit]"
  ">>  What is the @fail message before the exit's usecount is reached?"
  Tell Tell ReadLine strip QCheck
  dup ".n" smatch if
    pop
  else
    trig "_tmp/before_fail" rot setprop
  then
  
  ">> [Enter @ofail, or .n for `none', or .q to quit]"
  ">>  What is the @ofail message before the exit's usecount is reached?"
  Tell Tell ReadLine strip QCheck
  dup ".n" smatch if
    pop
  else
    trig "_tmp/before_ofail" rot setprop
  then
                      (* get number of uses that will trigger `after' *)
  begin
    ">>  How many uses trigger this exit?" Tell
    ">> [Enter number of uses, or .q to quit]" Tell
    ReadLine strip QCheck
    dup number? not if
      ">>  Sorry, that's not a number." Tell pop continue
    then
    dup atoi 1 < if
      ">>  Sorry, number of uses must be a positive number."
      Tell pop continue
    then
    break
  repeat
  trig "_tmp/trip" rot setprop
                              (* get `after usecount is reached' data *)
  begin 
    ">>  Where does this exit lead to *after* its usecount is reached?"
    Tell
    ">> [Enter destination as dbref, regname, list or "
    "`nowhere', or .q to quit]" strcat Tell ReadLine strip QCheck
    dup "nowhere" smatch if
      pop "#-1" break
    then
    trig "_sequence/" 3 pick strcat getpropstr if
      break
    then
    trig "_random/" 3 pick strcat getpropstr if
      break
    then
    dup DoMatchLink not if
      pop continue
    then
    DoCanLink? not if
      pop continue
    then
    break
  repeat
  trig "_tmp/after" rot setprop 
   
  ">> [Enter @succ, or .n for `none', or .q to quit]"
  ">>  What is the @succ message after the exit's usecount is reached?"
  Tell Tell ReadLine strip QCheck
  dup ".n" smatch if
    pop
  else
    trig "_tmp/after_succ" rot setprop
  then
     
  ">> [Enter @osucc, or .n for `none', or .q to quit]"
  ">>  What is the @osucc message after the exit's usecount is reached?"
  Tell Tell ReadLine strip QCheck
  dup ".n" smatch if
    pop
  else
    trig "_tmp/after_osucc" rot setprop
  then
  
  ">> [Enter @odrop, or .n for `none', or .q to quit]"
  ">>  What is the @odrop message after the exit's usecount is reached?"
  Tell Tell ReadLine strip QCheck
  dup ".n" smatch if
    pop
  else
    trig "_tmp/after_odrop" rot setprop
  then
    
  ">>  @fail and @ofail are triggered when the destination is `nowhere'."
  Tell
  ">> [Enter @fail, or .n for `none', or .q to quit]"
  ">>  What is the @fail message after the exit's usecount is reached?"
  Tell Tell ReadLine strip QCheck
  dup ".n" smatch if
    pop
  else
    trig "_tmp/after_fail" rot setprop
  then
  
  ">> [Enter @ofail, or .n for `none', or .q to quit]"
  ">>  What is the @ofail message after the exit's usecount is reached?"
  Tell Tell ReadLine strip QCheck
  dup ".n" smatch if
    pop
  else
    trig "_tmp/after_ofail" rot setprop
  then
                           (* copy data from temp dir to actual props *)
  trig "_type" "use" setprop
  trig "_before"       trig "_tmp/before"       getpropstr setprop
  trig "_before_succ"  trig "_tmp/before_succ"  getpropstr setprop
  trig "_before_osucc" trig "_tmp/before_osucc" getpropstr setprop
  trig "_before_odrop" trig "_tmp/before_odrop" getpropstr setprop
  trig "_before_fail"  trig "_tmp/before_fail"  getpropstr setprop
  trig "_before_ofail" trig "_tmp/before_ofail" getpropstr setprop
  trig "_trip"         trig "_tmp/trip"         getpropstr setprop
  trig "_after"  trig "_tmp/after"   getpropstr setprop
  trig "_after_succ"   trig "_tmp/after_succ"   getpropstr setprop
  trig "_after_osucc"  trig "_tmp/after_osucc"  getpropstr setprop
  trig "_after_odrop"  trig "_tmp/after_odrop"  getpropstr setprop
  trig "_after_fail"   trig "_tmp/after_fail"   getpropstr setprop
  trig "_after_ofail"  trig "_tmp/after_ofail"  getpropstr setprop
;
  
: DoConfigure  ( s --  )             (* get configuration type; route *) 
  
  pop
  me @ trig controls if              (* check: user must control exit *)
    ">>  Configuring... " Tell
    begin                                                 (* get type *)
      ">>  Is this exit's configuration use-based, prop-based, "
      "or object-based?" strcat Tell
      ">>  [Enter `usecount', `prop', or `object', or .q to quit]" Tell
      ReadLine QCheck                                        (* route *)
      "object"   over stringpfx if pop DoObjectConfig break then
      "property" over stringpfx if pop DoPropConfig   break then
      "usecount" over stringpfx if pop DoUseConfig    break then
      ">>  Entry not understood." Tell pop 
    repeat
    trig "_tmp/" nextprop                         (* remove temp data *)
    begin
      dup while
      trig over nextprop
      trig rot remove_prop
    repeat
    pop
    ">>  Done." Tell
  else
    ">>  Permission denied." 
  then
;
  
: DoSequence  ( s --  )  (* define a dest-group accessed sequentially *)
  
  pop
  me @ trig controls not if ">>  Permission denied." Tell exit then
  "1" ourCounter !
  ">>  What is the name of this sequence?"
  Tell ReadLine strip QCheck ourString !
  begin
    ">>  What is room number <number> in the <sequence> sequence?"
    ourCounter @ "<number>"   subst 
    ourString  @ "<sequence>" subst Tell 
    ">> [Enter room by dbref or regname, or `nowhere', or .q to quit]"
    Tell ReadLine strip QCheck
    dup "nowhere" smatch if
      pop trig "_sequence/" ourString @ strcat #-1 REF-add
      ">>  `Nowhere' added as a destination in the sequence." Tell
      ourCounter @ atoi 1 + intostr ourCounter !
      continue
    then
    DoMatchLink if
      trig "_sequence/" ourString @ strcat 3 pick REF-add
      ">>  <name> added as a destination in the sequence."
      swap name "<name>" subst Tell
      ourCounter @ atoi 1 + intostr ourCounter !
      continue
    then
  repeat
;
   
: DoGroup  ( s --  )         (* define a dest-group accessed randomly *)
  
  pop
  me @ trig controls not if ">>  Permission denied." Tell exit then
  "1" ourCounter !
  ">>  What is the name of this random group?"
  Tell ReadLine strip QCheck ourString !
  begin
    ">>  What is room number <number> in the <group> group?"
    ourCounter @ "<number>"   subst 
    ourString  @ "<group>" subst Tell 
    ">> [Enter room by dbref or regname, or `nowhere', or .q to quit]"
    Tell ReadLine strip QCheck
    dup "nowhere" smatch if
      pop trig "_random/" ourString @ strcat #-1 REF-add
      ">>  `Nowhere' added as a destination in the group." Tell
      ourCounter @ atoi 1 + intostr ourCounter !
      continue
    then
    DoMatchLink if
      trig "_random/" ourString @ strcat 3 pick REF-add
      ">>  <name> added as a destination in the group."
      swap name "<name>" subst Tell
      ourCounter @ atoi 1 + intostr ourCounter !
      continue
    then
  repeat
;
  
: DoReset  ( s --  )                      (* reset exit's use-counter *)
  
  me @ trig controls if              (* check: user must control exit *)
    trig "_count" remove_prop
    ">>  You reset the count on " trig name strcat "." strcat Tell
  else
    ">>  Permission denied." Tell
  then
;
  
: DoBeforeFail  (  --  )      (* output messages for a `nowhere' dest *)
 
  trig "_before_fail" DoDressProp Tell
  trig "_before_ofail" DoDressProp dup if
    me @ name " " strcat swap strcat
    me @ location me @ rot notify_except
  else
    pop
  then
;
 
: DoAfterFail  (  --  )       (* output messages for a `nowhere' dest *)
 
  trig "_after_fail" DoDressProp Tell
  trig "_after_ofail" DoDressProp dup if
    me @ name " " strcat swap strcat
    me @ location me @ rot notify_except
  else
    pop
  then
;
   
: DoHasFail  (  --  )         (* output messages for a `nowhere' dest *)
 
  trig "_has_fail" DoDressProp Tell
  trig "_has_ofail" DoDressProp dup if
    me @ name " " strcat swap strcat
    me @ location me @ rot notify_except
  else
    pop
  then
;
  
: DoHasNotFail  (  --  )      (* output messages for a `nowhere' dest *)
 
  trig "_hasnot_fail" DoDressProp Tell
  trig "_hasnot_ofail" DoDressProp dup if
    me @ name " " strcat swap strcat
    me @ location me @ rot notify_except
  else
    pop
  then
;
     
: DoObjFail  (  --  )         (* output messages for a `nowhere' dest *)
 
  trig "_obj_fail" DoDressProp Tell
  trig "_obj_ofail" DoDressProp dup if
    me @ name " " strcat swap strcat
    me @ location me @ rot notify_except
  else
    pop
  then
;
  
: DoObjNoFail  (  --  )       (* output messages for a `nowhere' dest *)
 
  trig "_objno_fail" DoDressProp Tell
  trig "_objno_ofail" DoDressProp dup if
    me @ name " " strcat swap strcat
    me @ location me @ rot notify_except
  else
    pop
  then
;
 
: DoUseRoute ( s s --  )      (* route for a usecount-controlled exit *)
  
  pop pop                           (* check: has count been reached? *)
  trig "_count" getpropstr atoi
  trig "_trip"  getpropstr atoi < if         (* this way for `before' *)
    trig "_before" getpropstr "#-1" smatch if       (* going nowhere? *)
      DoBeforeFail exit                     (* if so, handle and exit *)
    then
    trig "_before_succ"  DoDressProp Tell              (* do messages *)
    trig "_before_osucc" DoDressProp dup if
      me @ name " " strcat swap strcat
      me @ location me @ rot notify_except
    else
      pop
    then                                          (* find destination *)
    trig "_count" over over getpropstr atoi 1 + intostr setprop
    trig "_random/" trig "_before" getprop strcat getprop dup if
      " " explode
      random swap % 1 + pick
    else
      pop
      trig "_sequence/" trig "_before" getprop strcat getprop dup if
        dup " " instr strcut pop ourString !
        trig "_sequence/" trig "_before" getpropstr strcat 
        ourString @ "" "#" subst atoi dbref REF-add
        ourString @
      else
        pop trig "_before" getpropstr
      then
    then
    "" "#" subst atoi dbref 
    me @ swap moveto                                     (* move user *)
    NukeStack
    trig "_before_odrop" DoDressProp dup if            (* do messages *)
      me @ name " " strcat swap strcat
      me @ location me @ rot notify_except
    else
      pop
    then 
  else                                        (* this way for `after' *)
    trig "_after" getpropstr "#-1" smatch if        (* going nowhere? *)
      DoAfterFail exit                      (* if so, handle and exit *)
    then
    trig "_after_succ"  DoDressProp Tell               (* do messages *)
    trig "_after_osucc" DoDressProp dup if
      me @ name " " strcat swap strcat
      me @ location me @ rot notify_except
    else
      pop
    then                                           (* get destination *)
    trig "_count" over over getpropstr atoi 1 + intostr setprop
    trig "_random/" trig "_after" getprop strcat getprop dup if
      " " explode
      random swap % 1 + pick
    else
      pop
      trig "_sequence/" trig "_after" getprop strcat getprop dup if
        dup " " instr strcut pop ourString !
        trig "_sequence/" trig "_before" getpropstr strcat 
        ourString @ "" "#" subst atoi dbref REF-add
        ourString @
      else
        pop trig "_after" getpropstr
      then
    then                                                 (* move user *)
    "" "#" subst atoi dbref 
    me @ swap moveto
    NukeStack
    trig "_after_odrop" DoDressProp dup if             (* do messages *)
      me @ name " " strcat swap strcat
      me @ location me @ rot notify_except
    else
      pop
    then 
  then
;
  
: DoPropRoute  ( s s --  )        (* route for a prop-controlled exit *)
  
  pop pop "FALSE" ourCounter !             (* see if we have the prop *)
  trig "_prop" getpropstr ourString !
  me @ ourString @ getprop if
    "TRUE" ourCounter !
  else
    me @ DoCheckContents if
      "TRUE" ourCounter !
    then
  then
                       (* ourCounter will be "TRUE" if prop was found *)
  ourCounter @ "TRUE" smatch if
    trig "_has" getpropstr "#-1" smatch if          (* going nowhere? *)
      DoHasFail exit                        (* if so, handle and exit *)
    then
    trig "_has_succ"  DoDressProp Tell                 (* do messages *)
    trig "_has_osucc" DoDressProp dup if
      me @ name " " strcat swap strcat
      me @ location me @ rot notify_except
    else
      pop
    then                                           (* get destination *)
    trig "_random/" trig "_has" getprop strcat getprop dup if
      " " explode
      random swap % 1 + pick 
    else
      pop
      trig "_sequence/" trig "_has" getprop strcat getprop dup if
        dup " " instr strcut pop strip ourString !
        trig "_sequence/" trig "_has" getpropstr strcat 
        ourString @ "" "#" subst atoi dbref REF-add
        ourString @
      else
        pop trig "_has" getpropstr
      then
    then                                                 (* move user *)
    "" "#" subst atoi dbref 
    me @ swap moveto
    NukeStack
    trig "_has_odrop" DoDressProp dup if               (* do messages *)
      me @ name " " strcat swap strcat
      me @ location me @ rot notify_except
    else
      pop
    then 
  else                                  (* this way if prop not found *)
    trig "_hasnot" getpropstr "#-1" smatch if       (* going nowhere? *)
      DoHasNotFail exit                     (* if so, handle and exit *)
    then
    trig "_hasnot_succ"  DoDressProp Tell              (* do messages *)
    trig "_hasnot_osucc" DoDressProp dup if
      me @ name " " strcat swap strcat
      me @ location me @ rot notify_except
    else
      pop
    then 
    NukeStack                                      (* get destination *)
    trig "_random/" trig "_hasnot" getprop strcat getprop dup if
      " " explode
      random swap % 1 + pick
    else
      pop
      trig "_sequence/" trig "_hasnot" getprop strcat getprop dup if
        dup " " instr strcut pop ourString !
        trig "_sequence/" trig "_hasnot" getpropstr strcat 
        ourString @ "" "#" subst atoi dbref REF-add
        ourString @
      else
        pop trig "_hasnot" getpropstr
      then
    then
    "" "#" subst atoi dbref 
    me @ swap moveto                                     (* move user *)
    NukeStack
    trig "_hasnot_odrop" DoDressProp dup if            (* do messages *)
      me @ name " " strcat swap strcat
      me @ location me @ rot notify_except
    else
      pop
    then 
  then
;
  
: DoObjectRoute  ( s s --  )      (* route for object-controlled exit *)
  
  pop pop "FALSE" ourString !            (* see if we have the object *)
  trig "_object" getpropstr "" "#" subst atoi dbref ourCounter !
  me @ DoCheckObjects if
    "TRUE" ourString !
  then
                      (* ourString will be "TRUE" if object was found *)
  ourString @ "TRUE" smatch if
    trig "_obj" getpropstr "#-1" smatch if          (* going nowhere? *)
      DoObjFail exit                        (* if so, handle and exit *)
    then
    trig "_obj_succ"  DoDressProp Tell                 (* do messages *)
    trig "_obj_osucc" DoDressProp dup if
      me @ name " " strcat swap strcat
      me @ location me @ rot notify_except
    else
      pop
    then                                          (* find destination *)
    trig "_random/" trig "_obj" getprop strcat getprop dup if
      " " explode
      random swap % 1 + pick 
    else
      pop
      trig "_sequence/" trig "_obj" getprop strcat getprop dup if
        dup " " instr strcut pop strip ourString !
        trig "_sequence/" trig "_obj" getpropstr strcat 
        ourString @ "" "#" subst atoi dbref REF-add
        ourString @
      else
        pop trig "_obj" getpropstr
      then
    then
    "" "#" subst atoi dbref 
    me @ swap moveto                                     (* move user *)
    NukeStack
    trig "_obj_odrop" DoDressProp dup if
      me @ name " " strcat swap strcat
      me @ location me @ rot notify_except
    else
      pop
    then 
  else                            (* this way if object was not found *)
    trig "_objno" getpropstr "#-1" smatch if        (* going nowhere? *)
      DoHasNotFail exit                     (* if so, handle and exit *)
    then
    trig "_objno_succ"  DoDressProp Tell
    trig "_objno_osucc" DoDressProp dup if
      me @ name " " strcat swap strcat
      me @ location me @ rot notify_except
    else
      pop
    then 
    NukeStack                                      (* get destination *)
    trig "_random/" trig "_objno" getprop strcat getprop dup if
      " " explode
      random swap % 1 + pick
    else
      pop
      trig "_sequence/" trig "_objno" getprop strcat getprop dup if
        dup " " instr strcut pop ourString !
        trig "_sequence/" trig "_objno" getpropstr strcat 
        ourString @ "" "#" subst atoi dbref REF-add
        ourString @
      else
        pop trig "_objno" getpropstr
      then
    then
    "" "#" subst atoi dbref 
    me @ swap moveto                                     (* move user *)
    NukeStack
    trig "_objno_odrop" DoDressProp dup if             (* do messages *)
      me @ name " " strcat swap strcat
      me @ location me @ rot notify_except
    else
      pop
    then 
  then
;
 
: DoRoute  ( s -- s )                     (* find routing type to use *)
  
  trig "_type" getpropstr 
  dup "use"    smatch if DoUseRoute    else
  dup "prop"   smatch if DoPropRoute   else
  dup "object" smatch if DoObjectRoute else
  ">>  This exit is improperly configured." Tell
  ">>  Please contact " trig owner name strcat "." strcat Tell
  then then then
;
  
: main
   
  "me" match me !                             (* catch dbref spoofing *)
  
  trig "_tmp/" nextprop                (* clear old temp data, if any *)
  begin
    dup while
    trig over nextprop
    trig rot remove_prop
  repeat
  pop
 
  dup if                                               (* parse input *)
    "#help"      over stringpfx if DoHelp      else
    "#reset"     over stringpfx if DoReset     else
    "#sequence"  over stringpfx if DoSequence  else
    "#group"     over stringpfx if DoGroup     else
    "#configure" over stringpfx if DoConfigure else
    ">>  #Option not understood." Tell
    then then then then then
  else
    DoRoute
  then
;
.
c
q