@program #1170
1 10000 d
i
$include $lib/rp
$include $lib/alynna
$def RPSYSTEM "$rpsystem" match
$def AVATAR "*Furryfaire" match
lvar param
lvar cmode
lvar mainmenu
$def }yerf }cat "FFa2.Chargen" pretty tellme
$def }oyerf }cat "FFa2.Chargen" pretty tellhere
$def LINE "------------------------------------------------------------------------------" tellme


$def CHAR_SHEETLOCKED      -1
$def CHAR_NEWBIE           0
$def CHAR_IN_CHARGEN       4
$def CHAR_IN_CHARGEN_PC    8
$def CHAR_WAITING_APPROVAL 16
$def CHAR_APPROVED         256
$def yip me @ swap getstatstr dup not if pop "^RED^Not set^NORMAL^" then
$define FASTCOLOR
 "^CYAN^(^GREEN^" "(" subst
 "^CYAN^)^YELLOW^" ")" subst
 "^PURPLE^: ^GREEN^" ": " subst
$enddef
$def READ_SHOOTS_BLANKS READ_WANTS_BLANKS
$def PARANOIA prog "?" flag?

: qmorph[ arr:input -- arr:output ]
{
input @ foreach swap pop
 "^YELLOW^" swap strcat
 "^CYAN^[^GREEN^" "[" subst
 "^CYAN^]^YELLOW^" "]" subst
repeat
}array
;

: cgstage
var curdp
me @ "step" getstat not if me @ "step" "1" setstat then
cmode @ case
 CHAR_SHEETLOCKED = when
  { "Your sheet has been locked.  You cannot edit any of your stats." }yerf exit
 end
 CHAR_NEWBIE = when
  { "New character detected." }yerf
  me @ "@/+dp" getprop if
   me @ "@/+dp" getprop curdp !
   me @ "dp" curdp @ setstat
  else
   me @ "dp" getstat dup curdp ! not if
    me @ "dp" { "System" "Chargen" "Start.DP" }rpinfo atoi dup curdp ! setstat
   then
  then
  { "Starting you with " curdp @ " Discretionary Points. " }yerf
  me @ "character_mode" CHAR_IN_CHARGEN setstat
  me @ "start_chargen" systime setstat
  CHAR_IN_CHARGEN cmode !
 end
 CHAR_IN_CHARGEN = when
  { "Continuing where you left off in chargen." }yerf
 end
 CHAR_WAITING_APPROVAL = when
  { "Your character is awaiting approval.  You cannot change anything on your sheet at this time." }yerf
 end
 CHAR_APPROVED = when
  { "Access granted for approved PC.  Entering XP spending mode." }yerf
 end
 default pop { "What the heck?  You have unknown character mode " cmode @ "!  Call " prog owner "." }yerf exit end
endcase
;

( ****************************** Attribute handlers **************************************** )
: cg.attrs
READ_SHOOTS_BLANKS
0 var! mutex
{ 4 3 3 2 }array var! attrvals

"Attributes" header tellme
{ "^RED^" { "Physical: " me @ mphysical }cat 19 lj
  "^GREEN^" { "Mental: " me @ mmental }cat 19 lj
  "^CYAN^" { "Spiritual: " me @ mspiritual }cat 19 lj
  "^YELLOW^" { "Social: " me @ msocial }cat 19 lj
}tell
{ "You can now choose 4 attributes at 4, 3, 3 and 2, depending on your choice." }tell
{ "Please enter PHY, MEN, SPI and SOC below in the order you want." }tell
{ "For example, 'SPI MEN SOC PHY' will give you: " }tell
{ " 4 in Spiritual, 3 in Mental, 3 in Social, and 2 in Physical." }tell
{ "You may also enter ^RED^0^ ^ to clear your attributes, or ^RED^Q^ ^ to leave without changes. " }tell
LINE { "What's your choice:" }tell
begin read var! murr
murr @ case
 "0" smatch when
  me @ "m/Physical" 0 setstat
  me @ "m/Mental" 0 setstat
  me @ "m/Spiritual" 0 setstat
  me @ "m/Social" 0 setstat
  { "Your attributes were cleared." }yerf
  1 Mutex !
 end
 "Q*" smatch when 1 Mutex ! end
 default pop
 1 mutex !
 murr @ " " explode_array var! tmp
  tmp @ array_count 4 =  not if { "You need to specify all four stats at once in order." }yerf else
  0 3 1 for var! tmp2 tmp @ tmp2 @ [] case
   "PHY" smatch when
    me @ "m/Physical" attrvals @ tmp2 @ [] setstat
    { "^RED^" "Your Physical attribute was set to " attrvals @ tmp2 @ [] "." }yerf
   end
   "MEN" smatch when
    me @ "m/Mental" attrvals @ tmp2 @ [] setstat
    { "^GREEN^" "Your Mental attribute was set to " attrvals @ tmp2 @ [] "." }yerf
   end
   "SPI" smatch when
    me @ "m/Spiritual" attrvals @ tmp2 @ [] setstat
    { "^CYAN^" "Your Spiritual attribute was set to " attrvals @ tmp2 @ [] "." }yerf
   end
   "SOC" smatch when
    me @ "m/Social" attrvals @ tmp2 @ [] setstat
    { "^YELLOW^" "Your Social attribute was set to " attrvals @ tmp2 @ [] "." }yerf
   end
   default pop
    { "I couldn't understand what you wanted to set!  Try again. [" tmp @ tmp2 @ [] "]" }yerf
    0 mutex !
   end
   endcase
  repeat
  then
 end
endcase
mutex @ until
me @ "Physical" resetstat
me @ "Mental" resetstat
me @ "Spiritual" resetstat
me @ "Social" resetstat
READ_SHOOTS_BLANKS
; PUBLIC cg.attrs

: cg.finish
READ_SHOOTS_BLANKS
me @ "@/aup" getprop not if { "^RED^You must agree to the AUP before submitting a sheet.  Leave chargen, and enter '@aup'." }tell exit then
{ "^YELLOW^Once you select this option, you will not be able to do anything else with your sheet until it is approved!" }yerf
{ "Are you ready to submit your character? (y/N)" }yerf
read "y*" smatch if
 me @ "character_mode" CHAR_WAITING_APPROVAL setstat
 me @ "waiting_since" systime setstat
 CHAR_WAITING_APPROVAL cmode !
 AVATAR { "+bbpost 9/" me @ " (" "%x %X" systime timefmt ")=" me @ " submitted their character for approval at " "%C %X" systime timefmt "." }cat force
 { "^GREEN^Your sheet has just been submitted for approval by the wizards." }yerf
else
 { "Aborted." }yerf
then
READ_SHOOTS_BLANKS
; PUBLIC cg.finish

: cg.skills
READ_SHOOTS_BLANKS
0 var! mutex
{ 4 3 3 2 2 }array var! skillvals
"Skills" enumType var! skills
"Skills" header tellme
{
skills @ foreach var! value var! item
 { "[" item @ ++ tostr 2 rj "] " value @ }cat
repeat
}array 4 wrap_items_fixed qmorph atellme
LINE
{ "You can now choose 5 skills at 4, 3, 3, 2 and 2, depending on your choice." }tell
{ "Please enter the numbers of the skills below in the order you want." }tell
{ "Example: 1 7 2 13 4 " }tell
{ "Note, do NOT choose languages here, as this menu won't let you choose WHICH language." }tell
{ "To buy additional languages, switch chargen into PC mode with . then re-enter this menu." }tell
{ "You may also enter ^RED^0^ ^ to clear your skills, or ^RED^Q^ ^ to leave without changes. " }tell
LINE
{ "What's your choice:" }tell
begin read var! murr
murr @ case
 "0" smatch when
  me @ "/@rp/s/" remove_prop
  { "Your skillz were cleared." }yerf
  1 Mutex !
 end
 "Q*" smatch when 1 Mutex ! end
 default pop
 murr @ " " explode_array var! tmp
 tmp @ array_count 5 = not if { "^RED^You need to specify 5 different skills.  Try again." }yerf
 else
  1 mutex !
  me @ "/@rp/s/" remove_prop
  0 4 1 for var! tmp2
   skills @ tmp @ tmp2 @ [] toint -- [] not if
    { "^RED^Selection #" tmp2 @ ++ " was invalid.  Try it again." }yerf
    0 mutex !
   else
    me @ "s/" skills @ tmp @ tmp2 @ [] toint -- [] strcat skillvals @ tmp2 @ [] setstat
    { "^GREEN^Your skill in ^CYAN^" skills @ tmp @ tmp2 @ [] toint -- [] "^GREEN^ was set to ^YELLOW^" skillvals @ tmp2 @ [] "^GREEN^." }yerf
   then
  repeat
 then
 end
endcase
mutex @ until
READ_SHOOTS_BLANKS
; PUBLIC cg.skills

: cg.aspects
READ_SHOOTS_BLANKS
0 var! mutex
{ 3 2 2 1 1 }array var! aspectvals
"system/aspect/tables" enumType var! aspects
"Aspects" header tellme
aspects @ foreach var! value var! item
 { { item @ ++ tostr 2 rj ") " value @ }cat 20 lj FASTCOLOR "^YELLOW^[^GREEN^" me @ "as/" value @ strcat getstatint tostr 1 lj "^YELLOW^]^CYAN^  " { "aspects" value @ "desc" }rpinfo }cat tellme
repeat
LINE
{ "You can now choose 5 aspects at 3, 2, 2, 1 and 1, depending on your choice." }tell
{ "Please enter the numbers of the aspects below in the order you want." }tell
{ "Example: 1 5 3 4 2" }tell
{ "You may also enter ^RED^0^ ^ to clear your aspects, or ^RED^Q^ ^ to leave without changes. " }tell
LINE
{ "What's your choice:" }tell
begin read var! murr
murr @ case
 "0" smatch when
  me @ "/@rp/as/" remove_prop
  { "Your aspects were cleared." }yerf
  1 Mutex !
 end
 "Q*" smatch when 1 Mutex ! end
 default pop
 murr @ " " explode_array var! tmp
 tmp @ array_count 5 = not if { "^RED^You need to specify 5 different aspects.  Try again." }yerf
 else
  1 mutex !
  me @ "/@rp/as/" remove_prop
  0 4 1 for var! tmp2
   aspects @ tmp @ tmp2 @ [] toint -- [] not if
    { "^RED^Selection #" tmp2 @ ++ " was invalid.  Try it again." }yerf
    0 mutex !
   else
    me @ "as/" aspects @ tmp @ tmp2 @ [] toint -- [] strcat aspectvals @ tmp2 @ [] setstat
    { "^GREEN^Your aspect in ^CYAN^" aspects @ tmp @ tmp2 @ [] toint -- [] "^GREEN^ was set to ^YELLOW^" aspectvals @ tmp2 @ [] "^GREEN^." }yerf
   then
  repeat
 then
 end
endcase
mutex @ until
READ_SHOOTS_BLANKS
; PUBLIC cg.aspects

: cg.nation
READ_SHOOTS_BLANKS
0 var! mutex
var tmp var cur
var bonusstat var bonusamt
me @ "Nationality" getstat if { "^RED^You have already selected your nation.  To reselect, you have to start over (Clear your sheet)." }yerf exit then
{
 "Nationality" enumType foreach swap pop var! cur1
  cur1 @
  "Nationality/" cur1 @ strcat enumType foreach swap pop var! cur2
  { cur1 @ " ("  cur2 @ ")" }cat
  repeat
 repeat
}array var! nations
"Nations of Furryfaire" header tellme
nations @ foreach var! value var! item
 { item @ ++ ") " value @ }cat FASTCOLOR tellme
repeat
LINE
{ "Select a nation by number.  To quit, select Q." }tell
begin read var! murr
murr @ case
 "0" smatch when
  me @ "Nationality" 0 setstat
  { "Your nationality was cleared." }yerf
  1 Mutex !
 end
 "Q*" smatch when 1 Mutex ! end
 default pop
  me @ "Nationality" getstat dup tmp ! if
   { "Nationality" tmp @ todir "Attributes" }rpinfo if
   { "Removing bonuses from your old nation ^CYAN^" tmp @ "^ ^..." }yerf
   { "Nationality" tmp @ todir "Attributes" }rpinfo ", " explode_array foreach swap pop cur !
    cur @ "*" instr 1 = if
     me @ "~/shire-bonus-stat" getstat bonusstat ! 1 bonusamt !
    else
     cur @ " " split toint bonusamt ! bonusstat !
    then
    me @ "m/" bonusstat @ strcat over over getstat bonusamt @ - setstat
    { bonusstat @ " -" bonusamt @ }yerf
   repeat
  then
  then
  me @ "Nationality" nations @ murr @ toint -- [] dup tmp ! setstat
  { "Nationality" tmp @ todir "Attributes" }rpinfo if
  { "Adding bonuses from your new nation ^CYAN^" tmp @ "^ ^..." }yerf
  { "Nationality" tmp @ todir "Attributes" }rpinfo ", " explode_array foreach swap pop cur !
   cur @ "*" instr 1 = if
    { "Which stat do you want to add your +1 attribute to (Physical, Mental, Spiritual or Social)?  Please do not abbreviate." }yerf
    read bonusstat ! 1 bonusamt !
    me @ "~/shire-bonus-stat" bonusstat @ setstat
   else
    cur @ " " split toint bonusamt ! bonusstat !
   then
   me @ "m/" bonusstat @ strcat over over getstat bonusamt @ + setstat
   { bonusstat @ " +" bonusamt @ }yerf
  repeat
  then
  { "Adding languages ..." }yerf
  { "Nationality" tmp @ todir "Language" }rpinfo mklist var! tmp2
  tmp2 @ array_count 2 >= if
   begin
   { "Pick a language, " tmp2 @ array_commas " are your choices, you get one: " }yerf
   read dup var! tmp3 tmp2 @ emerge if
    me @ "la/" tmp3 @ strcat 1 setstat
    { "You learned the language ^GREEN^" tmp3 @ "^ ^!" }yerf break
   else
    { "^RED^That's just a bunch of nonsense!" }yerf
   then
   repeat
  else
   me @ "la/" tmp2 @ mkstr strcat 1 setstat
   { "You learned the language ^GREEN^" tmp2 @ mkstr "^ ^!" }yerf
  then
  { "Your nationality was set to ^GREEN^" me @ "Nationality" getstat "^NORMAL^." }yerf
  1 Mutex !
 end
endcase
mutex @ until
READ_SHOOTS_BLANKS
; PUBLIC cg.nation

: addRace[ d:target s:race -- ]
var bonusstat
var bonusamt
( Dont add if I already have it )
target @ "Races" getstatstr mklist race @ emerge if
 { "No, you already have this race." }yerf exit
then

( Find out what the cost of taking this race will be )
{ "Nationality" target @ "Nationality" getstatstr todir "Races" }rpinfo "*" instr if
 5
else
 { "Nationality" target @ "Nationality" getstatstr todir "Races" }rpinfo race @ chopallsub emerge if
  5
 else
  10
 then
then var! cost
{ "Your chosen race ^CYAN^" race @ "^ ^ costs ^GREEN^" cost @ "^ ^DP." }yerf

( Die if not enough DP )
target @ DP cost @ < if { "^RED^Not enough DP, you have " target @ DP ", you need " cost @ "." }yerf exit then
( Spend the DP )
target @ cost @ spendDP if { "Danger Will Robinson!  I failed to spend the DP!" }yerf exit then

( Add everything this race gets to stats.. )
( First attributes )
{ "Race" race @ todir "Attributes" }rpinfo dup if
 mklist foreach swap pop " " split toint bonusamt ! bonusstat !
 { race @ capitalize ": Adding +" bonusamt @ " to " bonusstat @ "..." }yerf
 target @ "m/" bonusstat @ strcat over over getstat bonusamt @ + setstat
 repeat
else pop then
( Now powers )
{ "Race" race @ todir "Powers" }rpinfo dup if
 mklist foreach swap pop bonusstat ! 1 bonusamt !
 { race @ capitalize ": Adding +" bonusamt @ " to " bonusstat @ "..." }yerf
 target @ "p/" bonusstat @ todir strcat over over getstat bonusamt @ + setstat
 bonusstat @ "* (*)" smatch if target @ "p/" bonusstat @ chopsub strcat over over getstat bonusamt @ + setstat then
 repeat
else pop then
( Now immunities )
{ "Race" race @ todir "Immunity" }rpinfo dup if
 mklist foreach swap pop bonusstat ! 1 bonusamt !
 { race @ capitalize ": Adding immunity " bonusamt @ " to " bonusstat @ "..." }yerf
 target @ "p/Immunity" over over getstat bonusamt @ + setstat
 target @ "p/Immunity/" bonusstat @ strcat over over getstat bonusamt @ + setstat
 repeat
else pop then
( Attempt inheritance )
race @ "* (*)" smatch if
 race @ todir "/" split pop var! race2
( First attributes )
{ "Race" race2 @ "Attributes" }rpinfo dup if
 mklist foreach swap pop " " split toint bonusamt ! bonusstat !
 { race2 @ capitalize ": Adding +" bonusamt @ " to " bonusstat @ " (inherited)..." }yerf
 target @ "m/" bonusstat @ strcat over over getstat bonusamt @ + setstat
 repeat
else pop then
( Now powers )
{ "Race" race2 @ "Powers" }rpinfo
 dup if mklist foreach swap pop bonusstat ! 1 bonusamt !
 { race2 @ capitalize ": Adding +" bonusamt @ " to " bonusstat @ " (inherited)..." }yerf
 target @ "p/" bonusstat @ todir strcat over over getstat bonusamt @ + setstat
 bonusstat @ "* (*)" smatch if target @ "p/" bonusstat @ chopsub strcat over over getstat bonusamt @ + setstat then
 repeat
else pop then
( Now immunities )
{ "Race" race2 @ todir "Immunity" }rpinfo dup if
 mklist foreach swap pop bonusstat ! 1 bonusamt !
 { race @ capitalize ": Removing immunity " bonusamt @ " to " bonusstat @ "..." }yerf
 target @ "p/Immunity" over over getstat bonusamt @ + setstat
 target @ "p/Immunity/" bonusstat @ strcat over over getstat bonusamt @ + setstat
 repeat
else pop then
then
{ "Finished adding race bonuses." }yerf
( add this race to my profile )
target @ "races" getstat not if
 target @ "races" race @ setstat
else
 target @ "races" over over getstatstr mklist race @ mklist array_union mkstr setstat
then
{ "Finished adding race!" }yerf
;

: delRace[ d:target s:race -- ]
var bonusstat
var bonusamt
( Dont add if I already have it )
target @ "Races" getstatstr mklist race @ emerge not if
 { "I cant remove races you dont have!" }yerf exit
then

( Find out what the cost of taking this race will be )
{ "Nationality" target @ "Nationality" getstatstr todir "Races" }rpinfo "*" instr if
 5
else
 { "Nationality" target @ "Nationality" getstatstr todir "Races" }rpinfo race @ chopallsub emerge if
  5
 else
  10
 then
then var! cost
{ "Your chosen race ^CYAN^" race @ "^ ^ costs ^GREEN^" cost @ "^ ^DP." }yerf

( Spend the DP )
target @ 0 cost @ - spendDP if { "Danger Will Robinson!  I failed to spend the DP!" }yerf exit then

( Remove everything this race gets to stats.. )
( First attributes )
{ "Race" race @ todir "Attributes" }rpinfo dup if
 mklist foreach swap pop " " split toint bonusamt ! bonusstat !
 { race @ capitalize ": Removing +" bonusamt @ " from " bonusstat @ "..." }yerf
 me @ "m/" bonusstat @ strcat over over getstat bonusamt @ - setstat
 repeat
else pop then
( Now powers )
{ "Race" race @ todir "Powers" }rpinfo dup if
 mklist foreach swap pop bonusstat ! 1 bonusamt !
 { race @ capitalize ": Removing +" bonusamt @ " from " bonusstat @ "..." }yerf
 me @ "p/" bonusstat @ todir strcat over over getstat bonusamt @ - setstat
 bonusstat @ "* (*)" smatch if target @ "p/" bonusstat @ chopsub strcat over over getstat bonusamt @ - setstat then
 repeat
else pop then
( Now immunities )
{ "Race" race @ todir "Immunities" }rpinfo dup if
 mklist foreach swap pop bonusstat ! 1 bonusamt !
 { race @ capitalize ": Removing +" bonusamt @ " to " bonusstat @ "..." }yerf
 target @ "p/Immunity" over over getstat bonusamt @ - setstat
 target @ "p/Immunity/" bonusstat @ strcat over over getstat bonusamt @ - setstat
 repeat
else pop then

( Attempt inheritance )
race @ "* (*)" smatch if
 race @ todir "/" split pop var! race2
( First attributes )
{ "Race" race2 @ "Attributes" }rpinfo dup if
 mklist foreach swap pop " " split toint bonusamt ! bonusstat !
 { race2 @ capitalize ": Removing +" bonusamt @ " to " bonusstat @ " (inherited)..." }yerf
 me @ "m/" bonusstat @ strcat over over getstat bonusamt @ - setstat
 repeat
else pop then
( Now powers )
{ "Race" race2 @ "Powers" }rpinfo dup if
 mklist foreach swap pop bonusstat ! 1 bonusamt !
 { race2 @ capitalize ": Removing +" bonusamt @ " to " bonusstat @ " (inherited)..." }yerf
 me @ "p/" bonusstat @ todir strcat over over getstat bonusamt @ - setstat
 bonusstat @ "* (*)" smatch if target @ "p/" bonusstat @ chopsub strcat over over getstat bonusamt @ - setstat then
 repeat
else pop then
( Now immunities )
{ "Race" race2 @ todir "Immunities" }rpinfo dup if
 mklist foreach swap pop bonusstat ! 1 bonusamt !
 { race @ capitalize ": Removing +" bonusamt @ " to " bonusstat @ "..." }yerf
 target @ "p/Immunity" over over getstat bonusamt @ - setstat
 target @ "p/Immunity/" bonusstat @ strcat over over getstat bonusamt @ - setstat
 repeat
else pop then

then
{ "Finished removing race bonuses." }yerf
target @ "Races" over over getstatstr mklist race @ mklist swap array_diff mkstr setstat
{ "Finished removing race!" }yerf
;

: cg.races
READ_SHOOTS_BLANKS
0 var! mutex
var tmp
begin
mutex @ not if
{
 "Race" enumType foreach swap pop var! cur1
  cur1 @
  "Race/" cur1 @ strcat enumType foreach swap pop var! cur2
  { cur1 @ " ("  cur2 @ ")" }cat
  repeat
 repeat
}array var! Races
"Races of Furryfaire" header tellme
Races @ foreach var! value var! item
 { item @ ++ ") " value @
 me @ "races" getstatstr value @ emerge if "^Purple^ [Active]^ ^" then }cat FASTCOLOR tellme
repeat
LINE
then
1 mutex !
{ "^RED^You cannot remove a race without starting over, so choose carefully!" }yerf
{ "Enter the number of a race to add, ^CYAN^L^ ^ to relist, or ^RED^Q^ ^ to quit." }yerf
read var! murr
murr @ "Q" smatch not if
 murr @ "L" smatch if
  0 mutex !
 else
  murr @ toint var! yerf
  races @ yerf @ -- [] dup not if
   pop { "^RED^I dont know what kind of people yer talking about." }yerf
  else
   tmp !
   me @ "races" getstatstr tmp @ emerge if
    { "Enter the number of a race to add, ^CYAN^L^ ^ to relist, or ^RED^Q^ ^ to quit." }yerf
   else
    { "^YELLOW^Are you sure you want to buy the race ^GREEN^" tmp @ "^YELLOW^?" }yerf read "Y*" smatch if
     me @ tmp @ addRace
    then
   then
  then
 then
else
 2 mutex !
then
2 mutex @ = until
READ_SHOOTS_BLANKS
; PUBLIC cg.races

: traits
READ_SHOOTS_BLANKS
var cost
var point
"Traits" header tellme
{ "^GREEN^-3^CYAN^)^YELLOW^      Set my size to -3 (Squirrel sized)" }tell
{ "^GREEN^-2^CYAN^)^YELLOW^      Set my size to -2 (Skunk sized)" }tell
{ "^GREEN^-1^CYAN^)^YELLOW^      Set my size to -1 (Fox sized)" }tell
{ "^GREEN^ 0^CYAN^)^YELLOW^      Set my size to  0 (Normal sized)" }tell
{ "^GREEN^ 1^CYAN^)^YELLOW^      Set my size to  1 (Wolf sized)" }tell
{ "^GREEN^ 2^CYAN^)^YELLOW^      Set my size to  2 (Horse sized)" }tell
{ "^GREEN^ 3^CYAN^)^YELLOW^      Set my size to  3 (Moose sized)" }tell
{ "^GREEN^ +^CYAN^)^YELLOW^      Add a point of resources" }tell
{ "^GREEN^ -^CYAN^)^YELLOW^      Remove a point of resources" }tell
begin
LINE { "^GREEN^Resources: " me @ "m/resources" getstat "      ^YELLOW^Size: " me @ "m/size" getstat }tell LINE
{ "Enter an option on the command line, multiple options can be seperated by spaces" }yerf
{ "(example: '+ + 1' will raise your resources by 2 and set your size to 1)" }yerf
{ "Or press ^RED^Q^ ^ to quit:" }yerf
read " " explode_array foreach swap pop dup var! opt case
 "{-3|-2|-1|0|1|2|3}" smatch when
  me @ "m/size" opt @ toint setstat
  { "Your size trait has been set to ^GREEN^" opt @ "^ ^." }yerf
 end
 "{+|-}" smatch when
  opt @ "+" smatch if
   me @ "m/resources" getstat ++ dup point ! "Skill" getCostXP cost !
  else
   me @ "m/resources" getstat -- dup point ! "Skill" getCostXP 0 swap - cost !
  then
  point @ 0 10 .. not if
   { "^RED^You cannot get less than 0 and more than 10 points of resources." }yerf
  else
   { "Attempting to set your resources to ^GREEN^" point @ "^ ^..." }yerf
   me @ cost @ spend not if
    { "^GREEN^Purchase successful, " cost @ " XP spent." }yerf
    me @ "m/resources" point @ setstat
   else
    { "^RED^Failed to purchase, you have " me @ xp ", you need " cost @ "." }yerf
   then
  then
 end
 "Q*" smatch when end
 default pop { "^RED^Invalid option: " opt @ }yerf end
endcase repeat
opt @ "Q*" smatch until
READ_SHOOTS_BLANKS
; PUBLIC traits

: findpowercost[ d:target s:mypower -- i:cost ]
target @ "races" getstatstr var! myraces
{ "Powers" mypower @ "Races" }rpinfo var! sysraces
sysraces @ "All" smatch if 8 exit then

sysraces @ myraces @ chopallsub emerge if
 4
else
 12
then
;

: powers
READ_SHOOTS_BLANKS
"Powers you can take" header tellme
{
 RPSYSTEM "/Powers/" array_get_propdirs foreach var! item pop
  { item @ " [" me @ item @ findpowercost "]" }cat
 repeat
}array 3 wrap_items_fixed qmorph atellme
begin
"Powers you have" header tellme
{
 me @ "/@rp/p/" array_get_propvals foreach toint var! value var! item
  { item @ value @ toint 1 > if " [" value @ "]" then }cat
 repeat
}array 3 wrap_items_fixed qmorph atellme
LINE
{ "Enter the name of a power to add (or raise by one point), seperate multiple entries with ','" }yerf
cmode @ CHAR_IN_CHARGEN if
 {  "To remove a power (or a point in a power), enter the name with a - sign (like -Unaging)" }yerf
then
{ "Or enter ^RED^Q^ ^ to quit: " }yerf
read "," ", " subst "," explode_array foreach var! murr pop
murr @ "Q" smatch not if
 murr @ "-*" smatch not if
  { "Powers" murr @ "Desc" }rpstat not if
   { "^RED^Invalid power specified: " murr @ }yerf continue
  then
  { "powers" murr @ "level" }rpinfo "0" smatch me @ "p/" murr @ strcat getstatint and if
   { "^RED^You can't get any more of that." }yerf continue
  then
  { "powers" murr @ "level" }rpinfo "inf" smatch not if
   me @ "p/" murr @ strcat getstat 
   { "powers" murr @ "level" }rpinfo toint 1 10 limit
   {
    me @ "races" getstatstr dup if mklist else 0 array_make then foreach var! tmp pop
     { "race" tmp @ todir "powers" }rpinfo dup if mklist array_vals pop then
    repeat
   }array murr @ 1 array_make array_intersect array_count +
   dup var! x < not if
    { "^RED^" murr @ capitalize " capped at " x @ "." }yerf continue
   then
  then
  me @ me @ murr @ findpowercost spend not if
   me @ "p/" murr @ capitalize strcat over over getstat ++ setstat
   { "^GREEN^" murr @ capitalize " power bought for ^CYAN^" me @ murr @ findpowercost "^GREEN^XP." }yerf
   murr @ "{Immunity|Transform}" smatch murr @ "Enhanced sense" smatch or if
    { "Please enter the name of the " murr @ capitalize " you are adding: " }yerf read var! x
    me @ { "p/" murr @ "/" x @ }cat over over getstat ++ setstat
   then
  else
   { "^RED^Could not afford " murr @ capitalize " you have " me @ XP ", you need " me @ murr @ findpowercost "." }yerf
  then
 else
  cmode @ CHAR_IN_CHARGEN not if { "^RED^Unable to remove points after chargen." }yerf else
  murr @ 1 strcut swap pop murr !
  { "Powers" murr @ "Desc" }rpstat not if
   { "^RED^Invalid power specified: " murr @ }yerf
  else
   me @ 0 me @ murr @ findpowercost - spend pop
   me @ "p/" murr @ capitalize strcat over over getstat -- setstat
   { "^GREEN^" murr @ capitalize " power removed for ^CYAN^" me @ murr @ findpowercost "^GREEN^XP." }yerf
    murr @ "{Immunity|Transform" smatch murr @ "Enhanced sense" smatch or if
     { murr @ capitalize ": " { me @ "/@rp/p/" murr @ strcat array_get_propvals foreach swap pop repeat }array array_commas }yerf
     { "Please enter the name of the " murr @ capitalize " you are removing: " }yerf read var! x
     me @ { "p/" murr @ "/" x @ }cat over over getstat -- setstat
    then
  then
  then
 then
then
repeat
murr @ "Q" smatch until
READ_SHOOTS_BLANKS
; PUBLIC powers

: findtalentcost[ d:target s:mytalent -- i:cost ]
target @ "/@rp/ta/" array_get_propvals array_count not if 0 exit then
target @ "/@rp/ta/" array_get_propvals array_count 5 >= if -1 exit then
target @ "races" getstatstr if 4 else 2 then
;

: talents
READ_SHOOTS_BLANKS
"Talents you can take" header tellme
{
 RPSYSTEM "/talents/" array_get_propdirs foreach var! item pop
  { item @ " [" me @ item @ findtalentcost "]" }cat
 repeat
}array 3 wrap_items_fixed qmorph atellme
begin
"Talents you have" header tellme
{
 me @ "/@rp/ta/" array_get_propvals foreach toint var! value var! item
  { item @ value @ toint 1 > if " [" value @ "]" then }cat
 repeat
}array 3 wrap_items_fixed qmorph atellme
LINE
{ "Enter the name of a talent to add (or raise by one point), seperate multiple entries with ','" }yerf
cmode @ CHAR_IN_CHARGEN if
 {  "To remove a talent (or a point in a talent), enter the name with a - sign (like -Unaging)" }yerf
then
{ "Or enter ^RED^Q^ ^ to quit: " }yerf
read "," ", " subst "," explode_array foreach var! murr pop
murr @ "Q" smatch not if
 murr @ "-*" smatch not if
  { "talents" murr @ "Desc" }rpstat not if
   { "^RED^Invalid talent specified: " murr @ }yerf
  else
   me @ murr @ findtalentcost 0 >= if 
    me @ me @ murr @ findtalentcost spend not if
     me @ "ta/" murr @ capitalize strcat over over getstat ++ setstat
     { "^GREEN^" murr @ capitalize " talent bought for ^CYAN^" me @ murr @ findtalentcost "^GREEN^XP." }yerf
    else
     { "^RED^Could not afford " murr @ capitalize " you have " me @ XP ", you need " me @ murr @ findtalentcost "." }yerf
    then
   else
    { "^RED^At the maximum number of talents." }yerf
   then
  then
 else
  cmode @ CHAR_IN_CHARGEN not if { "^RED^Unable to remove points after chargen." }yerf else
  murr @ 1 strcut swap pop murr !
  { "talents" murr @ "Desc" }rpstat not if
   { "^RED^Invalid talent specified: " murr @ }yerf
  else
   me @ 0 me @ murr @ findtalentcost - spend pop
   me @ "ta/" murr @ capitalize strcat over over getstat -- setstat
   { "^GREEN^" murr @ capitalize " talent removed for ^CYAN^" me @ murr @ findtalentcost "^GREEN^XP." }yerf
   then
  then
 then
then
repeat
murr @ "Q" smatch until
READ_SHOOTS_BLANKS
; PUBLIC talents

: findmagiccost[ d:target s:mymagic -- i:cost ]
15
{
target @ "races" getstatstr chopallsub mklist array_vals pop
target @ "/@rp/or" array_get_propdirs foreach swap pop repeat
}array mkstr var! mystuff
{ "Magic" mymagic @ "Approved" }rpinfo var! approved
mystuff @ approved @ emerge if
 5 -
then
target @ "nationality" getstatstr var! mystuff
{ "Nationality" mystuff @ "Sorcery" }rpinfo var! approved
mystuff @ approved @ emerge if
 5 -
then
;

: magics
READ_SHOOTS_BLANKS
"Magic you can take" header tellme
{
 RPSYSTEM "/Magic/" array_get_propdirs foreach var! item pop
  { item @ " [" me @ item @ findmagiccost "]" }cat
 repeat
}array 3 wrap_items_fixed qmorph atellme
begin
"Magic you have" header tellme
{
 me @ "/@rp/mag/" array_get_propvals foreach toint var! value var! item
  { item @ value @ toint 1 > if " [" value @ "]" then }cat
 repeat
}array 3 wrap_items_fixed qmorph atellme
LINE
{ "Enter the name of a magic to add (or raise by one point), seperate multiple entries with ','" }yerf
cmode @ CHAR_IN_CHARGEN if
 {  "To remove a magic (or a point in a magic), enter the name with a - sign (like -Aria)" }yerf
then
{ "Or enter ^RED^Q^ ^ to quit: " }yerf
read "," ", " subst "," explode_array foreach var! murr pop
murr @ "Q" smatch not if
 murr @ "-*" smatch not if
  { "Magic" murr @ "Desc" }rpstat not if
   { "^RED^Invalid magic specified: " murr @ }yerf
  else
   me @ me @ murr @ findmagiccost spend not if
    me @ "mag/" murr @ capitalize strcat over over getstat ++ setstat
    { "^GREEN^" murr @ capitalize " magic bought for ^CYAN^" me @ murr @ findmagiccost "^GREEN^XP." }yerf
   else
    { "^RED^Could not afford " murr @ capitalize " you have " me @ XP ", you need " me @ murr @ findmagiccost "." }yerf
   then
  then
 else
  cmode @ CHAR_IN_CHARGEN not if { "^RED^Unable to remove points after chargen." }yerf else
  murr @ 1 strcut swap pop murr !
  { "Magic" murr @ "Desc" }rpstat not if
   { "^RED^Invalid magic specified: " murr @ }yerf
  else
   me @ 0 me @ murr @ findmagiccost - spend pop
   me @ "mag/" murr @ capitalize strcat over over getstat -- setstat
   { "^GREEN^" murr @ capitalize " magic removed for ^CYAN^" me @ murr @ findmagiccost "^GREEN^XP." }yerf
  then
  then
 then
then
repeat
murr @ "Q" smatch until
READ_SHOOTS_BLANKS
; PUBLIC magics

: findskillcost[ d:target s:myskill -- i:cost ]
target @ "s/" myskill @ strcat getstatint ++ "Skill" getCostXP
;

: pc.skills
READ_SHOOTS_BLANKS
var tmp var tmp2
"Skills you can take" header tellme
{
 RPSYSTEM "/skills/" array_get_propdirs foreach var! item pop
  { item @ " [" me @ item @ findskillcost "]" }cat
 repeat
}array 3 wrap_items_fixed qmorph atellme
begin
"Skills you have" header tellme
{
 me @ "/@rp/s/" array_get_propvals foreach toint var! value var! item
  { item @ value @ toint 1 > if " [" value @ "]" then }cat
 repeat
}array 3 wrap_items_fixed qmorph atellme
LINE
{ "Enter the name of a skill to add (or raise by one point), seperate multiple entries with ','" }yerf
{ "Or enter ^RED^Q^ ^ to quit: " }yerf
read "," ", " subst "," explode_array foreach var! murr pop
murr @ "Q" smatch not if
 { "Skills" murr @ "Desc" }rpstat not if
  { "^RED^Invalid skill specified: " murr @ }yerf
 else
  me @ "s/" murr @ strcat getstat 10 >= if
   { "^RED^" murr @ capitalize " capped at 10." }yerf
  else
  me @ me @ murr @ findskillcost dup tmp ! spend not if
   me @ "s/" murr @ capitalize strcat over over getstat ++ setstat
   { "^GREEN^" murr @ capitalize " skill bought to ^GREEN^" me @ "s/" murr @ strcat getstat "^NORMAL^ for ^CYAN^" tmp @ "^GREEN^XP." }yerf
   murr @ "Language" smatch if
    "Languages" header tellme
    RPSYSTEM "/Languages/" array_get_propdirs var! languages
    languages @ 4 wrap_items_fixed atellme
    LINE
    begin
    { "Please select a language to speak: " }yerf
    read tmp !
    tmp @ languages @ emerge if { "^GREEN^Learned." }yerf break else { "^RED^That's greek to me ..." }yerf then
    repeat
    me @ "la/" tmp @ strcat 1 setstat
   then
  else
   { "^RED^Could not afford " murr @ capitalize " you have " me @ XP ", you need " me @ murr @ findskillcost "." }yerf
  then
 then
 then
then
repeat
murr @ "Q" smatch until
READ_SHOOTS_BLANKS
; PUBLIC pc.skills

: findaspectcost[ d:target s:myskill -- i:cost ]
target @ "as/" myskill @ strcat getstatint ++ "Aspect" getCostXP
;

: pc.aspects
READ_SHOOTS_BLANKS
var tmp var tmp2
"Aspects you can take" header tellme
{
 RPSYSTEM "system/aspect/tables" array_get_propdirs foreach var! item pop
  { item @ " [" me @ item @ findaspectcost "]" }cat
 repeat
}array 5 wrap_items_fixed qmorph atellme
begin
"Aspects you have" header tellme
{
 me @ "/@rp/as/" array_get_propvals foreach toint var! value var! item
  { item @ value @ toint 1 > if " [" value @ "]" then }cat
 repeat
}array 5 wrap_items_fixed qmorph atellme
LINE
{ "Enter the name of an aspect to add (or raise by one point), seperate multiple entries with ','" }yerf
{ "Or enter ^RED^Q^ ^ to quit: " }yerf
read "," ", " subst "," explode_array foreach var! murr pop
murr @ "Q" smatch not if
 { "system/aspect/tables" murr @ "Desc" }rpstat not if
  { "^RED^Invalid aspect specified: " murr @ }yerf
 else
  me @ "as/" murr @ strcat getstat 10 >= if
   { "^RED^" murr @ capitalize " capped at 10." }yerf
  else
  me @ me @ murr @ findaspectcost dup tmp ! spend not if
   me @ "as/" murr @ capitalize strcat over over getstat ++ setstat
   { "^GREEN^" murr @ capitalize " aspect bought to ^GREEN^" me @ "as/" murr @ strcat getstat "^NORMAL^ for ^CYAN^" tmp @ "^GREEN^XP." }yerf
  else
   { "^RED^Could not afford " murr @ capitalize " you have " me @ XP ", you need " me @ murr @ findaspectcost "." }yerf
  then
 then
 then
then
repeat
murr @ "Q" smatch until
READ_SHOOTS_BLANKS
; PUBLIC pc.aspects

: findattrcost[ d:target s:myattr -- i:cost ]
target @ "m/" myattr @ strcat getstatint ++ "Attr" getCostXP
;

: pc.attrs
READ_SHOOTS_BLANKS
begin
"Attributes" header tellme
{ "^RED^" { "Physical: " me @ mphysical " (" me @ "Physical" findattrcost ")" }cat 19 lj
  "^GREEN^" { "Mental: " me @ mmental " (" me @ "Mental" findattrcost ")" }cat 19 lj
  "^CYAN^" { "Spiritual: " me @ mspiritual " (" me @ "Spiritual" findattrcost ")" }cat 19 lj
  "^YELLOW^" { "Social: " me @ msocial " (" me @ "SOCIAL" findattrcost ")" }cat 19 lj
}tell
LINE
{ "Enter PHY MEN SPI or SOC to raise an attribute by 1 (seperate multiple purchases with spaces)" }yerf
{ "Or enter ^RED^Q^ ^ to quit: " }yerf
read
 "Physical" "PHY" subst "Mental" "MEN" subst "Spiritual" "SPI" subst "Social" "SOC" subst
 "Physical" "phy" subst "Mental" "men" subst "Spiritual" "spi" subst "Social" "soc" subst
" " explode_array foreach var! murr pop
murr @ "Q" smatch not if
 murr @ "{Physical|Mental|Spiritual|Social}" smatch not if
  { "^RED^Invalid attribute specified: " murr @ }yerf
 else
  me @ murr @ strcat getstat 10 >= if
   { "^RED^" murr @ capitalize " capped at 10." }yerf
  else
  me @ me @ murr @ findattrcost dup var! tmp spend not if
   me @ "m/" murr @ capitalize strcat over over getstat ++ setstat
   { "^GREEN^" murr @ capitalize " attribute bought to ^GREEN^" me @ "m/" murr @ strcat getstat "^NORMAL^ for ^CYAN^" tmp @ "^GREEN^XP." }yerf
  else
   { "^RED^Could not afford " murr @ capitalize " you have " me @ XP ", you need " tmp @ "." }yerf
  then
 then
 then
then
repeat
murr @ "Q" smatch until
READ_SHOOTS_BLANKS
; PUBLIC pc.attrs

: giftCost[ d:target -- i:cost ]
target @ "/@rp/psi/gifts/" array_get_propvals array_count ++ 4 >= if 4 else 0 then
;

: psiCheck[ d:target s:gift -- i:canIhaveIt? ]
{ me @ "psi/1" getstat dup not if pop then me @ "psi/2" getstat dup not if pop then }array var! x
x @ array_count not if 0 exit then
gift @ chopsub { "{" x @ "|" array_join "}" }cat smatch not if 0 exit then
{ "Psionics" gift @ "Attribute" }rpinfo " " split toint var! value var! attr
me @ attr @ getstat value @ >= if 1 else 0 then
{ "Psionics" gift @ "Attribute" }rpinfo " " split toint var! value var! attr
me @ attr @ getstat me @ "psi/gifts/" gift @ "/" split swap pop strcat getstat > if 1 else 0 then
and
;

: psionics
READ_SHOOTS_BLANKS
var tmp  var tmp2  var tmp3
begin
"Psionics" header tellme
me @ "or/Kithain" getstat if 4 else 8 then var! psicost

{ "1) Select primary psionics form (Cost: " psicost @ "XP):    ^GREEN^" me @ "Psi/1" getstatstr }cat FASTCOLOR tellme
{ "2) Select secondary psionics form (Cost: " psicost @ 2 * "XP):  ^CYAN^"  me @ "Psi/2" getstatstr }cat FASTCOLOR tellme
"Gifts you can take" header tellme
{
 RPSYSTEM "/Psionics/" array_get_propdirs foreach swap pop var! cur
  RPSYSTEM "/Psionics/" cur @ strcat array_get_propdirs foreach var! item pop
   me @ { cur @ "/" item @ }cat psiCheck if item @ then
  repeat
 repeat
}array 3 wrap_items_fixed qmorph atellme
begin 0 var! mutex
{
 RPSYSTEM "/Psionics/" array_get_propdirs foreach swap pop var! cur
  RPSYSTEM "/Psionics/" cur @ strcat array_get_propdirs foreach var! item pop
   me @ { cur @ "/" item @ }cat psiCheck if item @ then
  repeat
 repeat
}array var! allowedGifts
"Gifts you have" header tellme
{
 me @ "/@rp/psi/gifts/" array_get_propvals foreach toint var! value var! item
  { item @ value @ toint 1 > if " [" value @ "]" then }cat
 repeat
}array 3 wrap_items_fixed qmorph atellme
LINE
{ "Multiple options can be seperated by commas." }yerf
cmode @ CHAR_IN_CHARGEN if
 { "Use -1, -2 or -gift to remove a form of psionics." }yerf
then
{ "Enter: 1, 2, a name of a gift to buy, ^GREEN^L^ ^ to relist or ^RED^Q^ ^ to quit: " }yerf
read dup var! murr "," ", " subst "," explode_array foreach var! opt pop
 opt @ case
  "[12]" smatch when
   { "Psionics types: " RPSYSTEM "/Psionics/" array_get_propdirs array_commas }yerf
   opt @ "1" smatch if
    { "^GREEN^Please select one to be your primary psionics: " }yerf
    read tmp !
    tmp @ { "{" RPSYSTEM "/Psionics/" array_get_propdirs "|" array_join "}" }cat smatch not if
     { "My goodness, I dont know what your talking about!" }yerf
    else
     { "Nationality" me @ "Nationality" getstatstr todir "Psionics" }rpinfo tmp @ emerge if psicost @ 2.0 / psicost ! then
     me @ psicost @ spend if
      { "^RED^You couldnt afford it, you needed " psicost @ "XP, you have " me @ XP "XP." }yerf
     else
      me @ "psi/1" tmp @ capitalize setstat
      { "^GREEN^You got into " tmp @ capitalize " psionics for " psicost @ "XP." }yerf
      1 mutex !
     then
    then
   else
    { "^CYAN^Please select one to be your secondary psionics: " }yerf
    read tmp !
    tmp @ { "{" RPSYSTEM "/Psionics/" array_get_propdirs "|" array_join "}" }cat smatch not if
     { "My goodness, I dont know what your talking about!" }yerf
    else
     { "Nationality" me @ "Nationality" getstatstr todir "Psionics" }rpinfo tmp @ emerge if psicost @ 2.0 / psicost ! then
     me @ psicost @ 2 * spend if
      { "^RED^You couldnt afford it, you needed " psicost @ 2 * "XP, you have " me @ XP "XP." }yerf
     else
      me @ "psi/2" tmp @ capitalize setstat
      { "^CYAN^You got into " tmp @ capitalize " psionics for " psicost @ 2 * "XP." }yerf
      1 mutex !
     then
    then
   then
  end
  "{-1|-2}" smatch when cmode @ CHAR_IN_CHARGEN = if
   opt @ "1" smatch if
    me @ "psi/1" getstat if
     { "Nationality" me @ "Nationality" getstatstr todir "Psionics" }rpinfo me @ "psi/1" getstatstr emerge if psicost @ 2.0 / psicost ! then
     me @ "psi/1" 0 setstat
     me @ 0 psicost - spend pop
     { "^GREEN^Your primary psionics was removed." }yerf
    then
   else
    me @ "psi/2" getstat if
     { "Nationality" me @ "Nationality" getstatstr todir "Psionics" }rpinfo me @ "psi/2" getstatstr emerge if psicost @ 2.0 / psicost ! then
     me @ "psi/2" 0 setstat
     me @ 0 psicost @ 2 * - spend pop
     { "^GREEN^Your secondary psionics was removed." }yerf
    then
   then
  then end
  "-[^12]*" smatch when cmode @ CHAR_IN_CHARGEN = if
   opt @ 1 strcut swap pop opt !
   me @ "psi/gifts/" opt @ strcat getstat if
     me @ "@rp/psi/gifts" array_get_propvals array_count 4 >= if 4 else 0 then tmp !
     opt @ "Savant" smatch if
      me @ "@rp/psi/Savant" array_get_propvals array_keys array_make tmp2 !
      "Skills" header tellme
      tmp2 @ 4 wrap_items_fixed atellme
      LINE
      { "Please enter a skill in which to remove to your Savant profile: " }yerf
      read tmp3 ! tmp3 @ tmp2 @ emerge if
       me @ "psi/Savant/" tmp3 @ strcat over over getstat -- setstat
       { "^GREEN^Removed." }yerf
       me @ 0 tmp @ - spend pop
       me @ "psi/Gifts/" opt @ capitalize strcat over over getstat -- setstat
       { "^GREEN^You removed the gift ^YELLOW^" opt @ capitalize "^GREEN^ for ^CYAN^" tmp @ "XP^GREEN^." }yerf
      else
       { "^RED^Unown skill." }yerf
      then
     else
     me @ 0 tmp @ - spend pop
     me @ "psi/Gifts/" opt @ capitalize strcat over over getstat -- setstat
     { "^GREEN^You removed the gift ^YELLOW^" opt @ capitalize "^GREEN^ for ^CYAN^" tmp @ "XP^GREEN^." }yerf
     then
   else
    { "^RED^I couldnt find that gift to remove." }yerf
   then
  then end
  "[LQ]" smatch when 1 mutex ! end
  default pop
   allowedGifts @ opt @ emerge if
    me @ giftcost tmp !
    me @ tmp @ spend if
     { "^RED^You couldn't afford it, you needed " tmp @ "XP, you have " me @ xp "XP." }yerf
    else
     opt @ "Savant" smatch if
      RPSYSTEM "/Skills/" array_get_propdirs tmp2 !
      "Skills" header tellme
      tmp2 @ 4 wrap_items_fixed atellme
      LINE
      { "Please enter a skill in which to add to your Savant profile: " }yerf
      read tmp3 ! tmp3 @ tmp2 @ emerge if
       me @ "psi/savant/" tmp3 @ strcat over over getstat ++ setstat
       { "^GREEN^Added." }yerf
       me @ "psi/Gifts/" opt @ capitalize strcat over over getstat ++ setstat
       { "^GREEN^You bought the gift ^YELLOW^" opt @ capitalize "^GREEN^ for ^CYAN^" tmp @ "XP^GREEN^." }yerf
      else
       { "^RED^Unown skill." }yerf
      then
     else
      me @ "psi/Gifts/" opt @ capitalize strcat over over getstat ++ setstat
      { "^GREEN^You bought the gift ^YELLOW^" opt @ capitalize "^GREEN^ for ^CYAN^" tmp @ "XP^GREEN^." }yerf
     then
    then
   else
    { "^RED^I didn't recognize that as a gift you could take..." }yerf
   then
  end
 endcase
repeat
mutex @ until
murr @ "Q" smatch until
READ_SHOOTS_BLANKS
; PUBLIC psionics

: getUsableOrders[ -- a:orders ]
{
RPSYSTEM "/Orders/" array_get_propdirs foreach var! tmp pop
 { "Orders" tmp @ "order" }rpinfo
 RPSYSTEM { "Orders/" tmp @ "/" }cat array_get_propdirs array_count or
 if { "Orders" tmp @ "_delist" }rpinfo not if tmp @ then then
repeat
}array
;

: orders
var value var item var tmp
READ_SHOOTS_BLANKS
getUsableOrders var! myOrders
"Orders" header tellme
{
 myOrders @ foreach value ! item !
  { item @ ++ tostr 2 rj ") " value @ { "Orders" value @ "Order" }rpinfo if " (" { "Orders" value @ "Order" }rpinfo ")" then }cat FASTCOLOR
 repeat
}array atellme
LINE
{ "Which order do you want?  Enter a single number." }yerf
{ "Remember that taking 2 or more orders requires staff approval." }yerf
{ "This option will exit after your attempt to select a new order: " }yerf
read atoi -- var! murr
murr @ 0 myOrders @ array_count -- .. not if { "^RED^Invalid order." }yerf else
 me @ 4 spend if { "^RED^Unable to afford it." }yerf else
  myOrders @ murr @ [] var! cur
  me @ "or/" cur @ strcat over over getstat ++ setstat
  { "Orders" cur @ "Skills" }rpinfo dup not if pop { "Orders" { "Orders" cur @ "Order" }rpinfo "Skills" }rpinfo then mklist var! newSkills
  newskills @ foreach " " split var! nskill toint var! amount
   nskill @ "Resources" smatch if
    me @ "m/Resources" over over getstat ++ setstat
   else
    me @ "s/" nskill @ strcat over over getstat ++ setstat
   then
  { "^GREEN^" nskill @ " +" amount @ }yerf
  repeat
 then
then
READ_SHOOTS_BLANKS
; PUBLIC orders

: getValidAbilities[ d:target -- a:abilities ]
{
 me @ "/@rp/or/" array_get_propvals foreach pop var! cur
  RPSYSTEM "/Orders/" cur @ strcat array_get_propdirs array_count if
   RPSYSTEM "/Orders/" cur @ strcat array_get_propdirs array_vals pop
  else
   RPSYSTEM "/Orders/" { "Orders" cur @ "Order" }rpinfo strcat array_get_propdirs array_vals pop
  then
 repeat
}array
;

: abilities
READ_SHOOTS_BLANKS
var tmp var tmp2
me @ getValidAbilities var! sysAbilities
"Abilities you can take" header tellme
sysAbilities @ 3 wrap_items_fixed qmorph atellme
begin
"Abilities you have" header tellme
{
 me @ "/@rp/ab/" array_get_propvals foreach toint var! value var! item
  { item @ value @ toint 1 > if " [" value @ "]" then }cat
 repeat
}array 3 wrap_items_fixed qmorph atellme
LINE
{ "Enter the name of an ability to add, seperate multiple entries with ','" }yerf
{ "Each one costs 2XP.  Or ... enter ^RED^Q^ ^ to quit: " }yerf
read "," ", " subst "," explode_array foreach var! murr pop
murr @ "Q" smatch not if
 murr @ sysAbilities @ emerge not if
  { "^RED^Invalid skill specified: " murr @ }yerf
 else
  me @ 2 spend not if
   me @ "ab/" murr @ capitalize strcat over over getstat ++ setstat
   { "^GREEN^" murr @ capitalize " ability bought for ^CYAN^2^GREEN^XP." }yerf
  else
   { "^RED^Could not afford " murr @ capitalize " you have " me @ XP ", you need 2XP." }yerf
  then
 then
then
repeat
murr @ "Q" smatch until
READ_SHOOTS_BLANKS
; PUBLIC abilities

: cg.reset
READ_SHOOTS_BLANKS
{ "^RED^Are you sure you want to reset your sheet and everything?  Type YES in all caps to continue." }yerf
read "YES" strcmp not if
 { "Your sheet is going byebye..." }yerf
 paranoia if AVATAR { "!wc #" me @ " just reset their sheet." }cat force then
 me @ "/@rp/" remove_prop
 { "It's dead, Jim." }yerf
 { "Hard restarting chargen.." }yerf
 me @ "chargen" force
 pid kill
else
 { "You abort the spell at the last moment.  Whew." }yerf
then
READ_SHOOTS_BLANKS
; PUBLIC cg.reset

: rpinfo
command @ var! x "+rpinfo" command !
{ "Enter a term to search for: " }yerf read #1029 call
x @ command !
; PUBLIC rpinfo



: MainMenu.create
$def MENU_CHARGEN 1
$def MENU_PC 2
$def MENU_ANY 3
$def MENU_COMMON 4
$def STEPS "123456789ABCZ"
{
 "1" { "attrs" "Attributes" MENU_ANY }array
 "2" { "traits" "Traits" MENU_COMMON }array
 "3" { "skills" "Skills" MENU_ANY }array
 "4" { "nation" "Nationality" MENU_CHARGEN }array
 "5" { "races" "Races" MENU_CHARGEN }array
 "6" { "powers" "Powers" MENU_COMMON }array
 "7" { "talents" "Talents" MENU_COMMON }array
 "8" { "magics" "Magic" MENU_COMMON }array
 "9" { "aspects" "Aspect" MENU_ANY }array
 "A" { "psionics" "Psionics" MENU_COMMON }array
 "B" { "orders" "Orders" MENU_COMMON }array
 "C" { "abilities" "Abilities" MENU_COMMON }array
 "P" { "spells" "Spells" MENU_COMMON }array
 "R" { "rpinfo" "RPInfo" MENU_COMMON }array
 "S" { "sheet" "Display sheet" MENU_COMMON }array
 "X" { "reset" "Reset sheet" MENU_CHARGEN }array
 "Z" { "finish" "Finish chargen" MENU_CHARGEN }array
}dict mainMenu !
;

: nextStep[ str:curStep -- ]
cmode @ 16 < if
 me @ "step" getstat var! myStep
 STEPS curstep @ instr STEPS mystep @ instr >= if
  me @ "step" STEPS STEPS curstep @ instr ++ 1 midstr dup not if pop "Z" then setstat
 then
then
;


: MainMenu.display[ str:item -- ]
mainMenu @ item @ [] var! tmp
tmp @ 0 [] var! section
tmp @ 1 [] var! sectionName
tmp @ 2 [] var! sectionType
{
cmode @ CHAR_IN_CHARGEN = if
 sectionType @ MENU_CHARGEN = sectionType @ MENU_ANY = sectionType @ MENU_COMMON = or or if
  { item @ me @ "step" getstat smatch if "^PURPLE^" else "^GREEN^" then
    { item @ ") " }cat 3 lj "^CYAN^)^YELLOW^" ")" subst
    { sectionName @ ":" }cat 15 lj
    " ^NORMAL^"
  }cat
 else
  { "^GLOOM^"
    { item @ ") " }cat 3 lj
    { sectionName @ ":" }cat 15 lj
    " ^NORMAL^"
  }cat
 then
else
 sectionType @ MENU_PC = sectionType @ MENU_ANY = sectionType @ MENU_COMMON = or or if
  { "^GREEN^"
    { item @ ") " }cat 3 lj "^CYAN^)^YELLOW^" ")" subst
    { sectionName @ ":" }cat 15 lj
    " ^NORMAL^"
  }cat
 else
  { "^GLOOM^"
    { item @ ") " }cat 3 lj
    { sectionName @ ":" }cat 15 lj
    " ^NORMAL^"
  }cat
 then
then
"^YELLOW^"
section @ case
 "nation" smatch when
   "Nationality" yip
 end
 "attrs" smatch when
  { "^RED^" { "Physical: " me @ mphysical }cat 15 lj
    "^GREEN^" { "Mental: " me @ mmental }cat 15 lj
    "^CYAN^" { "Spiritual: " me @ mspiritual }cat 15 lj
    "^YELLOW^" { "Social: " me @ msocial }cat 15 lj
  }cat
 end
 "traits" smatch when
  { "^GREEN^" { "Resources: " me @ mresources }cat 15 lj
    "^YELLOW^" { "Size: " me @ msize }cat 15 lj
  }cat
 end
 "skills" smatch when
  "See your sheet."
 end
 "sheet" smatch when
  "Display what is currently on your sheet so far."
 end
 "powers" smatch when
  "See your sheet."
 end
 "magics" smatch when
  "See your sheet."
 end
 "talents" smatch when
  "See your sheet."
 end
 "psionics" smatch when
  { "^GREEN^Primary: " me @ "psi/1" getstatstr "^NORMAL^; ^CYAN^Secondary: " me @ "psi/2" getstatstr }cat
 end
 "aspects" smatch when
  { "^GREEN^"
  "Area: " me @ "as/area" getstatstr "; "
  "Effect: " me @ "as/effect" getstatstr "; "
  "Range: " me @ "as/range" getstatstr "; "
  "Target: " me @ "as/target" getstatstr "; "
  "Time: " me @ "as/time" getstatstr
  }cat
 end
 "orders" smatch when
  { "^PURPLE^" me @ "@rp/or" array_get_propvals array_keys array_make array_commas }cat
 end
 "abilities" smatch when
  "See your sheet."
 end
 "rpinfo" smatch when
  "Get more information about practically anything!"
 end
 "spells" smatch when
  "Run the spell-maker (also +spell/make outside this proggie)"
 end
 "races" smatch when
  "Races" yip
 end
 "finish" smatch when
  "Submit your character for approval."
 end
 "reset" smatch when
  "Delete your sheet and start over."
 end
endcase
}tell
;

: sheet "" #1162 call ; PUBLIC sheet

: spells
 "$muf/spellmaker" match int 0 < if
  { "^RED^I couldn't find a spellmaking program!  Maybe it's not done yet." }tell
 else
  "$muf/spellmaker" match call
 then
; PUBLIC spells

$def BBOARD #52
$def BBLOC "/@Boards/Num/9/Msgs/"
: removeRequest[ d:target -- ]
target @ name var! myname
BBOARD BBLOC array_get_propdirs foreach swap pop var! tmp
 BBOARD { BBLOC tmp @ "/Subject" }cat getprop dup not if pop "" then myname @ "*" strcat smatch if
  AVATAR { "+bbdelete 9/" tmp @ }cat force
 then
repeat
;

: approve
param @ not if { "Format: @approve <player>[=<note>]" }yerf exit then
param @ "=" split var! note pmatch var! target
target @ int 0 < if { "Who the heck is that?" }yerf exit then
target @ "character_mode" 256 setstat
{ "^GREEN^You have just *approved* " target @ " sheet!" note @ if "  (" note @ ")" then }yerf
target @ { "^GREEN^Your character sheet has just been *approved* by " me @ "!" note @ if "  (" note @ ")" then }cat "FFa2RPS.Chargen" pretty ansi_notify
paranoia if AVATAR { "!wc #" target @ "'s character sheet has just been *approved* by " me @ "." note @ if "  (" note @ ")" then }cat force then
AVATAR { "p #mail " target @ "=Your character sheet has been *approved* by " me @ " as of " "%C %X" systime timefmt "." note @ if "  (" note @ ")" then }cat force
AVATAR { "@wln " target @ "=SYSTEM: " target @ "'s character sheet was *approved* by " me @ " as of " "%C %X" systime timefmt "." note @ if "  (" note @ ")" then }cat force
target @ "approvedby" me @ setstat
target @ "approvedat" systime setstat
target @ "@/+dp" 0 setprop
target @ removeRequest
;

: disapprove
param @ not if { "Format: @disapprove <player>[=<note>]" }yerf exit then
param @ "=" split var! note pmatch var! target
target @ int 0 < if { "Who the heck is that?" }yerf exit then
target @ "character_mode" 4 setstat
{ "^RED^You have just *disapproved* " target @ " sheet!" note @ if "  (" note @ ")" then }yerf
target @ { "^RED^Your character sheet has been *disapproved* by " me @ "... your character has been reverted to chargen status." note @ if "  (" note @ ")" then }cat "FFa2RPS.Chargen" pretty ansi_notify
paranoia if AVATAR { "!wc #" target @ "'s character sheet has been *disapproved* by " me @ "." note @ if "  (" note @ ")" then }cat force then
AVATAR { "p #mail " target @ "=Your character sheet has been *disapproved* by " me @ " as of " "%C %X" systime timefmt "." note @ if "  (" note @ ")" then }cat force
AVATAR { "@wln " target @ "=SYSTEM: " target @ "'s character sheet was *disapproved* by " me @ " as of " "%C %X" systime timefmt "." note @ if "  (" note @ ")" then }cat force
target @ "disapprovedby" me @ setstat
target @ "disapprovedat" systime setstat
target @ removeRequest
;

: main
READ_SHOOTS_BLANKS
var murr
param !
me @ mlevel 5 >= if
 command @ "@approve" smatch if approve exit then
 command @ "@disapprove" smatch if disapprove exit then
then
MainMenu.Create
me @ "character_mode" getstat cmode ! cgstage
begin
{ "FFa2RPS Character Developer, editing " me @ unparseobj }cat header tellme
mainmenu @ foreach pop var! item
 item @ MainMenu.Display
repeat
cmode @ 16 < if
 { "^GREEN^.) Toggle Chargen and PC mode (Currently " cmode @ CHAR_IN_CHARGEN = if "^GREEN^Chargen" else "^YELLOW^PC" then ")" }cat FASTCOLOR tellme
else
 { "^GLOOM^.) Toggle Chargen and PC mode (Currently " cmode @ CHAR_IN_CHARGEN = if "^GREEN^Chargen" else "^YELLOW^PC" then ")" }cat FASTCOLOR tellme
then
{ "^GREEN^Q) Quit chargen"                                                   FASTCOLOR }tell
LINE
{ "^GREEN^" me @ dp 1 fchop " DP, ^YELLOW^" me @ rawXP " XP, ^CYAN^" me @ xp " total XP, ^PURPLE^" me @ power " total power (spent DP and XP)" }tell
LINE
cmode @ CHAR_IN_CHARGEN = if
 { "Press ENTER alone to enter the highlighted step." }yerf
else
 { "Press ENTER alone to leave the character editor." }yerf
then
{ "Please select an option or press ^RED^Q^NORMAL^ to quit:" }yerf
read murr !
murr @ not if
 cmode @ CHAR_IN_CHARGEN = if
  me @ "step" getstat murr !
 else
  "Q" murr !
 then
then
murr @ "{Q|.}" smatch not if
mainMenu @ murr @ [] var! opt
opt @ not if
 { "That was an invalid selection, try again." }yerf
else
 opt @ 0 [] var! section
 opt @ 2 [] MENU_COMMON = if
  prog section @ call
 else
  cmode @ CHAR_IN_CHARGEN = if
   opt @ 2 [] MENU_CHARGEN = opt @ 2 [] MENU_ANY = or if
    prog "cg." section  @ strcat call
   else
    { "^RED^This option is not valid during chargen (and thus, grayed out).  Please try again." }yerf
   then
  else
   opt @ 2 [] MENU_PC = opt @ 2 [] MENU_ANY = or if
    prog "pc." section @ strcat call
   else
    { "^RED^This option is not valid after chargen (and thus, grayed out).  Please try again." }yerf
   then
  then
 then
then
then
murr @ "." smatch cmode @ 16 < and if
 cmode @ CHAR_IN_CHARGEN = if
  CHAR_IN_CHARGEN_PC cmode !
  { "^GREEN^Now in Chargen mode." }tell
 else
  CHAR_IN_CHARGEN cmode !
  { "^GREEN^Now in Player Character mode." }tell
 then
else
 murr @ nextstep
then
murr @ "Q" smatch until
{ "Ja ne!" }yerf
READ_SHOOTS_BLANKS
;
.
c
q