@q @program asys-check 1 99999 d i ( asys-check v1.2 Jessy @ FurryMUCK 6/00 This program controls the Argo +check command, which is used to verify the nature of Argo objects and to get basic event information about Argo players. INSTALLATION: Asys-check uses the standard Argo installation method. Port the program and set it Wizard. Type '+install asys-check' USAGE: +check ...................... Show basic info about yourself +check ............. Show basic info about +check ............. Show basic info about +check 's .. Show basic info about +check #on .................. Report automatically when injured +check #off ................. Don't report automatically Asys-check may be freely ported. Please comment any changes. ) (2345678901234567890123456789012345678901234567890123456789012345678901) $def thisVersion "1.2" $define Tell me @ owner swap notify $enddef $include $lib/argo lvar scratch (* workspace var *) lvar ourCounter (* misc. counter var *) lvar ourArg (* inital arg string, unmodified *) lvar ourCom (* string: 'official' name of command *) lvar ourObject1 (* string or dbref: primary target *) lvar ourObject2 (* string or dbref: carried target *) lvar ourDataObj (* dbref: dbref of realm env room *) : 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 (* confirm re-install *) ">> Reinstalling..." else ">> Installing..." then Tell (* record 'official' name of prog; remove old links *) prog "@a/name" "asys-check" setprop RecOldActions #0 "+check" newexit dup scratch ! (* create command *) prog setlink prog "@a/version" thisVersion setprop (* set version *) scratch @ "@a/version" thisVersion setprop #0 "@a/comm_list/+check" scratch @ setprop (* register command *) #0 "@a/prog_list/" prog name strcat prog setprop scratch @ "@a/name" "+check" setprop ">> 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/+check" RemoveCommand #0 "@a/prog_list/" prog "@a/name" getpropstr strcat remove_prop RecOldActions ">> Uninstalled. Please edit the online manual as appropriate." Tell ; : DoHelp ( -- ) (* display help screen *) " " Tell prog name " (#" strcat prog intostr strcat ")" strcat Tell " " Tell "This command is used to verify the nature of Argo objects and to " "get basic event information about Argo players." strcat Tell " " Tell "Syntax:" Tell " " Tell " $com ...................... Show basic info about yourself" command @ "$com" subst Tell " $com ............. Show basic info about " command @ "$com" subst Tell " $com ............. Show basic info about " command @ "$com" subst Tell " $com 's .. Show basic info about " command @ "$com" subst Tell " $com #on .................. Report automatically when you are injured" command @ "$com" subst Tell " $com #off ................. Don't report automatically" command @ "$com" subst Tell " " Tell ; : DoMatchObject ( s -- d ) (* matches s; kills process if not found *) match dup #-1 dbcmp if ">> Sorry, I don't see that." Tell pid kill then dup #-2 dbcmp if ">> Sorry, I don't know which one you mean." Tell pid kill then ; : DoGetFatLevel ( -- s ) (* get and format fatigue info for player *) ourObject1 @ "@a/stats/fat" getpropstr dup if atoi ourObject1 @ "@a/stats/con" GetModAbility ourObject1 @ "@a/stats/str" GetModAbility + dup 3 pick - over 2 / > if pop pop "rested" exit then dup 3 pick - 0 > if pop pop "a bit tired" exit then dup 3 pick - over 2 / -1 * > if pop pop "tired" exit else pop pop "exhausted" exit then else pop "rested" then ; : DoGetDamLevel ( -- s ) (* get and format damage info for player *) ourObject1 @ "@a/stats/dam" getpropstr dup if atoi ourObject1 @ "@a/stats/con" GetModAbility dup 3 pick - over 2 / > if pop pop "pretty healthy" exit then dup 3 pick - 0 > if pop pop "slightly injured" exit then dup 3 pick - over 2 / -1 * > if pop pop "injured" exit else pop pop "seriously injured" exit then else pop "healthy" then ; : DoCheckPlayer ( -- ) (* show info about a player *) ourObject1 @ me @ dbcmp if CheckMe exit then ourObject1 @ "@a/version" getpropstr if ourObject1 @ "@a/status" getpropstr "dead" smatch if ">> $name is dead!" ourObject1 @ name "$name" subst Tell exit then ourObject1 @ "@a/combat" getpropstr if ourObject1 @ name scratch ! ">> $name is an Argo player ('combat ok')." ourObject1 @ player? not if "puppet" "player" subst then scratch @ "$name" subst Tell ourObject1 @ "@a/eloop/weapon" getprop if ourObject1 @ ">> %S is armed." pronoun_sub else ourObject1 @ ">> %S is unarmed." pronoun_sub then Tell ourObject1 @ "@a/eloop/armor" getprop ourObject1 @ "@a/eloop/shield" getprop or if ourObject1 @ ">> %S is armored." pronoun_sub else ourObject1 @ ">> %S is not armored." pronoun_sub then Tell ourObject1 @ "@a/eloop/acting" getprop dup if ourObject1 @ ">> %S is $action." pronoun_sub swap "$action" subst Tell then ourObject1 @ "@a/eloop/target" getprop dup if ourObject1 @ ">> %S is targeting $name." pronoun_sub swap name "$name" subst else pop ourObject1 @ ">> %S is not targeting anyone." pronoun_sub then Tell ourObject1 @ ">> %S looks $fat and $dam." pronoun_sub DoGetFatLevel "$fat" subst DoGetDamLevel "$dam" subst Tell else ">> $name is an Argo player (not 'combat ok')." ourObject1 @ name "$name" subst Tell then else ">> $name is not an Argo player." ourObject1 @ name "$name" subst Tell then ; : DoCheckAt ( -- ) (* check a carried object *) ourObject1 @ FindOther ourObject1 ! (* find player *) ourObject1 @ contents (* find object *) begin dup while dup name ourObject2 @ smatch if (* show object info *) dup "@a/version" getpropstr if ourDataObj @ "@a/objects/$name/masked" 3 pick "@a/name" getpropstr "$name" subst getpropstr StaffCheck not and if ">> $name's $object is an Argo object." ourObject1 @ name "$name" subst swap name "$object" subst Tell exit then dup "@a/name" getpropstr dup if ">> $name's $object is an Argo-created object of type $type." swap "$type" subst swap name "$object" subst ourObject1 @ name "$name" subst Tell exit else pop ">> $name's $object is an Argo object." swap name "$object" subst ourObject1 @ name "$name" subst Tell exit then else ">> $name's $object is not an Argo object." ourObject1 @ name "$name" subst swap name "$object" subst Tell exit then then next repeat pop ">> $name is not carrying that." ourObject1 @ name "$name" subst Tell ; : DoCheckThing ( -- ) (* show info about an object *) ourObject1 @ dup "@a/version" getpropstr if dup "Z" flag? over "@a/stats/dex" getpropstr and if DoCheckPlayer exit then ourDataObj @ "@a/objects/$name/masked" 3 pick "@a/name" getpropstr "$name" subst getpropstr StaffCheck not and if ">> $object is an Argo object." swap name "$object" subst Tell exit then dup "@a/name" getpropstr dup if ">> $object is an Argo-created object of type $type." swap "$type" subst swap name "$object" subst Tell else pop ">> $object is an Argo object." swap name "$object" subst Tell then else ">> $object is not an Argo object." ourObject1 @ name "$name" subst Tell then ; : DoCheck ( -- ) (* check a player or object's Argo status *) ourArg @ not if me @ name ourArg ! then ourArg @ "'s" instr if ourArg @ dup "'s" instr 1 + strcut strip ourObject2 ! dup strlen 2 - strcut pop strip ourObject1 ! else ourArg @ strip ourObject1 ! then ourObject2 @ if DoCheckAt exit else ourObject1 @ DoMatchObject ourObject1 ! ourObject1 @ player? if DoCheckPlayer else ourObject1 @ thing? if DoCheckThing else ">> Sorry, I don't know how to check that." Tell exit then then then ; : DoCheckOn ( -- ) (* set auto notifies 'on' *) me @ "@a/eloop/check" "on" setprop ">> You will recieve notifications when your damage level changes." ">> Auto-check 'on'." Tell Tell ; : DoCheckOff ( -- ) (* set auto notifies 'off' *) me @ "@a/eloop/check" remove_prop ">> You will not receive notifications when your damage level changes." ">> Auto-check 'off'." Tell Tell ; : main "me" match me ! (* initialize *) GetDataObj ourDataObj ! strip ourArg ! trig "@a/name" getpropstr ourCom ! ourArg @ if ourArg @ "#" stringpfx if "#on" ourArg @ stringpfx if DoCheckOn else "#off" ourArg @ stringpfx if DoCheckOff else "#yes" ourArg @ stringpfx if DoCheckOn else "#no" ourArg @ stringpfx if DoCheckOff else "#help" ourArg @ stringpfx if DoHelp else "#enable" ourArg @ stringpfx if DoEnable else "#disable" ourArg @ stringpfx if DoDisable else "#version" ourArg @ stringpfx if DoVersion else "#install" ourArg @ stringpfx if DoInstall else "#uninstall" ourArg @ stringpfx if DoUninstall else ">> #Argument not understood." Tell then then then then then then then then then then exit then then me @ ArgoPermCheck Disabled? DoCheck ; . c q @set asys-check=W