@q @program asys-repair 1 99999 d i ( asys-repair v1.2 Jessy@FurryMUCK 6/97, 11/99 This program handles the artisan command +repair, used to repair Argo objects. INSTALLATION: Asys-repair uses the standard Argo installation method. Port the program and set it Wizard. Type '+install asys-repair' USAGE: +repair .............. Repair an instance of Asys-repair 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 ourCom (* string: 'official' name of command *) lvar ourCounter (* misc. counter var *) lvar ourDataObj (* dbref: object holding system-wide data *) lvar ourObject (* dbref: object to repair *) 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 (* confirm re-install *) ">> Reinstalling..." Tell else ">> Installing..." Tell then (* record 'official' name of prog; remove old links *) prog "@a/name" "asys-repair" setprop RecOldActions (* create and register command; set default props *) #0 "+repair" newexit dup scratch ! prog setlink prog "@a/version" thisVersion setprop scratch @ "@a/version" thisVersion setprop #0 "@a/comm_list/+repair" scratch @ setprop #0 "@a/prog_list/" prog name strcat prog setprop scratch @ "@a/name" "+repair" setprop #0 "@a/calls/repair_object" 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 background "@a/comm_list/+repair" RemoveCommand #0 "@a/prog_list/" prog "@a/name" getpropstr strcat remove_prop RecOldActions #0 "@a/calls/repair_object" 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 $repair command is used to repair Argo objects." "+repair" GetCommandName "$repair" subst Tell " " Tell " $com ............ Repair an instance of " command @ "$com" subst Tell "You must have the approriate Abilties, tools, and materials, as " "displayed with '$info object/' in order to repair an object." strcat "+info" GetCommandName "$info" subst Tell ; : DoCheckAbilities ( -- i ) (* return true if player has the ability prereqs to repair ourArg *) ourDataObj @ scratch @ "stats/" strcat nextprop begin dup while dup "*/cra" smatch if ourDataObj @ over getpropstr atoi me @ GetCraftSkill atoi > if ">> Sorry, you do not have the necessary abilities to repair that." Tell pop pop 0 exit else ourDataObj @ swap nextprop continue then else dup "*/phy" smatch if ourDataObj @ over getpropstr atoi me @ GetPhysSkill atoi > if ">> Sorry, you do not have the necessary abilities to repair that." Tell pop pop 0 exit else ourDataObj @ swap nextprop continue then else me @ over "@a/" scratch @ subst getpropstr dup if atoi ourDataObj @ 3 pick getpropstr atoi < if ">> Sorry, you do not have the necessary abilities to repair that." Tell pop pop 0 exit then else ">> Sorry, you do not have the necessary abilities to repair that." Tell pop pop 0 exit then then then ourDataObj @ swap nextprop repeat pop ourDataObj @ scratch @ "skills/" strcat nextprop begin dup while me @ over "@a/" scratch @ subst getpropstr dup if atoi ourDataObj @ 3 pick getpropstr atoi < if ">> Sorry, you do not have the necessary abilities to repair that." Tell pop pop 0 exit then else ">> Sorry, you do not have the necessary abilities to repair that." Tell pop pop 0 exit then ourDataObj @ swap nextprop repeat pop ourDataObj @ scratch @ "spells/" strcat nextprop begin dup while me @ over "@a/" scratch @ subst getpropstr dup if atoi ourDataObj @ 3 pick getpropstr atoi < if ">> Sorry, you do not have the necessary abilities to repair that." Tell pop pop 0 exit then else ">> Sorry, you do not have the necessary abilities to repair that." Tell pop pop 0 exit then ourDataObj @ swap nextprop repeat pop ourDataObj @ scratch @ "psiabs/" strcat nextprop begin dup while me @ over "@a/" scratch @ subst getpropstr dup if atoi ourDataObj @ 3 pick getpropstr atoi < if ">> Sorry, you do not have the necessary abilities to repair that." Tell pop pop 0 exit then else ">> Sorry, you do not have the necessary abilities to repair that." Tell pop pop 0 exit then ourDataObj @ swap nextprop repeat pop ourDataObj @ scratch @ "dis-ad/" strcat nextprop begin dup while me @ over "@a/" scratch @ subst getpropstr dup if atoi ourDataObj @ 3 pick getpropstr atoi < if ">> Sorry, you do not have the necessary abilities to repair that." Tell pop pop 0 exit then else ">> Sorry, you do not have the necessary abilities to repair that." Tell pop pop 0 exit then ourDataObj @ swap nextprop repeat pop 1 ; : DoCheckRepairCost ( s -- i ) (* return true if user can afford to repair s *) ourDataObj @ scratch @ "cost" strcat getpropstr dup if me @ swap atoi CheckFunds else pop 1 then ; : DoChargeRepairCost ( s -- ) (* charge funds to repair s *) ourDataObj @ scratch @ "cost" strcat getpropstr dup if me @ swap atoi Charge not if ">> ERROR: Unable to charge cost to repair." Tell pid kill then else pop then ; : DoRepair ( -- ) (* user attempts to repair ourArg *) ourArg @ not if (* check: object to repair specified? *) ">> Syntax: $command " command @ "$command" subst Tell exit then (* check: object exists? can be made? *) ourArg @ VerifyObject if "@a/objects/$object/repair/" ourArg @ CapAll "$object" subst scratch ! else ">> Sorry, object not found." Tell exit then ourArg @ match dup #-1 dbcmp if ">> Sorry, object not found." Tell pop exit then dup #-2 dbcmp if ">> Ambiguous. I don't know which one you mean!" Tell pop exit then dup #-3 dbcmp if ">> Sorry, object not found." Tell pop exit then ourObject ! (* check: does it need repaired? *) ourObject @ "@a/broken" getpropstr not if ">> $object isn't broken." ourObject @ name "$object" subst Tell exit then (* check: user can repair? has tools? has materials? *) DoCheckAbilities not if exit then scratch @ "tools/" strcat Tools? not if ">> You don't have the tools needed to repair that." Tell exit then scratch @ "materials/" strcat Materials? not if ">> You don't have the materials needed to repair that." Tell exit then DoCheckRepairCost not if ">> You don't have the funds needed to repair that." Tell exit then (* passed all checks. So... *) DoChargeRepairCost (* spend needed funds *) scratch @ "materials/" strcat UseMaterials (* use up materials *) ourDataObj @ scratch @ "time" strcat getprop dup if me @ "@a/events/" 3 pick systime + intostr strcat "repair_object," ourObject @ intostr strcat setprop ">> Set." Tell ourDataObj @ scratch @ "rolls/" strcat nextprop if ">> Rolls to see if your attempt to repair $object succeeds will be made" ourArg @ "$object" subst Tell " in $time." swap ParseTimeInt "$time" subst Tell else ">> Object will be repaired in $time." swap ParseTimeInt "$time" subst Tell then else me @ ourArg @ CapAll RollRepair if ourObject @ intostr RepairObject if ">> Your attempt to repair $object succeeds." ourArg @ CapAll "$object" subst Tell else ">> Your attempt to repair $object fails." ourArg @ CapAll "$object" subst Tell then then then ; : main "me" match me ! (* initialize *) GetDataObj ourDataObj ! strip ourArg ! trig "@a/name" getpropstr ourCom ! Update ourArg @ if ourArg @ "#" stringpfx if ourArg @ " " instr if ourArg @ dup " " instr strcut strip ourArg ! strip ourOption ! else ourArg @ strip ourOption ! then "#help" ourOption @ stringpfx if DoHelp 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 exit then then me @ ArgoPermCheck Disabled? DeadCheck DoRepair ; . c q @set asys-repair=W