@q @program asys-disads 1 99999 d i ( asys-disads v1.2 Jessy @ FurryMUCK 6/97, 2/99 asys-disads runs Argo +advantages and +disadvantages commands, which are used to set and modify advantages and disadvantages during character generation. INSTALLATION: asys-disads uses the default Argo installation method. Port and install lib-Argo. Set asys-disads W. Type '+install asys-disads' to install this program and its actions. USAGE: +advantages............ Follow prompts to apply new advantages or modify existing ones +disadvantages......... Follow prompts to apply new disadvantages or modify existing ones See lib-Argo and the Argo manual for further information. asys-disads 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 ourDataObj (* dbref: object holding system-wide data *) lvar ourArg (* inital arg string, unmodified *) lvar ourCom (* string: 'official' name of command *) lvar form1 (* string: prop for shapeshift form1 *) lvar form2 (* string: prop for shapeshift form2 *) : 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-disads" setprop RecOldActions (* create, register, and desc commands *) #0 "+advantages" newexit dup scratch ! prog setlink prog "@a/version" thisVersion setprop scratch @ "@a/version" thisVersion setprop #0 "@a/comm_list/+advantages" scratch @ setprop #0 "@a/prog_list/" prog name strcat prog setprop scratch @ "@a/name" "+advantages" setprop #0 "+disadvantages" newexit dup scratch ! prog setlink scratch @ "@a/version" thisVersion setprop #0 "@a/comm_list/+disadvantages" scratch @ setprop #0 "@a/prog_list/" prog name strcat prog setprop scratch @ "@a/name" "+disadvantages" 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/+advantages" RemoveCommand "@a/comm_list/+disadvantages" 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-disads (#" prog intostr strcat ")" strcat Tell " " Tell ourCom @ "+advantages" smatch if "The " command @ strcat " command is used to configure advantages during character generation" ". Advantages are things that work in your favor: status, wealth, con" "tacts, reputation, and inborn abilities. As a part of the character " "generation process, you should specify what form the advantage takes" ", how frequently it comes into play, and how great the benefits are." " The more frequent and beneficial, the more the advantage costs. The" " range of possible costs is 1-6 points. Some advantages may be defin" "ed by the MUCK staff: defined advantages have a pre-set cost, and wi" "ll usually trigger other effects, such as modifications to your abil" "ities. See the Argo Manual for more complete information on advantag" "es." strcat strcat strcat strcat strcat strcat strcat strcat strcat strcat strcat Tell " " Tell "Syntax: " Tell " " Tell " +advantages............ Follow prompts to apply new advantages" Tell " or modify existing ones" Tell " " Tell else "The " command @ strcat " command is used to configure disadvantages during character genera" "tion. Disadvantages are problems -- such as social stigmas, obligat" "tions, or physical or mental handicaps -- acquired before your char" "acter enters play. There are two reasons for taking disadvantages. " "One, they are worth points. Two, if they are well chosen, they make" " the character more interesting and fun to play. As you create your" " character, you should specify what precise form your disadvantages" " take, how severe their effect is, and how often they come into pla" "y. These factors will be the basis for determining the point value " "of the disadvantages. Some disadvantages may be predefined by the M" "UCK staff. Predefined disadvantages have a pre-set point bonus, and" " may trigger modification of your abilities. See the Argo Manual fo" "r more complete information." strcat strcat strcat strcat strcat strcat strcat strcat strcat strcat strcat strcat strcat Tell " " Tell "Syntax: " Tell " " Tell " +advantages............ Follow prompts to apply new advantages" Tell " or modify existing ones" Tell " " Tell then ; : GetTerm ( -- s ) (* return 'advantage' or 'disadvantage' based on command *) trig "@a/name" getpropstr "+advantages" smatch if "advantage" else "disadvantage" then ; : GetMax ( s1 s2 -- s ) (* return num string equal lower of s1 & s2 *) atoi swap atoi over over < if pop intostr else intostr swap pop then ; : GetMin ( s1 s2 -- s ) (* return num string equal higher of s1 & s2 *) atoi swap atoi over over < if intostr swap pop else pop intostr then ; : ListDisads ( -- ) (* show 3-col list of disads *) "ADVANTAGES AND DISADVANTAGES:" Tell "@a/dis-ad/" 3-coln-prop " " Tell ; : SetDefSW ( s -- ) (* set s -- status|wealth -- to defaults *) "@a/dis-ad/" swap strcat (* store category prop *) me @ over getpropstr atoi 8 - (* restore points *) me @ "@a/avail/main" getpropstr atoi swap + me @ "@a/avail/main" rot intostr setprop me @ over getpropstr atoi 8 swap - dup 0 > if me @ "@a/disad_total" getpropstr atoi swap - me @ "@a/disad_total" rot dup 0 < if pop 0 then intostr setprop else pop then me @ swap "8" setprop ; : RemoveDisAdFloor ( -- ) (* remove floors that no longer apply *) me @ "@a/dis-ad/" 3 pick strcat getpropstr atoi 0 <= if ourDataObj @ "@a/dis-ad/" 3 pick strcat "/preqs#/" strcat nextprop dup if begin (* begin floor-removing loop *) dup while ourDataObj @ over getpropstr "," explode pop me @ "@a/" rot strcat "/" strcat rot strcat "/floor" strcat over over 5 rotate atoi 0 swap - ApplyArgoMod over over getpropstr atoi 0 <= if (* strip floors <= 0 *) remove_prop else pop pop then ourDataObj @ swap nextprop repeat (* end floor-removing loop *) pop else pop then then ; : DoShapeShifting ( s -- ) (* get names of the two forms *) ">> NOTE: Form names can later be changed with the $shift command." "+shift" GetCommandName "$shift" subst Tell begin ">> What is the name of your current form?" Tell ">> [Enter a name string, or .q to quit]" Tell ReadLine strip QCheck dup "current" smatch if ">> Please choose a different name." ">> Sorry, the string 'Current' is used internally by this program." Tell Tell pop continue then me @ "@a/shapes/" rot strcat dup form1 ! "1" setprop break repeat begin ">> What is the name of your alternate form?" Tell ">> [Enter a name string, or .q to quit]" Tell ReadLine strip QCheck dup "current" smatch if ">> Please choose a different name." ">> Sorry, the string 'Current' is used internally by this program." Tell Tell pop continue then me @ "@a/shapes/" rot strcat dup form2 ! "2" setprop break repeat me @ "@a/avail/" me @ form1 @ "/avail/" strcat CopyDir me @ "@a/dis-ad/" me @ form1 @ "/dis-ad/" strcat CopyDir me @ "@a/money/" me @ form1 @ "/money/" strcat CopyDir me @ "@a/psiabs/" me @ form1 @ "/psiabs/" strcat CopyDir me @ "@a/skills/" me @ form1 @ "/skills/" strcat CopyDir me @ "@a/spells/" me @ form1 @ "/spells/" strcat CopyDir me @ "@a/stats/" me @ form1 @ "/stats/" strcat CopyDir me @ "@a/bg/" me @ form1 @ "/bg/" strcat CopyDir-r me @ "@a/disad_total" me @ form1 @ "/disad_total" strcat CopyProp me @ "@a/status" me @ form1 @ "/status" strcat CopyProp me @ "@a/avail/" RemoveDir me @ "@a/dis-ad/" RemoveDir me @ "@a/skills/" RemoveDir me @ "@a/spells/" RemoveDir me @ "@a/psiabs/" RemoveDir me @ "@a/stats/" RemoveDir me @ "@a/disad_total" RemoveDir me @ "@a/status" RemoveDir me @ SetArgoDefaults me @ form1 @ "/money/" strcat me @ "@a/money/" CopyDir me @ "@a/dis-ad/Shapeshifting" ourDataObj @ "@a/dis-ad/Shapeshifting" getpropstr setprop me @ "@a/disad_total" ourDataObj @ "@a/dis-ad/Shapeshifting" getpropstr setprop me @ "@a/avail/" me @ form2 @ "/avail/" strcat CopyDir me @ "@a/dis-ad/" me @ form2 @ "/dis-ad/" strcat CopyDir me @ "@a/money/" me @ form2 @ "/money/" strcat CopyDir me @ "@a/psiabs/" me @ form2 @ "/psiabs/" strcat CopyDir me @ "@a/skills/" me @ form2 @ "/skills/" strcat CopyDir me @ "@a/spells/" me @ form2 @ "/spells/" strcat CopyDir me @ "@a/stats/" me @ form2 @ "/stats/" strcat CopyDir me @ "@a/bg/" me @ form2 @ "/bg/" strcat CopyDir-r me @ "@a/disad_total" me @ form2 @ "/disad_total" strcat CopyProp me @ "@a/status" me @ form2 @ "/status" strcat CopyProp me @ "@a/avail/" RemoveDir me @ "@a/dis-ad/" RemoveDir me @ "@a/skills/" RemoveDir me @ "@a/spells/" RemoveDir me @ "@a/psiabs/" RemoveDir me @ "@a/stats/" RemoveDir me @ "@a/disad_total" RemoveDir me @ "@a/status" RemoveDir me @ form2 @ "/avail/" strcat me @ "@a/avail/" CopyDir me @ form2 @ "/dis-ad/" strcat me @ "@a/dis-ad/" CopyDir me @ form2 @ "/money/" strcat me @ "@a/money/" CopyDir me @ form2 @ "/psiabs/" strcat me @ "@a/psiabs/" CopyDir me @ form2 @ "/skills/" strcat me @ "@a/skills/" CopyDir me @ form2 @ "/spells/" strcat me @ "@a/spells/" CopyDir me @ form2 @ "/stats/" strcat me @ "@a/stats/" CopyDir me @ form2 @ "/disad_total" strcat me @ "@a/disad_total" CopyProp me @ form2 @ "/status" strcat me @ "@a/status" CopyProp me @ "@a/avail/main" over over getpropstr atoi ourDataObj @ "@a/dis-ad/Shapeshifting" getpropstr atoi - intostr setprop me @ "@a/shapes/current" form2 @ "" "@a/shapes/" subst setprop ">> You are now in your $form form." form2 @ "" "@a/shapes/" subst "$form" subst Tell ; : DoCodedDisAd ( s -- ) (* apply all settings for coded dis-ad s *) (* check: reselecting a dis-ad? *) me @ "@a/dis-ad/" 3 pick strcat getpropstr if ">> You already have that." Tell ">> Do you want to remove it? (y/n)" Tell ReadYesNo if dup "shapeshifting" smatch if " the Shapeshifting advantage? (y/n)" " are not currently using. Please confirm: You wish to deselect" ">> NOTE: Removing this advantage will delete all info for the form you" Tell Tell Tell ReadYesNo if me @ "@a/shapes/" RemoveDir else ">> Aborted." pop exit then then RemoveDisAdFloor me @ "@a/dis-ad/" 3 pick strcat getpropstr atoi ( 0 swap - ) dup 0 < if me @ "@a/disad_total" getpropstr atoi over + intostr me @ "@a/disad_total" rot setprop then me @ "@a/avail/main" over over getpropstr atoi 4 rotate + intostr setprop me @ "@a/dis-ad/" rot strcat remove_prop ">> Removed." Tell 0 exit then pop 0 exit then (* check: user has enough points? *) ourDataObj @ "@a/dis-ad/" 3 pick strcat getpropstr atoi me @ "@a/avail/main" getpropstr atoi > GetTerm "advantage" smatch and if ">> Sorry, you don't have enough points for that." Tell pop 0 exit then (* check: user has enough disad points left? *) ourDataObj @ "@a/dis-ad/" 3 pick strcat getpropstr atoi dup 0 < if CheckMaxDisads not if exit then else pop then (* set dis-ad *) ourDataObj @ "@a/dis-ad/" 3 pick strcat getpropstr atoi me @ "@a/avail/main" over over getpropstr atoi 4 pick - intostr setprop (* set dis-ad points *) me @ "@a/disad_total" over over getpropstr atoi Abs 4 rotate Abs + intostr setprop me @ "@a/dis-ad/" 3 pick strcat ourDataObj @ "@a/dis-ad/" 5 pick strcat getpropstr setprop dup "shapeshifting" smatch if DoShapeShifting exit then (* check: does this dis-ad have triggers? *) ourDataObj @ "@a/dis-ad/" 3 pick strcat "/trigs#" strcat getprop if ourDataObj @ "@a/dis-ad/" rot strcat "/trigs#/" strcat nextprop begin (* begin trig-applying loop *) dup while ourDataObj @ over getpropstr "," explode pop me @ "@a/" rot strcat "/" strcat rot strip CapAll strcat over over getpropstr atoi 4 rotate atoi + intostr setprop ourDataObj @ swap nextprop repeat (* end trig-applying loop *) then pop 1 ">> Set." Tell ; : DoStatWealth ( -- ) (* adjust status or wealth *) CheckCGRoom not if ">> Sorry, this command mus be used in a designated setup room." Tell exit then scratch @ "poverty" smatch if "wealth" scratch ! then begin (* begin input-reading loop *) ">> What level do you want to select?" scratch @ "" subst Tell ">> [Enter a number between 4 and 14, inclusive, or .q to quit]" Tell ReadLine strip QCheck dup number? not if ">> Sorry, that's not a number." Tell pop continue then dup atoi dup 4 >= swap 14 <= and not if ">> Sorry, that's outside the valid range." Tell pop continue then me @ "@a/avail/main" getpropstr atoi 8 + over atoi < if ">> Sorry, you don't have enough points available for that." Tell pop continue then dup atoi 8 < if 8 over atoi - CheckMaxDisads not if pop continue then then me @ "@a/dis-ad/" scratch @ strcat "/floor" strcat getpropstr dup if me @ "@a/dis-ad/" scratch @ strcat getpropstr atoi over > if ">> Sorry, that would violate a prerequisite or " "template dependency." strcat Tell pop continue then else pop then (* recredit for current setting *) me @ "@a/avail/main" over over getpropstr atoi me @ "@a/dis-ad/" scratch @ strcat getpropstr atoi 8 - + intostr setprop me @ "@a/dis-ad/" scratch @ strcat "8" setprop 8 over atoi - me @ "@a/avail/main" over over getpropstr atoi 4 pick + intostr setprop me @ "@a/dis-ad/" scratch @ strcat rot setprop dup atoi 8 < if 8 over atoi Abs - me @ "@a/disad_total" getpropstr atoi Abs + me @ "@a/disad_total" rot setprop then me @ "@a/dis-ad/" scratch @ strcat 3 pick setprop ">> Set." Tell "Status" scratch @ smatch if (* for Status, we're done *) break then (* allocate funds *) me @ "@a/money/large_coins" ourDataObj @ "@a/sysparms/starting_large_coins" getpropstr setprop me @ "@a/money/small_coins" ourDataObj @ "@a/sysparms/starting_small_coins" getpropstr setprop atoi (* wealth advantage: double money for each level *) dup 8 > if 8 - begin (* begin money-doubling loop *) dup while me @ "@a/money/large_coins" over over getpropstr atoi 2 * intostr setprop me @ "@a/money/small_coins" over over getpropstr atoi 2 * intostr setprop 1 - repeat (* end money-doubling loop *) pop break then (* poverty disadvantage: set per book values *) dup 8 < if dup 7 = if me @ "@a/money/small_coins" over over getpropstr atoi me @ "@a/money/large_coins" getpropstr atoi 100 * + dup 2 / swap 4 / + intostr setprop me @ "@a/money/large_coins" "0" setprop else dup 6 = if me @ "@a/money/small_coins" getpropstr atoi me @ "@a/money/large_coins" getpropstr atoi me @ "@a/money/large_coins" "0" setprop 100 * + 2 / begin dup 100 > while 100 - me @ "@a/money/large_coins" over over getpropstr atoi 1 + intostr setprop repeat me @ "@a/money/small_coins" rot intostr setprop else dup 5 = if me @ "@a/money/large_coins" "0" setprop me @ "@a/money/small_coins" "0" setprop else dup 4 = if me @ "@a/money/large_coins" 0 ourDataObj @ "@a/sysparms/starting_large_coins" getpropstr atoi - intostr setprop me @ "@a/money/small_coins" 0 ourDataObj @ "@a/sysparms/starting_small_coins" getpropstr atoi - intostr setprop else ">> Outside range." Tell then then then then then pop break repeat ; : DoDisAds ( -- ) (* enter interactive session to adjust disads *) (* check: location ok? *) CheckCGRoom not if ">> Sorry, this command must be used in a designated setup room." Tell exit then ExemptCheck not if (* check perm *) ">> Sorry, you cannot select " ourCom @ 1 strcut swap pop tolower strcat " after character approval." strcat Tell exit then (* get info *) begin (* begin info-reading loop *) ourDataObj @ "@a/sysparms/strict_disads" getpropstr "yes" smatch if ">> What " GetTerm Capitalize strcat " do you want to select?" strcat Tell ">> [Enter " GetTerm Capitalize strcat ", .l to list choices, or .q to quit]" strcat Tell else ">> Please provide a brief descriptive name for this " GetTerm Capitalize strcat "." strcat Tell ourDataObj @ "@a/sysparms/strict_disads" getprop "yes" smatch if ">> [Enter " GetTerm capitalize strcat " name, or .l to list choices, or .q to quit]" strcat Tell else ">> [Enter a string up to 24 characters, or .q to quit]" Tell then then ReadLine strip QCheck dup "*/" smatch if (* make sure it's not a propdir *) dup strlen 1 - strcut pop then ".list" over stringpfx if ListDisads pop continue then CapAll dup ":" instr if ">> Sorry, " GetTerm Capitalize strcat " names cannot include colons." strcat Tell pop continue then dup "{wealth|poverty|status}" smatch if Capitalize scratch ! DoStatWealth ">> Set another " GetTerm Capitalize strcat "? \(y/n\)" strcat Tell ReadYesNo if continue else ">> Done." Tell exit then then ourDataObj @ "@a/dis-ad/" 3 pick strcat getpropstr if DoCodedDisAd ">> Set another " GetTerm Capitalize strcat "? \(y/n\)" strcat Tell ReadYesNo if continue else ">> Done." Tell exit then then ourDataObj @ "@a/sysparms/strict_disads" getpropstr "yes" smatch if ">> " GetTerm Capitalize strcat " not found." strcat Tell pop continue then CapAll 24 strcut pop "@a/dis-ad/" swap dup scratch ! strcat begin (* begin dis-ad reading loop *) ">> How many points is this " GetTerm Capitalize strcat " worth?" strcat Tell ">> [Enter a number, or .q to quit]" Tell ReadLine strip QCheck (* check: valid entry? *) dup number? not if ">> Sorry, that's not a number." Tell pop continue then (* check: would current mod go below floor? *) dup atoi 0 < if me @ "@a/dis-ad/" 4 pick strcat "/floor" strcat getpropstr dup if me @ "@a/dis-ad/" 5 pick strcat getpropstr atoi 3 pick atoi + swap atoi < if pop pop ">> Sorry, that would violate a prerequisite or " "template dependency." strcat Tell exit then else pop then then (* work with positive numbers only *) atoi dup 0 < if 0 swap - then GetTerm "disadvantage" smatch if dup CheckMaxDisads not if continue then else dup me @ "@a/avail/main" getpropstr atoi > if ">> Sorry, you don't have enough points for that." Tell pop continue then then me @ "@a/avail/main" over over getpropstr atoi 4 pick GetTerm "advantage" smatch if - else + then intostr setprop me @ "@a/dis-ad/" scratch @ strcat rot GetTerm "disadvantage" smatch if 0 swap - then intostr setprop ">> Set." Tell ">> Do you want to set another " GetTerm Capitalize strcat "? (y/n)" strcat Tell ReadYesNo if break else ">> Done." Tell exit then repeat (* end dis-ad reading loop *) repeat (* end info-reading loop *) ; : main "me" match me ! (* initialize *) 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? DoDisAds ; . c q @set asys-disads=W