@q
@program places.muf
1 99999 d
i
( Places.muf by Deedlit@DragonMUCK / Mara@RanmaMUCK
Inspired by places code as seen on various MUSHes.
This is a program for creating 'places' to sit/stand/etc within a room,
without actually making a seperate room. You can still hear/contribute
to anything going on in the rest of the room, but you may also carry on
less obvious, 'private' dialogue/etc with persons at your 'place'.
Feel free to copy/modify/distribute/digest/whatever as yuo like, just
leave my name in the credits for the work I did. ^_^
)
$define puppet? dup thing? swap "Z" flag? and if 1 else 0 then $enddef
$include $lib/reflist
$include $lib/strings
var var1
lvar pscan
: pscan1 ( s -- s )
pscan !
"_places/people/"
begin
loc @ swap nextprop dup not if pop break then
loc @ over getpropstr pscan @ stringcmp not if
dup 15 strcut swap pop 1 strcut swap pop atoi dbref
me @ "^/placetemp" rot REF-add
then
repeat
me @ "^/placetemp" getpropstr if
me @ "^/placetemp" REF-list
me @ "^/placetemp" remove_prop
" Present is: " swap strcat "." strcat .tell
then
;
: do-places ( -- )
" " .tell
"_places/places/"
begin
loc @ swap nextprop dup not if pop break then
dup 15 strcut swap pop var1 !
loc @ over "/name" strcat getpropstr
"(#" var1 @ strcat ") has " strcat strcat
over "/curplaces" strcat loc @ swap getpropstr strcat
" empty places." strcat .tell
var1 @ pscan1
repeat
loc @ contents
begin
dup ok? while
dup player? over puppet? or not if next continue then
"_places/people/" over intostr "#" swap strcat strcat
loc @ swap getpropstr not if
me @ "^/placetemp" 3 pick REF-add
then
next
repeat
pop
me @ "^/placetemp" getpropstr if
me @ "^/placetemp" REF-list
me @ "^/placetemp" remove_prop
"Milling around: " swap strcat "." strcat .tell
then
;
: do-place ( s -- )
loc @ "_places/places/" 3 pick strcat "/name" strcat getpropstr not if
pop "There is no place for that number." .tell exit
then
var1 !
loc @ "_places/places/" var1 @ strcat "/name" strcat getpropstr
" (#" var1 @ strcat ") has " strcat strcat
loc @ "_places/places/" var1 @ strcat "/curplaces" strcat getpropstr strcat
" empty places." strcat .tell
var1 @ pscan1
;
: do-depart ( -- )
loc @ "_places/people/" me @ intostr "#" swap strcat strcat getpropstr
dup not if
command @ "Queued event." stringcmp not if exit then
pop "You aren't at a place right now." .tell exit
then
dup
"_places/places/" swap strcat "/name" strcat loc @ swap getpropstr
loc @ "_places/places/" 4 pick strcat "/curplaces" strcat getpropstr
atoi 1 + intostr
loc @ "_places/places/" 5 pick strcat "/curplaces" strcat rot setprop
dup
"You leave " swap strcat "." strcat .tell
me @ name " leaves " strcat swap strcat "." strcat .otell
loc @ "_places/people/" me @ intostr "#" swap strcat strcat remove_prop
;
: do-join ( s -- )
var1 !
loc @ "_places/places/" var1 @ strcat "/name" strcat getpropstr not if
"There is no place for that number." .tell exit
then
loc @ "_places/places/" var1 @ strcat "/curplaces" strcat getpropstr
atoi 1 >= not if
"There are no places left there." .tell exit
then
loc @ "_places/people/" me @ intostr "#" swap strcat strcat getpropstr if
do-depart
then
loc @ "_places/people/" me @ intostr "#" swap strcat strcat
var1 @ setprop
loc @ "_places/places/" var1 @ strcat "/curplaces" strcat getpropstr
atoi 1 - intostr
loc @ "_places/places/" var1 @ strcat "/curplaces" strcat rot setprop
loc @ "_places/places/" var1 @ strcat "/name" strcat getpropstr
" (#" strcat var1 @ strcat ")." strcat
"You join " over strcat .tell
me @ name " joins " strcat over strcat "." strcat .otell
"_places/people/"
begin
loc @ swap nextprop dup not if pop break then
loc @ over getpropstr var1 @ stringcmp not if
dup 15 strcut swap pop 1 strcut swap pop atoi dbref
me @ name " joins you." strcat notify
then
repeat
;
: do-saypose ( s -- )
dup ":" instr 1 = if
1 strcut swap pop
dup 1 strcut pop "[.,?!-' ]" smatch not if " " then
swap strcat me @ name swap strcat
var1 !
else
dup strlen over "!" rinstr = if
" exclaims, "
else
dup strlen over "?" rinstr = if
" asks, "
else
" says, "
then
then
swap "\"" swap strcat strcat "\"" strcat me @ name swap strcat
var1 !
then
loc @ "_places/people/" me @ intostr "#" swap strcat strcat getpropstr
dup not if pop "You need to be at a place first." .tell exit then
pscan !
"_places/people/"
begin
loc @ swap nextprop dup not if pop break then
loc @ over getpropstr pscan @ stringcmp not if
dup 15 strcut swap pop 1 strcut swap pop atoi dbref
"At your location, " var1 @ strcat notify
then
repeat
;
: rem-place ( -- )
"Remove which place #?" .tell
read
var1 !
loc @ "_places/places/" var1 @ strcat propdir? not if
"There is no place for that number." .tell exit
then
"_places/places/" var1 @ strcat
dup "/name" strcat loc @ swap remove_prop
dup "/maxplaces" strcat loc @ swap remove_prop
"/curplaces" strcat loc @ swap remove_prop
"Place cleared." .tell
;
: list-places ( -- )
"---------------------------------------------------" .tell
"_places/places/"
begin
loc @ swap nextprop dup not if pop break then
dup
dup 15 strcut swap pop ") " strcat
over loc @ swap "/name" strcat getpropstr strcat "." strcat
over loc @ swap "/maxplaces" strcat getpropstr
" Allowed people: " swap strcat strcat .tell
repeat
"---------------------------------------------------" .tell
"*Done*" .tell
"Type anything to continue." .tell
read pop
;
: edit-place ( -- )
"Which place # do you wish to edit?" .tell
read
var1 !
loc @ "_places/places/" var1 @ strcat propdir? not if
"There is no place for that number." .tell exit
then
"Current name of place is '"
loc @ "_places/places/" var1 @ strcat "/name" strcat getpropstr strcat
"'" strcat .tell
"New name?" .tell
read
loc @ "_places/places/" var1 @ strcat "/name" strcat rot setprop
"Current maximum number of people allowed: "
loc @ "_places/places/" var1 @ strcat "/maxplaces" strcat getpropstr strcat
.tell
"New maximum?" .tell
read
dup loc @ "_places/places/" var1 @ strcat "/maxplaces" strcat getpropstr
atoi swap atoi over over
>= if
dup loc @ "_places/places/" var1 @ strcat "/maxplaces" strcat rot
intostr setprop
- loc @ "_places/places/" var1 @ strcat "/curplaces" strcat getpropstr
atoi swap -
intostr
loc @ "_places/places/" var1 @ strcat "/curplaces" strcat rot setprop
else
dup loc @ "_places/places/" var1 @ strcat "/maxplaces" strcat rot intostr
setprop
swap -
loc @ "_places/places/" var1 @ strcat "/curplaces" strcat getpropstr
atoi swap +
intostr loc @ "_places/places/" var1 @ strcat "/curplaces" strcat rot
setprop
then
"*Done.*" .tell
;
: do-help2 ( -- )
"Filler stuff again, sorry. -_-" .tell
;
: do-help ( -- )
"Places.muf by Mara@RanmaMUCK / Deedlit@DragonMUCK" .tell
"~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" .tell
"Commands:" .tell
" place <number> - Look at who's at place <number>" .tell
" places - Look at who's where in this area." .tell
" join <number> - Join place <number>" .tell
" depart - Leave your current place." .tell
" tt - Say/pose to others at your current place." .tell
" " .tell
"Options:" .tell
" #help - This screen." .tell
" #config - Configuration editor - room owner ONLY." .tell
"*Done*" .tell
;
: add-place ( -- )
1 var1 !
begin
loc @ "_places/places/" var1 @ intostr strcat "/" strcat propdir?
not if break then
var1 @ 1 + var1 !
repeat
"Enter the name of the new 'place' to be added:" .tell
read
loc @ "_places/places/" var1 @ intostr strcat "/name" strcat rot setprop
"Enter the maximum number of people allowed at this location:" .tell
read
dup loc @ "_places/places/" var1 @ intostr strcat "/maxplaces" strcat
rot setprop
loc @ "_places/places/" var1 @ intostr strcat "/curplaces" strcat
rot setprop
"*Place added.*" .tell
;
: show-configscreen ( -- )
"Places.muf by Mara@RanmaMUCK / Deedlit@DragonMUCK" .tell
"~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" .tell
"Main Configuration Screen" .tell
" " .tell
"1) Add New Place" .tell
"2) Edit Current Place" .tell
"3) Remove Place" .tell
"4) List Current Places" .tell
" " .tell
"[ Type 1-4, H for help, or Q to quit. ]" .tell
;
: do-config ( -- )
""
begin
dup "1" strcmp not if pop add-place "" then
dup "2" strcmp not if pop edit-place "" then
dup "3" strcmp not if pop rem-place "" then
dup "4" strcmp not if pop list-places "" then
dup "h" stringcmp not if pop do-help2 "" then
"q" stringcmp not if break then
show-configscreen
read
repeat
"*Done*" .tell
;
: main
dup "#help" stringcmp not if pop do-help exit then
dup "#config" stringcmp not if
me @ loc @ controls not if
pop "Permission Denied." .tell exit
else
pop do-config exit
then
then
command @
dup "Queued event." stringcmp not if pop do-depart exit then
dup "tt" stringcmp not if pop do-saypose exit then
dup "depart" stringcmp not if pop pop do-depart exit then
dup "join" stringcmp not if pop do-join exit then
dup "place" stringcmp not if pop do-place exit then
pop pop
do-places
;
.
c
q