@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 '. To remove the prototype, type '@vcreate #!prototype . 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 ' 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 '. 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 USE: Used together, the vsys programs allow users to control, configure, and secure vehicles. Newly created vehicles have an 'enter ;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 ;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 ........... Create a vehicle named 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 ...... Add to current vehicle a @vcreate #remove ... Remove from current vehicle @vcreate #packages ........... List available packages w @vcreate #package ..... Store data for package w @vcreate #!package .... Delete package and its data @vcreate #prototypes ......... List available prototypes w @vcreate #prototype .... Store data needed to reproduce w @vcreate #!prototype .. Delete prototype and its data w @vcreate #cost ... Set cost for w @vcreate #money ..... Set currency w @vcreate #strict ............. Allow only prototyped vehicles w @vcreate #!strict ............ Allow any type vehicles @vexit ....................... Leave vehicle a @vexit ................ Create vehicle exit named u @vforce ............. Force vehicle to do/go a @vlock #lock ................. Lock exits leading into vehicle a @vlock #unlock ............... Unlock exits leading into vehicle a @vlock #user ........ Allow to drive vehicle a @vlock #!user ....... Don't allow to drive vehicle a @vlock #admin ....... Give vehicle admin permissions a @vlock #!admin ...... Revoke '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 .......... Recycle 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|=@quota/rooms: #0|=@quota/exits: #0|=@quota/things: 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= drop corvette @set corvette=V @set corvette=X @flock corvette=me @act 'enter corvette;enter'=corvette @link enter=corvette enter @idesc corvette= @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