@q
@program freelock.muf
1 9999 d
i
( FreeLock.muf    v1.0   Jessy @ FurryMUCK    5/97
    
  This program provides a way for players other than the owner of
  an exit to lock or unlock it, and includes routines that insure
  the lock will be cleared if the room the exit leads to becomes
  vacant. Its intended use is to allow public rooms to be locked for
  privacy, without the danger that players will disconnect or depart 
  the room without unlocking it, leaving it inaccessible for others.
  
  INSTALLATION:
  
  Set FreeLock.muf M3 and L.
  
  SET-UP
  
  A separate action locks and unlocks the exit. Normally, this lock/unlock
  command will be located inside the room to be locked. The command name 
  should include two aliases, one including the string 'unlock' and one
  including the string 'lock', such as 'lock;unlock' or 'lock booth;unlock
  booth.' Then, designate the exit to be locked/unlocked with the #link
  argument, and @lock it to this program. Example:
  
     @open lock booth;unlock booth
     @link lock booth = <#dbref of FreeLock.muf>
     lock booth #link #123
     @lock #123 = <#dbref of FreeLock.muf>
  
  Exit #123 is the exit leading into the booth room. Players inside the 
  booth may type 'lock booth' for privacy. To unlock it, they can type 
  'unlock booth', or simply leave.
  
  The self-clearing routine is only used if the locked exit leads to a 
  room. In other cases, the lock remains in place until it is explicitly
  unlocked.
  
  FreeLock.muf may be freely ported. Please comment any changes.
)
 
$include $lib/strings
 
: DoHelp  (  --  )                           (* direct user to @view *)
    
    prog "_docs" "@list #" prog intostr strcat "=1-37" strcat setprop
    "Type '@view #" prog intostr strcat "' for information on "
    "configuring a publically lockable exit." strcat strcat .tell
;
    
: DoLink  ( s --  )         (* set props designating exit controlled
                               by a FreeLock lock/unlock command.    *)
      
    " " STRsplit dup not if                      (* parse exit dbref *)
        DoHelp pop exit
    then
    dup "#*" smatch if
        "" "#" subst atoi dbref
    else
        match dup not if
            "I can't find the exit you want to make lockable." 
            .tell pop exit
        else
            dup #-2 dbcmp if
                "I'm not sure which one you mean." .tell pop exit
            then
        then
    then
                                                  (* check: allowed? *)
    me @ over controls not if
        "Permission denied." .tell pop exit
    then
                                                   (* designate exit *)
    dup trig "_lock_to" rot setprop
    "Lock set." .tell
                              (* remind about locking exit to program *)
    dup getlockstr "" "#" subst
    prog intostr smatch not if
        "Now lock the action to this program: @lock #"
        swap intostr strcat " = #" strcat prog intostr strcat .tell
    then
;
    
: DoLock  (  --  )                        (* freelock designated exit *)
    
    trig "_lock_to" getprop dup not if
        "No action has been designated for this lock." .tell pop exit
    then
    "_freelocked" trig setprop
    trig "_/sc" getpropstr not if
        "Locked." .tell
    then
;
 
: DoUnlock  (  --  )                        (* unlock designated exit *)
    
    trig "_lock_to" getprop dup not if
        "No action has been designated for this lock." .tell pop exit
    then
    "_freelocked" remove_prop
    trig "_/sc" getpropstr not if
        "Unlocked." .tell
    then
;
 
: main
    
    "me" match me !
                            (* this way if exit is LOCKED to program *)
    trig getlockstr dup if
        "" "#" subst
        prog intostr smatch if
        
                          (* is it freelocked? Return true if not... *)
            trig "_freelocked" getprop not if
                1 exit
            else
                          (* ...otherwise check for awake players... *)
                trig getlink dup room? not if
                    pop 1 exit
                then
                contents
                begin
                    dup while
                    dup player? if
                       dup awake? if           (* found awake player  )
                           pop 0 exit          (  in locked room...   )
                       then                    (  lock fails         *)
                    then
                    next
                repeat
                trig "_freelocked" remove_prop (* ...or, didn't find  )
                1 exit                         ( one: clear lock prop )
            then                               ( and return true     *)
        then
    then
                           (* this way if exit is LINKED to program. *)
                           (* figure out what player wants to do...  *)
    trig getlink prog dbcmp if
        dup if
            dup "#help"  swap stringpfx if DoHelp exit else
            dup "#link*" smatch         if DoLink exit
            then then
        then
        command @ "unlock" instr if
            DoUnlock
        else
            command @ "lock" instr if
                DoLock
            then
        then
        exit
    then
;
.
c
q