@q
@program lib-vsys
1 99999 d
i
( lib-vsys v1.0 Jessy @ FurryMUCK 4/00
A generic vehicle system.
COMPONENTS:
lib-vsys ................ Holds shared vsys code, props, and docs
vsys-@vbcast ............ Handles messaging into and out of vehciles
vsys-@vexit ............. Handles and creates exits from vehicles
vsys-@force ............. Controls vehicles via a puppet-like force
vsys-@vlock ............. Handles vehicle user permissions
vsys-@vlookout .......... Allows vehicle occupants to look outside
vsys-@vrecycle .......... Recycles vehicles and vehicle rooms
Other vsys programs may be added, but these are required for core
functionality. Some of the programs will also require lib-reflist,
which should be available on any established MUCK.
INSTALLATION:
[Pre-install tip: copying all the flush-left, MUCK command lines
in this header comment into a separate file will create an installation
script.]
Port lib-vsys and the basic vsys programs: vsys-@vbcast, vsys-@vexit,
vsys-@vforce, vsys-@vlock, vsys-@vlookout and vsys-@vrecycle. Set all
the programs Wizard. Set lib-vsys, vsys-@vbcast, and vsys-@vlock
Link_OK. Register lib-vsys and set its _def/ props:
@set lib-vsys=W
@set lib-vsys=L
@reg lib-vsys=lib/vsys
@set lib-vsys=_defs/CapAll:"$lib/vsys" match "CapAll" call
@set lib-vsys=_defs/Capitalize:"$lib/vsys" match "Capitalize" call
@set lib-vsys=_defs/Charge:"$lib/vsys" match "Charge" call
@set lib-vsys=_defs/CheckCost:"$lib/vsys" match "CheckCost" call
@set lib-vsys=_defs/CheckName:"$lib/vsys" match "CheckName" call
@set lib-vsys=_defs/CheckQuota:"$lib/vsys" match "CheckQuota" call
@set lib-vsys=_defs/CopyDir:"$lib/vsys" match "CopyDir" call
@set lib-vsys=_defs/Credit:"$lib/vsys" match "Credit" call
@set lib-vsys=_defs/ExitsAllowed:"$lib/vsys" match "ExitsAllowed" call
@set lib-vsys=_defs/ExitsOwned:"$lib/vsys" match "ExitsOwned" call
@set lib-vsys=_defs/GetEnvForVeh:"$lib/vsys" match "GetEnvForVeh" call
@set lib-vsys=_defs/GetFlagList:"$lib/vsys" match "GetFlagList" call
@set lib-vsys=_defs/GetPobj:"$lib/vsys" match "GetPobj" call
@set lib-vsys=_defs/GetQuota:"$lib/vsys" match "GetQuota" call
@set lib-vsys=_defs/GetVehicle:"$lib/vsys" match "GetVehicle" call
@set lib-vsys=_defs/GetVehicleEnv:"$lib/vsys" match "GetVehicleEnv" call
@set lib-vsys=_defs/LibInit:"$lib/vsys" match "LibInit" call
@set lib-vsys=_defs/NamesToRange:"$lib/vsys" match "NamesToRange" call
@set lib-vsys=_defs/ParseThis:"$lib/vsys" match "ParseThis" call
@set lib-vsys=_defs/QCheck:"$lib/vsys" match "QCheck" call
@set lib-vsys=_defs/ReadLine:"$lib/vsys" match "ReadLine" call
@set lib-vsys=_defs/ReadYesNo:"$lib/vsys" match "ReadYesNo" call
@set lib-vsys=_defs/RemoveDir:"$lib/vsys" match "RemoveDir" call
@set lib-vsys=_defs/RoomsAllowed:"$lib/vsys" match "RoomsAllowed" call
@set lib-vsys=_defs/RoomsOwned:"$lib/vsys" match "RoomsOwned" call
@set lib-vsys=_defs/SetFlagList:"$lib/vsys" match "SetFlagList" call
@set lib-vsys=_defs/ShowLocation:"$lib/vsys" match "ShowLocation" call
@set lib-vsys=_defs/ThingsAllowed:"$lib/vsys" match "ThingsAllowed" call
@set lib-vsys=_defs/ThingsOwned:"$lib/vsys" match "ThingsOwned" call
@set lib-vsys=_defs/VehicleAdmin?:"$lib/vsys" match "VehicleAdmin?" call
@set lib-vsys=_defs/VehicleUser?:"$lib/vsys" match "VehicleUser?" call
@set vsys-@vbcast=W
@set vsys-@vbcast=L
@set vsys-@vcreate=W
@set vsys-@vexit=W
@set vsys-@vforce=W
@set vsys-@vlock=W
@set vsys-@vlock=L
@set vsys-@vlookout=W
@set vsys-@vrecycle=W
Create a global action for each of the basic programs, and link it:
@action @vbcast=#0
@link @vbcast=vsys-@vbcast
@action @vcreate=#0
@link @vcreate=vsys-@vcreate
@action @vexit=#0
@link @vexit=vsys-@vexit
@action @vforce=#0
@link @vforce=vsys-@vforce
@action @vlock=#0
@link @vlock=vsys-@vlock
@action @vlookout=#0
@link @vlookout=vsys-@vlookout
@action @vrecycle;@vrec=#0
@link @vrecycle=vsys-@vrecycle
Run the #install routine for each of the basic commands:
@vbcast #install
@vcreate #install
@vexit #install
@vforce #install
@vlock #install
@vlookout #install
@vrecycle #install
CONFIGURATION:
The system should be completely workable at this point. Users will be
able to enter one-line commands to create vehicles. For example, typing
'@vcreate Corvette' would create vehicle called 'Corvette', which users
could drive, lock, look out of, talk to and from, etc.
You may however wish to perform some additional configuration.
Prototypes and 'strict' vehicle settings: The @vcreate program lets
administrators define 'prototype' vehicles. This is done by creating a
vehicle and then extending and modifying it as desired. Once it is
designated as a prototype, users may create exact copies with a one-line
command. To create a prototype, take an existing vehicle that is desc'd
and configured as desired, and type '@vcreate #prototype <vehicle
object>'. To remove the prototype, type '@vcreate #!prototype <prototype
name>. When the 'strict' @vcreate setting is used, users may only create
defined types of vehicles. In other words, they have to select a prototype
when using the @vcreate command. To turn on the 'strict' option, type
'@vcreate #strict'. To turn it off, '@vcreate #!strict'.
Packages: Packages are named collections of property settings for a
vehicle. To take a simple example, a package called 'Flight' could be
defined, which would simply set the '~flight' property on the vehicle
object to 'yes'. Assuming that exits and programs on the MUCK are set
up to recognize this property, this vehicle would be allowed to fly,
and objects without the property would not. To define a package, type
'@vcreate #define <package name>' and follow prompts. At each prompt,
you will be asked for a property:value pair. In our example, you
would type '~flight:yes' at the prompt. To delete or undefine a pack-
age, type '@vcreate #!define <package name>'. You may talk and pose
while at the prompt.
Money: By default, creating a vehicle costs nothing. Administrators
may assign a monetary cost to vehicle creation and package additions.
The cost may be in pennies, the currency used by the Argo roleplaying
system, or that of some other program. Programs used for this purpose
must accept and return data in the following format:
d i1 "#charge" -- i2 Reduce d's coins by i1. Return true
if successful.
d i1 "#credit" -- i2 Increase d's coins by i1. Return true
if successful.
d i "#check" -- i Return true if d has at least i coins
To designate currency, use @vcreate's #money option:
@vcreate #money pennies .... Use pennies as the currency
@vcreate #money argo ....... Use Argo currency
@vcreate #money <prog> .... Call <prog> for money functions
To designate the cost for prototyped vehicles and packages, use @vcreate's
#cost option:
@vcreate #cost <prototype or package name>
USE:
Used together, the vsys programs allow users to control, configure,
and secure vehicles.
Newly created vehicles have an 'enter <vehicle name>;enter;getin' exit
that takes users from the vehicle's exterior to the interior, a
'drive;dr;d' action that controls the vehicle, and an 'Out <O>;out;ou;o'
exit that takes users from the vehicle's interior to the exterior. The
creator of the vehicle will also be given a set of keys. The vehicle may
be driven by the wizards, the owner, or anyone holding the keys. The
vehicle consists of these actions, a vehicle object, an environment room,
and an interior room. The vehicle may be extended into a multiroom
vehicle -- as would be appropriate for a spaceship, for example -- by
using the standard building commands while inside the vehicle. Any of the
program-created objects may be renamed, redesc'd, etc.
The following vehicle manipulation and modification commands are also
available:
a @vbcast #broadcast ........... Broadcast says/poses from room to ext
a @vbcast #!broadcast .......... Don't broadcast to exterior
a @vbcast #listen .............. Listen from ext to all !Q interior rooms
a @vbcast #!listen ............. Do not listen in interior rooms
a @vbcast #quiet ............... Don't broadcast or listen in current room
a @vbcast #!quiet .............. Honor #broadcast and #listen settings
@vcreate <vehicle> ........... Create a vehicle named <vehicle>
a @vcreate #keys ............... Create a set of keys for vehicle
o @vcreate #!keys .............. Recycle all existing keys to vehicle
a @vcreate #add ................ List available packages
a @vcreate #add <package> ...... Add <package> to current vehicle
a @vcreate #remove <package> ... Remove <package> from current vehicle
@vcreate #packages ........... List available packages
w @vcreate #package <name> ..... Store data for package <name>
w @vcreate #!package <name> .... Delete package <name> and its data
@vcreate #prototypes ......... List available prototypes
w @vcreate #prototype <obj> .... Store data needed to reproduce <obj>
w @vcreate #!prototype <name> .. Delete prototype <name> and its data
w @vcreate #cost <type|pack> ... Set cost for <prototype|package>
w @vcreate #money <string> ..... Set currency
w @vcreate #strict ............. Allow only prototyped vehicles
w @vcreate #!strict ............ Allow any type vehicles
@vexit ....................... Leave vehicle
a @vexit <name> ................ Create vehicle exit named <name>
u @vforce <string> ............. Force vehicle to do/go <string>
a @vlock #lock ................. Lock exits leading into vehicle
a @vlock #unlock ............... Unlock exits leading into vehicle
a @vlock #user <player> ........ Allow <player> to drive vehicle
a @vlock #!user <player> ....... Don't allow <player> to drive vehicle
a @vlock #admin <player> ....... Give <player> vehicle admin permissions
a @vlock #!admin <player> ...... Revoke <player>'s vehicle admin permissions
a @vlock #public ............... Allow anyone to enter and use vehicle
a @vlock #!public .............. Remove 'public vehicle' setting
@vlookout .................... Look outside the vehicle
o @vrecycle <vehicle> .......... Recycle <vehicle> and its rooms
The codes preceding each command and #option are as follows:
w = Wizard only
o = Wizard or vehicle owner
a = Wizard, vehicle owner, or vehicle admin
u = Wizaard, vehicle owner, vehicle admin, or vehicle user
The remaining commands may be used by anyone. Command #options do not
have to be typed completely: you may specify only the first one or few
characters. For example, '@vlock #user jessy' and '@vlock #u jessy' will
have the same effect.
COMPATIBILITY NOTES:
Say and Pose: The 'say' and 'pose' programs on many MUCKS do not allow
says and poses outside a vehicle to be heard inside, and vice-versa...
either vsys vehicles or those created using the native MUCK vehicle
commands. For this to happen, and for the vsys-@vbcast #options to be
meaningful, say and pose programs that emit to vehicle and room objects
must be used. Tinysay.muf -- a simple, flexible, vehicle-aware say program
-- and a modified version of cmd-pose should be available on the site
where you obtained this program. Check the program header comment of
each to be sure you're using a version that is vehicle-aware.
Terraform: Most versions of Triggur's Terrform program -- in fact, all
current versions that I know of -- have problems with vehicles.
Specifically, they do not recycle rooms when a vehicle leaves the room...
a situation which can result in thousands of 'wasted' room objects.
NB: this is due to inherent limitations of fb5.x's handling of _depart/
triggers, not Triggur's coding. Vsys deals with this via a hackish
workaround: it moves a dummy player object into and out of rooms as
needed. If you have terraformed areas on your MUCK, you will need to
create and conconfigure the dummy player object as follows:
@pcreate vsys-pobj=somepassword
@set *vsys-pobj=D
@reg *vsys-pobj=vsys-pobj
Quota: Vsys honors quota settings so long as they are controlled via
the standard props:
#0|<player>=@quota/rooms:<number>
#0|<player>=@quota/exits:<number>
#0|<player>=@quota/things:<number>
If another method of data storage is used by your quota system, either
it or vsys will need to be modified. Note that vsys vehicles use
a total of six objects: the vehicle object itself, the environment room,
the primary vehicle room, the 'enter' exit, the 'out' exit', the 'drive'
action, and the 'keys' object. If players don't need all the functionality
of vsys vehicles and would like to save on quota, you may point out that
one-object/two-exit vehicles may still be created using 'native' methods:
@create Corvette
@desc corvette=<exterior description>
drop corvette
@set corvette=V
@set corvette=X
@flock corvette=me
@act 'enter corvette;enter'=corvette
@link enter=corvette
enter
@idesc corvette=<interior description>
@act drive;dr;d=here
@lock dr=me&!me
@fail dr={force:<dbref of corvette>,{&arg}}
leave
'Move' and 'Copy': Like many programs, vsys makes use of wiz-only
properties, which should not be accessed by non-wiz players. The
'mv' and 'cp' commands on some MUCKs allow @wizard and/or ~restricted
properties to be manipulated by non-wiz players. As a general
security measure, you should make sure that your copy of the
cmd-mv-cp program has been either been patched to fix this problem
or is *not* set Wizard.
PUBLIC FUNCTIONS:
Lib-vsys includes the following public functions:
CapAll [ s -- s' ]
Capitalize all words in s. Replace lower-case Roman letters from
i to x with upper case. Ex: 'iv' becomes 'IV'.
Capitalize [ s -- s' ]
Make first character of string s upper case.
Charge [ d i1 -- i2 ]
Reduce coins held by user d by i1. Return true if successful.
CheckCost [ d i -- i ]
Return true if user d has at least i coins.
CheckName [ s -- i ]
Return false if s is an invalid MUCK name such as 'me', 'here',
or 'home'.
CheckQuota [ -- i ]
Return true if current user has enough quota to create a vsys
vehicle.
CopyDir [ d1 s1 d2 s2 -- ]
Copy propdir s1 and all its subdirectories from object d1 to
propdir s2 on object d2.
Credit [ d i1 -- i2 ]
Increase coins held by user d by i1. Return true if successful.
ExitsAllowed [ d -- i ]
Return number of exits d may create. That is, quota for exits minus
number of exits currently owned.
ExitsOwned [ d -- i ]
Return number of exits currently owned by player d.
GetEnvForVeh [ d1 -- d2 ]
Return environment room associated with vehicle object d1.
GetFlagList [ d -- s ]
Return space-separated list including all flags on object d.
GetQuota [ d s -- i ]
Return player d's quota for objects of type s, where s is "rooms",
"exits", or "things". i will be -1 if player d has unlimited quota
for objects of type s.
GetVehicle [ d1 -- d2 ]
Simply put, return the dbref of the vehicle that d1 is in. More
specifically, d2 is the dbref of the vehicle object associated with
the vehicle environment room that contains the room currently holding
d1. If d1 is not in a vehicle, d2 will be #-1, false.
GetVehicleEnv [ d1 -- d2 ]
Return the dbref of vehicle environment room for d1's location. If
d1 is not in a vehicle, d2 will be #-1, false.
LibInit [ -- ]
Ensure that we have a valid, registered vehicle environment room.
NamesToRange [ s -- {dbrng} i ]
Parse s for player names and return a range of player dbrefs followed
by an index of the number of dbrefs in the range. Example: if
'BogusBoy' is not a player, but Jessy[#2PBJW] and Jihad[#13PBJ] are,
then
"bogusboy jessy jihad" NamesToRange
would put...
#13 #2 2
on the stack
ParseThis [ d s -- ? ]
Parse d's prop s for MPI.
QCheck [ s -- ]
Kill current process of s is ".quit" or a prefix thereof.
ReadLine [ -- s ]
Read a line of input from user, allowing poses and says.
ReadYesNo [ -- i ]
Read a line of input from users, allowing poses and says. Return
true if input is "yes" or a prefix thereof. Return false of input
is "no" or a prefix thereof.
RemoveDir [ d s -- ]
Remove propdir s and all its subdirectories from object d.
RoomsAllowed [ d -- i ]
Return number of rooms d may create. That is, quota for rooms minus
number of rooms currently owned.
RoomsOwned [ d -- i ]
Return number of rooms currently owned by player d.
SetFlagList [ d s -- ]
Set all flags that we can using SET from flag list s on object d:
Abode, Chown_OK, Dark, Haven, Jump, Link, and Sticky.
ShowLocation [ d -- ]
Display the name, desc, exits, and contents of room holding vehicle
occupied by d to d. If d is not in a vehicle, nothing will be displayed.
ThingsAllowed [ d -- i ]
Return number of things d may create. That is, quota for things minus
number of things currently owned.
ThingsOwned [ d -- i ]
Return number of things currently owned by player d.
VehicleAdmin? [ -- i ]
Return true if current user has admin permissions for the vehicle
he or she currently occupies. Return false if current user either
is not an administrator or is not in a vehicle.
VehicleUser? [ -- i ]
Return true if current user has user permissions for the vehicle
he or she currently occupies. Return false if current user either
is not a user or is not in a vehicle.
The vsys programs may be freely ported. Please comment any changes.
)
$include $lib/reflist
$define Tell me @ swap notify $enddef
: ParseThis ( d s -- s ) (* returns d's prop s, parsed for MPI *)
dup 3 pick swap getpropstr 0 parseprop
;
public ParseThis
: CapRomans ( s -- s' ) (* return s, all caps if it's a low roman *)
dup "{ii|iii|iv|v|vi|vii|viii|ix}" smatch if
toupper
then
;
: Capitalize ( s -- s' ) (* return s, capitalized *)
1 strcut swap toupper swap strcat CapRomans
;
public Capitalize
: CapAll ( s -- s' ) (* return s, all words upper case *)
" " " " subst " " explode (* break into words *)
dup if
""
begin (* cap each word *)
rot Capitalize " " strcat strcat
swap 1 - swap
over while
repeat
swap pop dup strlen 1 - strcut pop (* cat onto built string *)
else
pop
then
;
public CapAll
: RemoveDir ( d s -- ) (* remove dir s and s's subdirs from d *)
dup "*/" smatch not if
"/" strcat
then
over over nextprop swap pop
begin
dup while
over over nextprop
3 pick rot remove_prop
repeat
pop pop
;
Public RemoveDir
: MoveDir ( d1 s2 d2 s2 -- ) (* move dir/subdirs s1 on d1
to dir/subdirs s2 on d2 *)
begin
4 pick 4 pick propdir? not if
dup "*/" smatch if
dup strlen 1 - strcut pop
then
3 pick "*/" smatch if
3 pick dup strlen 1 - strcut pop 3 put
then
4 pick 4 pick getprop setprop remove_prop break
then
4 pick 4 pick propdir? if
4 pick 4 pick 4 pick 4 pick
dup "*/" smatch not if
"/" strcat
then
3 pick "*/" smatch not if
3 pick "/" strcat 3 put
then
4 pick 4 pick nextprop dup
3 pick 6 pick subst
2 put 3 put
MoveDir
else
4 pick 4 pick getprop setprop remove_prop
then
repeat
;
: CopyDirLoop ( d1 s1 d2 s2 -- ) (* move dir/subdirs s1 on d1
to dir/subdirs s2 on d2 *)
begin
4 pick 4 pick propdir? not if
dup "*/" smatch if
dup strlen 1 - strcut pop
then
3 pick "*/" smatch if
3 pick dup strlen 1 - strcut pop 3 put
then
4 pick 4 pick over over
dup pid intostr "/" strcat swap strcat rot rot
getprop prog rot rot setprop
getprop setprop remove_prop break
then
4 pick 4 pick propdir? if
4 pick 4 pick 4 pick 4 pick
dup "*/" smatch not if
"/" strcat
then
3 pick "*/" smatch not if
3 pick "/" strcat 3 put
then
4 pick 4 pick nextprop dup
3 pick 6 pick subst
2 put 3 put
CopyDirLoop
else
4 pick 4 pick getprop setprop remove_prop
then
repeat
;
: CopyDir ( d1 s1 d2 s2 -- ) (* copy dir/subdirs s1 on d1
to dir/subdirs s2 on d2 *)
(* function copies to dest and prog, deleting from source;
then copies back from prog to source, deleting from prog.
This turns out to be more efficient than leaving dir on
source and recording info necessary to back out of subdirs *)
4 pick 4 pick
6 rotate 6 rotate 6 rotate 6 rotate
CopyDirLoop
prog pid intostr "/" strcat 3 pick strcat
4 rotate 4 rotate MoveDir
;
Public CopyDir
: GetFlagList ( d -- s )
(* return space-separated list of all flags on object d *)
"" swap
dup "A" flag? if
swap "A " strcat swap
then
dup "B" flag? if
swap "B " strcat swap
then
dup "C" flag? if
swap "C " strcat swap
then
dup "D" flag? if
swap "D " strcat swap
then
dup exit? if
swap "E " strcat swap
then
dup program? if
swap "F " strcat swap
then
dup "H" flag? if
swap "H " strcat swap
then
dup "J" flag? if
swap "J " strcat swap
then
dup "K" flag? if
swap "K " strcat swap
then
dup "L" flag? if
swap "L " strcat swap
then
dup mlevel if
swap "M" 3 pick mlevel intostr
strcat " " strcat strcat swap
then
dup player? if
swap "P " strcat swap
then
dup "Q" flag? if
swap "Q " strcat swap
then
dup room? if
swap "R " strcat swap
then
dup "S" flag? if
swap "S " strcat swap
then
dup "W" flag? if
swap "W " strcat swap
then
dup "X" flag? if
swap "X " strcat swap
then
dup "V" flag? if
swap "V " strcat swap
then
dup "Z" flag? if
swap "Z " strcat swap
then
pop strip
;
public GetFlagList
: SetFlagList ( d s -- ) (* set all the flags that we can using
SET from flag list s on object d *)
" " explode dup 2 + rotate swap
begin
dup while
rot
dup "A" smatch if
3 pick swap set
else
dup "C" smatch if
3 pick swap set
else
dup "D" smatch if
3 pick swap set
else
dup "H" smatch if
3 pick swap set
else
dup "J" smatch if
3 pick swap set
else
dup "L" smatch if
3 pick swap set
else
dup "S" smatch if
3 pick swap set
else
pop
then then then then then then then
1 -
repeat
pop pop
;
public SetFlagList
: GetVehicle ( d1 -- d2 ) (* return dbref of vehicle containing d1 *)
"@v/id" envpropstr pop (* find env room*)
dup if
"@v/id" getprop (* get vehicle dbref *)
dup if
dup string? if
"" "#" subst atoi dbref
then
dup #0 dbcmp if (* check it *)
pop #-1
else
dup ok? not if (* return if good *)
pop #-1
then
then
then
else
pop #-1
then
;
public GetVehicle
: GetVehicleEnv ( d1 -- d2 ) (* return dbref of vehicle env room *)
"@v/id" envpropstr pop
;
public GetVehicleEnv
: GetEnvForVeh ( d1 -- d2 ) (* return dbref of vehicle room
associated with vehicle obj d1 *)
"@v/env" getprop dup string? if
"" "#" subst atoi dbref
then
;
public GetEnvForVeh
: GetPobj ( -- ) (* move vsys-pobj to vehicle room *)
"$vsys-pobj" match dup if
me @ GetVehicle location moveto
else
pop
then
;
public GetPobj
: ReadLine ( -- s )
(* read keyboard input; emit poses|says and continue, else return *)
begin (* begin input-scanning loop *)
read (* does input begin with 'say ' or " ? Emit if so *)
dup "\"" stringpfx if
1 strcut swap pop
me @ name " says, \"" strcat
swap strcat "\"" strcat
loc @ swap 0 swap notify_exclude
continue
then
dup "say " stringpfx if
4 strcut swap pop
me @ name " says, \"" strcat
swap strcat "\"" strcat
loc @ swap 0 swap notify_exclude
continue
then
(* does input begin with 'pose ' or : ? Emit if so *)
dup ":" stringpfx if
1 strcut swap pop
me @ name " " strcat swap strcat
loc @ swap 0 swap notify_exclude
continue
then
dup "pose " stringpfx if
5 strcut swap pop
me @ name " " strcat swap strcat
loc @ swap 0 swap notify_exclude
continue
then
(* continue for strings of all spaces; i.e., treat as null *)
dup strip not if
pop continue
then
break (* it's not a pose or say; break and exit *)
repeat
;
public ReadLine
: QCheck ( -- i )(* wrap smatch for .q in an if, to avoid null string
match error if user enters a string of all spaces,
which ReadLine would strip to a null string *)
dup if
dup ".quit" swap stringpfx
over ".end" swap stringpfx or if
pop ">> Done." Tell pid kill
then
then
;
Public QCheck
: ReadYesNo ( -- i )
(* read from keyboard; accept only vars of yes|no; return 1 for yes *)
begin (* begin input-scanning loop *)
ReadLine
QCheck
"yes" over stringpfx if
pop 1 break
then
"no" over stringpfx if
pop 0 break
then
pop
">> Please enter 'Yes' or 'No'." Tell
repeat (* end input-scanning loop *)
;
public ReadYesNo
: VehicleUser? ( d -- i )
(* return true if d is an authorize user for current vehicle *)
me @ GetVehicle dup if (* find current vehicle *)
me @ swap controls if
1
else
me @ GetVehicleEnv dup if (* check its user list *)
"@v/users" me @ REF-inlist? if
1
else
0
then
else
pop 0
then
then
else
pop 0
then
;
public VehicleUser?
: VehicleAdmin? ( d -- i )
(* return true if d is an authorize user for current vehicle *)
me @ GetVehicle dup if (* find current vehicle *)
me @ swap controls if
1
else
me @ GetVehicleEnv dup if (* check its admin list *)
"@v/admins" me @ REF-inlist? if
1
else
0
then
else
pop 0
then
then
else
pop 0
then
;
public VehicleAdmin?
: NamesToRange ( s -- {dbrng} i )
(* return space-sep'd string s as a range of player dbrefs *)
(* notify if player not found *)
" " ", " subst (* clear out junk *)
" " " and " subst
" " " " subst
" " explode dup (* explode into names *)
begin (* convert names to dbrefs *)
dup while
dup 2 + rotate
dup "*," smatch if
dup strlen 1 - strcut pop strip
then
dup .pmatch
dup if
dup #-2 dbcmp not if
swap pop over 2 + -1 * rotate
else
pop
">> Player '$player' not found."
swap "$player" subst Tell (* if not good name, *)
swap 1 - swap (* decrement counter left by explode *)
then
else
pop
">> Player '$player' not found."
swap "$player" subst Tell
swap 1 - swap
then
1 -
repeat
pop (* return range *)
;
public NamesToRange
: ShowLocation ( d -- ) (* show name, desc, exits, and contents
of room holding player d to player d *)
(* exit with no effect if d is not in a vehicle *)
dup GetVehicle dup not if pop pop exit then
dup location (* get location name *)
3 pick over controls if
dup unparseobj
else
dup name
then (* preface with vecho string *)
3 pick "_/vecho" getpropstr dup not if
pop ">"
then
swap strcat
4 pick swap notify (* display location name *)
over location "_/de" ParseThis (* display desc *)
dup if
dup string? if
3 pick "_/vecho" getpropstr dup not if
pop ">"
then
swap strcat
4 pick swap notify
then
else
pop
then
(* display exit list *)
dup exits dup if
"Exits: "
4 pick "_/vecho" getpropstr dup not if
pop ">"
then
swap strcat swap
begin
dup while
swap over
dup "D" flag? if
next continue
else
name
then
dup ";" instr if
dup ";" instr strcut pop
dup strlen 1 - strcut pop
then
strcat " " strcat swap
next
repeat
pop strip 4 pick swap notify
else
pop
then
(* display contents list *)
dup contents dup if
"Contents:"
4 pick "_/vecho" getpropstr dup not if
pop ">"
then
swap strcat
5 pick swap notify
begin
dup while
dup room? if
next continue
then
dup program? if
next continue
then
dup "D" flag? me @ 3 pick controls not and if
next continue
then
me @ over controls if
dup unparseobj
else
dup name
then
3 pick "_/vecho" getpropstr dup not if
pop ">"
then
swap strcat
5 pick swap notify
next
repeat
then
pop pop pop pop
;
public ShowLocation
: GetQuota ( d s -- i ) (* return d's quota for type s *)
(* return -1 if quota for type is unlimited *)
over "W" flag? if pop pop -1 exit then
over "@quota/" 3 pick strcat getpropstr dup if
swap pop swap pop
else
pop swap pop
#0 "@quota/" rot strcat getpropstr
then
dup if
atoi
else
-1
then
;
public GetQuota
: ExitsOwned ( d -- i ) (* return number of exits owned by d *)
stats pop pop pop pop swap pop swap pop
;
public ExitsOwned
: RoomsOwned ( d -- i ) (* return number of rooms owned by d *)
stats pop pop pop pop pop swap pop
;
public RoomsOwned
: ThingsOwned ( d -- i ) (* return number of rooms owned by d *)
stats pop pop pop swap pop swap pop swap pop
;
public ThingsOwned
: ExitsAllowed ( d -- i ) (* return number of exits d may make *)
dup "exits" GetQuota
dup -1 = if pop 2000000000 then
swap ExitsOwned -
dup 0 < if pop 0 then
;
public ExitsAllowed
: RoomsAllowed ( d -- i ) (* return number of rooms d may make *)
dup "rooms" GetQuota
dup -1 = if pop 2000000000 then
swap RoomsOwned -
dup 0 < if pop 0 then
;
public RoomsAllowed
: ThingsAllowed ( d -- i ) (* return number of things d may make *)
dup "things" GetQuota
dup -1 = if pop 2000000000 then
swap ThingsOwned -
dup 0 < if pop 0 then
;
public ThingsAllowed
: CheckQuota ( -- i ) (* return true if user has quota for a vechile *)
me @ "W" flag? if 1 exit then
#0 "@quota/rooms" getprop me @ "@quota/rooms" getprop or if
me @ RoomsAllowed 2 <
else
0
then
#0 "@quota/exits" getprop me @ "@quota/exits" getprop or if
me @ ExitsAllowed 3 <
else
0
then
#0 "@quota/things" getprop me @ "@quota/things" getprop or if
me @ ThingsAllowed 2 <
else
0
then
or or if
">> Sorry, you do not have enough quota to "
"create a vehicle at this time." strcat Tell 0
else
1
then
;
public CheckQuota
: CheckName ( s -- i ) (* return true if s is a valid name *)
dup "#" stringpfx if 0 then
dup "me" smatch if 0 then
dup "here" smatch if 0 then
dup "home" smatch if 0 then
if
1
else
"That's a silly name!" Tell 0
then
;
public CheckName
: Charge ( d i -- i ) (* charge d i funds; return true for succ *)
(* wizards are exempt from charges *)
over "W" flag? if pop pop 1 exit then
(* get currency *)
prog "@v/money" getprop dup not if
pop "pennies"
then
dup dbref? if
"#charge" call exit
then
(* charge this way for Argo currency... *)
dup "argo" smatch if
(* charge player d i1 small coins; return true if successful *)
pop over "@a/money/large_coins" getpropstr atoi 100 *
3 pick "@a/money/small_coins" getpropstr atoi +
over < if
0 exit
then
(* charge small coins, exchanging large coins for small if needed *)
begin (* begin charge loop *)
over "@a/money/small_coins" getpropstr atoi
over > if
over "@a/money/small_coins" over over
getpropstr atoi 4 rotate - intostr setprop
pop break
else
over "@a/money/large_coins" over over
6 pick "@a/money/small_coins" over over
getpropstr atoi 100 + intostr setprop
getpropstr atoi 1 - intostr setprop
then
repeat (* end charge loop *)
1 exit
then
(* charge this way for pennies *)
dup "pennies" smatch if
pop over pennies over >= if
-1 * addpennies 1 exit
else
0 exit
then
then
pop 0
;
public Charge
: Credit ( d i -- i ) (* add i small coins to d's funds *)
(* wizards don't pay, so don't get back *)
over "W" flag? if pop pop 1 exit then
(* get currency *)
prog "@v/money" getprop dup not if
pop "pennies"
then
dup dbref? if
"#credit" call exit
then
(* charge this way for Argo currency... *)
dup "argo" smatch if
pop swap "@a/money/small_coins" over over
getpropstr atoi 4 rotate + intostr setprop 1 exit
then
(* charge this way for pennies *)
dup "pennies" smatch if
pop addpennies 1 exit
then
pop 0
;
public Credit
: CheckCost ( d i -- i ) (* return true if player d has funds >= i *)
(* wizards aren't charged, so can always pay *)
over "W" flag? if pop pop 1 exit then
(* get currency *)
prog "@v/money" getprop dup not if
pop "pennies"
then
dup dbref? if
"#check" call exit
then
(* check this way for Argo currency... *)
dup "argo" smatch if
pop swap dup "@a/money/large_coins" getpropstr atoi 100 *
swap "@a/money/small_coins" getpropstr atoi +
<= if
1
else
0
then
exit
then
(* check this way for pennies *)
dup "pennies" smatch if
pop swap pennies <= if
1
else
0
then
exit
then
pop 0
;
public CheckCost
: LibInit ( -- ) (* make sure we have a vehicle env room *)
prog "W" flag? if
#0 "_reg/env/vehicle" getprop dup not if
pop
#0 "Vehicle Enivornment Room" newroom
#0 "_reg/env/vehicle" rot setprop
else
dup ok? if
room? not if
pop
#0 "Vehicle Environment Room" newroom
#0 "_reg/env/vehicle" rot setprop
then
else
pop
#0 "Vehicle Environment Room" newroom
#0 "_reg/env/vehicle" rot setprop
then
then
prog "_docs" "@list $lib/vsys=1-452" setprop
else
prog name " must be set Wizard." strcat me @ swap notify
pid kill
then
;
public LibInit
.
c
q
@set lib-vsys=W
@set lib-vsys=L
@reg lib-vsys=lib/vsys
@set lib-vsys=_defs/CapAll:"$lib/vsys" match "CapAll" call
@set lib-vsys=_defs/Capitalize:"$lib/vsys" match "Capitalize" call
@set lib-vsys=_defs/Charge:"$lib/vsys" match "Charge" call
@set lib-vsys=_defs/CheckCost:"$lib/vsys" match "CheckCost" call
@set lib-vsys=_defs/CheckName:"$lib/vsys" match "CheckName" call
@set lib-vsys=_defs/CheckQuota:"$lib/vsys" match "CheckQuota" call
@set lib-vsys=_defs/CopyDir:"$lib/vsys" match "CopyDir" call
@set lib-vsys=_defs/Credit:"$lib/vsys" match "Credit" call
@set lib-vsys=_defs/ExitsAllowed:"$lib/vsys" match "ExitsAllowed" call
@set lib-vsys=_defs/ExitsOwned:"$lib/vsys" match "ExitsOwned" call
@set lib-vsys=_defs/GetEnvForVeh:"$lib/vsys" match "GetEnvForVeh" call
@set lib-vsys=_defs/GetFlagList:"$lib/vsys" match "GetFlagList" call
@set lib-vsys=_defs/GetPobj:"$lib/vsys" match "GetPobj" call
@set lib-vsys=_defs/GetQuota:"$lib/vsys" match "GetQuota" call
@set lib-vsys=_defs/GetVehicle:"$lib/vsys" match "GetVehicle" call
@set lib-vsys=_defs/GetVehicleEnv:"$lib/vsys" match "GetVehicleEnv" call
@set lib-vsys=_defs/LibInit:"$lib/vsys" match "LibInit" call
@set lib-vsys=_defs/NamesToRange:"$lib/vsys" match "NamesToRange" call
@set lib-vsys=_defs/ParseThis:"$lib/vsys" match "ParseThis" call
@set lib-vsys=_defs/QCheck:"$lib/vsys" match "QCheck" call
@set lib-vsys=_defs/ReadLine:"$lib/vsys" match "ReadLine" call
@set lib-vsys=_defs/ReadYesNo:"$lib/vsys" match "ReadYesNo" call
@set lib-vsys=_defs/RemoveDir:"$lib/vsys" match "RemoveDir" call
@set lib-vsys=_defs/RoomsAllowed:"$lib/vsys" match "RoomsAllowed" call
@set lib-vsys=_defs/RoomsOwned:"$lib/vsys" match "RoomsOwned" call
@set lib-vsys=_defs/SetFlagList:"$lib/vsys" match "SetFlagList" call
@set lib-vsys=_defs/ShowLocation:"$lib/vsys" match "ShowLocation" call
@set lib-vsys=_defs/ThingsAllowed:"$lib/vsys" match "ThingsAllowed" call
@set lib-vsys=_defs/ThingsOwned:"$lib/vsys" match "ThingsOwned" call
@set lib-vsys=_defs/VehicleAdmin?:"$lib/vsys" match "VehicleAdmin?" call
@set lib-vsys=_defs/VehicleUser?:"$lib/vsys" match "VehicleUser?" call