@q
@program smelletc.muf
1 99999 d
i
( smelletc.muf v1.0 Jessy @ Forgotten Paths 10/96
This program runs a 'smell;feel;taste' action. It's a bit long for
the purpose, primarily because of the interactive-menu functions
for setting messages and notification formats.
Installation:
Create a global action named 'smell;feel;taste' and link it to this
program. Messages may include MPI; the program therefore requires
Mucker level 3, for the PARSEPROP primitive.
For the 'smell' action, the program searches up the environment tree for
the _prefs/smell prop. To set a default for the MUCK or an area, set this
prop on room #0 or the appropriate environment room.
Note: this program is not compatible with EditPlayer in its standard
form. If your MUCK uses EditPlayer, the hammer will need to be edited.
Search the text of the program for instances of '_scent' and replace them
with '_prefs/smell'. Replace instances of '_smell_notify' with
'_prefs/smell_notify'. Alternatively, you can replace EditPlayer with
PropSetter.muf and/or SetUp.muf, available on Forgotten Paths.
Use:
<cmd> <string> Smell, taste, or feel something or someone.
<cmd> #set Set your <cmd> message.
<cmd> #format Set your <cmd>-notification format.
<cmd> #clear Clear your <cmd> message and notification.
This program may be freely ported. Please comment any changes.
)
$include $lib/match
$define Tell me @ swap notify $enddef
lvar ourProp (* stores prop to be manipulated, as a string *)
lvar ourBoolean (* just used in DoHere, to determine format *)
: A-An ( s -- s' ) (* return s prepended w/ 'a' or 'an' *)
dup 1 strcut pop "{a|e|i|o|u}" smatch if
"an " swap strcat
else
"a " swap strcat
then
;
: ParseThis ( d s -- s ) (* returns d's prop s, parsed for MPI *)
dup 3 pick swap getpropstr 0 parseprop
;
: Pad ( s i -- s ) (* pad string s to i characters, spaces right *)
swap
" "
strcat swap strcut pop
;
: SayPose ( -- ) (* scan keyboard input for poses and says. *)
(* emit poses and says, and continue *)
begin (* BEGIN INPUT-SCANNING LOOP *)
read (* does input begin with " or say ? ; say if so & continue *)
dup "\"" stringpfx
over "say " stringpfx or if
dup "say " stringpfx if
4 strcut
else
1 strcut
then swap pop
me @ name " says, \"" strcat swap strcat "\"" strcat dup
loc @ me @ rot notify_except Tell
continue
then
(* does input begin with : or pose ? ; pose if so & continue *)
dup ":" stringpfx
over "pose " stringpfx or if
dup "pose " stringpfx if
5 strcut
else
1 strcut
then swap pop
me @ name
over "'*" smatch not if
" " strcat
then
swap strcat dup
loc @ me @ rot notify_except Tell
continue
then
exit (* it's not a pose or say; exit *)
repeat (* END INPUT-SCANNING LOOP *)
;
: DoHelp ( -- ) (* show help screen *)
" " Tell
"cmd-" command @ strcat " (#" strcat prog intostr strcat ")" strcat
Tell " " Tell
command @ " <string> strcat 20 Pad
command @ 1 strcut swap toupper swap strcat
strcat " someone or something." strcat Tell
command @ " #set" strcat 20 Pad
"Set your " strcat command @ strcat " message." strcat Tell
command @ " #format" strcat 20 Pad
"Set your " strcat command @ strcat "-notification format." strcat Tell
command @ " #clear" strcat 20 Pad
"Clear your " strcat command @ strcat " message and notification."
strcat Tell " " Tell
"Related commands: "
command @ "smell" smatch if
"taste, feel"
then
command @ "taste" smatch if
"smell, feel"
then
command @ "feel" smatch if
"smell, taste"
then strcat Tell
" " Tell
"Functions which require additional information will supply prompts. "
"You may talk and pose while at a prompt line. "
"Settings for this command are stored in the _prefs/ directory. To set a "
command @ strcat " message on a room or thing, use this syntax:"
strcat strcat strcat
Tell " " Tell
" @set <object> = _prefs/" command @ strcat " : <message>" strcat
Tell " " Tell
"Messages may include MPI, in order to match a specific desc or morph, "
"to include random elements, etc." strcat Tell
" " Tell
;
: DoClear ( -- ) (* clear user's props for the appropriate command *)
me @ "_prefs/" command @ strcat over over
"_notify" strcat
remove_prop remove_prop
">> Cleared." Tell
;
: DoSet ( -- ) (* set user's <cmd> message *)
">> What do you " command @ strcat " like?" strcat Tell
">> [Enter your " command @ strcat " message, or .q to quit]" strcat Tell
SayPose strip
dup ".q" smatch if
">> Done." Tell exit
then
me @ "_prefs/" command @ strcat rot setprop
">> Set." Tell
;
: SetFormat ( -- ) (* set user's <cmd>-notification string *)
">> Enter your " command @ strcat "-notification format, or .q to quit]"
strcat Tell SayPose strip
dup ".q" smatch if
">> Done." Tell exit
then
me @ "_prefs/" command @ strcat "_notify" strcat rot setprop
">> Set." Tell
;
: DoFormat ( -- ) (* see if user wants notified; set if so *)
pop
begin (* BEGIN OUTER LOOP *)
(* see what they want *)
">> Do you want to be notified when someone " command @ strcat
" you?" strcat Tell
">> [Enter 'yes', 'no', or .q to quit]" Tell
SayPose strip
dup ".q" smatch if
">> Done." Tell exit
then
dup "no" swap stringpfx if
me @ "_prefs/" command @ strcat "_notify" strcat remove_prop
">> Set." Tell exit
then
"yes" swap stringpfx if
">> The default format is "
command @ "smell" smatch if
"[ %N just smelled you. ]"
then
command @ "taste" smatch if
"[ %N licks you! ]"
then
command @ "feel" smatch if
"[ %N is checking you out. ]"
then
strcat Tell
begin (* BEGIN INNER LOOP *)
">> Do you want to use the default?" Tell
">> [Enter 'yes', 'no', or .q to quit]" Tell
SayPose strip
dup ".q" smatch if
">> Done." Tell exit
then
dup "no" swap stringpfx if
SetFormat exit
then
dup "yes" swap stringpfx if
me @ "_prefs/" command @ strcat "_notify" strcat
command @ "smell" smatch if
"[ %N just smelled you. ]"
then
command @ "taste" smatch if
"[ %N licks you! ]"
then
command @ "feel" smatch if
"[ %N is checking you out. ]"
then
setprop
">> Done." Tell exit
then
(* hmm.. got this far; must be bad input. repeat *)
">> Entry not understood." Tell
repeat (* END INNER LOOP *)
then
">> Entry not understood." Tell (* repeat if bad input *)
repeat
;
: DoHere ( -- ) (* do this for 'here' or no argument *)
loc @ ourProp @ envpropstr dup if
Tell exit
else
command @ "smell" smatch if
loc @ "_prefs/smell" envpropstr dup if
Tell
else
pop
"You smell a variety of scents, mixed together." Tell
then exit
then
command @ "taste" smatch if
ourBoolean @ if
"You give the ground lick. Bleh!" Tell
else
"Yes, but *what* do you want to taste?" Tell
then exit
then
command @ "feel" smatch if
ourBoolean @ if
"You test the ground here. Feels pretty firm." Tell
else
"Yes, but *what* do you want to feel?" Tell
then exit
then
then
;
: DoIt ( s -- ) (* show smell|taste|feel msg for s *)
(* if no argument, treat arg as 'here' *)
"_prefs/" command @ strcat ourProp !
dup not if
DoHere exit
then
(* treat 'here' as 'here' too, for that matter *)
dup "here" smatch if
1 ourBoolean ! DoHere exit
then
(* otherwise find it *)
.noisy_match dup not if
exit
then
dup #-2 dbcmp if
exit
then
(* then smell|taste|feel it *)
dup ourProp @ over over getpropstr if
ParseThis Tell
else
pop pop
command @ 1 strcut swap toupper swap strcat
"s like " strcat over
dup "species" getpropstr if
dup "species" getpropstr 1 strcut swap
tolower swap strcat A-An
else
name A-An "pop me!" swap
then
swap pop
strcat "." strcat Tell
then
(* and notify *)
dup ourProp @ "_notify" strcat over over getpropstr if
ParseThis me @ swap pronoun_sub notify
else
pop
ourProp @ "_prefs/smell" smatch if
"[ " me @ name strcat " sniffed you! ]" strcat notify
else
ourProp @ "_prefs/taste" smatch if
"[ " me @ name strcat " licked you! ]" strcat notify
else
ourProp @ "_prefs/feel" smatch if
"[ " me @ name strcat " is checking you out. ]" strcat
notify
else
pop pop
then then then
then
;
: main
"me" match me !
dup if
dup "#*" smatch if
dup "#help" swap stringpfx if DoHelp else
dup "#set" swap stringpfx if DoSet else
dup "#format" swap stringpfx if DoFormat else
dup "#clear" swap stringpfx if DoClear else
pop ">> Command not understood." Tell exit
then then then then
exit
then
then
DoIt
;
.
c
q