@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