@q @program asys-stats 1 99999 d i ( asys-stats v1.2 Jessy@FurryMUCK 6/97, 2/99 asys-stats runs Argo +stats command, adjusting a player's Argo character statistics. INSTALLATION: asys-stats uses the default Argo installation method. Port and install lib-Argo. Set asys-Sheet W. Type '+install asys-stats' to install this program and its actions. USAGE: Type +stats and follow prompts. +Stats follows the character generation rules of the Argo system. Only primary stats may be directly manipulated. Stats may be lowered only before character approval or while set 'exempt'. Raising a stat costs 1 point before character approval, and 3 points after that. Reducing a stat 'buys back' the appropriate amount of points. Stats may not be set lower than the sysparm min_stats unless the player is set 'exempt'. See lib-Argo and the Argo manual for further information. asys-stats may be freely ported. Please comment any changes. ) (2345678901234567890123456789012345678901234567890123456789012345678901) $def thisVersion "1.2" $define Tell me @ owner swap notify $enddef $include $lib/argo lvar lib (* dbref of lib-Argo *) lvar scratch (* workspace var *) lvar ourCounter (* misc. counter var *) lvar ourDataObj (* dbref: object holding system-wide data *) lvar ourArg (* inital arg string, unmodified *) lvar ourCom (* string: 'official' name of command *) : 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-stats" setprop RecOldActions #0 "+stats" newexit dup scratch ! (* create command *) prog setlink prog "@a/version" thisVersion setprop (* set version *) scratch @ "@a/version" thisVersion setprop #0 "@a/comm_list/+stats" scratch @ setprop (* register command *) #0 "@a/prog_list/" prog name strcat prog setprop scratch @ "@a/name" "+stats" 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/+stats" 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 "asys-Stats \(#" prog intostr strcat "\)" strcat Tell " " Tell "The " command @ strcat " command manipulates your character Stats. Before character approv" "al, Stats may be raised or lowered, at a cost or gain of 1 characte" "r point per level. After character approval, Stats may only be rais" "ed, at a cost of 3 points per level. Stats may not be set lower tha" "n the system parameter min_stats, unless your character's status is" " set 'exempt'." strcat strcat strcat strcat strcat strcat Tell " " Tell "See the Argo manual for further information." Tell ; : DoListStats ( -- ) (* list valid stats *) ">> VALID CHARACTER STATS:" Tell " " Tell "Strength" "Constitution" "Dexterity" "Intelligence" "Presence" 5 3-col ">> adjust: the first one or few letters is sufficient." ">> It is not necessary to type the whole word when entering a stat to" " " Tell Tell Tell ; : DoStats ( -- ) (* adjust user's stats *) (* check: location ok? *) CheckCGRoom not if ">> Sorry, this command must be used in a designated setup room." Tell exit then (* set defaults if needed *) me @ "@a/version" getprop not if ">> Setting your character with default Argo values.... " Tell me @ SetArgoDefaults then (* get stat *) begin (* begin stat-getting loop *) "" "" scratch ! ourCounter ! ">> You have $num available character $noun." me @ "@a/avail/main" getpropstr dup scratch ! "$num" subst scratch @ "1" smatch if "point" else "points" then "$noun" subst Tell ">> What stat do you want to adjust?" Tell ">> [Enter a stat, .l to list choices, or .q to quit]" Tell ReadLine strip QCheck ".list" over stringpfx if DoListStats NukeStack continue then (* check: valid stat? *) "strength" over stringpfx if "str" scratch ! else "constitution" over stringpfx if "con" scratch ! else "dexterity" over stringpfx if "dex" scratch ! else "intelligence" over stringpfx if "int" scratch ! else "presence" over stringpfx if "pre" scratch ! else ">> Sorry, that's not a valid Stat." Tell pop continue then then then then then pop (* get level *) begin (* begin level-getting loop *) ">> To what level do you want to set your " scratch @ UnAbbreviateStat Capitalize strcat "?" strcat Tell ">> [Enter a number, or .q to quit]" Tell ReadLine strip QCheck (* check: valid number? *) dup number? not if ">> Sorry, that's not a number." Tell pop continue then (* convert to int *) dup atoi ourDataObj @ "@a/sysparms/min_stats" getpropstr atoi over > me @ "@a/status" getpropstr "exempt" smatch not and if ">> Sorry, that's below the allowed minimum." Tell pop continue then (* check: lowering after approval? *) me @ "@a/status" getpropstr "na" smatch not if dup me @ "@a/stats/" scratch @ strcat getpropstr atoi < if ">> Sorry, once you have entered play, Stats may not " "be lowered." strcat Tell pop continue then then (* check: going below a floor? *) me @ "@a/stats/" scratch @ strcat "/floor" strcat getpropstr dup if atoi over > if ">> Sorry, that would violate a prerequisite or " "template dependency." strcat Tell pop pop continue then else pop then scratch @ "int" smatch if 0 ourCounter ! GetDataObj ourDataObj ! me @ "@a/skills/" nextprop begin dup while ourDataObj @ over getpropstr dup if "," explode pop pop swap pop atoi dup ourCounter @ > if ourCounter ! else pop then else pop then me @ swap nextprop repeat pop me @ "@a/spells/" nextprop begin dup while ourDataObj @ over getpropstr dup if "," explode pop pop swap pop atoi dup ourCounter @ > if ourCounter ! else pop then else pop then me @ swap nextprop repeat pop me @ "@a/psiabs/" nextprop begin dup while ourDataObj @ over getpropstr dup if "," explode pop pop swap pop atoi dup ourCounter @ > if ourCounter ! else pop then else pop then me @ swap nextprop repeat pop ourCounter @ over > if ">> Sorry, your Abilities require an INT of $int." ourCounter @ intostr "$int" subst Tell pop pop continue then then (* check: can afford? *) me @ "@a/stats/" scratch @ strcat getpropstr atoi - me @ "@a/status" getpropstr "na" smatch not if 3 * then me @ "@a/avail/main" getpropstr atoi swap - dup ourCounter ! 0 < if ">> Sorry, you don't have enough points for that." Tell pop continue else (* checks out: set it *) me @ "@a/stats/" scratch @ strcat rot setprop (* prop *) me @ "@a/avail/main" ourCounter @ intostr setprop (* cost *) ">> Your " scratch @ UnAbbreviateStat strcat " is now " strcat me @ "@a/stats/" scratch @ strcat getpropstr strcat "." strcat Tell break then repeat (* end level-getting loop *) repeat (* end stat-getting loop *) ; : main "me" match me ! (* initialize *) "$lib/argo" match lib ! GetDataObj ourDataObj ! strip ourArg ! trig "@a/name" getpropstr ourCom ! ourArg @ if ourArg @ "#" stringpfx if "#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 exit then then me @ ArgoPermCheck Disabled? DeadCheck DoStats ; . c q @set asys-stats=W