@q @program asys-make 1 99999 d i ( asys-make v1.2 Jessy@FurryMUCK 6/97, 11/99 This program handles the artisan command +make, used to create Argo objects. INSTALLATION: Asys-make uses the standard Argo installation method. Port the program and set it Wizard. Type '+install asys-make' USAGE: +make .............. Make an instance of Asys-make may be freely ported. Please comment any changes. ) (2345678901234567890123456789012345678901234567890123456789012345678901) $def thisVersion "1.1" $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 ourMaterial (* str: material or tool we're working with *) lvar ourOption (* string: command #option *) lvar ourString (* string: job prop *) 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-make" setprop RecOldActions (* create and register command; set default props *) #0 "+make" newexit dup scratch ! prog setlink prog "@a/version" thisVersion setprop scratch @ "@a/version" thisVersion setprop #0 "@a/comm_list/+make" scratch @ setprop #0 "@a/prog_list/" prog name strcat prog setprop scratch @ "@a/name" "+make" setprop #0 "@a/calls/create_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/+make" RemoveCommand #0 "@a/prog_list/" prog "@a/name" getpropstr strcat remove_prop RecOldActions #0 "@a/calls/create_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 $make command is used to make Argo objects." "+make" GetCommandName "$make" subst Tell " " Tell " $com ............ Make an instance of " command @ "$com" subst Tell "You must have the approriate Abilties, tools, and materials, as " "displayed with '$info object/' in order to make an object." strcat "+info" GetCommandName "$info" subst Tell ; : DoCheckAbilities ( -- i ) (* return true if player has the ability prereqs to make ourArg *) ourDataObj @ scratch @ "prereqs/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 make 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 make that." Tell pop pop 0 exit else ourDataObj @ swap nextprop continue then else me @ over "@a/" scratch @ subst "" "prereqs/" subst getpropstr dup if atoi ourDataObj @ 3 pick getpropstr atoi < if ">> Sorry, you do not have the necessary abilities to make that." Tell pop pop 0 exit then else ">> Sorry, you do not have the necessary abilities to make that." Tell pop pop 0 exit then then then ourDataObj @ swap nextprop repeat pop ourDataObj @ scratch @ "prereqs/skills/" strcat nextprop begin dup while me @ over "@a/" scratch @ subst "" "prereqs/" subst getpropstr dup if atoi ourDataObj @ 3 pick getpropstr atoi < if ">> Sorry, you do not have the necessary abilities to make that." Tell pop pop 0 exit then else ">> Sorry, you do not have the necessary abilities to make that." Tell pop pop 0 exit then ourDataObj @ swap nextprop repeat pop ourDataObj @ scratch @ "prereqs/spells/" strcat nextprop begin dup while me @ over "@a/" scratch @ subst "" "prereqs/" subst getpropstr dup if atoi ourDataObj @ 3 pick getpropstr atoi < if ">> Sorry, you do not have the necessary abilities to make that." Tell pop pop 0 exit then else ">> Sorry, you do not have the necessary abilities to make that." Tell pop pop 0 exit then ourDataObj @ swap nextprop repeat pop ourDataObj @ scratch @ "prereqs/psiabs/" strcat nextprop begin dup while me @ over "@a/" scratch @ subst "" "prereqs/" subst getpropstr dup if atoi ourDataObj @ 3 pick getpropstr atoi < if ">> Sorry, you do not have the necessary abilities to make that." Tell pop pop 0 exit then else ">> Sorry, you do not have the necessary abilities to make that." Tell pop pop 0 exit then ourDataObj @ swap nextprop repeat pop ourDataObj @ scratch @ "prereqs/dis-ad/" strcat nextprop begin dup while me @ over "@a/" scratch @ subst "" "prereqs/" subst getpropstr dup if atoi ourDataObj @ 3 pick getpropstr atoi < if ">> Sorry, you do not have the necessary abilities to make that." Tell pop pop 0 exit then else ">> Sorry, you do not have the necessary abilities to make that." Tell pop pop 0 exit then ourDataObj @ swap nextprop repeat pop 1 ; : DoCheckMakeCost ( s -- i ) (* return true if user can afford to make s *) ourDataObj @ scratch @ "cost" strcat getpropstr dup if me @ swap atoi CheckFunds else pop 1 then ; : DoChargeMakeCost ( s -- ) (* charge funds to make s *) ourDataObj @ scratch @ "cost" strcat getpropstr dup if me @ swap atoi Charge not if ">> ERROR: Unable to charge cost to make." Tell pid kill then else pop then ; : DoMake ( -- ) (* user attempts to make ourArg *) ourArg @ not if (* check: object to make specified? *) ">> Syntax: $command " command @ "$command" subst Tell exit then (* check: object exists? can be made? *) ourArg @ VerifyObject if "@a/objects/$object/create/" ourArg @ CapAll "$object" subst scratch ! else ">> Sorry, object not found." Tell exit then (* check: user can make? has tools? has materials? *) DoCheckAbilities not if exit then scratch @ "tools/" strcat Tools? not if ">> You don't have the tools needed to make that." Tell exit then scratch @ "materials/" strcat Materials? not if ">> You don't have the materials needed to make that." Tell exit then DoCheckMakeCost not if ">> You don't have the funds needed to make that." Tell exit then (* passed all checks. So... *) DoChargeMakeCost (* 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 "create_object," ourArg @ strcat setprop ">> Set." Tell ourDataObj @ scratch @ "rolls/" strcat nextprop if ">> Rolls to see if your attempt to make $object succeeds will be made" ourArg @ "$object" subst Tell " in $time." swap ParseTimeInt "$time" subst Tell else ">> Object will be created in $time." swap ParseTimeInt "$time" subst Tell then else me @ ourArg @ CapAll RollMake if me @ ourArg @ CapAll CreateObject if ">> Your attempt to make $object succeeds." ourArg @ CapAll "$object" subst Tell else ">> Your attempt to make $object fails." ourArg @ CapAll "$object" subst Tell then else ">> Your attempt to make $object fails." ourArg @ CapAll "$object" subst Tell 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 DoMake ; . c q @set asys-make=W