@q @program lib-argo 1 999999 d i ( lib-argo v1.2.1 Jessy @ FurryMUCK 6/97, 2/99, 7/00, 4/02 This program contains routines common to the Argo System game programs. See The Argo Manual for more information. ) $include $lib/reflist $include $lib/lmgr $include $lib/editor $include $lib/strings $include $lib/match $define Tell me @ swap notify $enddef lvar libAbility (* string: ability name or propdir *) lvar libCounter (* miscellaneous counter *) lvar libDataObj (* dbref: obj holding Argo data *) lvar libPlayerObj (* dbref: system NPC player object *) lvar libObject (* dbref of player under consideration *) lvar libString (* workspace var *) lvar libScratch (* workspace var *) lvar libTarget (* dbref: target object *) (************** Begin system/program handling functions ***************) : ArgoVersion ( -- s ) (* return Argo version *) "1.2" ; public ArgoVersion : GetDataObj ( -- d ) (* return dbref of envroom for current realm *) me @ "@a/dataobj" envpropstr not if pop #0 then ; public GetDataObj : DoVersion ( -- ) (* display program version info *) ">> " caller name strcat ", version " strcat caller "@a/version" getpropstr strcat Tell ; public DoVersion : VerifyCaller ( -- ) (* kill process if calling program is now W *) caller program? if caller "W" flag? not if ">> $prog must be set Wizard." Tell pid kill then then ; : NoisyMatch ( s -- d ) (* match s; notify for failures *) (* note that "home" returns #-3, a nonvalid dbref, but true value *) dup match dup #-1 dbcmp if swap ">> " swap strcat " not found." strcat Tell exit then dup #-2 dbcmp if swap pop ">> I'm not sure which one you mean!" Tell exit then ; public NoisyMatch : RecOldActions ( d -- ) (* recycle all exits linked to d *) VerifyCaller (* recycle all actions linked to calling program except trigger *) 1 libCounter ! begin (* begin exit-finding loop *) libCounter @ dbref dbtop dbcmp not while libCounter @ dbref dup ok? if dup exit? if getlink caller dbcmp if (* found old exit: recycle *) libCounter @ dbref recycle then else pop then else pop then libCounter @ 1 + libCounter ! repeat (* end exit-finding loop *) ; public RecOldActions : RemoveCommand ( s -- ) (* remove prop s from command list *) #0 over getprop dup if dup string? if "@a/comm_list/" "go to " subst RemoveCommand #0 swap remove_prop else recycle #0 swap remove_prop then else #0 swap remove_prop then ; public RemoveCommand : DoInstall ( s -- ) (* install program s into Argo system *) "#help" over stringpfx if " " Tell "lib-Argo $#" prog intostr strcat "$" strcat Tell " " Tell "The +install command is used to add programs and commands to the " "Argo system. While it is possible to 'manually' port Argo program" "s, using +install instead is highly recommended, as it ensures th" "at the props necessary for Argo programs to communicate with each" "other are all set." strcat strcat strcat strcat Tell " " Tell "Syntax: +install " Tell "Example: +install asys-tune" Tell " " Tell "+Install is a wizard-only command." Tell exit then me @ "W" flag? not if exit then (* check perms *) NoisyMatch dup not if (* find program to install *) exit then dup program? not if ">> Sorry, that's not a program." Tell pop exit then dup "W" flag? not if (* check program's flags *) ">> " swap name strcat " must be set Wizard before installation." strcat Tell pop exit then "#install" swap call (* call program; run its installation routine *) ; : DoUninstall ( s -- ) (* uninstall program s from Argo system *) "#help" over stringpfx if " " Tell "lib-Argo $#" prog intostr strcat "$" strcat Tell " " Tell "The +uninstall command is used to remove programs and commands fr" "om the Argo system. While it is possible to 'manually' uninstall " "programs, using +uninstall is highly recommended, as it ensures t" "hat all props and actions created during installation will be rem" "oved." strcat strcat strcat strcat Tell " " Tell "Syntax: +uninstall " Tell "Example: +uninstall asys-tune" Tell " " Tell "+Uninstall is a wizard-only command." Tell exit then me @ "W" flag? not if (* check perms *) ">> Permission denied." Tell exit then NoisyMatch dup not if (* find program to uninstall *) exit then (* call program's uninstall routine *) dup "#uninstall" over call (* remove marking props from program obj *) dup "@a/version" remove_prop dup "@a/name" remove_prop pop ; (************************ Begin math functions ************************) : abs ( i -- i' ) (* return absolute value of i *) dup 0 < if -1 * then ; public abs (******************* Begin stack-handling functions *******************) : NukeStack ( x ... x' -- ) (* clear stack *) begin depth while pop repeat ; public NukeStack : SortStrings ( s ... s' i -- s .... s' ) (* bubble sort range of strings *) dup begin (* begin outer loop *) dup while (* iterate as many times as items in range *) over begin (* begin inner loop *) dup 1 > while (* iterate up through range *) dup 3 + pick over 3 + pick over over strcmp 0 > if (* compare; swap if necesarry *) swap then 3 pick 3 + put (* put sorted pair back in place *) over 3 + put 1 - (* decrement inner loop *) repeat (* end inner loop *) pop (* pop inner loop counter *) 1 - (* decrement outer loop *) repeat (* end outer loop *) pop pop (* pop outer loop counter and range indicator *) ; : SortInts ( i ... i' i2 -- i ... i' ) (* bubble sort range of ints *) dup (* see SortStrings for stack comments *) begin dup while over begin dup 1 > while dup 3 + pick over 3 + pick over over > if swap then 3 pick 3 + put over 3 + put 1 - repeat pop 1 - repeat pop pop ; : SortDbrefs ( d ... d' i -- d ... d' ) (* bubble sort range of dbrefs *) dup (* see SortStrings for stack comments *) begin dup while over begin dup 1 > while dup 3 + pick over 3 + pick over intostr atoi over intostr atoi > if swap then 3 pick 3 + put over 3 + put 1 - repeat pop 1 - repeat pop pop ; : Sort ( x ... x' i -- x ... x' ) (* determine data type and send to appropriate sort function *) over string? if SortStrings exit then over int? if SortInts exit then over dbref? if SortDbrefs exit then ; public Sort (******************* Begin list handling functions ********************) : AddListLine ( s s' -- ) (* add line s' to list s on library *) (* NOTE: this function foobars list line numbering *) (* use it only when order of lines is unimportant *) VerifyCaller over GetDataObj LMGR-GetCount 1 + 3 pick GetDataObj LMGR-PutElem pop ; public AddListLine : EditLoop ( listname dbref {rng} mask currline cmdstring -- ) (* read input for list editor *) EDITORloop dup "save" stringcmp not if pop pop pop pop 3 pick 3 + -1 * rotate over 3 + -1 * rotate dup 5 + pick over 5 + pick over over LMGR-DeleteList 1 rot rot LMGR-PutRange 4 pick 4 pick LMGR-GetList dup 3 + rotate over 3 + rotate ">> List saved." Tell "" EditLoop exit then dup "abort" stringcmp not if ">> List not saved." Tell pop pop pop pop pop pop pop pop pop exit then dup "end" stringcmp not if pop pop pop pop pop pop dup 3 + rotate over 3 + rotate over over LMGR-DeleteList 1 rot rot LMGR-PutRange ">> List saved." Tell exit then ; : EditList ( d s -- ) (* edit list s on d *) VerifyCaller swap ">> Welcome to the list editor. You can get help by entering '.h' on" Tell ">> a line by itself. '.end' will save and exit. '.abort' will abort" Tell ">> any changes. To save changes and continue editing, use '.save'." Tell over over LMGR-GetList "save" 1 ".i $" EditLoop ; public EditList : RemoveList ( d s -- ) (* remove list s from d *) VerifyCaller "#" strcat libString ! libScratch ! libScratch @ libString @ remove_prop libString @ "/" strcat libString ! "1" libCounter ! begin (* begin line-removing loop *) libScratch @ libString @ libCounter @ strcat over over getpropstr while remove_prop libCounter @ atoi 1 + intostr libCounter ! repeat (* end line-removing loop *) pop pop libScratch @ libString @ dup "*/" smatch if dup strlen 1 - strcut pop strip then remove_prop ; public RemoveList : ShowList ( d s -- ) (* display list s on object d *) VerifyCaller "#/" strcat swap LMGR-GetList begin (* begin line-listing loop *) dup while dup 1 + rotate Tell 1 - repeat (* end line-listing loop *) pop ; public ShowList (********************* Begin encryption functions *********************) (************ Encryption functions borrowed from cmd-page *************) : asc (stringchar -- int) dup if " 1234567890-=!@#$%&*()_+qwertyuiop[]QWERTYUIOP{}asdfghjkl;'ASDFGHJKL:zxcvbnm,./ZXCVBNM<>?\"`~\\|^" swap instr 1 - exit then pop 0 ; : chr (int -- strchar) " 1234567890-=!@#$%&*()_+qwertyuiop[]QWERTYUIOP{}asdfghjkl;'ASDFGHJKL:zxcvbnm,./ZXCVBNM<>?\"`~\\|^" swap strcut 1 strcut pop swap pop ; : cypher (key chars -- chars') 1 strcut asc swap asc over 89 > over 89 > or if chr swap chr strcat swap pop exit then dup 10 / 10 * 4 pick 10 + rot 10 % - 10 % rot dup 10 / 10 * 5 rotate 10 + rot 10 % - 10 % 4 rotate + chr -3 rotate + chr strcat ; : crypt2-loop (key strcrypt strnorm -- strcrypt) dup not if pop swap pop exit then 2 strcut 4 pick rot cypher rot swap strcat swap crypt2-loop ; : crypt2-loop2 (key strcrypt strnorm -- strcrypt) dup strlen 200 < if crypt2-loop exit then 200 strcut swap 4 pick 4 rotate rot crypt2-loop swap crypt2-loop2 ; : Encrypt (key string -- string') VerifyCaller swap 9 % 100 + "" rot crypt2-loop2 ; public Encrypt (***************** Begin directory handling functions *****************) : CopyProp ( d1 s1 d2 s2 -- ) (* copy prop s1 on d1 to s2 on d2 *) VerifyCaller 4 rotate 4 rotate getprop setprop ; Public CopyProp : MoveProp ( d1 s1 d2 s2 -- ) (* move prop s1 on d1 to s2 on d2 *) VerifyCaller 4 pick 4 pick getprop setprop remove_prop ; Public MoveProp : RemoveDir ( d s -- ) (* remove dir s from d; leave subdirs *) VerifyCaller dup "*/" smatch not if "/" strcat then over over nextprop swap pop begin dup while over over nextprop 3 pick rot "" setprop repeat pop pop ; Public RemoveDir : CopyDir ( d1 s1 d2 s2 -- ) (* copy dir s1 on d1 to dir s2 on d2. do not copy subdirs *) VerifyCaller 4 pick 4 pick propdir? if 3 pick "*/" smatch not if 3 pick "/" strcat 3 put then else pop pop pop pop exit then dup "*/" smatch not if "/" strcat then 3 pick 5 rotate 5 rotate 5 rotate 5 rotate dup 5 rotate 5 rotate 5 rotate 5 rotate 4 pick 4 pick nextprop dup 4 put 5 rotate 5 rotate 5 rotate 5 rotate begin 4 pick 4 pick getprop if pop over 7 pick 7 pick swap subst 4 pick 4 pick 4 pick 4 pick 4 rotate 4 rotate getprop setprop 4 pick 4 pick nextprop dup not if break then dup 4 put 5 put else 4 pick 4 pick dup "*/" smatch if dup strlen 1 - strcut pop then over over nextprop not if pop pop break then nextprop dup 4 put 5 put then pop over 7 pick 7 pick swap subst repeat pop pop pop pop pop pop pop pop ; Public CopyDir : MoveDir ( d1 s1 d2 s2 -- ) (* move dir s1 on d1 to dir s2 on d2; delete originals; do not copy or delete subdirs *) VerifyCaller 4 pick 4 pick 4 pick 4 pick CopyDir pop pop RemoveDir ; Public MoveDir : RemoveDir-r ( d s -- ) (* remove dir s and s's subdirs from d *) VerifyCaller 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-r : MoveDir-r ( d1 s2 d2 s2 -- ) (* move dir/subdirs s1 on d1 to dir/subdirs s2 on d2 *) VerifyCaller 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-r else 4 pick 4 pick getprop setprop remove_prop then repeat ; Public MoveDir-r : CopyDirLoop ( d1 s1 d2 s2 -- ) (* move dir/subdirs s1 on d1 to dir/subdirs s2 on d2 *) VerifyCaller GetDataObj libDataObj ! 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 libDataObj @ 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-r ( d1 s1 d2 s2 -- ) (* copy dir/subdirs s1 on d1 to dir/subdirs s2 on d2 *) VerifyCaller (* function copies to dest and prog, deleting from source; then copies back from dataobj to source, deleting from dataobj. 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 GetDataObj pid intostr "/" strcat 3 pick strcat 4 rotate 4 rotate MoveDir-r ; Public CopyDir-r (************************** Begin I/O functions ***********************) : Pad ( s i -- s' ) (* pad string s to i characters *) " " rot swap strcat swap strcut pop ; public Pad : LPad ( s i -- s ) (* pad string s to i characters, spaces left *) swap " " swap strcat dup strlen rot - strcut swap pop ; public LPad : Line72 ( -- ) (* display 72-char line *) "------------------------------------------------------------------------" Tell ; public Line72 : A-An ( s -- s' ) (* return s, prepended with 'a' or 'an' *) dup 1 strcut pop "{a|e|i|o|u}" smatch if "an " else "a " then swap strcat ; public A-An : 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 *) " " explode dup if "" begin rot Capitalize " " strcat strcat swap 1 - swap over while repeat swap pop dup strlen 1 - strcut pop else pop then ; public CapAll : CleanString ( s -- s' ) (* remove spaces and punctuation from s *) strip (* spaces... *) dup .pmatch if (* leave alone if it's a player name *) exit then "" "," subst "" "." subst "" "'s" subst "" "'" subst "" "!" subst "" ":" subst " " " " subst ; public CleanString : ParseTimeString ( s -- i1 i2 | i ) (* convert string s to number of seconds i1. i2 is true if successful *) (* format of s is ' ', eg '3 hours', '1 day', '2 weeks' *) (* if unsuccessful, return only one val, 0 *) (* tokenize string *) " " explode dup 2 = if (* check syntax and bail out if needed *) pop else begin dup while swap pop 1 - repeat pop ">> Entry not understood." Tell 0 exit then (* parse units and convert amount *) swap strip "seconds" over stringpfx if 1 else "minutes" over stringpfx if 60 else "hours" over stringpfx if 3600 else "days" over stringpfx if 86400 else "weeks" over stringpfx if 604800 else "months" over stringpfx if 1036800 else "years" over stringpfx if 12441600 else pop pop 0 exit then then then then then then then swap pop swap atoi * 1 ; public ParseTimeString : ParseTimeInt ( i -- s ) (* convert i seconds to time units *) dup 12441600 / dup if intostr " years" strcat else pop dup 1036800 / dup if intostr " months" strcat else pop dup 604800 / dup if intostr " weeks" strcat else pop dup 86400 / dup if intostr " days" strcat else pop dup 3600 / dup if intostr " hours" strcat else pop dup 60 / dup if intostr " minutes" strcat else pop dup intostr " seconds" strcat then then then then then then swap pop dup "1 " stringpfx if dup strlen 1 - strcut pop then ; public ParseTimeInt : TellRoom ( s -- ) (* emit s in user's location *) VerifyCaller libString ! me @ location contents begin dup while dup "@a/store/veron" getpropstr if dup libString @ over "@a/store/verstring" getpropstr strcat notify else dup libString @ notify then next repeat pop ; public TellRoom : VerTell ( s -- ) (* notify user with s; add verstring if needed *) VerifyCaller me @ swap me @ "@a/store/veron" getpropstr if me @ "@a/store/verstring" getpropstr strcat then notify ; public VerTell : TellWait ( -- ) (* set user's action to 'wait' and notify *) VerifyCaller me @ "@a/eloop/act" "wait" setprop me @ "@a/eloop/acting" "waiting" setprop me @ "@a/eloop/target" remove_prop ">> Your current action is 'wait'." Tell ; public TellWait : 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 : ReadAbilitySet ( -- s i ) (* read three vals that define an ability level: cat, ability, level *) (* return false if user aborted read but did not quit process *) VerifyCaller GetDataObj libDataObj ! begin (* begin cat-reading loop *) ">> What is the category of this ability?" Tell ">> [Enter category ('stats', 'skills', etc), " ".n for none, or .q to quit]" strcat Tell ReadLine strip QCheck dup ".n" smatch if pop "" 0 exit then "stats" over stringpfx if pop "stats" else "skills" over stringpfx if pop "skills" else "spells" over stringpfx if pop "spells" else "psiabs" over stringpfx if pop "psiabs" else "advantages" over stringpfx if pop "dis-ad" else "disadvantages" over stringpfx if pop "dis-ad" else ">> Category not found." Tell pop continue then then then then then then break repeat (* end cat-reading loop *) begin (* begin instance-reading loop *) ">> What is the instance of this ability?" Tell ">> [Enter instance ('str', 'mechanic', etc), or .q to quit]" Tell ReadLine strip QCheck dup ".n" smatch if pop pop "" 0 exit then libDataObj @ "@a/" 4 pick strcat "/" strcat 3 pick strcat getpropstr over "{str|con|dex|int|pre}" smatch or over "{strength|constitution|dexterity|intelligence|presence}" smatch or "craft skill" 3 pick stringpfx or "physical skill" 3 pick stringpfx or not if ">> Instance not found." Tell pop continue then "craft skill" over stringpfx if pop "cra" then "physical skill" over stringpfx if pop "phy" then swap "," strcat swap strcat "," strcat break repeat (* end instance-reading loop *) begin (* begin level-reading loop *) ">> What is the level of this ability?" Tell ">> [Enter level number, or .q to quit]" Tell ReadLine strip QCheck dup ".n" smatch if pop pop "" 0 exit then dup number? not if ">> Sorry, that's not a number." Tell pop continue then strcat break repeat (* end level-reading loop *) 1 ; public ReadAbilitySet : MakeDbref ( x -- d ) (* convert x to dbref is needed; ensure ok *) dup dbref? if dup ok? not if pop ">> Error: Invalid #dbref." Tell pid kill then else dup string? if "" "#" subst atoi dbref dup ok? not if pop ">> Error: Invalid #dbref." Tell pid kill then else dbref dup ok? not if pop ok? not if pop ">> Error: Invalid #dbref." Tell pid kill then then then then ; public MakeDbref : MakeString ( x -- s ) (* convert i's to strings; convert d's to names *) dup int? if intostr exit then dup dbref? if name then ; : 3-col ( {rng} i -- ) (* output the i top things on the stack in 3 columns; top item on stack will be shown last *) dup 3 % (* fill to multiple of 3 *) dup 1 = if pop 2 + " " " " rot else dup 2 = if pop 1 + " " swap else pop then then (* get next 3; format; show *) begin (* begin get-next-three loop *) dup 3 > while dup 1 + rotate swap dup 1 + rotate swap dup 1 + rotate swap 4 rotate MakeString 24 Pad 4 rotate MakeString 24 Pad strcat 3 rotate MakeString 24 Pad strcat " " swap strcat me @ swap notify 3 - repeat (* end get-next-three loop *) pop (* format and show last 3 *) rot 24 Pad rot 24 Pad strcat swap strcat " " swap strcat me @ swap notify ; public 3-col : 2-col ( {rng} i -- ) (* output the i top things on the stack in 2 columns; top item on stack will be shown last *) begin (* begin item-fetching loop *) dup 0 > while dup 2 > if (* if more than two items, fetch and format two *) dup dup 2 + rotate " " swap strcat 38 Pad swap 1 + rotate strcat Tell 2 - continue then dup 1 = if (* or show last one *) " " rot strcat Tell 1 - continue then 1 - dup 0 <= if break then repeat (* end item-fetching loop *) pop ; public 2-col : 3-coln ( {rng} i -- ) (* output the top i things on the stack in 3 columns of numbered items; top thing on the stack will be shown last *) dup 3 % (* fill to multiple of 3 *) dup 1 = if pop 2 + " " " " rot else dup 2 = if pop 1 + " " swap else pop then then 1 swap (* get next 3; format; output *) begin (* begin get-next-three loop *) dup 3 > while dup 2 + rotate rot rot dup 2 + rotate rot rot dup 2 + rotate rot rot 5 rotate 3 pick intostr ")" strcat 4 Pad swap MakeString strcat 24 Pad 3 pick 1 + 3 put 5 rotate 4 pick intostr ")" strcat 4 Pad swap MakeString strcat 24 Pad strcat 3 pick 1 + 3 put 4 Rotate 4 pick intostr ")" strcat 4 Pad swap MakeString strcat 24 Pad strcat 3 pick 1 + 3 put " " swap strcat me @ swap notify 3 - repeat (* end get-next-three loop *) (* format and output last 3 *) pop 4 rotate 4 rotate 4 rotate swap rot dup " " smatch not if 4 pick intostr ")" strcat 4 Pad swap MakeString strcat 24 Pad 4 pick 1 + 4 put else pop pop pop pop exit then over " " smatch not if 4 pick intostr ")" strcat 4 Pad rot MakeString strcat 24 pad strcat 3 pick 1 + 3 put else " " swap strcat me @ swap notify pop pop pop exit then over " " smatch not if rot intostr ")" strcat 4 Pad strcat swap MakeString strcat " " swap strcat me @ swap notify else " " swap strcat me @ swap notify pop pop exit then ; public 3-coln : SC ( -- i ) (* return true if user is staff or wiz *) me @ "W" flag? me @ "@a/staff" getprop me @ "@a/staff/offduty" getpropstr not and or if 1 else 0 then ; : 2-col-prop ( s -- ) (* display unnumbered, 2-col list of propnames in dir s *) GetDataObj libDataObj ! 0 libCounter ! libDataObj @ swap nextprop libScratch ! begin libScratch @ while me @ "W" flag? not SC not and libDataObj @ libScratch @ "/masked" strcat getpropstr and if libDataObj @ libScratch @ nextprop libScratch ! continue then libCounter @ 1 + libCounter ! libScratch @ dup "/" rinstr strcut swap pop libCounter @ 2 % not if swap " " swap strcat " " strcat 36 strcut pop swap strcat Tell then libDataObj @ libScratch @ nextprop libScratch ! repeat libCounter @ if dup "/" rinstr strcut swap pop " " swap strcat Tell then ; public 2-col-prop : 2-coln-prop ( s -- ) (* display numbered, 2-col list of propnames in dir s *) GetDataObj libDataObj ! 0 libCounter ! libDataObj @ swap nextprop libScratch ! begin libScratch @ while me @ "W" flag? not SC not and libDataObj @ libScratch @ "/masked" strcat getpropstr and if libDataObj @ libScratch @ nextprop libScratch ! continue then libCounter @ 1 + libCounter ! libScratch @ dup "/" rinstr strcut swap pop libCounter @ intostr ") " strcat swap strcat libCounter @ 2 % not if swap " " swap strcat " " strcat 36 strcut pop swap strcat Tell then libDataObj @ libScratch @ nextprop libScratch ! repeat libCounter @ 2 % if depth if dup string? if dup "/" rinstr strcut swap pop " " swap strcat Tell then then then ; public 2-coln-prop : 3-coln-prop ( s -- ) (* display numbered, 3-col list of propnames in dir s *) GetDataObj libDataObj ! " " Tell (* loop through item list; get names; format to 3 cols *) "1" libCounter ! libDataObj @ swap nextprop libScratch ! begin (* begin prop-listing loop *) libScratch @ while (* first column *) me @ "W" flag? not SC not and libDataObj @ libScratch @ "/masked" strcat getpropstr and if libDataObj @ libScratch @ nextprop libScratch ! continue then libCounter @ 4 LPad ") " strcat libScratch @ dup "/" rinstr strcut swap pop dup "*#" smatch if dup strlen 1 - strcut pop then strcat 24 Pad libDataObj @ libScratch @ nextprop libScratch ! libCounter @ atoi 1 + intostr libCounter ! libScratch @ not if (* second column *) Tell break else me @ "W" flag? not SC not and libDataObj @ libScratch @ "/masked" strcat getpropstr and if libDataObj @ libScratch @ nextprop libScratch ! continue then libCounter @ 4 LPad ") " strcat libScratch @ dup "/" rinstr strcut swap pop dup "*#" smatch if dup strlen 1 - strcut pop then strcat strcat 48 Pad libDataObj @ libScratch @ nextprop libScratch ! libCounter @ atoi 1 + intostr libCounter ! then libScratch @ not if (* third column *) Tell break else me @ "W" flag? not SC not and libDataObj @ libScratch @ "/masked" strcat getpropstr and if libDataObj @ libScratch @ nextprop libScratch ! continue then libCounter @ 4 LPad ") " strcat libScratch @ dup "/" rinstr strcut swap pop dup "*#" smatch if dup strlen 1 - strcut pop then strcat strcat Tell libDataObj @ libScratch @ nextprop libScratch ! libCounter @ atoi 1 + intostr libCounter ! then repeat (* end prop-listing loop *) ; public 3-coln-prop : FindNumProp ( s1 s2 -- s3 ) (* find prop specified by number s2 in list s1 *) (* s3 is a null string if not found *) GetDataObj libDataObj ! atoi libScratch ! (* store num string as int *) libDataObj @ swap nextprop libCounter ! 0 begin (* begin prop-finding loop *) libCounter @ not if pop "" break then 1 + dup libScratch @ = if pop libCounter @ dup "/" rinstr strcut swap pop break then libDataObj @ libCounter @ nextprop libCounter ! repeat (* end prop-finding loop *) ; public FindNumProp : SpellNum ( s -- s' ) (* return spelled equiv of number s *) dup number? not if exit then dup "1" smatch if "one" else dup "2" smatch if "two" else dup "3" smatch if "three" else dup "4" smatch if "four" else dup "5" smatch if "five" else dup "6" smatch if "six" else dup "7" smatch if "seven" else dup "8" smatch if "eight" else dup "9" smatch if "nine" else dup "10" smatch if "ten" else dup "11" smatch if "eleven" else dup "12" smatch if "twelve" else dup "13" smatch if "thirteen" else dup "14" smatch if "fourteen" else dup "15" smatch if "fifteen" else dup "16" smatch if "sixteen" else dup "17" smatch if "seventeen" else dup "18" smatch if "eighteen" else dup "19" smatch if "nineteen" else dup "20" smatch if "twenty" else exit then then then then then then then then then then then then then then then then then then then then swap pop ; public SpellNum : UnSpellNum ( s -- s' ) (* return numeric equiv of number s *) dup number? if exit then dup "one" smatch if "1" else dup "two" smatch if "2" else dup "three" smatch if "3" else dup "four" smatch if "4" else dup "five" smatch if "5" else dup "six" smatch if "6" else dup "seven" smatch if "7" else dup "eight" smatch if "8" else dup "nine" smatch if "9" else dup "ten" smatch if "10" else dup "eleven" smatch if "11" else dup "twelve" smatch if "12" else dup "thirteen" smatch if "13" else dup "fourteen" smatch if "14" else dup "fifteen" smatch if "15" else dup "sixteen" smatch if "16" else dup "seventeen" smatch if "17" else dup "eighteen" smatch if "18" else dup "nineteen" smatch if "19" else dup "twenty" smatch if "20" else exit then then then then then then then then then then then then then then then then then then then then swap pop ; public UnSpellNum (************************ Begin money functions ***********************) : GetDenom ( s -- s )(* figure out which currency user is indicating *) GetDataObj libDataObj ! libDataObj @ "@a/sysparms/small_coins" getpropstr over smatch if pop "small_coins" else libDataObj @ "@a/sysparms/large_coins" getpropstr over smatch if pop "large_coins" else libDataObj @ "@a/sysparms/small_coin" getpropstr over smatch if pop "small_coins" else libDataObj @ "@a/sysparms/large_coin" getpropstr over smatch if pop "large_coins" else ">> Cannot determine currency denomination." Tell pid kill then then then then ; public GetDenom : Charge ( d i -- i ) VerifyCaller (* charge player d i1 small coins; return true if successful *) 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 ; public Charge : Credit ( d i -- ) (* add i small coins to d's funds *) VerifyCaller swap "@a/money/small_coins" over over getpropstr atoi 4 rotate + intostr setprop ; public Credit : CheckFunds ( d i -- i ) (* return true if player d has funds >= i small coins *) swap dup "@a/money/large_coins" getpropstr atoi 100 * swap "@a/money/small_coins" getpropstr atoi + <= if 1 else 0 then ; public CheckFunds : ExpressLowestMoney ( i -- s ) (* express small coins cost as lowest number of coins *) (* zero or negative amounts return a null string *) (* calling with 130 on stack return '1 dollar and 30 cents' *) GetDataObj libDataObj ! dup 0 > not if pop "" exit then dup 100 / dup if intostr " " strcat dup "1 " smatch if libDataObj @ "@a/sysparms/large_coin" else libDataObj @ "@a/sysparms/large_coins" then getpropstr strcat " and " strcat else pop intostr " " strcat dup "1 " smatch if libDataObj @ "@a/sysparms/small_coin" else libDataObj @ "@a/sysparms/small_coins" then getpropstr strcat exit then swap 100 % dup if intostr " " strcat dup "1 " smatch if libDataObj @ "@a/sysparms/small_coin" else libDataObj @ "@a/sysparms/small_coins" then getpropstr strcat strcat else pop dup strlen 5 - strcut pop then ; public ExpressLowestMoney (************************* Begin game functions ***********************) : EventLoop ( -- ) (* call event manager *) VerifyCaller #0 "@a/calls/eventloop" getprop dup if "#eventloop" swap Call else ">> Asys-eventmgr not installed." Tell ">> Cannot continue." Tell pop pid kill then ; public EventLoop : VerifyObject ( s -- i ) (* return true if object is +def'd *) GetDataObj "@a/objects/" rot strcat "/" strcat nextprop if 1 else 0 then ; public VerifyObject : VerifyClass ( s -- i ) (* return true if at least one object with class s is +def'd *) GetDataObj libDataObj ! libDataObj @ "@a/objects/" nextprop begin (* begin object-searching loop *) dup while libDataObj @ over "/class/" strcat nextprop begin (* begin class-searching loop *) dup while dup "*" 5 pick strcat smatch if pop pop pop 1 exit then libDataObj @ swap nextprop repeat (* end class-searching loop *) pop libDataObj @ swap nextprop repeat (* end object-searching loop *) pop pop 0 ; public VerifyClass : RepairObject ( d -- i ) (* repair object d; return true for success *) atoi dbref "@a/broken" remove_prop 1 ; public RepairObject : CreateObject ( d s -- d i ) (* create object s chowned to d *) (* return dbref of object, and true for success *) (* return #-1 and 0 for failure *) VerifyCaller GetDataObj libDataObj ! libDataObj @ "@a/objects/" 3 pick strcat "/" strcat nextprop if over ok? if over player? if swap over CapAll newobject libDataObj @ "@a/objects/$object/class/" 3 pick name "$object" subst 3 pick "@a/class/" CopyDir dup "@a/uses" libDataObj @ "@a/objects/$object/uses" 6 pick "$object" subst getpropstr setprop dup "@a/name" libDataObj @ "@a/objects/$object/name" 6 pick "$object" subst getpropstr setprop libDataObj @ "@a/objects/$object/desc#/" 4 pick "$object" subst 3 pick "_desc#/" CopyDir dup "{eval:{list:_desc}}" setdesc dup "@a/version" ArgoVersion setprop dup dup owner setlink swap pop else pop pop #-1 0 then else pop pop #-1 0 then else pop pop #-1 0 then ; public CreateObject : CountUse ( d -- ) (* decrement d's uses counter *) VerifyCaller dup "@a/version" getpropstr if dup "@a/uses" getpropstr if dup "@a/uses" over over getpropstr atoi 1 - intostr setprop dup "@a/uses" getpropstr atoi 0 <= if ">> $object is used up." over name "$object" subst Tell recycle else pop then then then ; public CountUse : CheckMatsTools ( d -- i ) (* use materials for current action *) contents libObject ! begin libObject @ while libObject @ owner me @ dbcmp not libDataObj @ "@a/sysparms/require_own" getpropstr "yes" smatch and if libObject @ next libObject ! continue then libObject @ "@a/broken" getpropstr if libObject @ next libObject ! continue then libObject @ "@a/version" getpropstr if libObject @ "@a/class/" libString @ strcat getpropstr dup if libCounter @ swap atoi - libCounter ! libCounter @ 0 <= if 0 libCounter ! 1 exit then else pop libObject @ "@a/name" getpropstr if libDataObj @ "@a/objects/$object/class/$material" libObject @ "@a/name" getpropstr "$object" subst libString @ "$material" subst getpropstr dup if libObject @ "@a/class/" libString @ strcat rot setprop continue else pop then then then then libObject @ next libObject ! repeat 0 ; : UseThisTool ( d -- ) (* use tools for current action *) contents libObject ! begin libObject @ while libObject @ owner me @ dbcmp not libDataObj @ "@a/sysparms/require_own" getpropstr "yes" smatch and if libObject @ next libObject ! continue then libObject @ "@a/broken" getpropstr dup if libObject @ next libObject ! continue then libObject @ "@a/version" getpropstr if libObject @ "@a/class/" libString @ strcat getpropstr if libObject @ CountUse libCounter @ 1 - libCounter ! libObject @ "@a/uses/" libString @ strcat getpropstr atoi 0 <= if libObject @ next libObject @ recycle then libCounter @ not if exit then else libObject @ "@a/name" getpropstr if libDataObj @ "@a/objects/$object/class/$material" libObject @ "@a/name" getpropstr "$object" subst libString @ "$material" subst getpropstr dup if libObject @ "@a/class/" libString @ strcat rot setprop continue else pop then then then then libObject @ next libObject ! repeat ; : UseThisMaterial ( d -- ) (* use materials for current action *) contents libObject ! begin libObject @ while libCounter @ 0 <= if 0 libCounter ! break then libObject @ thing? not libObject @ "@a/version" getpropstr not or libObject @ "@a/broken" getpropstr or libObject @ owner me @ dbcmp not libDataObj @ "@a/sysparms/require_own" getpropstr "yes" smatch and or not if libObject @ "@a/class/" libString @ strcat getpropstr if libCounter @ 1 - libCounter ! libObject @ "@a/class/" libString @ strcat over over getpropstr atoi 1 - intostr setprop libObject @ "@a/class/" libString @ strcat getpropstr atoi 0 <= if libObject @ next libObject @ recycle libObject ! continue then then then libCounter @ 0 <= if 0 libCounter ! break then libObject @ next libObject ! repeat ; : UseTools ( s -- ) (* find and use tools for current action *) (* sample s : "@a/skills/physician/tools/" *) VerifyCaller GetDataObj dup libDataObj ! swap nextprop begin dup while dup dup "/" rinstr strcut swap pop libString ! libDataObj @ over getpropstr atoi libCounter ! me @ UseThisTool libCounter @ not if break then loc @ UseThisTool libCounter @ not if break then libDataObj @ swap nextprop repeat pop ; public UseTools : UseMaterials ( s -- )(* find and use materials for current action *) (* sample s : "@a/skills/physician/materials/" *) VerifyCaller GetDataObj dup libDataObj ! swap nextprop begin dup while dup dup "/" rinstr strcut swap pop libString ! libDataObj @ over getpropstr atoi libCounter ! me @ UseThisMaterial libCounter @ not if break then loc @ UseThisMaterial libCounter @ not if break then libDataObj @ swap nextprop repeat pop ; public UseMaterials : Tools? ( s -- i ) (* return true if user has tools for s *) (* sample s : "@a/objects/sword/create/tools/" *) GetDataObj dup libDataObj ! swap nextprop dup if begin dup while dup dup "/" rinstr strcut swap pop libString ! libDataObj @ over getpropstr atoi libCounter ! me @ CheckMatsTools if pop 1 exit then loc @ CheckMatsTools if pop 1 exit then libDataObj @ swap nextprop repeat pop 0 else pop 1 then ; public Tools? : Materials? ( s -- i ) (* return true if user has materials for s *) (* sample s: "@a/spells/fireball/materials/" *) GetDataObj dup libDataObj ! swap nextprop dup if begin dup while dup dup "/" rinstr strcut swap pop libString ! libDataObj @ over getpropstr atoi libCounter ! me @ CheckMatsTools if pop 1 exit then loc @ CheckMatsTools if pop 1 exit then libDataObj @ swap nextprop repeat pop 0 else pop 1 then ; public Materials? : FindOther ( s -- d ) (* match to find player *) me @ "W" flag? if (* wizzes find anywhere *) dup .pmatch dup if swap pop exit else pop match dup if dup "Z" flag? if dup "@a/stats/dex" getpropstr if exit else ">> Player not found." Tell pop pid kill then else ">> Player not found." Tell pop pid kill then else ">> Player not found." Tell pop pid kill then then else (* players find in room *) match dup if exit else #-2 dbcmp if ">> Cannot determine which player you mean." Tell pid kill else ">> Player not found here." Tell pid kill then then then ; public FindOther : Dice ( i1 i2 i3 -- i )(* roll i1 i2-sided dice with an i3 modifier *) 0 (* <-- This is how many we've rolled so far: zero *) begin (* begin die-rolling loop *) 4 rotate dup if (* check: more dice to roll? *) 1 - (* if yes... decrement counter *) 4 rotate (* put stack back in order *) 4 rotate 4 rotate else (* if no... *) pop + (* apply modifier... *) swap pop break (* pop num-sides and break *) then random 4 pick % 1 + + (* roll die; apply to total so far *) repeat ; public Dice : TimeSet ( d s -- ) (* timestamp user d's use of command s *) VerifyCaller strip "@a/commands/" swap strcat systime setprop ; public TimeSet : GetCommandName ( s -- s' ) (* return current name for default command name s' *) GetDataObj "@a/comm_alia/" 3 pick strcat getpropstr dup if swap pop else pop then ; public GetCommandName : Relock ( d -- ) (* reset exit d's lock to pre-argo status *) dup "@a/fl" getprop if dup "_/fl" over "@a/fl" getprop setprop dup "@a/fl" remove_prop then dup "@a/lok" getprop if dup "_/lok" over "@a/lok" getprop setprop dup "@a/lok" remove_prop else dup "_/lok" remove_prop then dup "@a/relock_at" remove_prop GetDataObj "@a/relock" rot REF-delete ; public Relock : MatchStat ( s -- s' ) (* return abbrev form of stat s if a full form is matched *) dup "strength" smatch if "str" else dup "intelligence" smatch if "int" else dup "dexterity" smatch if "dex" else dup "constitution" smatch if "con" else dup "presence" smatch if "pre" else dup "craft" smatch if "cra" else dup "physical" smatch if "phy" else dup "craft skill" smatch if "cra" else dup "physical skill" smatch if "phy" else exit then then then then then then then then then swap pop ; public MatchStat : AbbreviateStat ( s -- s' ) (* abbreviate full stat name s to s' *) dup "str" stringpfx if "str" else dup "int" stringpfx if "int" else dup "dex" stringpfx if "dex" else dup "con" stringpfx if "con" else dup "pre" stringpfx if "pre" else dup "cra" stringpfx if "cra" else dup "phy" stringpfx if "phy" else exit then then then then then then then swap pop ; public AbbreviateStat : UnAbbreviateStat ( s -- s' (* unabbreviate stat name s to s' *) dup "str" smatch if "Strength" else dup "int" smatch if "Intelligence" else dup "dex" smatch if "Dexterity" else dup "con" smatch if "Constitution" else dup "pre" smatch if "Presence" else dup "cra" smatch if "Craft Skill" else dup "phy" smatch if "Physical Skill" else exit then then then then then then then swap pop ; public UnAbbreviateStat : ApplyArgoMod ( d s i -- ) (* modify d's val for s by +i *) VerifyCaller 3 pick 3 pick getpropstr atoi + intostr setprop ; public ApplyArgoMod : GetRoomMods VerifyCaller 0 me @ location "@a/glob_mod" getpropstr atoi + me @ location contents begin dup while dup contents begin dup while dup "@a/glob_mod" getpropstr atoi 4 rotate + -3 rotate next repeat pop dup me @ dbcmp not if dup "@a/glob_mod" getpropstr atoi rot + swap then next repeat pop ; public GetRoomMods : GetEnduranceAdv ( d -- i ) (* return bonus for endurance *) dup "@a/dis-ad/endurance iii" getpropstr if pop 9 else dup "@a/dis-ad/endurance ii" getpropstr if pop 6 else "@a/dis-ad/endurance i" getpropstr if 3 else 0 then then then ; public GetEnduranceAdv : GetToughnessAdv ( d -- i ) (* return bonus for toughness *) dup "@a/dis-ad/toughness iii" getpropstr if pop 6 else dup "@a/dis-ad/toughness ii" getpropstr if pop 4 else "@a/dis-ad/toughness i" getpropstr if 2 else 0 then then then ; public GetToughnessAdv : GetPsiResAdv ( d -- i ) (* return bonus for psionic resistance *) dup "@a/dis-ad/psionic resistance iii" getpropstr if pop 6 else dup "@a/dis-ad/psionic resistance ii" getpropstr if pop 4 else "@a/dis-ad/psionic resistance i" getpropstr if 2 else 0 then then then ; public GetPsiResAdv : GetMagResAdv ( d -- i ) (* return bonus for magic resistance *) dup "@a/dis-ad/magic resistance iii" getpropstr if pop 6 else dup "@a/dis-ad/magic resistance ii" getpropstr if pop 4 else "@a/dis-ad/magic resistance i" getpropstr if 2 else 0 then then then ; public GetMagResAdv : GMA ( d s -- i ) (* get d's level for s, after mods *) over over getpropstr atoi (* put base on stack *) loc @ 3 pick getpropstr atoi + rot rot (* apply room mods *) over over "_mod" strcat getpropstr dup if (* apply stat mods *) atoi 4 rotate + rot rot else pop then (* apply mods from carried objects *) over contents (* stack: b d s c *) begin (* begin item-searching loop *) dup while dup program? over "@a/version" getprop not or if next continue then libDataObj @ "@a/objects/" 3 pick "@a/name" getpropstr strcat "/" strcat 4 pick "" "@a/" subst strcat getpropstr atoi 5 rotate + -4 rotate next repeat (* end item-searching loop *) pop pop pop ; : GCS ( d -- s ) (* get d's current craft skill *) pop libObject ! libObject @ "@a/stats/dex" GMA libObject @ "@a/stats/int" GMA libObject @ "@a/stats/pre" GMA + + 3 / ; : GPS ( d -- s ) (* get d's current physical skill *) pop libObject ! libObject @ "@a/stats/str" GMA libObject @ "@a/stats/con" GMA libObject @ "@a/stats/dex" GMA + + 3 / ; : GetModAbility ( d s -- i ) (* get d's level for s, after mods *) GetDataObj libDataObj ! dup "@a/stats/cra" smatch if GCS exit then dup "@a/stats/phy" smatch if GPS exit then dup "@a/skills/cra" smatch if GCS exit then dup "@a/skills/phy" smatch if GPS exit then over over getpropstr atoi (* put base on stack *) loc @ 3 pick getpropstr atoi + rot rot (* apply room mods *) over over "_mod" strcat getpropstr dup if (* apply stat mods *) atoi 4 rotate + rot rot else pop then (* apply mods from carried objects *) over contents (* stack: b d s c *) begin (* begin item-searching loop *) dup while dup program? over "@a/version" getprop not or if next continue then libDataObj @ "@a/objects/$object/ready_mod" 3 pick "@a/name" getpropstr "$object" subst getpropstr if 3 pick "@a/eloop/weapon" getprop dup if over dbcmp not if next continue then else pop next continue then then libDataObj @ "@a/objects/" 3 pick "@a/name" getpropstr strcat "/" strcat 4 pick "" "@a/" subst strcat getpropstr atoi 5 rotate + -4 rotate next repeat (* end item-searching loop *) pop pop pop ; public GetModAbility : GetPhysSkill ( d -- s ) (* get d's current physical skill *) libObject ! libObject @ "@a/stats/str" GetModAbility libObject @ "@a/stats/con" GetModAbility libObject @ "@a/stats/dex" GetModAbility + + 3 / intostr ; public GetPhysSkill : GetCraftSkill ( d -- s ) (* get d's current craft skill *) libObject ! libObject @ "@a/stats/dex" GetModAbility libObject @ "@a/stats/int" GetModAbility libObject @ "@a/stats/pre" GetModAbility + + 3 / intostr ; public GetCraftSkill : GetBase ( s -- s' ) (* return base of abil s *) GetDataObj "@a/" rot strcat getpropstr dup if "," explode pop swap pop swap pop else pop "nullstat" then ; public GetBase : KillLoop ( d -- ) (* kill d's events process *) VerifyCaller dup "@a/eloop/act" remove_prop "@a/eloop/pid" over over getprop kill pop remove_prop ; public KillLoop : ClearBank ( d -- ) (* clean out d's bank accounts *) VerifyCaller #0 "@a/banks/" nextprop begin dup while #0 over "/$player/large_coins" strcat 4 pick intostr "$player" subst remove_prop #0 over "/$player/small_coins" strcat 4 pick intostr "$player" subst remove_prop #0 swap nextprop repeat pop pop ; public ClearBank : ExecuteWill ( d -- ) (* execute d's will *) dup libScratch ! "@a/money/will" REF-allrefs libCounter ! libCounter @ if 0 #0 "@a/banks/" nextprop begin dup while #0 over "/$me/large_coins" strcat me @ intostr "$me" subst getpropstr atoi 100 * rot + swap #0 over "/$me/small_coins" strcat me @ intostr "$me" subst getpropstr atoi rot + swap #0 swap nextprop repeat pop libCounter @ / dup 100 / over 100 % begin libCounter @ while 4 pick "@a/money/small_coins" over over getpropstr atoi 4 pick + intostr setprop 4 pick "@a/money/large_coins" over over getpropstr atoi 5 pick + intostr setprop 4 pick ">> You just inheritied $amount from $player." 5 pick ExpressLowestMoney "$amount" subst libScratch @ name "$player" subst notify 4 rotate pop libCounter @ 1 - libCounter ! repeat pop pop pop then libScratch @ ClearBank ; : CheckDeath ( d -- i ) (* see if player d is dead *) (* kill if so! mwahahaha! *) libObject ! #0 "@a/argo_pobj" getprop dup if dup player? if libPlayerObj ! else pop prog owner libPlayerObj ! then else pop prog owner libPlayerObj ! then libObject @ "@a/stats/con" GetModAbility libObject @ GetToughnessAdv + dup libObject @ "@a/stats/dam" getpropstr atoi - swap -1 * < if (* check: enough damage to kill?*) libObject @ KillLoop (* if so, kill events... *) libObject @ "@a/status" "dead" setprop (* set dead *) libObject @ "@a/combat" remove_prop (* disable from combat *) libObject @ location libObject @ name "'s body" strcat newobject libScratch ! (* create the body *) libScratch @ "@a/version" ArgoVersion setprop libScratch @ "@a/owner" libObject @ setprop libScratch @ "@a/class/dead body" "1" setprop libObject @ "species" getpropstr dup if libScratch @ "@a/class/$species body" rot "$species" subst "1" setprop else pop then (* set a rec_after, so we won't have rotting bodies *) libScratch @ "@a/rec_after" systime 86400 + setprop libScratch @ prog owner setown libScratch @ "C" set libScratch @ "The dead body of $name." libObject @ name "$name" subst setdesc libObject @ contents begin (* set all carried objects C and put in room o' death *) dup while dup next swap dup thing? if dup "@a/name" getpropstr if dup libObject @ location moveto dup libPlayerObj @ setown dup "_/lk" remove_prop dup "C" set pop else pop then else pop then repeat pop (* make an object to be victim's carried money *) libObject @ location "Money" newobject dup prog owner setown dup "C" set dup "@a/version" ArgoVersion setprop dup "Some money. Take it!" setdesc dup "@a/money/large_coins" libObject @ "@a/money/large_coins" getpropstr setprop dup "@a/money/small_coins" libObject @ "@a/money/small_coins" getpropstr setprop "{muf:#$dbref,#auto}" #0 "@a/prog_list/asys-money" getprop intostr libObject @ "@a/money/large_coins" "0" setprop libObject @ "@a/money/small_coins" "0" setprop "" "#" subst "$dbref" subst setsucc (* share the news *) ">> $name is killed!" libObject @ name "$name" subst TellRoom libObject @ "player_start" sysparm "" "#" subst atoi dbref moveto (* send victim to player_start *) libObject @ ">> Sorry, you're dead." notify 1 libObject @ ExecuteWill (* execute victim's will *) else 0 then ; public CheckDeath : CheckWimpOut ( d -- ) (* see if d needs to wimp out *) dup libScratch ! dup "@a/stats/wimpout" getpropstr dup if swap dup "@a/stats/con" getpropstr atoi libScratch @ GetToughnessAdv + over "@a/stats/dam" getpropstr atoi - (* see if we've hit number *) rot atoi <= if dup location exits (* find an exit to use if so *) begin dup while dup getlink dup if room? if dup getlockstr "*UNLOCKED*" smatch not if parselock 3 pick swap testlock not if next continue then else ">> $name wimps out!" (* run away! *) libScratch @ name "$name" subst TellRoom getlink moveto libScratch @ KillLoop NukeStack exit then then else pop then next repeat pop (* if we can't find an exit, just send home *) ">> $name wimps out!" libScratch @ name "$name" subst TellRoom libScratch @ KillLoop libScratch @ dup getlink moveto else pop then else pop pop then NukeStack ; public CheckWimpOut : CreateBot ( s -- d ) (* create a bot of type s *) (* d is created object's dbref *) dup libString ! "@a/bots/$type/" swap "$type" subst libScratch ! GetDataObj libDataObj ! libDataObj @ libScratch @ nextprop not if #-1 exit then me @ location libString @ CapAll newobject libObject ! #0 "@a/argo_pobj" getprop dup if dup dbref? not if dup string? if atoi then dup int? if dbref then then else pop prog owner then libObject @ swap setown libObject @ "@a/bottype" libString @ setprop libObject @ "@a/version" ArgoVersion setprop libObject @ "@a/status" "approved" setprop libObject @ "@a/enabled" "yes" setprop libObject @ "@a/combat" "yes" setprop libObject @ "Z" set libDataObj @ libScratch @ libObject @ "@a/" CopyDir-r libObject @ "species" libObject @ "@a/species" getprop setprop libObject @ "@a/sex" over over getpropstr dup "random" stringcmp 0 = if pop random 2 % if "male" else "female" then then setprop libObject @ ; public CreateBot : CreateCreature ( s -- d ) (* create a creature of type s *) (* d is created object's dbref *) dup libString ! "@a/creatures/$type/" swap "$type" subst libScratch ! GetDataObj libDataObj ! libDataObj @ libScratch @ nextprop not if #-1 exit then me @ location libString @ CapAll newobject libObject ! #0 "@a/argo_pobj" getprop dup if dup dbref? not if dup string? if atoi then dup int? if dbref then then else pop prog owner then libObject @ "@a/version" ArgoVersion setprop libObject @ "@a/status" "approved" setprop libObject @ "@a/enabled" "yes" setprop libObject @ "@a/combat" "yes" setprop libObject @ "Z" set libDataObj @ libScratch @ libObject @ "@a/" CopyDir-r libObject @ "species" libObject @ "@a/species" getprop setprop libObject @ "sex" random 2 % if "male" else "female" then setprop libObject @ ; public CreateCreature : CheckCombatInfo ( d -- ) (* show combat info for d *) dup libScratch ! ">> Fatigue: Normal:$norm Current:$current" libScratch @ "@a/stats/con" GetModAbility libScratch @ "@a/stats/str" GetModAbility + intostr 4 LPad "$norm" subst libScratch @ "@a/stats/con" GetModAbility libScratch @ "@a/stats/str" GetModAbility + libScratch @ GetEnduranceAdv + libScratch @ "@a/stats/fat" getpropstr atoi - intostr 4 LPad "$current" subst notify libScratch @ ">> Damage: Normal:$norm Current:$current" libScratch @ "@a/stats/con" GetModAbility libScratch @ GetToughnessAdv + intostr 4 LPad "$norm" subst libScratch @ "@a/stats/con" GetModAbility libScratch @ GetToughnessAdv + libScratch @ "@a/stats/dam" getpropstr atoi - intostr 4 LPad "$current" subst notify ; public CheckCombatInfo : ApplyCombatFatigue ( d -- ) (* increment d's fatigue *) VerifyCaller GetDataObj libDataObj ! libScratch ! libScratch @ "@a/stats/fat" over over getpropstr atoi 1 + 0 libScratch @ "@a/eloop/weapon" getprop dup if libDataObj @ "@a/objects/$name/weapon/fatacc" rot "@a/name" getpropstr "$name" subst getpropstr atoi + then libScratch @ "@a/eloop/shield" getprop dup if libDataObj @ "@a/objects/$name/armor/fatacc" rot "@a/name" getpropstr "$name" subst getpropstr atoi + then libScratch @ "@a/eloop/armor" getprop dup if libDataObj @ "@a/objects/$name/armor/fatacc" rot "@a/name" getpropstr "$name" subst getpropstr atoi + then libScratch @ "@a/stats/str" GetModAbility libScratch @ "@a/stats/con" GetModAbility + 2 / dup 16 >= if pop 4 - else dup 14 >= if pop 3 - else dup 12 >= if pop 2 - else dup 10 >= if pop 1 - else pop then then then then dup 0 < if pop 0 then begin over int? while + repeat intostr setprop ; public ApplyCombatFatigue : CheckMe ( -- ) (* show event info for user *) VerifyCaller ">> Target: " 16 Pad me @ "@a/eloop/target" getprop dup if name else pop "none" then strcat Tell ">> Weapon: " 16 Pad me @ "@a/eloop/weapon" getprop dup if GetDataObj "@a/objects/$object/combat/" 3 pick "@a/name" getpropstr "$object" subst nextprop not if swap pop ">> Tool: " 16 Pad swap then name else pop "none" then strcat Tell ">> Shield: " 16 Pad me @ "@a/eloop/shield" getprop dup if name else pop "none" then strcat Tell ">> Armor: " 16 Pad me @ "@a/eloop/armor" getprop dup if name else pop "none" then strcat Tell ">> Defense: " 16 Pad me @ "@a/eloop/defmode" getprop dup if Capitalize else pop "none" then strcat Tell ">> Action: " 16 Pad me @ "@a/eloop/acting" getprop dup if Capitalize else pop "none" then strcat Tell me @ CheckCombatInfo ; public CheckMe : GetTurnLength ( d -- i ) (* return d's effective turn length *) GetDataObj libDataObj ! dup "@a/stats/dex" getprop if libDataObj @ "@a/sysparms/turn_length" getpropstr atoi libScratch ! dup "@a/stats/dex" GetModAbility dup 4 <= if pop 4 else dup 5 <= if pop 3 else dup 6 <= if pop 2 else dup 7 <= if pop 1 else dup 8 <= if pop 0 else dup 10 <= if pop -1 else dup 12 <= if pop -2 else dup 14 <= if pop -3 else dup 16 <= if pop -4 else pop -5 then then then then then then then then then libScratch @ + libScratch ! dup "@a/eloop/shield" getprop dup if libDataObj @ "@a/objects/$name/armor/turnslow" rot "@a/name" getpropstr "$name" subst getpropstr atoi else pop 0 then over "@a/eloop/armor" getprop dup if libDataObj @ "@a/objects/$name/armor/turnslow" rot "@a/name" getpropstr "$name" subst getpropstr atoi else pop 0 then + dup if over "@a/stats/str" GetModAbility dup 16 >= if pop 8 else dup 14 >= if pop 6 else dup 12 >= if pop 4 else dup 10 >= if pop 2 else dup 8 >= if pop 1 else 0 then then then then then - dup 0 < if pop 0 then then libScratch @ + libScratch ! dup "@a/eloop/act" getpropstr dup if "{attack|feint}" smatch if dup "@a/eloop/weapon" getprop if libDataObj @ "@a/objects/$name/class/fencing weapons" 3 pick "@a/eloop/weapon" getprop "@a/name" getpropstr "$name" subst getpropstr if dup "@a/skills/fencing" getpropstr atoi 2 1 + / else 0 then else dup "@a/eloop/armor" getprop not if dup "@a/skills/martial arts" getpropstr atoi 2 1 + / else 0 then then else 0 then else pop 0 then libScratch @ swap - dup 0 < if pop 0 then libScratch ! pop libScratch @ else pop pop 0 then ; public GetTurnLength : RollMake ( d s -- i ) (* make rolls for d to make object s *) VerifyCaller GetDataObj libDataObj ! libDataObj @ "@a/objects/$object/create/rolls/" 3 pick "$object" subst nextprop begin (* begin category-finding loop *) dup while dup "/" strcat libDataObj @ swap nextprop begin (* begin roll-finding loop *) dup while (* get value to roll against *) dup "^" "/rolls/" subst dup "^" instr strcut swap pop dup GetBase "@a/stats/" swap strcat swap "@a/" swap strcat 6 pick swap GetModAbility 6 pick rot GetModAbility over if 3 else 4 then 6 0 Dice rot rot + > if pop pop 0 exit then libDataObj @ swap nextprop repeat pop pop libDataObj @ swap nextprop repeat (* made all rolls; return true *) pop pop pop 1 ; public RollMake : RollRepair ( d s -- i ) (* make rolls for d to make object s *) VerifyCaller "@a/objects/$object/repair/rolls/" swap "$object" subst libString ! libObject ! GetDataObj libDataObj ! libObject @ libString @ nextprop begin (* begin category-finding loop *) dup while libObject @ "@a/" over "" libString @ subst strcat GetModAbility dup if 3 else 4 then 6 0 Dice >= not if pop 0 exit then libDataObj @ swap nextprop repeat (* made all rolls; return true *) pop 1 ; public RollRepair : RunEvent ( s -- ) (* run a timed event *) VerifyCaller "," explode pop (* find event category *) dup "create_object" smatch if (* check: create something? *) pop me @ over RollMake if ">> Your attempt to create $object succeeds." over CapAll "$object" subst Tell me @ over CreateObject pop exit else ">> Your attempt to create $object fails." over CapAll "$object" subst Tell then pop pop exit then dup "repair_object" smatch if pop me @ over RollRepair if atoi dbref dup "@a/broken" remove_prop ">> Your attempt to repair $object succeeds." swap name "$object" subst Tell else ">> Your attempt to repair $object fails." swap name "$object" subst Tell then then ; : CheckMaxDisads ( i1 -- i2 ) (* return true if user has enough disad_total points left to add another disadvantage with value i1 *) me @ "@a/disad_total" getpropstr atoi Abs GetDataObj "@a/sysparms/max_disadvantages" getpropstr atoi Abs > if ">> Sorry, you are over the maximum allowed total of Disadvantages." Tell pop 0 else Abs me @ "@a/disad_total" getpropstr atoi Abs + GetDataObj "@a/sysparms/max_disadvantages" getpropstr atoi Abs > if ">> Sorry, that would put you over the maximum allowed total of " "Disadvantages." strcat Tell 0 else 1 then then ; public CheckMaxDisads : UpdateVotes ( -- ) (* update vote dirs for new interval *) GetDataObj libDataObj ! libDataObj @ "@a/vote/one_per/" nextprop (* clear one_per records *) begin dup while libDataObj @ over nextprop libDataObj @ rot remove_prop repeat pop libDataObj @ "@a/vote/voted/" nextprop (* clear times-voted records *) begin dup while libDataObj @ over nextprop libDataObj @ rot remove_prop repeat pop libDataObj @ "@a/sysparms/vote_interval" getpropstr (* reset *) ParseTimeString pop libCounter ! begin libDataObj @ "@a/vote/start" getprop libCounter @ + systime < while libDataObj @ "@a/vote/start" over over getprop libCounter @ + setprop repeat ; : StoreRolls ( -- ) (* there are places where randomizer is clearly scewed; for these places, store a 3- and 4-die roll *) me @ "@a/store/roll3" 3 6 0 Dice setprop me @ "@a/store/roll4" 4 6 0 Dice setprop ; : VerifyDisadTotal ( -- ) (* make sure dis-ad total is right *) 0 libCounter ! me @ "@a/dis-ad/" nextprop begin dup while me @ over getpropstr atoi dup 0 < if libCounter @ + libCounter ! else pop then me @ swap nextprop repeat pop me @ "@a/disad_total" libCounter @ -1 * intostr setprop ; : SetArgoDefaults ( d -- ) (* set player d with default Argo props *) GetDataObj libDataObj ! VerifyCaller libObject ! libObject @ "@a/version" ArgoVersion setprop libObject @ "@a/status" "na" setprop libObject @ "@a/stats/str" "8" setprop libObject @ "@a/stats/str_mod" "0" setprop libObject @ "@a/stats/dex" "8" setprop libObject @ "@a/stats/dex_mod" "0" setprop libObject @ "@a/stats/int" "8" setprop libObject @ "@a/stats/int_mod" "0" setprop libObject @ "@a/stats/con" "8" setprop libObject @ "@a/stats/con_mod" "0" setprop libObject @ "@a/stats/pre" "8" setprop libObject @ "@a/stats/pre_mod" "0" setprop libObject @ "@a/disad_total" "0" setprop libObject @ "@a/dis-ad/Status" "8" setprop libObject @ "@a/dis-ad/Wealth" "8" setprop libObject @ "@a/avail/main" libDataObj @ "@a/sysparms/starting_points" getpropstr setprop libObject @ player? if libObject @ "@a/money/large_coins" libDataObj @ "@a/sysparms/starting_large_coins" getpropstr setprop libObject @ "@a/money/small_coins" libDataObj @ "@a/sysparms/starting_small_coins" getpropstr setprop libObject @ "@a/tl" libDataObj @ "@a/sysparms/tech_level" getpropstr setprop else libObject @ "@a/money/large_coins" "0" setprop libObject @ "@a/money/small_coins" "0" setprop then ; public SetArgoDefaults : CheckIdle ( d -- i ) (* return true if d is an idle player *) dup player? if dup awake? if 99999999999 libScratch ! descriptors begin dup while over libScratch @ < if over descrcon conidle libScratch ! then swap pop 1 - repeat pop libScratch @ GetDataObj "@a/sysparms/idle_time" getpropstr atoi > if 1 else 0 then else pop 0 then else pop 0 then ; public CheckIdle : CheckXPs ( d -- ) (* check xps; bump char points and notify d if > 100 *) libScratch ! GetdataObj libDataObj ! libDataObj @ "@a/sysparms/auto_xp" getpropstr "yes" smatch if libScratch @ "@a/avail/xps" getpropstr if begin libScratch @ "@a/avail/xps" getpropstr atoi 100 >= while libScratch @ "@a/avail/xps" over over getpropstr atoi 100 - intostr setprop libScratch @ "@a/avail/main" over over getpropstr atoi 1 + intostr setprop ">> You just received a Character Development Point from experience." libScratch @ swap notify repeat then then ; public CheckXPs : RollXPs ( d -- ) (* give d a roll to get some XPs *) libScratch ! GetDataObj libDataObj ! libDataObj @ "@a/sysparms/auto_xp" getpropstr "yes" smatch if libScratch @ location "@a/ic" envpropstr pop if 0 libCounter ! libScratch @ location contents begin dup while dup libScratch @ dbcmp not if dup player? if dup awake? if dup CheckIdle not if libCounter @ 1 + libCounter ! then then then then next repeat pop libCounter @ if libScratch @ "@a/stats/int" GetModAbility libScratch @ "@a/stats/pre" GetModAbility + 2 / 3 6 0 Dice >= if libScratch @ "@a/avail/xps" over over getpropstr atoi 10 + intostr setprop libScratch @ CheckXPs then then then then ; public RollXPs : Update ( -- ) (* clear temp props; check timed events *) me @ "@a/version" getpropstr not if me @ SetArgoDefaults then (* clear temp dir for player *) GetDataObj libDataObj ! libDataObj @ "@a/temp/" me @ intostr strcat "/" strcat RemoveDir-r me @ "@a/reveal_at" getprop dup if systime < if me @ "!D" set me @ "@a/reveal_at" remove_prop me @ "@a/hidden" remove_prop me @ "@a/invisible" remove_prop #0 "@a/reveal" me @ REF-delete ">> $me reappears." me @ name "$me" subst TellRoom then else pop then (* handle high priority recycles *) #0 "@a/recycle" REF-allrefs libCounter ! begin libCounter @ 0 > while dup ok? if dup "@a/rec_after" getprop dup if systime < if #0 "@a/recycle" 3 pick REF-delete dup recycle then then else #0 "@a/recycle" 3 pick REF-delete then pop libCounter @ 1 - libCounter ! repeat (* return moved objects *) #0 "@a/return" REF-allrefs libCounter ! begin libCounter @ 0 > while dup ok? if dup "@a/return_at" getprop dup if systime < if dup "@a/eloop/return_to" getprop dup if moveto else pop dup getlink moveto then then else pop then else #0 "@a/return" 3 pick REF-delete then pop libCounter @ 1 - libCounter ! repeat me @ "@a/to_recycle" REF-allrefs (* recycle any outstanding junk *) begin dup while over ok? if over owner me @ dbcmp if over "@a/version" getpropstr if over recycle then then then me @ "@a/to_recycle" 4 rotate REF-delete 1 - repeat pop (* remove old healing times *) me @ "@a/healing/" nextprop begin dup while libDataObj @ over getprop systime libCounter @ - < if libDataObj @ over nextprop libDataObj @ rot remove_prop else libDataObj @ swap nextprop then repeat pop (* get num votes for current player *) (* award vote_xp_amount xp's if amount >= votes_required *) libDataObj @ "@a/vote/votes/" me @ intostr strcat getpropstr atoi libDataObj @ "@a/sysparms/votes_required" getpropstr atoi >= if me @ "@a/avail/main" over over getpropstr atoi 1 + intostr setprop libDataObj @ "@a/vote/votes/" me @ intostr strcat over over getpropstr atoi libDataObj @ "@a/sysparms/votes_required" getpropstr atoi - intostr setprop me @ ">> You have received a character development point as a result of" notify me @ " player votes for good roleplay." me @ "@a/store/veron" getpropstr if me @ "@a/store/verstring" getpropstr strcat then notify then (* check: do we need to update vote info? *) libDataObj @ "@a/vote/start" getprop dup if systime libDataObj @ "@a/sysparms/vote_interval" getpropstr ParseTimeString pop - < if UpdateVotes then else (* set a vote start if none exists *) pop libDataObj @ "@a/vote/start" systime setprop then (* make sure disad_total values are in positive form *) me @ "@a/disad_total" over over getpropstr atoi Abs intostr setprop (* check: does player have timed events to run? *) me @ "@a/events/" nextprop dup if begin dup while dup dup "/" rinstr strcut swap pop atoi systime < if (* found an event that needs to run *) me @ over getpropstr RunEvent begin dup "@a/event*" smatch not while pop repeat me @ over nextprop me @ rot remove_prop else me @ swap nextprop then repeat pop else pop then me @ CheckXPs (* see if user has accrued a char point *) VerifyDisadTotal (* disad_total is bug prone. stomp it *) ; public Update : ArgoCheck ( d -- i ) (* return true if object d is Argo-enabled *) "@a/version" getprop if 1 else 0 then ; public ArgoCheck : CheckCGRoom ( -- i ) (* return true if 'here' is an authorized chargen location *) GetDataObj "@a/cg_locs" getpropstr if GetDataObj "@a/cg_locs" loc @ REF-inlist? if 1 else 0 then else 1 then ; public CheckCGRoom : CheckPerqs ( d s1 s2 -- i ) (* return true if player d satisfies preqs for skell s2 in set s1 *) GetDataObj libDataObj ! (* store propdir to check on player *) "@a/" 3 pick strcat "/" strcat libScratch ! (* assemble string for perq list *) libDataObj @ "@a/" 4 rotate strcat "/" strcat rot strcat "/" strcat "preqs#/" strcat nextprop begin (* begin perq-listing loop *) dup while libDataObj @ over getpropstr "," explode pop (* parse perq,min *) "@a/" swap strcat "/" strcat swap strcat 4 pick swap getpropstr dup if (* check: has it? high enough ?*) atoi swap atoi < if pop pop pop 0 exit (* too low *) then else pop pop pop pop 0 exit (* doesn't have it *) then libDataObj @ swap nextprop repeat (* end perq-listing loop *) pop pop pop 1 (* made it through: pop null string and return true *) ; public CheckPerqs : ArgoPermCheck ( d -- ) (* kill process if d cannot use Argo *) dup player? not if dup "@a/enabled" getpropstr not if ">> Permission denied." Tell pop pid kill then then dup "guest_player?" getprop if ">> Permission denied." Tell pop pid kill then "@a/status" getpropstr dup if "suspended" smatch if ">> Permission denied." Tell pid kill then else pop then ; public ArgoPermCheck : DeadCheck ( -- ) (* notify and kill process if user is dead *) me @ "@a/status" getpropstr dup if "dead" smatch if ">> Sorry, dead people can't do that." Tell pid kill then else pop then ; public DeadCheck : StaffCheck ( -- i ) (* return true if user is staff or wiz *) me @ "W" flag? me @ "@a/staff" getprop me @ "@a/staff/offduty" getpropstr not and or if 1 else 0 then ; public StaffCheck : ExemptCheck (* return true if user's status is 'na' or 'exempt' *) me @ "@a/status" getpropstr dup if dup "na" smatch swap "exempt" smatch or if 1 else 0 then else pop me @ SetArgoDefaults 1 then ; public ExemptCheck : ComCheck ( d -- i ) (* return true if player d is combat_ok *) dup "@a/status" getpropstr dup if "suspended" smatch if pop 0 exit then else pop 0 exit then dup "@a/status" getpropstr "dead" smatch if pop 0 exit then "@a/combat" getprop if 1 else 0 then ; public ComCheck : VerifyCombat ( -- ) (* kill process if user is not combat_ok *) GetDataObj "@a/sysparms/combat" getpropstr "yes" smatch not if ">> Combat is currently disabled." Tell pid kill then me @ ComCheck not if ">> You must be set 'combat ok' to use this command." Tell #0 "@a/comm_list/+combat" getprop dup if name dup ";" instr if dup ";" instr 1 - strcut pop then else exit then ">> Use the $command command to make this setting." swap "$command" subst Tell pid kill then ; public VerifyCombat : VerifyTarget ( d -- i ) (* return true if d is a valid target *) dup ok? not if pop 0 exit then dup location me @ location dbcmp not if pop 0 exit then dup "Z" flag? over player? or if dup "@a/combat" getpropstr not if pop 0 exit then then dup player? if dup CheckIdle if pop 0 exit then dup awake? not if pop 0 exit then then pop 1 ; public VerifyTarget : Approved? ( -- ) (* notify and kill pid if user is not approved *) me @ "W" flag? not me @ "@a/status" getpropstr "approved" smatch not and me @ "@a/staff" getpropstr not and if ">> Sorry, you must be an approved character to use this command." Tell pid kill then ; public Approved? : ActionCheck ( -- ) (* notify and kill pid if user is dead or unconsious *) me @ "@a/status" getpropstr dup if dup "dead" smatch if ">> Sorry, you cannot use this command while dead." Tell pop pid kill then dup "unconscious" smatch if ">> Sorry, you cannot use this command while unconscious." Tell pop pid kill then pop else ">> You must set up as an Argo player before using this command." Tell pop pid kill then ; public ActionCheck : Combat? ( -- i ) (* return true if combat is enabled *) GetDataObj "@a/sysparms/combat" getpropstr "yes" smatch if 1 else 0 then ; public Combat? : Magic? ( -- i ) (* return true if magic is enabled *) GetDataObj "@a/sysparms/magic" getpropstr "yes" smatch if 1 else 0 then ; public Magic? : Psionics? ( -- i ) (* return true if psionics are enabled *) GetDataObj "@a/sysparms/psionics" getpropstr "yes" smatch if 1 else 0 then ; public Psionics? : DoEnable ( -- ) (* enable command *) StaffCheck not if ">> Permission denied." Tell exit then trig "@a/disabled" "" setprop ">> Command enabled." Tell ; public DoEnable : DoDisable ( -- ) (* disable command *) StaffCheck not if ">> Permission denied." Tell exit then trig "@a/disabled" "yes" setprop ">> Command disabled." Tell ; public DoDisable : Disabled? ( -- ) (* check trigger: action disabled? *) trig "@a/disabled" getprop if ">> This command is currently disabled." Tell pid kill then ; public Disabled? : SetWait ( -- ) (* reset user to waiting and clear stack *) me @ "@a/eloop/target" remove_prop me @ "@a/eloop/act" "wait" setprop me @ "@a/eloop/acting" "waiting" setprop NukeStack ; public SetWait lvar nonamestr lvar namestr : SpellTell ( s -- ) (* notify room with spell result *) (* mages who know the spell will see what spell it was *) (* others will just see 'a spell' *) me @ "@a/eloop/target" getprop libTarget ! me @ "@a/eloop/spell" getprop libAbility ! me @ name "$me" subst me @ libTarget @ dbcmp if "" "$target" subst else "on " libTarget @ name strcat " " strcat "$target" subst then dup "a Spell" "$spell" subst "'s" " 's" subst " " " " subst ">> " ">>" subst "." " ." subst nonamestr ! libAbility @ "$spell" subst "'s" " 's" subst " " " " subst ">> " ">>" subst "." " ." subst namestr ! "@a/spells/" libAbility @ strcat libString ! me @ location contents begin dup while dup "@a/version" getpropstr if dup libString @ GetModAbility if dup namestr @ else dup nonamestr @ then else dup nonamestr @ then over "@a/veron" getpropstr if over "@a/verstring" getpropstr strcat then notify next repeat pop ; public SpellTell : PresenceRoll ( -- i ) (* make a presense roll for user *) (* return true if the roll succeeds *) 3 6 0 Dice dup 17 >= if pop 0 exit then me @ "@a/stats/pre" GetModAbility <= if 1 else 0 then ; public PresenceRoll : PsiabTargetTell ( -- ) (* notify target that something happened *) libTarget @ libString @ GetModAbility if me @ name "$me" subst libAbility @ "$psiab" subst "on you " "$target" subst dup "'s" instr if "" "'s" subst "on your " "$target" subst else "on you " "$target" subst then " " " " subst ">> " ">>" subst "." " ." subst libTarget @ swap notify exit then libTarget @ "@a/skills/perception" GetModAbility libTarget @ "@a/dis-ad/psionic aptitude" GetModAbility or if me @ name "$me" subst "a Psionic Ability" "$psiab" subst "on you " "$target" subst dup "'s" instr if "" "'s" subst "on your " "$target" subst else "on you " "$target" subst then " " " " subst ">> " ">>" subst "." " ." subst libTarget @ swap notify exit else "Someone" "$me" subst "a Psionic Ability" "$psiab" subst dup "'s" instr if "" "'s" subst "on your " "$target" subst else "on you " "$target" subst then " " " " subst ">> " ">>" subst "." " ." subst libTarget @ swap notify exit then ; : PsiabTell ( s -- ) (* notify room with psiab result *) (* mages who know the psiab will see what psiab it was *) (* others will just see 'a psiab' *) me @ "@a/eloop/target" getprop libTarget ! me @ "@a/eloop/psiab" getpropstr libAbility ! "@a/psiabs/" libAbility @ strcat libString ! dup PsiabTargetTell me @ name "$me" subst me @ libTarget @ dbcmp if "" "$target" subst else "on " libTarget @ name strcat " " strcat "$target" subst then dup "a Psiab" "$psiab" subst "'s" " 's" subst " " " " subst ">> " ">>" subst "." " ." subst nonamestr ! libAbility @ "$psiab" subst "'s" " 's" subst " " " " subst ">> " ">>" subst "." " ." subst namestr ! me @ location contents begin dup while dup "@a/version" getpropstr if dup libTarget @ dbcmp not if dup "@a/dis-ad/psionic aptitude" getpropstr over "@a/skills/perception" getpropstr or if dup "@a/stats/int" GetModAbility over "@a/skills/perception" GetModAbility + over "@a/skills/mental discipline" GetModAbility + 3 6 0 Dice >= if dup libString @ GetModAbility if dup namestr @ else dup nonamestr @ then else dup nonamestr @ then over "@a/veron" getpropstr if over "@a/verstring" getpropstr strcat then notify then then then next repeat pop ; public PsiabTell (****************** begin security system functions *******************) : GetScope ( -- s ) (* return name of effective scope *) loc @ "@s/scope" envpropstr swap pop ; public GetScope : GetScopeRoom ( -- d ) (* return room defining scope *) loc @ "@s/scope" envpropstr pop ; public GetScopeRoom : IsScope? ( s -- i ) (* return true if s is the name of a scope *) "@s/scopes/" rot strcat "/" strcat nextprop if 1 else 0 then ; public IsScope? (************ This is main: Installs and registers lib-argo ***********) : Install GetDataObj libDataObj ! dup if caller "W" flag? if dup string? if dup "#charge" smatch if Charge exit then dup "#credit" smatch if Credit exit then dup "#check" smatch if CheckFunds exit then then then then me @ "W" flag? not if ">> Permission denied." Tell then prog "W" flag? not if ">> lib-Argo must be set Wizard in order to perform installation." Tell exit then dup command @ "+install" smatch and if DoInstall exit then dup command @ "+uninstall" smatch and if DoUninstall exit then prog "@a/version" getpropstr if ">> Reinstalling... " Tell else prog "@a/version" ArgoVersion setprop then (* get rid of any old actions linked to program *) ">> Searching dbase for old commands linked to library, recycling... " Tell 1 libCounter ! begin (* begin exit-finding loop *) (* end when all dbrefs have been checked *) libCounter @ dbref dbtop dbcmp not while libCounter @ dbref dup ok? if dup exit? if dup getlink prog dbcmp over trig dbcmp not and if libCounter @ dbref recycle else pop then else pop then else pop then libCounter @ 1 + libCounter ! repeat (* end exit-finding loop *) ">> Registering library... " Tell (* register library *) #0 "_reg/lib/argo" prog setprop #0 "@a/prog_list/" prog name strcat prog setprop ">> Creating +install action... " Tell (* rename trig *) trig "+install" setname #0 "@a/comm_list/+install" trig setprop ">> Creating +uninstall action... " Tell #0 "+uninstall" newexit dup prog setlink #0 "@a/comm_list/+uninstall" rot setprop ">> Setting version number... " Tell (* set version *) #0 "@a/version" ArgoVersion setprop libDataObj @ "@a/sysparms/" nextprop if ">> Storing current system parameters..." Tell libDataObj @ "@a/sysparms/" libDataObj @ "@a/sysparms_bak/" CopyDir then (* set default sysparms *) ">> Setting default system parameters... " Tell libDataObj @ dup "@a/sysparms/auto_xp" "yes" setprop dup "@a/sysparms/cap_large_coin" "Silver piece" setprop dup "@a/sysparms/cap_large_coins" "Silver pieces" setprop dup "@a/sysparms/cap_small_coin" "Copper piece" setprop dup "@a/sysparms/cap_small_coins" "Copper pieces" setprop dup "@a/sysparms/character_approval" "yes" setprop dup "@a/sysparms/combat" "no" setprop dup "@a/sysparms/income_interval" "1 week" setprop dup "@a/sysparms/idle_time" "300" setprop dup "@a/sysparms/heal_interval" "1 day" setprop dup "@a/sysparms/large_coin" "silver piece" setprop dup "@a/sysparms/large_coins" "silver pieces" setprop dup "@a/sysparms/magic" "no" setprop dup "@a/sysparms/max_disadvantages" "8" setprop dup "@a/sysparms/min_stats" "4" setprop dup "@a/sysparms/monitor" "Monitor" setprop dup "@a/sysparms/monitors" "Monitors" setprop dup "@a/sysparms/player_pause" "yes" setprop dup "@a/sysparms/psionics" "no" setprop dup "@a/sysparms/require_own" "yes" setprop dup "@a/sysparms/rumor_interval" "3 hours" setprop dup "@a/sysparms/small_coin" "copper piece" setprop dup "@a/sysparms/small_coins" "copper pieces" setprop dup "@a/sysparms/starting_points" "16" setprop dup "@a/sysparms/starting_large_coins" "1" setprop dup "@a/sysparms/starting_small_coins" "100" setprop dup "@a/sysparms/strict_disads" "no" setprop dup "@a/sysparms/tech_level" "4" setprop dup "@a/sysparms/turn_length" "30" setprop dup "@a/sysparms/use_dark" "yes" setprop dup "@a/sysparms/vote_xp_given" "1" setprop dup "@a/sysparms/vote_interval" "1 week" setprop dup "@a/sysparms/votes_per_interval" "3" setprop dup "@a/sysparms/votes_required" "10" setprop libDataObj @ "@a/sysparms_bak/" nextprop if ">> Restoring previous system parameters..." Tell libDataObj @ "@a/sysparms_bak/" libDataObj @ "@a/sysparms/" CopyDir libDataObj @ "@a/sysparms_bak/" RemoveDir then dup #0 dbcmp if "@a/dataobj" "Global" setprop #0 "@a/realms" #0 REF-add else pop then (* set function call defs *) ">> Setting function call definitions... " Tell prog "_defs/" RemoveDir prog "_defs/2-col" "\"$lib/argo\" match \"2-col\" call" setprop prog "_defs/2-col-prop" "\"$lib/argo\" match \"2-col-prop\" call" setprop prog "_defs/2-coln-prop" "\"$lib/argo\" match \"2-coln-prop\" call" setprop prog "_defs/3-col" "\"$lib/argo\" match \"3-col\" call" setprop prog "_defs/3-coln" "\"$lib/argo\" match \"3-coln\" call" setprop prog "_defs/3-coln-prop" "\"$lib/argo\" match \"3-coln-prop\" call" setprop prog "_defs/A-An" "\"$lib/argo\" match \"A-An\" call" setprop prog "_defs/Abs" "\"$lib/argo\" match \"Abs\" call" setprop prog "_defs/AbbreviateStat" "\"$lib/argo\" match \"AbbreviateStat\" call" setprop prog "_defs/ActionCheck" "\"$lib/argo\" match \"ActionCheck\" call" setprop prog "_defs/AddListLine" "\"$lib/argo\" match \"AddListLine\" call" setprop prog "_defs/ApplyArgoMod" "\"$lib/argo\" match \"ApplyArgoMod\" call" setprop prog "_defs/ApplyCombatFatigue" "\"$lib/argo\" match \"ApplyCombatFatigue\" call" setprop prog "_defs/Approved?" "\"$lib/argo\" match \"Approved?\" call" setprop prog "_defs/ArgoCheck" "\"$lib/argo\" match \"ArgoCheck\" call" setprop prog "_defs/ArgoPermCheck" "\"$lib/argo\" match \"ArgoPermCheck\" call" setprop prog "_defs/ArgoVersion" "\"$lib/argo\" match \"ArgoVersion\" call" setprop prog "_defs/Capitalize" "\"$lib/argo\" match \"Capitalize\" call" setprop prog "_defs/CapAll" "\"$lib/argo\" match \"CapAll\" call" setprop prog "_defs/Charge" "\"$lib/argo\" match \"Charge\" call" setprop prog "_defs/CheckCGRoom" "\"$lib/argo\" match \"CheckCGRoom\" call" setprop prog "_defs/CheckCombatInfo" "\"$lib/argo\" match \"CheckCombatInfo\" call" setprop prog "_defs/CheckDeath" "\"$lib/argo\" match \"CheckDeath\" call" setprop prog "_defs/CheckFunds" "\"$lib/argo\" match \"CheckFunds\" call" setprop prog "_defs/CheckIdle" "\"$lib/argo\" match \"CheckIdle\" call" setprop prog "_defs/CheckMaxDisads" "\"$lib/argo\" match \"CheckMaxDisads\" call" setprop prog "_defs/CheckMe" "\"$lib/argo\" match \"CheckMe\" call" setprop prog "_defs/CheckPerqs" "\"$lib/argo\" match \"CheckPerqs\" call" setprop prog "_defs/CheckWimpOut" "\"$lib/argo\" match \"CheckWimpOut\" call" setprop prog "_defs/CheckXPs" "\"$lib/argo\" match \"CheckXPs\" call" setprop prog "_defs/CleanString" "\"$lib/argo\" match \"CleanString\" call" setprop prog "_defs/ClearBank" "\"$lib/argo\" match \"ClearBank\" call" setprop prog "_defs/Combat?" "\"$lib/argo\" match \"Combat?\" call" setprop prog "_defs/ComCheck" "\"$lib/argo\" match \"ComCheck\" call" setprop prog "_defs/CopyDir" "\"$lib/argo\" match \"CopyDir\" call" setprop prog "_defs/CopyDir-r" "\"$lib/argo\" match \"CopyDir-r\" call" setprop prog "_defs/CopyProp" "\"$lib/argo\" match \"CopyProp\" call" setprop prog "_defs/CountUse" "\"$lib/argo\" match \"CountUse\" call" setprop prog "_defs/CreateBot" "\"$lib/argo\" match \"CreateBot\" call" setprop prog "_defs/CreateCreature" "\"$lib/argo\" match \"CreateCreature\" call" setprop prog "_defs/CreateObject" "\"$lib/argo\" match \"CreateObject\" call" setprop prog "_defs/Credit" "\"$lib/argo\" match \"Credit\" call" setprop prog "_defs/DeadCheck" "\"$lib/argo\" match \"DeadCheck\" call" setprop prog "_defs/Dice" "\"$lib/argo\" match \"Dice\" call" setprop prog "_defs/Disabled?" "\"$lib/argo\" match \"Disabled?\" call" setprop prog "_defs/DoDisable" "\"$lib/argo\" match \"DoDisable\" call" setprop prog "_defs/DoEnable" "\"$lib/argo\" match \"DoEnable\" call" setprop prog "_defs/DoVersion" "\"$lib/argo\" match \"DoVersion\" call" setprop prog "_defs/EditList" "\"$lib/argo\" match \"EditList\" call" setprop prog "_defs/Encrypt" "\"$lib/argo\" match \"Encrypt\" call" setprop prog "_defs/EventLoop" "\"$lib/argo\" match \"EventLoop\" call" setprop prog "_defs/ExemptCheck" "\"$lib/argo\" match \"ExemptCheck\" call" setprop prog "_defs/ExpressLowestMoney" "\"$lib/argo\" match " "\"ExpressLowestMoney\" call" strcat setprop prog "_defs/FindNumProp" "\"$lib/argo\" match \"FindNumProp\" call" setprop prog "_defs/FindOther" "\"$lib/argo\" match \"FindOther\" call" setprop prog "_defs/GetBase" "\"$lib/argo\" match \"GetBase\" call" setprop prog "_defs/GetCommandName" "\"$lib/argo\" match \"GetCommandName\" call" setprop prog "_defs/GetCraftSkill" "\"$lib/argo\" match \"GetCraftSkill\" call" setprop prog "_defs/GetDataObj" "\"$lib/argo\" match \"GetDataObj\" call" setprop prog "_defs/GetDenom" "\"$lib/argo\" match \"GetDenom\" call" setprop prog "_defs/GetEnduranceAdv" "\"$lib/argo\" match \"GetEnduranceAdv\" call" setprop prog "_defs/GetMagResAdv" "\"$lib/argo\" match \"GetMagResAdv\" call" setprop prog "_defs/GetModAbility" "\"$lib/argo\" match \"GetModAbility\" call" setprop prog "_defs/GetPhysSkill" "\"$lib/argo\" match \"GetPhysSkill\" call" setprop prog "_defs/GetPsiResAdv" "\"$lib/argo\" match \"GetPsiResAdv\" call" setprop prog "_defs/GetRoomMods" "\"$lib/argo\" match \"GetRoomMods\" call" setprop prog "_defs/GetScope" "\"$lib/argo\" match \"GetScope\" call" setprop prog "_defs/GetScopeRoom" "\"$lib/argo\" match \"GetScopeRoom\" call" setprop prog "_defs/GetToughnessAdv" "\"$lib/argo\" match \"GetToughnessAdv\" call" setprop prog "_defs/GetTurnLength" "\"$lib/argo\" match \"GetTurnLength\" call" setprop prog "_defs/IsScope?" "\"$lib/argo\" match \"IsScope?\" call" setprop prog "_defs/KillLoop" "\"$lib/argo\" match \"KillLoop\" call" setprop prog "_defs/Line72" "\"$lib/argo\" match \"Line72\" call" setprop prog "_defs/LPad" "\"$lib/argo\" match \"LPad\" call" setprop prog "_defs/Magic?" "\"$lib/argo\" match \"Magic?\" call" setprop prog "_defs/MakeDbref" "\"$lib/argo\" match \"MakeDbref\" call" setprop prog "_defs/MatchStat" "\"$lib/argo\" match \"MatchStat\" call" setprop prog "_defs/Materials?" "\"$lib/argo\" match \"Materials?\" call" setprop prog "_defs/MoveDir" "\"$lib/argo\" match \"MoveDir\" call" setprop prog "_defs/MoveDir-r" "\"$lib/argo\" match \"MoveDir-r\" call" setprop prog "_defs/MoveProp" "\"$lib/argo\" match \"MoveProp\" call" setprop prog "_defs/NukeStack" "\"$lib/argo\" match \"NukeStack\" call" setprop prog "_defs/Pad" "\"$lib/argo\" match \"Pad\" call" setprop prog "_defs/ParseTimeInt" "\"$lib/argo\" match \"ParseTimeInt\" call" setprop prog "_defs/ParseTimeString" "\"$lib/argo\" match \"ParseTimeString\" call" setprop prog "_defs/PresenceRoll" "\"$lib/argo\" match \"PresenceRoll\" call" setprop prog "_defs/PsiabTell" "\"$lib/argo\" match \"PsiabTell\" call" setprop prog "_defs/Psionics?" "\"$lib/argo\" match \"Psionics?\" call" setprop prog "_defs/QCheck" "\"$lib/argo\" match \"QCheck\" call" setprop prog "_defs/ReadAbilitySet" "\"$lib/argo\" match \"ReadAbilitySet\" call" setprop prog "_defs/ReadLine" "\"$lib/argo\" match \"ReadLine\" call" setprop prog "_defs/ReadYesNo" "\"$lib/argo\" match \"ReadYesNo\" call" setprop prog "_defs/RecOldActions" "\"$lib/argo\" match \"RecOldActions\" call" setprop prog "_defs/Relock" "\"$lib/argo\" match \"Relock\" call" setprop prog "_defs/RepairObject" "\"$lib/argo\" match \"RepairObject\" call" setprop prog "_defs/RemoveCommand" "\"$lib/argo\" match \"RemoveCommand\" call" setprop prog "_defs/RemoveDir" "\"$lib/argo\" match \"RemoveDir\" call" setprop prog "_defs/RemoveDir-r" "\"$lib/argo\" match \"RemoveDir-r\" call" setprop prog "_defs/RemoveList" "\"$lib/argo\" match \"RemoveList\" call" setprop prog "_defs/RollCreate" "\"$lib/argo\" match \"RollCreate\" call" setprop prog "_defs/RollMake" "\"$lib/argo\" match \"RollMake\" call" setprop prog "_defs/RollRepair" "\"$lib/argo\" match \"RollRepair\" call" setprop prog "_defs/RollXPs" "\"$lib/argo\" match \"RollXPs\" call" setprop prog "_defs/SetArgoDefaults" "\"$lib/argo\" match \"SetArgoDefaults\" call" setprop prog "_defs/SetWait" "\"$lib/argo\" match \"SetWait\" call" setprop prog "_defs/SpellNum" "\"$lib/argo\" match \"SpellNum\" call" setprop prog "_defs/SpellTell" "\"$lib/argo\" match \"SpellTell\" call" setprop prog "_defs/ShowList" "\"$lib/argo\" match \"ShowList\" call" setprop prog "_defs/Sort" "\"$lib/argo\" match \"Sort\" call" setprop prog "_defs/StaffCheck" "\"$lib/argo\" match \"StaffCheck\" call" setprop prog "_defs/TellRoom" "\"$lib/argo\" match \"TellRoom\" call" setprop prog "_defs/TellWait" "\"$lib/argo\" match \"TellWait\" call" setprop prog "_defs/TimeSet" "\"$lib/argo\" match \"TimeSet\" call" setprop prog "_defs/Tools?" "\"$lib/argo\" match \"Tools?\" call" setprop prog "_defs/UnAbbreviateStat" "\"$lib/argo\" match " "\"UnAbbreviateStat\" call" strcat setprop prog "_defs/UnSpellNum" "\"$lib/argo\" match \"UnSpellNum\" call" setprop prog "_defs/Update" "\"$lib/argo\" match \"Update\" call" setprop prog "_defs/UseMaterials" "\"$lib/argo\" match \"UseMaterials\" call" setprop prog "_defs/UseTools" "\"$lib/argo\" match \"UseTools\" call" setprop prog "_defs/VerifyClass" "\"$lib/argo\" match \"VerifyClass\" call" setprop prog "_defs/VerifyCombat" "\"$lib/argo\" match \"VerifyCombat\" call" setprop prog "_defs/VerifyObject" "\"$lib/argo\" match \"VerifyObject\" call" setprop prog "_defs/VerifyTarget" "\"$lib/argo\" match \"VerifyTarget\" call" setprop prog "_defs/VerTell" "\"$lib/argo\" match \"VerTell\" call" setprop ">> Setting miscellaneous bits... " Tell GetDataObj "@a/dis-ad/Status" "0" setprop GetDataObj "@a/dis-ad/Wealth" "0" setprop ">> Installation complete." Tell ; . c q @set lib-argo=W @set lib-argo=L