@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