$include $lib/rp
$include $lib/alynna
$def RPSYSTEM "$rpsystem" match
$def AVATAR "*Amber" match
lvar param
lvar cmode
lvar mainmenu
$def }yerf }cat "Amber.Chargen" pretty tellme
$def }oyerf }cat "Amber.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?
$def BBOARD #47
$def BBLOC "/@Boards/Num/4/Msgs/"
 
( --- BEGIN MODULES --- )
 
: cg.race
READ_SHOOTS_BLANKS
var tmp
"Race" enumType var! Races
"Races of Amber" header tellme
Races @ foreach var! value var! item
 { item @ ++ ") " value @
 me @ "race" getstatstr value @ emerge if "^Purple^ [Active]^ ^" then }cat FASTCOLOR tellme
repeat
LINE
{ "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
 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 @ "race" getstatstr tmp @ emerge if
    { "Enter the number of a race to add, ^CYAN^L^ ^ to relist, or ^RED^Q^ ^ to quit." }yerf
   else
    { "Race" tmp @ "Restricted" }rpinfo if
     { "^RED^This race is restricted!  Be sure to ask staff about taking this race before you do so!" }yerf
    then
    { "^YELLOW^Are you sure you want to buy the race ^GREEN^" tmp @ "^YELLOW^?" }yerf read "Y*" smatch if
     me @ "Race" tmp @ setstat
     { "Race" tmp @ "Stuff" }rpinfo if
      { "^YELLOW^Adjusting STUFF by " { "Race" tmp @ "Stuff" }rpinfo }yerf
      me @ "Stuff" over over getstat { "Race" tmp @ "Stuff" }rpinfo toint setstat
      me @ "@/startstuff" me @ stuff setstat
    then
    then
   then
  then
 then
else
then
READ_SHOOTS_BLANKS
; SAFECALL cg.race
 
: cg.attrs
var temp
{ "Strength" -1 "Endurance" -1 "Psyche" -1 "Warfare" -1 }dict var! attr
"Setting Attributes" header tellme
{ "Please set the initial attributes for your character." }yerf
{ "Specify them in the following order: Strength, Endurance, Psyche, Warfare" }yerf
{ "You can specify the following values: Human, Chaos, Amber, or a positive number greater than 0." }yerf
{ "Human has 0 cost, Chaos costs 15 stuff, Amber costs 25 stuff, and Ranked costs 25 plus the amount you specify." }yerf
{ "You will be automatically ranked against other players and it will show on the sheet." }yerf
begin
{ "Example:  To take the following attributes: " }yerf
{ " Strength at Human, Endurance at Amber, Psyche at Ranked 10, and Warfare at Amber, enter" }yerf
{ " Human Amber 10 Amber" }yerf
{ "Please enter the attributes now or ^RED^Q^ ^ to quit: " }yerf
read var! input
input @ "Q" smatch if break then
input @ " " explode_array var! attrinput
attrinput @ array_count 4 = not if
 { "^RED^Exactly 4 values must be entered." }yerf continue
then
( DEBUG_ON )
100 me @ mstrength me @ mendurance me @ mpsyche me @ mwarfare + + + + var! attrspent
attrinput @ 0 [] case
 "Human" smatch when 0 attr @ "Strength" ->[] attr ! end
 "Chaos" smatch when 15 attr @ "Strength" ->[] attr ! end
 "Amber" smatch when 25 attr @ "Strength" ->[] attr ! end
 default atoi 25 + attr @ "Strength" ->[] attr ! end
endcase
attrinput @ 1 [] case
 "Human" smatch when 0 attr @ "Endurance" ->[] attr ! end
 "Chaos" smatch when 15 attr @ "Endurance" ->[] attr ! end
 "Amber" smatch when 25 attr @ "Endurance" ->[] attr ! end
 default atoi 25 + attr @ "Endurance" ->[] attr ! end
endcase
attrinput @ 2 [] case
 "Human" smatch when 0 attr @ "Psyche" ->[] attr ! end
 "Chaos" smatch when 15 attr @ "Psyche" ->[] attr ! end
 "Amber" smatch when 25 attr @ "Psyche" ->[] attr ! end
 default atoi 25 + attr @ "Psyche" ->[] attr ! end
endcase
attrinput @ 3 [] case
 "Human" smatch when 0 attr @ "Warfare" ->[] attr ! end
 "Chaos" smatch when 15 attr @ "Warfare" ->[] attr ! end
 "Amber" smatch when 25 attr @ "Warfare" ->[] attr ! end
 default atoi 25 + attr @ "Warfare" ->[] attr ! end
endcase
attr @ "Strength" [] -1 =
attr @ "Endurance" [] -1 =
attr @ "Psyche" [] -1 =
attr @ "Warfare" [] -1 = or or or if
 { "^RED^One of the inputs was incorrect." }yerf continue 
then
me @ "m/strength" attr @ "Strength" [] 25 - setstat 
me @ "m/endurance" attr @ "Endurance" [] 25 - setstat
me @ "m/psyche" attr @ "Psyche" [] 25 - setstat
me @ "m/warfare" attr @ "Warfare" [] 25 - setstat
100 me @ mstrength me @ mendurance me @ mpsyche me @ mwarfare + + + + var! temp
me @ temp @ attrspent @ - spend
{ "Attributes adjusted.  Your stuff was adjusted by " temp @ attrspent @ - "." }yerf break
( DEBUG_OFF )
until
; SAFECALL cg.attrs
 
: pc.attrs
var temp
"Setting Attributes" header tellme
{ "You can raise your attributes using stuff." }yerf
{ "Specify the attribute you want to raise, followed by an amount to raise it, seperated by a space." }yerf
begin
{ "Attributes: Psyche, Strength, Endurance, Warfare -- Values greater than zero allowed" }yerf
{ "To raise Psyche by 10 enter: Psyche 10" }yerf
{ "Please enter the attributes now or ^RED^Q^ ^ to quit: " }yerf
read var! input
input @ "Q" smatch if break then
input @ " " explode_array var! attrinput
attrinput @ array_count 2 = not if
 { "^RED^Exactly 2 values must be entered." }yerf continue
then
attrinput @ 0 [] "{psyche|endurance|strength|warfare}" smatch not if
 { "^RED^The attribute you entered was not valid." }yerf continue
then
attrinput @ 1 [] atoi 0 <= if
 { "^RED^The value must be greater than 0." }yerf continue
then
me @ "m/" attrinput @ 0 [] strcat over over getstat attrinput @ 1 [] atoi + setstat
me @  attrinput @ 1 [] atoi spend
{ "Attributes adjusted.  Your stuff was adjusted by " attrinput @ 1 [] atoi "." }yerf break
until
; SAFECALL pc.attrs
 
( --- END MODULES --- ) 
 
 
: qmorph[ arr:input -- arr:output ]
{
input @ foreach swap pop 
 "^YELLOW^" swap strcat
 "^CYAN^[^GREEN^" "[" subst
 "^CYAN^]^YELLOW^" "]" subst
repeat
}array
;
 
: cgstage
var curstuff
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 @ "@/stuff" getprop if
   me @ "@/stuff" getprop curstuff !
   me @ "stuff" curstuff @ setstat
  else
   me @ "stuff" getstat dup curstuff ! not if
    me @ "stuff" { "System" "Chargen" "Start.Stuff" }rpinfo atoi dup curstuff ! setstat
   then
  then
  { "Starting you with " curstuff @ " Stuff. " }yerf
  me @ "character_mode" CHAR_IN_CHARGEN setstat
  me @ "start_chargen" systime setstat
  me @ "m/strength" -25 setstat
  me @ "m/psyche" -25 setstat
  me @ "m/endurance" -25 setstat
  me @ "m/warfare" -25 setstat
  me @ "strength" -25 setstat
  me @ "psyche" -25 setstat
  me @ "endurance" -25 setstat
  me @ "warfare" -25 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 stuff spending mode." }yerf
 end
 default pop { "What the heck?  You have unknown character mode " cmode @ "!  Call " prog owner "." }yerf exit end
endcase
;
 
: 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 "1234567Z"
{
 "1" { "race" "Race" MENU_CHARGEN }array
 "2" { "attrs" "Attributes" MENU_ANY }array
 "3" { "powers" "Powers" MENU_COMMON }array
 "4" { "constructs" "Constructs" MENU_COMMON }array
 "5" { "allies" "Allies" MENU_COMMON }array
 "6" { "shadows" "Shadows" MENU_COMMON }array
 "7" { "trump" "Trump Cards" 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
;
: dependencies[ d:target s:step -- a:yip ]
target @ "/@rp/Chargen/Steps/" array_get_propvals array_keys array_make var! stepz
{ "System/Chargen/Dependencies" step @ }rpstat dup if  
 " " explode_array var! depends stepz @ depends @ array_diff
else
 array_make
then
;  
 
: restrictions[ d:target s:step -- a:yip ]
target @ "/@rp/Chargen/Steps/" array_get_propvals array_keys array_make var! stepz
{ "System/Chargen/Restrictions" step @ }rpstat dup if 
 " " explode_array var! restricts restricts @ stepz @ array_intersect
else
 array_make     
then
;  
 
: dependency?[ str:step -- int:yip ]
me @ step @ restrictions if -1 exit then
me @ step @ dependencies not if 1 exit then
0
;  
 
: 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 @ dependency? 0 > 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
   { item @ dependency? not if "^RED^" else "^BLUE^" then
     { item @ ") " }cat 3 lj
     { sectionName @ ":" }cat 15 lj
     " ^NORMAL^"
   }cat
  then 
 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
  cmode @ CHAR_IN_CHARGEN_PC = if
   item @ dependency? 0 > 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
    { item @ dependency? not if "^RED^" else "^BLUE^" then
     { item @ ") " }cat 3 lj
     { sectionName @ ":" }cat 15 lj
     " ^NORMAL^"
    }cat
   then
  else 
   { "^GREEN^"
    { item @ ") " }cat 3 lj "^CYAN^)^YELLOW^" ")" subst
    { sectionName @ ":" }cat 15 lj
    " ^NORMAL^"
   }cat
  then
 else
  { "^GLOOM^"
    { item @ ") " }cat 3 lj
    { sectionName @ ":" }cat 15 lj
    " ^NORMAL^"
  }cat
 then
then
"^YELLOW^"
section @ case
 "attrs" smatch when
  { "^RED^" { "Strength: " me @ mstrength }cat 15 lj
    "^GREEN^" { "Endurance: " me @ mendurance }cat 15 lj
    "^CYAN^" { "Psyche: " me @ mpsyche }cat 15 lj
    "^YELLOW^" { "Warfare: " me @ mwarfare }cat 15 lj
  }cat   
 end
 "powers" smatch when
  "Select powers to add to your character"
 end
 "constructs" smatch when
  "- ? -"
 end
 "shadows" smatch when
  "- ? -"
 end
 "allies" smatch when
  "- ? -"
 end
 "trump" smatch when
  "- ? -"
 end
 "sheet" smatch when
  "Display what is currently on your sheet so far."
 end
 "rpinfo" smatch when
  "Get more information about practically anything!"
 end
 "race" smatch when
  "Race" yip 
 end
 "finish" smatch when
  "Submit your character for approval." 
 end
 "reset" smatch when
  "Delete your sheet and start over." 
 end
endcase
}tell
;
 
: sheet "" "$lib/rp/sheet" match call ; PUBLIC sheet
 
: 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 "AmberRPS.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 @ "@/stuff" 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 "AmberRPS.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
{ "AmberRPS 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 @ stuff 1 fchop " stuff, ^PURPLE^" me @ power " total power." }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
;