@q @program asys-eventmgr 1 99999 d i ( asys-eventmgr v1.2 Jessy @ FurryMUCK 6/00 This program handles Argo event loops: the background process controlling the coded effects of skills, spells, and psionic abilities. INSTALLATION: Asys-eventmgr uses the standard Argo installation method. Port the program and set it Wizard. Type '+install asys-eventmgr' USAGE: Asys-eventmgr is not invoked directly; it is called by other Argo programs. Asys-eventmgr 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 ourTarget (* dbref: dbref of target player|obj *) lvar scratch (* workspace var *) lvar toldPause (* int: marks whether we need to notify of pause *) : 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..." Tell else ">> Installing..." Tell then (* record 'official' name of prog; remove old links *) prog "@a/name" "asys-eventmgr" setprop RecOldActions #0 "@a/prog_list/asys-eventmgr" prog setprop #0 "@a/calls/eventloop" prog 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 #0 "@a/calls/eventloop" remove_prop #0 "@a/prog_list/" prog "@a/name" getpropstr strcat remove_prop ">> Uninstalled. Please edit the online manual as appropriate." Tell ; : DoKillLoop ( d -- ) (* kill user's events process *) dup "@a/eloop/act" remove_prop "@a/eloop/pid" over over getprop kill pop remove_prop ; : DoTellTired ( -- ) (* notify for exhaustion levels *) me @ "@a/stats/dex" GetModAbility me @ "@a/stats/con" GetModAbility + dup scratch ! me @ "@a/dis-ad/endurance iii" getpropstr if 9 + else me @ "@a/dis-ad/endurance ii" getpropstr if 6 + else me @ "@a/dis-ad/endurance i" getpropstr if 3 + then then then me @ "@a/stats/fat" GetModAbility - dup 0 < if scratch @ -1 * <= if ">> You are exhausted." Tell else ">> You are tired." Tell then else pop then ; : DoRecStr ( -- ) (* de|increment d's str_mod as needed *) dup "@a/stats/str_mod" getpropstr "0" smatch not if "@a/stats/str_mod" over over getpropstr atoi dup 0 < if 1 + else 1 - then intostr setprop else pop then ; : DoRecCon ( -- ) (* de|increment d's con_mod as needed *) dup "@a/stats/con_mod" getpropstr "0" smatch not if "@a/stats/con_mod" over over getpropstr atoi dup 0 < if 1 + else 1 - then intostr setprop else pop then ; : DoRecDex ( -- ) (* de|increment d's dex_mod as needed *) dup "@a/stats/dex_mod" getpropstr "0" smatch not if "@a/stats/dex_mod" over over getpropstr atoi dup 0 < if 1 + else 1 - then intostr setprop else pop then ; : DoRecInt ( -- ) (* de|increment d's int_mod as needed *) dup "@a/stats/int_mod" getpropstr "0" smatch not if "@a/stats/int_mod" over over getpropstr atoi dup 0 < if 1 + else 1 - then intostr setprop else pop then ; : DoRecPre ( -- ) (* de|increment d's pre_mod as needed *) dup "@a/stats/pre_mod" getpropstr "0" smatch not if "@a/stats/pre_mod" over over getpropstr atoi dup 0 < if 1 + else 1 - then intostr setprop else pop then ; : DoRecFatigue ( d -- ) (* decrement d's fatigue level *) "@a/stats/fat" over over getpropstr atoi 1 - dup 0 <= if pop remove_prop else intostr setprop then ; : DoRecStun ( d -- ) (* decrement d's stun level *) "@a/stats/stun" over over getpropstr atoi 1 - dup 0 <= if pop remove_prop else intostr setprop then ; : DoRecover ( d -- ) (* handle all d's recovery events *) dup "@a/stats/stun" getpropstr if dup ">> Recovering stun..." notify dup DoRecStun exit then dup DoRecFatigue dup DoRecStr dup DoRecCon dup DoRecDex dup DoRecInt dup DoRecPre ; : DoClearInjured ( -- ) (* clear injured-this-turn props *) me @ "@a/eloop/injured" remove_prop me @ "@a/eloop/attacked" remove_prop ; : DoNoWeapon ( -- ) (* weapon invalid: notify and reset *) me @ "@a/eloop/weapon" remove_prop me @ "@a/eloop/defmode" getpropstr dup if dup "parry" smatch if me @ "@a/eloop/defmode" "dodge" setprop then else pop then ">> You no longer have a readied weapon." Tell ; : DoNoShield ( -- ) (* shield invalid: notify and reset *) me @ "@a/eloop/shield" remove_prop me @ "@a/eloop/defmode" getpropstr dup if dup "block" smatch if me @ "@a/eloop/defmode" "dodge" setprop then else pop then ">> You no longer have a readied shield." Tell ; : DoNoArmor ( -- ) (* armor invalid: notify and reset *) me @ "@a/eloop/armor" remove_prop ">> You now longer are wearing armor." Tell ; : DoVerifyEquipment ( -- ) (* make sure equipment is still valid *) me @ "@a/eloop/weapon" getprop dup if scratch ! begin scratch @ ok? not if DoNoWeapon break then scratch @ "@a/version" getprop not if DoNoWeapon break then scratch @ location me @ dbcmp not if DoNoWeapon break then scratch @ "@a/broken" getprop if DoNoWeapon break then break repeat else pop then me @ "@a/eloop/shield" getprop dup if scratch ! begin me @ "@a/eloop/weapon" getprop dup if ourDataObj @ "@a/objects/$name/combat/hands" rot "@a/name" getpropstr "$name" subst getpropstr dup if "2" smatch if ">> You cannot use a shield with a two handed weapon." Tell DoNoShield break then else pop then else pop then scratch @ ok? not if DoNoShield break then scratch @ ok? not if DoNoShield break then scratch @ "@a/version" getprop not if DoNoShield break then scratch @ location me @ dbcmp not if DoNoShield break then scratch @ "@a/broken" getprop if DoNoShield break then break repeat else pop then me @ "@a/eloop/armor" getprop dup if scratch ! begin scratch @ ok? not if DoNoArmor break then scratch @ "@a/version" getprop not if DoNoArmor break then scratch @ location me @ dbcmp not if DoNoArmor break then scratch @ "@a/broken" getprop if DoNoArmor break then break repeat else pop then ; : DoHighPriorityChecks ( -- ) (* run checks that affect events *) (* stop clairsentience an other listens that have expired *) #0 "@a/stop_listen" REF-allrefs ourCounter ! (* get listeners *) begin ourCounter @ 0 > while dup ok? if dup "@a/eloop/stop_listen" getprop dup if (* time's up? *) systime < if dup "@a/eloop/listening_to" getprop dup if dup "@a/eloop/listening" 3 pick REF-delete dup "@a/eloop/listening" getpropstr if "_listen/asys-stdpsiabs" remove_prop else pop then #0 "@a/stop_listen" 3 pick REF-delete dup "@a/eloop/stop_listen" remove_prop dup "@a/eloop/listening_to" remove_prop else pop then then else pop then then pop ourCounter @ 1 - ourCounter ! repeat (* relock any locks that got picked *) #0 "@a/relock" REF-allrefs ourCounter ! begin ourCounter @ 0 > while dup ok? if dup "@a/relock_at" getprop dup if systime < if ourDataObj @ "@a/relock_at" 3 pick REF-delete dup Relock then then else #0 "@a/relock" 3 pick REF-delete then pop ourCounter @ 1 - ourCounter ! repeat (* unhide/unvisible anything that's time is up *) #0 "@a/reveal" REF-allrefs ourCounter ! begin ourCounter @ 0 > while dup ok? if dup "@a/reveal_at" getprop dup if systime < if ourDataObj @ "@a/reveal_at" 3 pick REF-delete dup "!D" set dup "@a/hidden" remove_prop dup "@a/invisible" getpropstr if ">> $name reappears." over name "$name" subst TellRoom then dup "@a/invisible" remove_prop then then else #0 "@a/reveal" 3 pick REF-delete then pop ourCounter @ 1 - ourCounter ! repeat (* check +control experations *) #0 "@a/uncontrol" REF-allrefs ourCounter ! begin ourCounter @ 0 > while dup ok? if dup "@a/eloop/controlled" REF-allrefs scratch ! begin scratch @ while dup ok? if dup "@a/eloop/controlling" getprop dup if over dbcmp if dup "@a/eloop/control_expires" getprop dup if systime < if dup "@a/eloop/controlling" remove_prop over "@a/eloop/controlled" 3 pick REF-delete then else pop then then else pop then then pop scratch @ 1 - scratch ! repeat dup "@a/eloop/controlled" getpropstr if #0 "@a/uncontrol" 3 pick REF-delete then else #0 "@a/uncontrol" 3 pick REF-delete then pop ourCounter @ 1 - ourCounter ! repeat (* return moved objects *) #0 "@a/return" REF-allrefs ourCounter ! begin ourCounter @ 0 > while dup ok? if dup "@a/eloop/return_at" getprop dup if systime < if ourDataObj @ "@a/return" 3 pick REF-delete dup "@a/eloop/return_to" getprop dup if over swap moveto else pop dup dup getlink moveto then dup "@a/eloop/return_at" remove_prop dup "@a/eloop/return_to" remove_prop then then else #0 "@a/return" 3 pick REF-delete then pop ourCounter @ 1 - ourCounter ! repeat (* handle high priority recycles *) #0 "@a/recycle" REF-allrefs ourCounter ! begin ourCounter @ 0 > while dup ok? if dup "@a/rec_after" getprop dup if systime < if ourDataObj @ "@a/recycle" 3 pick REF-delete dup recycle then then else #0 "@a/recycle" 3 pick REF-delete then pop ourCounter @ 1 - ourCounter ! repeat ; : DoEventLoop ( -- ) (* run an event loop; act as needed *) background trigger @ "@a/version" getpropstr not if ">> This program must be called from an Argo command." Tell pid kill then me @ "@a/eloop/pid" getprop dup if ispid? if exit then else pop then me @ "@a/eloop/pid" pid setprop begin (* begin event loop *) NukeStack DeadCheck me @ location "@a/eloop/pause" getprop if toldPause @ not if ">> NOTE: Events are currently paused in this room." Tell 1 toldPause ! then ourDataObj @ "@a/sysparms/turn_length" getpropstr atoi sleep continue then 0 toldPause ! ourDataObj @ "@a/sysparms/combat" getpropstr dup if "yes" smatch not if ">> Combat is disabled." Tell ">> Stopping." Tell me @ DoKillLoop pid kill then else pop then DoVerifyEquipment #0 "@a/prog_list/asys-sysscan" getprop dup if "#cleanup" swap call NukeStack else pop then me @ GetTurnLength sleep me @ DoRecover DoTellTired me @ "@a/stats/con" GetModAbility me @ "@a/stats/str" GetModAbility + me @ GetEnduranceAdv + 2 * me @ "@a/stats/fat" getpropstr atoi < if me @ DoRecFatigue continue then me @ awake? not if me @ DoKillLoop pid kill then me @ CheckIdle if me @ DoKillLoop pid kill then me @ "@a/eloop/genmod" remove_prop me @ "@a/stats/stun" getpropstr if NukeStack continue then #0 "@a/calls/turnupkeep" getprop dup if "#turnupkeep" swap call else pop then me @ "@a/eloop/act" getpropstr dup if dup "wait" smatch if NukeStack continue then dup "rest" smatch if me @ DoRecFatigue me @ DoRecFatigue DoClearInjured NukeStack continue then #0 "@a/calls/" 3 pick strcat getprop dup if "#" rot strcat swap call DoClearInjured NukeStack continue else pop then then me @ "@a/stats/fat" getpropstr if me @ "@a/eloop/act" "rest" setprop me @ "@a/eloop/acting" "resting" setprop begin me @ "@a/eloop/act" getpropstr dup if "rest" smatch not if break then else pop exit then me @ DoRecover ourDataObj @ "@a/sysparms/turn_length" getpropstr atoi sleep me @ "@a/stats/fat" getpropstr not if exit then repeat then DoClearInjured repeat (* end event loop *) NukeStack ; : main "me" match me ! (* initialize *) GetDataObj ourDataObj ! strip ourArg ! trig "@a/name" getpropstr ourCom ! ourArg @ if ourArg @ "#" stringpfx if "#eventloop" ourArg @ smatch if DoEventLoop 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 exit then then ; . c q @set asys-eventmgr=W