@q
@program vsys-@vexit
1 99999 d
i 
 
( vsys-@vexit    v1.0    Jessy @ FurryMUCK    4/00 
  
  Part of the vsys vehicle system, this program handles exits leading
  out of vehicles.
  
  INSTALLATION:
  
  Port the program, set it Wizard and -- optionally -- Link_OK. Create
  a global action with a name such as @vexit, and link it to the program.
  Type '<action name> #install'.
   
  Vsys-@vexit requires lib-vsys. See the header comment of lib-vsys for
  more complete documentation on the vehicle system.
  
  USE:
  
    @vexit ................ Leave the vehicle you are currently in
    @vexit <name> ......... Create exit <name> leading our of vehicle [A]
  
  Creating an exit with this program requires Admin privileges for the
  vehicle.
  
  Vsys-@vexit may be freely ported. Please comment any changes.
)
 
$include $lib/vsys
 
$define Tell me @ swap notify $enddef
 
lvar ourExit
lvar ourString
lvar ourVehicle
 
: DoInit  (  --  )              (* ensure program is W and registered *)
  
  LibInit
  prog "W" flag? if
    #0 "_reg/vsys/vexit-prog" prog setprop
    #0 "_reg/vsys/vexit-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 manages vehicle exits." Tell " " Tell
  
  "  $com .................... Leave the current vehicle"
  command @ "$com" subst Tell
  "  $com <name> ............. Create exit <name> leading from vehicle"
  command @ "$com" subst Tell
  
  "Creating an exit with vsys-@vexit requires Administrator privileges "
  "for the current vehicle." strcat Tell " " Tell
  
  "For complete information on the vehicle system, type '@view $lib/vsys' "
  "(long)." strcat Tell
;
 
: DoMakeVexit  (  --  )      (* create an exit leading out of vehicle *)
  
  me @ GetVehicleEnv not if                         (* check location *)
    ">>  You are not in a vehicle." Tell
    ">>  Unable to create an exit." Tell exit
  then
  VehicleAdmin? if                                (* check permission *)
    me @ "exits" GetQuota 0 = not if
                  ourString @ strip ourString !
      me @ location ourString @ newexit ourExit !      (* create exit *)
      ourExit @ prog setlink
      ourExit @ "You leave the vehicle." setsucc      (* set messages *)
      ourExit @ "leaves the vehicle." setosucc
      ourExit @ "Sorry, the exit is locked." setfail
      ">>  Exit $exit created."
      ourString @ "$exit" subst Tell                        (* notify *)
    then
  else
    ">>  Permission denied." Tell
  then
;
 
: DoVexit  (  --  )                       (* move user out of vehicle *)
  
  me @ GetVehicle dup if                              (* find vehicle *)
    ourVehicle !
    me @ ourVehicle @ location moveto                    (* move user *)
    trig "_/dr" getpropstr if                 (* handle drop messages *)
      trig "_/dr" ParseThis
      dup string? if
        me @ swap notify
      then
    then
    trig "_/odr" getpropstr if
      trig "_/odr" ParseThis
      dup string? if
        me @ name " " strcat swap strcat
        me @ location me @ rot notify_except
      then
    then
  else              (* .. or fail gracefully if we can't find vehicle *)
    "You can't go that way." Tell
  then
;
  
: main
  
  "me" match me !
  DoInit
  
  dup if
    ourString !
  then
  
  ourString @ if
    "#help"    ourString @ stringpfx if DoHelp    exit then
    "#install" ourString @ stringpfx if DoInstall exit then
    DoMakeVexit
  else
    DoVexit
  then
;
.
c
q