@q @program asys-guard 1 99999 d i ( asys-guard v1.2 Jessy@FurryMUCK 6/00 This program controls the Argo +guard and +unguard commands. INSTALLATION: asys-guard uses the standard Argo installation method. Port the program and set it Wizard. Type '+install asys-guard' USAGE: +guard ............. Set: you are guarding +guard #ally .... Set: is an Ally +guard #!ally ... Set: is not an Ally +unguard ................. Set: you are not guarding anything asys-guard may be freely ported. Please comment any changes. ) (2345678901234567890123456789012345678901234567890123456789012345678901) $def thisVersion "1.2" $define Tell me @ owner swap notify $enddef $include $lib/argo $include $lib/reflist lvar ourArg (* inital arg string, unmodified *) lvar ourBoolean (* int: misc flow control var *) lvar ourCom (* string: 'official' name of command *) lvar ourCounter (* misc. counter var *) lvar ourDataObj (* dbref: object holding system-wide data *) lvar ourLocation (* dbref: room containing guarded obj *) lvar ourObject (* dbref: object being guarded *) lvar ourOption (* string: command #option *) lvar scratch (* workspace var *) : DoInstall ( -- ) (* install program into Argo system *) caller program? not if (* confirm installation method *) ">> Programs must be installed via the " "+install" GetCommandName strcat " command." strcat Tell exit then prog "@a/version" getpropstr if ">> Reinstalling..." Tell else ">> Installing..." Tell then (* record 'official' name of prog; remove old links *) prog "@a/name" "asys-guard" setprop RecOldActions (* create and register command; set default props *) #0 "+guard" newexit dup scratch ! prog setlink prog "@a/version" thisVersion setprop scratch @ "@a/version" thisVersion setprop #0 "@a/comm_list/+guard" scratch @ setprop #0 "@a/prog_list/" prog name strcat prog setprop scratch @ "@a/name" "+guard" setprop #0 "+unguard" newexit dup scratch ! prog setlink prog "@a/version" thisVersion setprop scratch @ "@a/version" thisVersion setprop #0 "@a/comm_list/+unguard" scratch @ setprop #0 "@a/prog_list/" prog name strcat prog setprop scratch @ "@a/name" "+unguard" setprop #0 "@a/calls/checkguard" prog setprop #0 "_reg/asys-guard" prog setprop prog "L" set ">> Installed." Tell ; : DoUninstall (* uninstall program from Argo *) prog "@a/name" getpropstr if #0 "@a/prog_list/" prog "@a/name" getpropstr strcat getprop not if ">> " prog name strcat " is not currently installed." strcat Tell pid kill then else ">> " prog name strcat " is not currently installed." strcat Tell pid kill then ">> Please confirm: You wish to uninstall " prog name strcat "?" strcat Tell ReadYesNo not if ">> Aborted." Tell pid kill Then background "@a/comm_list/+guard" RemoveCommand #0 "@a/prog_list/" prog "@a/name" getpropstr strcat remove_prop RecOldActions #0 "@a/comm_list/+unguard" over over getprop dup string? if "" "go to " subst #0 "@a/comm_list/" rot strcat over over getprop recycle remove_prop else recycle then remove_prop #0 "@a/prog_list/" prog "@a/name" getpropstr strcat remove_prop #0 "@a/calls/checkguard" remove_prop ">> Uninstalled. Please edit the online manual as appropriate." Tell ; : DoHelp ( -- ) (* display help screen *) " " Tell prog name " (#" strcat prog intostr strcat ")" strcat Tell " " Tell "The $guard command is used to guard players, exits, or objects. If you " "are guarding a player, he or she cannot be attacked with melee " "weapons, except by someone who is your Ally. If you are guarding an " "exit, it may not be used except by someone who is your Ally. If you " "are guarding a thing, it may not be picked up except by someone who is " "your Ally. If you are stunned, you are not able to guard. To stop " "guarding, use the $unguard command." strcat strcat strcat strcat strcat strcat "+guard" GetCommandName "$guard" subst "+unguard" GetCommandName "$unguard" subst Tell " " Tell "Syntax: $guard ............. Set: you are guarding " "+guard" GetCommandName "$guard" subst Tell " $guard #ally .... Set: is an Ally" "+guard" GetCommandName "$guard" subst Tell " $guard #!ally ... Set: is not an Ally" "+guard" GetCommandName "$guard" subst Tell " $unguard ................. Set: you are not guarding anything" "+unguard" GetCommandName "$unguard" subst Tell " " Tell ; : DoPopRefs ( d .. d' -- ) (* pop X dbrefs; x = ourCounter *) begin ourCounter @ while pop ourCounter @ 1 - ourCounter ! repeat ; : DoFindThis ( s -- d ) (* return dbref of s *) match dup #-1 dbcmp if ">> I don't see that here." Tell exit then dup #-2 dbcmp if ">> Ambiguous. I don't know which one you mean!" Tell exit then dup #-3 dbcmp if ">> I don't see that here." Tell pop #-1 exit then dup player? over "Z" flag? or if dup "@a/version" getpropstr not if ">> $name is not Argo enabled." swap name "$name" subst Tell #-1 exit then then dup me @ dbcmp if ">> Sorry, you can't $act yourself." ourBoolean @ if "ally with" else "guard" then "$act" subst Tell pop #-1 exit then ; : DoVerifyGuardName ( -- ) (* make sure _argoguard is ok *) ourObject @ "@a/eloop/guarded" getpropstr if ourObject @ "@a/eloop/guarded" REF-allrefs ourCounter ! ourObject @ "_argoguard" 3 pick name setprop DoPopRefs then ; : DoGetLocation ( d -- d' ) (* return room containing guarded obj *) dup player? if location exit then dup thing? if location exit then dup exit? if dup location dup room? if swap pop exit else location dup room? if swap pop exit else pop pop #-1 exit then then then ; : DoAlly ( -- ) (* set ourArg as an ally *) ourArg @ if 1 ourBoolean ! (* for output formatting in DoFindThis *) ourArg @ DoFindThis dup if me @ "@a/store/allies" 3 pick REF-add ">> Set. $name is now an Ally." swap name "$name" subst Tell else pop then else ">> Current Allies:" me @ "@a/store/allies" getpropstr if me @ "@a/store/allies" REF-list strcat then Tell then ; : DoNoAlly ( -- ) (* set ourArg as not an ally *) ourArg @ if 1 ourBoolean ! (* for output formatting in DoFindThis *) ourArg @ DoFindThis dup if me @ "@a/store/allies" 3 pick REF-delete ">> Set. $name is now not an Ally." swap name "$name" subst Tell else pop then else ">> Current Allies:" me @ "@a/store/allies" getpropstr if me @ "@a/store/allies" REF-list strcat then Tell then ; : DoUnGuard ( -- ) (* user stops guarding *) me @ "@a/eloop/guarding" getprop dup if ourObject ! else ">> You weren't guarding anything." Tell pop exit then me @ "@a/eloop/guarding" remove_prop ourObject @ "@a/eloop/guarded" me @ REF-delete ourObject @ "@a/eloop/guarded" getpropstr not if ourObject @ Relock then ">> You are no longer guarding $name." ourObject @ exit? if ourObject @ name dup ";" instr if dup ";" instr 1 - strcut pop then else ourObject @ name then "$name" subst Tell me @ location ourObject @ location dbcmp if ourObject @ ">> You are no longer being guarded by $name." me @ name "$name" subst ourObject @ "@a/store/veron" getprop if ourObject @ "@a/store/verstring" getpropstr strcat then notify then DoVerifyGuardName ; : DoGuard ( -- ) (* set: user is guarding ourArg *) ourArg @ if ourArg @ DoFindThis dup if ourObject ! else pop exit then ourObject @ "@a/eloop/guarding" getprop dup if ">> $name is guarding $type." ourObject @ name "$name" subst swap player? if "someone" else "something" then "$type" subst Tell ">> Cannot guard until $name stops guarding." ourObject @ name "$name" subst Tell NukeStack exit else pop then me @ "@a/eloop/guarding" getprop dup if dup location me @ location dbcmp if ">> You are no longer being guarded by $name." me @ name "$name" subst over "@a/store/veron" getprop if over "@a/store/verstring" getpropstr strcat then notify then else pop then me @ "@a/eloop/guarding" ourObject @ setprop ourObject @ "@a/eloop/guarded" me @ REF-add ourObject @ player? not if ourObject @ "@a/lok" getprop not if ourObject @ "_/lok" getprop if ourObject @ "@a/lok" ourObject @ "_/lok" getprop setprop then then ourObject @ "_/fl" getprop dup if ">> {name:this} is being guarded" "{if:{prop:_argoguard,this}, by {prop:_argoguard,this}.,.}" smatch not if pop ourObject @ "@a/fl" getprop not if ourObject @ "@a/fl" ourObject @ "_/fl" getprop setprop then then else pop then ourObject @ "_/lok" "$asys-guard" parselock setprop ourObject @ "_/fl" ">> {name:this} is being guarded" "{if:{prop:_argoguard,this}, by {prop:_argoguard,this}.,.}" strcat setprop ourObject @ "_argoguard" me @ name setprop then ">> You are now guarding $name." ourObject @ exit? if ourObject @ name dup ";" instr if dup ";" instr 1 - strcut pop then else ourObject @ name then "$name" subst Tell ourObject @ ">> You are now being guarded by $name." me @ name "$name" subst ourObject @ "@a/store/veron" getprop if ourObject @ "@a/store/verstring" getpropstr strcat then notify else ">> Syntax: $command " command @ "$command" subst Tell then DoVerifyGuardName ; : DoCheckGuard ( d1 -- d2 ) (* return dbref of obj guarding 21 *) ourObject ! ourObject @ not if #-1 exit then ourObject @ DoGetLocation dup if ourLocation ! else #-1 exit then ourObject @ "@a/eloop/guarded" me @ REF-inlist? if me @ exit then ourObject @ "@a/eloop/guarded" REF-allrefs ourCounter ! begin ourCounter @ while dup ok? not if dup "@a/eloop/guarding" ourObject @ REF-delete ourObject @ "@a/eloop/guarded" rot REF-delete ourCounter @ 1 - ourCounter ! continue then dup "@a/stats/stun" getprop if pop ourCounter @ 1 - ourCounter ! continue then dup "@a/store/allies" me @ REF-inlist? if pop ourCounter @ 1 - ourCounter ! continue then dup location ourLocation @ dbcmp not if dup "@a/eloop/guarding" ourObject @ REF-delete ourObject @ "@a/eloop/guarded" rot REF-delete ourCounter @ 1 - ourCounter ! continue then dup "@a/version" getpropstr not if dup "@a/eloop/guarding" ourObject @ REF-delete ourObject @ "@a/eloop/guarded" rot REF-delete ourCounter @ 1 - ourCounter ! continue then dup "@a/combat" getpropstr not if dup "@a/eloop/guarding" ourObject @ REF-delete ourObject @ "@a/eloop/guarded" rot REF-delete ourCounter @ 1 - ourCounter ! continue then dup player? if dup awake? not if dup "@a/eloop/guarding" ourObject @ REF-delete ourObject @ "@a/eloop/guarded" rot REF-delete ourCounter @ 1 - ourCounter ! continue then dup CheckIdle if dup "@a/eloop/guarding" ourObject @ REF-delete ourObject @ "@a/eloop/guarded" rot REF-delete ourCounter @ 1 - ourCounter ! continue then then DoVerifyGuardName scratch ! DoPopRefs scratch @ exit repeat ourObject @ "@a/eloop/guarded" getpropstr not if ourObject @ Relock then DoVerifyGuardName #-1 ; : main "me" match me ! (* initialize *) GetDataObj ourDataObj ! strip ourArg ! trig "@a/name" getpropstr ourCom ! Update ourCom @ not if ourArg @ if "#install" ourArg @ stringpfx if DoInstall exit then "#uninstall" ourArg @ stringpfx if DoUninstall exit then then trig DoCheckGuard if 0 else 1 then exit then ourArg @ if ourArg @ "#" stringpfx if ourArg @ " " instr if ourArg @ dup " " instr strcut strip ourArg ! strip ourOption ! else ourArg @ strip ourOption ! then "#checkguard" ourOption @ smatch if DoCheckGuard else "#help" ourOption @ stringpfx if DoHelp else "#ally" ourOption @ stringpfx if DoAlly else "#!ally" ourOption @ stringpfx if DoNoAlly else "#enable" ourOption @ stringpfx if DoEnable else "#disable" ourOption @ stringpfx if DoDisable else "#version" ourOption @ stringpfx if DoVersion else "#install" ourOption @ stringpfx if DoInstall else "#uninstall" ourOption @ stringpfx if DoUninstall else ">> #Argument not understood." Tell then then then then then then then then then exit then then me @ ArgoPermCheck Disabled? VerifyCombat ourCom @ "+guard" smatch if DoGuard exit then ourCom @ "+unguard" smatch if DoUnGuard exit then ">> ERROR: Command not found." Tell ; . c q @set asys-guard=W