@q
@program vsys-@vlock
1 99999 d
i
 
( vsys-@vlock    v1.0    Jessy @ FurryMUCK    4/00
  
  Part of the vsys vehicle system, this program handles locks based
  on the vsys user permission scheme.
  
  INSTALLATION:
  
  Port the program, set it Wizard and Link_OK. Create a global action 
  with a name such as '@vlock' and link it to the program. Type 
  '<action name> #install'.
  
  Vsys-@vlock requires lib-vsys and lib-reflist. See the header comment
  of lib-vsys for more complete information on the vehicle system.
  
  Vsys-@vlock may be freely ported. Please comment any changes.
)
 
$include $lib/vsys
$include $lib/reflist
 
$define Tell me @ swap notify $enddef
 
lvar ourArg
lvar ourString
lvar ourVehicle
 
: DoInit  (  --  )              (* ensure program is W and registered *)
  
  LibInit
  prog "W" flag? if
    #0 "_reg/vsys/vlock-prog" prog setprop
    #0 "_reg/vsys/vlock-com"  trig setprop
  else
    prog name " must be set Wizard." strcat me @ swap notify
    pid kill
  then
;
 
: DoInstall  (  --  )                   (* doesn't really do anything *)
  
  DoInit
  ">>  $prog installed." prog name "$prog" subst Tell
;
 
: DoHelp  (  --  )                                (* show help screen *)
  
  " " Tell
  prog name " (#" strcat prog intostr strcat ")" strcat Tell " " Tell
  
  "This program handles permissions for vehicles created with the "
  "vsys vehicle system." strcat Tell " " Tell
  
  "  $com #lock ...................."
  command @ "$com" subst dup strlen ourString !
  " Lock all exits into vehicle" strcat Tell
  "  $com #unlock [<vehicle>] ...... Unlock exits into vehicle"
  command @ "$com" subst Tell
  "  $com #user <player(s)> ........ Add <player(s)> to User list"
  command @ "$com" subst Tell
  "  $com #!user <player(s)> ....... Remove <player(s)> from User list"
  command @ "$com" subst Tell
  "  $com #admin <player(s)> ....... Add <player(s)> to Admin list"
  command @ "$com" subst Tell
  "  $com #!admin <player(s)> ...... Remove <player(s)> from Admin list"
  command @ "$com" subst Tell
  "  $com #public .................. Make current vehicle public"
  command @ "$com" subst Tell
  "  $com #!public ................. Make current vehicle not public"
  command @ "$com" subst Tell
  "  @lock <exit>=$vsys/vlock ......................................" 
  ourString @ strcut pop
  " Lock <exit> to vehicle users" strcat Tell " " Tell
  
  "All #options above require Admin permissions. Vehicle administrators "
  "include wizards, the owner of the vehicle, and anyone in the "
  "vehicle's Admin list. Authorized users include wizards, the owner "
  "of the vehicle, anyone in the vehicle's Admin list, anyone in the "
  "vehicle's User list, and anyone carrying a key to the vehicle. "
  "Public vehicles may be used by anyone." 
  strcat strcat strcat strcat strcat Tell " " Tell
  
  "For complete information on the vehicle system, type '@view $lib/vsys' "
  "(long)." strcat Tell
;
  
: DoCheckLock  (  --  )      (* return true if 'me' is a vehicle user *)
   
                             (* check: is 'me' in User or Admin list? *)
  VehicleUser? VehicleAdmin? or if 1 exit then 
   
  me @ GetVehicle dup if
    dup "@v/unlocked" getpropstr if    (* check: is vehicle unlocked? *)
      pop 1 exit
    then
    me @ over controls if       (* check: is 'me' a wiz or the owner? *)
      pop 1 exit
    then
    "@v/key" getpropstr dup if        (* check: does 'me' have a key? *)
      me @ contents
      begin
        dup while
        dup "@v/key" getpropstr dup if
          3 pick smatch if
            pop pop 1 exit
          then
        else
          pop
        then
        next
      repeat
      pop pop 0
    else
      pop 1
    then
  else
    0              (* ... if none of the above are true, return false *)
  then
;
 
: DoAdmin  (  --  )          (* add one or more players to Admin list *)
  
  me @ GetVehicle not if                              (* find vehicle *)
    ">>  You are not in a vehicle." Tell
    ">>  Unable to add vehicle administrators." Tell exit
  then
   
  VehicleAdmin? if                                (* check permission *)
    me @ GetVehicleEnv dup if
      ourVehicle !
      ourArg @ NamesToRange                (* get dbref/s of player/s *)
      begin
        dup while                       (* add player/s to Admin list *)
        ourVehicle @ "@v/admins" 4 pick REF-add
        ">>  $player added as a vehicle administrator." 
        rot name "$player" subst Tell
        1 -
      repeat
      pop
    else
      ">>  You are not in a vehicle." Tell
      ">>  Unable to add vehicle administrators." Tell pop exit
    then
  else
    ">>  Permission denied." Tell
  then
  begin depth while pop repeat
;
 
: DoNotAdmin  (  --  )  (* remove one or more players from Admin List *)
  
  me @ GetVehicle not if                              (* find vehicle *)
    ">>  You are not in a vehicle." Tell
    ">>  Unable to delete vehicle administrators." Tell exit
  then
  
  VehicleAdmin? if                                (* check permission *)
    me @ GetVehicleEnv dup if
      ourVehicle !
      ourArg @ NamesToRange                (* get dbref/s of player/s *)
      begin
        dup while                  (* remove player/s from Admin list *)
        ourVehicle @ "@v/admins" 4 pick REF-delete
        ">>  $player deleted as a vehicle administrator." 
        rot name "$player" subst Tell
        1 -
      repeat
      pop
    else
      ">>  You are not in a vehicle." Tell
      ">>  Unable to delete vehicle administrators." Tell pop exit
    then
  else
    ">>  Permission denied." Tell
  then
  begin depth while pop repeat
;
 
: DoUser  (  --  )            (* add one or more players to User list *)
  
  me @ GetVehicle not if                              (* find vehicle *)
    ">>  You are not in a vehicle." Tell
    ">>  Unable to add vehicle users." Tell exit
  then
   
  VehicleAdmin? if                                (* check permission *)
    me @ GetVehicleEnv dup if
      ourVehicle !
      ourArg @ NamesToRange                (* get dbref/s of player/s *)
      begin
        dup while                        (* add player/s to User list *)
        ourVehicle @ "@v/users" 4 pick REF-add
        ">>  $player added as a vehicle user." 
        rot name "$player" subst Tell
        1 -
      repeat
      pop
    else
      ">>  You are not in a vehicle." Tell
      ">>  Unable to add vehicle users." Tell pop exit
    then
  else
    ">>  Permission denied." Tell
  then
  begin depth while pop repeat
;
 
: DoNotUser  (  --  )    (* remove one or more players from User list *)
  
  me @ GetVehicle not if                              (* find vehicle *)
    ">>  You are not in a vehicle." Tell
    ">>  Unable to delete vehicle users." Tell exit
  then
  
  VehicleAdmin? if                                (* check permission *)
    me @ GetVehicleEnv dup if
      ourVehicle !
      ourArg @ NamesToRange                (* get dbref/s of player/s *)
      begin
        dup while                   (* remove player/s from User list *)
        ourVehicle @ "@v/users" 4 pick REF-delete
        ">>  $player deleted as a vehicle user." 
        rot name "$player" subst Tell
        1 -
      repeat
      pop
    else
      ">>  You are not in a vehicle." Tell
      ">>  Unable to delete vehicle users." Tell pop exit
    then
  else
    ">>  Permission denied." Tell
  then
  begin depth while pop repeat
;
 
: DoLock  (  --  )                     (* lock all exits into vehicle *)
  
  me @ GetVehicle dup if         (* find vehicle and check permission *)
    ourVehicle !
    VehicleAdmin? not if ">>  Permission denied." Tell exit then
  else
    pop ourArg @ dup if
      match
      dup #-1 dbcmp if
        ">>  I don't see that here." Tell exit
      then
      dup #-2 dbcmp if
        ">>  Ambiguous. I don't know which one you mean!" Tell exit
      then
      dup #-3 dbcmp if
        ">>  I don't see that here." Tell exit
      then
      ourVehicle !
      me @ ourVehicle @ controls
      ourVehicle @ "@v/admins" me @ REF-inlist? or not if
        ">>  Permission denied." Tell exit
      then
    else
      ">>  You are not in a vehicle." Tell
      ">>  Please supply vehicle name: $com #unlock <vehicle>"
      command @ "$com" subst Tell pop
    then
  then
   
  ourVehicle @ exits            (* find all exits on vehicle and lock *)
  begin
    dup while
    dup getlink dup if
      dup GetVehicle dup if
        ourVehicle @ dbcmp if
          over "#0&!#0" setlockstr pop swap
        then
      else
        pop
      then
    else
      pop
    then
    next
  repeat
  pop
  ">>  Vehicle locked." Tell
  
  begin depth while pop repeat
;  
 
: DoNotLock  (  --  )                  (* unlock all exits on vehicle *)
  
  me @ GetVehicle dup if         (* find vehicle and check permission *)
    ourVehicle !
    VehicleAdmin? not if ">>  Permission denied." Tell exit then
  else
    pop ourArg @ dup if
      match
      dup #-1 dbcmp if
        ">>  I don't see that here." Tell exit
      then
      dup #-2 dbcmp if
        ">>  Ambiguous. I don't know which one you mean!" Tell exit
      then
      dup #-3 dbcmp if
        ">>  I don't see that here." Tell exit
      then
      ourVehicle !
      me @ ourVehicle @ controls
      ourVehicle @ "@v/admins" me @ REF-inlist? or not if
        ">>  Permission denied." Tell exit
      then
    else
      ">>  You are not in a vehicle." Tell
      ">>  Please supply vehicle name: $com #unlock <vehicle>"
      command @ "$com" subst Tell pop
    then
  then
   
  ourVehicle @ exits                   (* unlock all exits on vehicle *)
  begin
    dup while
    dup getlink dup if
      dup GetVehicle dup if
        ourVehicle @ dbcmp if
          over "" setlockstr pop swap
        then
      else
        pop
      then
    else
      pop
    then
    next
  repeat
  pop
  ">>  Vehicle unlocked." Tell
  
  begin depth while pop repeat
;  
 
: DoPublic  (  --  )                            (* set vehicle public *)
      (* for vehicles set @v/unlocked:yes, @vlock always returns true *)
  
  me @ GetVehicle dup if         (* find vehicle and check permission *)
    ourVehicle !
    VehicleAdmin? if                           (* set public use prop *)
      ourVehicle @ "@v/unlocked" "yes" setprop
      ">>  Vehicle unlocked. Anyone may use it." Tell
    else
      ">>  Permission denied." Tell
    then
  else
    ">>  You are not in a vehicle." Tell
    ">>  Unable to set." Tell 
  then
  begin depth while pop repeat
;  
 
: DoNotPublic  (  --  )                     (* set vehicle not-public *)
  
  me @ GetVehicle dup if         (* find vehicle and check permission *)
    ourVehicle !
    VehicleAdmin? if                        (* remove public use prop *)
      ourVehicle @ "@v/unlocked" remove_prop
      ">>  Public lock removed." Tell
      ">>  User permission will be required to use vehicle." Tell
    else
      ">>  Permission denied." Tell
    then
  else
    ">>  You are not in a vehicle." Tell
    ">>  Unable to set." Tell 
  then
  begin depth while pop repeat
;  
: main
  
  "me" match me !
  DoInit
  
  dup if 
    ourString !
  then
   
  ourString @ if
    ourString @ " " instr if
      ourString @ dup " " instr strcut
      strip ourArg ! strip ourString !
    then
    "#admin"    ourString @ stringpfx if DoAdmin    exit then
    "#!admin"   ourString @ stringpfx if DoNotAdmin exit then
    "#help"     ourString @ stringpfx if DoHelp     exit then
    "#install"  ourString @ stringpfx if DoInstall  exit then
    "#lock"     ourString @ stringpfx if DoLock     exit then
    "#!lock"    ourString @ stringpfx if DoNotLock  exit then
    "#user"     ourString @ stringpfx if DoUser     exit then
    "#!user"    ourString @ stringpfx if DoNotUser  exit then
    "#unlock"   ourString @ stringpfx if DoNotLock  exit then
    DoCheckLock
  else
    DoCheckLock
  then
;
.
c
q