@q
@program vsys-@vforce
1 99999 d
i
 
( vsys-@vforce    v1.0    Jessy @ FurryMUCK    4/00
  
  Part of the vsys vehicle system, this program handles the vehicle-
  control action of a vehicle.
  
  INSTALLATION:
  
  Port the program, set it Wizard and -- optionally -- Link_OK. Create
  a global action with a name such as '@vforce', and link it to the
  program. Type '<action name> #install'.
  
  Vsys-@vforce requires lib-vsys. See the header comment of lib-vsys for
  more complete documentation on the vehicle system.
  
  Vsys-@vforce may be freely ported. Please comment any changes.
)
 
$include $lib/vsys
 
$define Tell me @ swap notify $enddef
 
lvar ourLocation
lvar ourString
lvar ourVehicle
 
: DoInit  (  --  )              (* ensure program is W and registered *)
  
  LibInit
  prog "W" flag? if
    #0 "_reg/vsys/vforce-prog" prog setprop
    #0 "_reg/vsys/vforce-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 vehicle control actions. It will usually be "
  "invoked through a control action such as 'drive' or 'fly' in a "
  "vehicle, but may also be used directly with the $com command."
  strcat strcat command @ "$com" subst Tell " " Tell
  
  "  $com <force string> ........ Force vehicle to go|do <string>"
  command @ "$com" subst Tell " " Tell
  
  "For complete information on the vehicle system, type '@view $lib/vsys' "
  "(long)." strcat Tell
;
 
: DoTravelMessage  (  --  )                  (* show desc of new room *)
  
  me @ GetVehicleEnv contents             (* find vehicle environment *)
  begin                                    (* begin room-finding loop *)
    dup while
    dup room? 
    over "Q" flag? not and if
      dup contents                     (* begin occupant-finding loop *)
      begin
        dup while
        dup ShowLocation                      (* show to one occupant *)
        next
      repeat                             (* end occupant-finding loop *)
      pop
    then
    next
  repeat                                     (* end room-finding loop *)
  begin depth while pop repeat 
;
 
: DoVforce  (  --  )                                 (* force vehicle *)
  
  me @ GetVehicle dup if                              (* find vehicle *)
    ourVehicle !
    ourVehicle @ location ourLocation !          (* store current loc *)
    GetPobj                   (* move a player to room, for terraform *)
    ourVehicle @ ourString @ force                  (* Use the Force! *)
    ourVehicle @ location ourLocation @ dbcmp not if
      DoTravelMessage                      (* show new room if needed *)
    then
  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
    DoVforce
  then
;
.
c
q