@program ClaimHome.muf
1 9999 d
i
( ClaimHome.muf, by Jessy @ FurryMUCK 5/95
Another program for claimable exits/homes, intended to be
simpler to set up than some of the others, and very modest
in its demands on the owner's quota.
To set up, @open an exit and link it to this program. One name of
the exit should be the command for claiming a home. An exit name
such as 'claim;directory' works well: typing 'claim <exit> will
give the player exits and a room; typing 'look directory' will show
a listing of residents.
There are only two settings that *must* be made:
@set <exit>=exits:<numbers or names of exits, separated by spaces>
@desc <exit>=dbref or reg name of this program>
That's it; you're a landlord! But should you aspire to more detail,
the following optional props may also be set.
@set <exit>=name:<name type. Apartment, House, etc. Defaults to 'Home'>
@set <exit>=roomdesc:<desc of rooms created by program>
@set <exit>=indesc:<desc of exit leading into room>
@set <exit>=insucc:<succ of exit leading into room>
@set <exit>=inosucc:<osucc of exit leading into room>
@set <exit>=inodrop:<odrop of exit leading into room>
@set <exit>=outdesc:<desc of exit leading out of room>
@set <exit>=outsucc:<succ of exit leading out of room>
@set <exit>=outosucc:<osucc of exit leading out of room>
@set <exit>=outodrop:<odrop of exit leading out of room>
@set <exit>=succmsg:<String to be given to a player when a home is
successfully claimed. Like a @succ.>
@set <exit>=namepad:< of characters in exit name/number field on
the directory. Defaults to 3, which is good for numbers.>
@set <exit>=parent:<parent of created rooms, if different from parent of
room holding trigger exit>
@set <exit>=show_exits:<no' or 'yes'. Determines whether created exits
will be dark or not. Defaults to not-dark.>
lsedit <exit>=header
<info/text/decoration preceding directory listings>
lsedit <exit>=trailer
<info/text/decoration following directory listings>
Residents can change the name displayed on the directory by typing
@set here=%n:<whatever> while in the room linked to the exit
created by ClaimHome.muf.
ClaimHome.muf checks for prop 'guest_player', and refuses permission
if the user has the prop.
)
lvar counter1
lvar counter2
lvar counter3
lvar counter4
: tell ( s -- ) ( notify user with s )
me @ swap notify
;
: addone ( -- ) ( add one to loop-checking counter, store as string )
counter1 @ atoi 1 + intostr counter1 ! exit
;
: takeone ( -- ) ( take 1 from loop-checking counter, store as string )
counter1 @ atoi 1 - intostr counter1 ! exit
;
: pad ( s i -- s ) ( pad a string to i characters, spaces right )
swap " "
strcat
swap strcut pop
;
( *** Directory display functions begin here *** )
: cleanup
trig "exits" getpropstr " " explode intostr counter1 !
counter2 !
begin
counter1 @ "0" smatch if
exit
then
trig counter2 @ getpropstr if
trig counter2 @ getpropstr atoi dbref ok? not if
trig counter2 @ "r" strcat getpropstr atoi dbref dup ok? if
recycle "zzz"
then
pop
trig counter2 @ remove_prop
trig counter2 @ "r" strcat remove_prop
then
then
takeone
counter2 !
repeat
;
: header ( -- ) ( call list of text preceding directory listings )
trig "header#/1" getpropstr not if exit then
"1" counter1 !
begin
trig "header#/" counter1 @ strcat getpropstr not if exit then
trig "header#/" counter1 @ strcat getpropstr tell
addone
repeat
;
: body ( -- ) ( list exits and their ownership; two columns )
trig "exits" getpropstr " " explode intostr counter1 !
counter2 !
begin
counter1 @ "0" smatch if
exit
then
counter2 @ trig "namepad" getpropstr dup if
atoi pad else
pop 3 pad
then
": " strcat
trig counter2 @ getpropstr atoi dbref "%n" getpropstr if
trig counter2 @ getpropstr atoi dbref "%n" getpropstr
strcat 32 pad else
trig counter2 @ getpropstr if
trig counter2 @ getpropstr atoi dbref name strcat 32 pad else
"* vacant *" strcat 32 pad then then
takeone counter1 @ "0" smatch if tell exit then
swap counter2 !
counter2 @ trig "namepad" getpropstr dup if
atoi pad else pop 3 pad then
": " strcat
trig counter2 @ getpropstr atoi dbref "%n" getpropstr if
trig counter2 @ getpropstr atoi dbref "%n" getpropstr
strcat strcat else
trig counter2 @ getpropstr if
trig counter2 @ getpropstr atoi dbref name strcat strcat
else
"* vacant *" strcat strcat then then
tell
takeone counter1 @ "0" smatch if exit then
counter2 !
repeat
;
: trailer ( -- ) ( call list of text following directory listings )
trig "trailer#/1" getpropstr not if exit then
"1" counter1 !
begin
trig "trailer#/" counter1 @ strcat getpropstr not if exit then
trig "trailer#/" counter1 @ strcat getpropstr tell
addone
repeat
;
: directory ( -- ) ( call functions that make up a complete directory )
cleanup
header
body
trailer
exit
;
: checkown ( -- ) ( check to see if the requested room/exit is owned )
loc @ exits counter2 !
begin
counter1 @ counter2 @ name smatch if 0 exit then
counter2 @ next counter2 !
counter2 @ not if 1 exit then
repeat
;
: claim ( s -- ) ( create room and exits, desc and prop )
( stop guests from claiming homes )
me @ "guest_player" getpropstr if
"Sorry, guests can't claim homes." me @ swap notify exit
then
( store requested exit name )
counter1 !
( see if requested exit is valid, exit if not )
"*" strcat "*" swap strcat
trig "exits" getpropstr swap smatch not if
"There is no " trig "name" getpropstr dup not if pop "home" then strcat
" by that name available." strcat tell exit then
( do checkown, exit if owned )
checkown not if "That " trig "name" getpropstr dup not if pop "home" then
strcat " has already been claimed." strcat tell exit then
( see if player already has a home at loc )
me @ intostr "*" strcat "*" swap strcat
trig "owners" getpropstr dup if swap smatch if
"You are already an owner here." tell exit 1 then then
( get parent prop, create room, create and link exits )
trig "parent" getpropstr dup if atoi dbref else
pop loc @ location then
me @ name "'s " strcat trig "name" getpropstr dup not if pop "Home"
then strcat
newroom counter2 !
loc @ counter1 @ newexit counter1 ! counter1 @ counter2 @ setlink
counter2 @ "Out <0>out;ou;o" newexit counter3 ! counter3 @
loc @ setlink
trig "show_exits" getpropstr dup if
"yes" smatch not if
counter1 @ "D" set
else
pop
then
else
counter1 @ "D" set pop
then
trig counter1 @ name counter2 @ intostr setprop
trig counter1 @ name "r" strcat counter1 @ intostr setprop
counter2 @ "_/claimprog" counter1 @ intostr setprop
counter1 @ "_/claimprog" counter2 @ intostr setprop
counter2 @ me @ setown
counter3 @ me @ setown
( store player's dbref on prop listing owners )
trig "owners" getpropstr if
trig "owners" trig "owners" getpropstr " " strcat me @ intostr strcat
setprop else
trig "owners" me @ intostr setprop then
( set room/exit props if supplied by owner of trigger )
trig "indesc" getpropstr if
counter1 @ trig "indesc" getpropstr setdesc then
trig "insucc" getpropstr if
counter1 @ trig "insucc" getpropstr setsucc then
trig "inosucc" getpropstr if
counter1 @ trig "inosucc" getpropstr setosucc then
trig "inodrop" getpropstr if
counter1 @ trig "inodrop" getpropstr setodrop then
trig "roomdesc" getpropstr if
counter2 @ trig "roomdesc" getpropstr setdesc then
trig "outdesc" getpropstr if
counter3 @ trig "outdesc" getpropstr setdesc then
trig "outsucc" getpropstr if
counter3 @ trig "outsucc" getpropstr setsucc then
trig "outosucc" getpropstr if
counter3 @ trig "outosucc" getpropstr setosucc then
trig "outodrop" getpropstr if
counter3 @ trig "outodrop" getpropstr setodrop then
trig "succmsg" getpropstr if
me @ trig "succmsg" getpropstr notify then
exit
;
: main
strip dup dup not if directory exit then claim
;
.
c
q
1/body>