( LibRPS.muf.so -- Alynna Trypnotk -- for AMBER rpsystem )
( It lives again )
$pubdef :
$def RPSYSTEM "$rpsystem" match
$def RPBASE "/@rp/"
$pubdef RPSYSTEM "$rpsystem" match
$pubdef RPBASE "/@rp/"
$include $lib/alynna
$undef resolve

( Define some modes for charmode )
$def CHAR

: rpstat[ str:item -- value ] RPSYSTEM item @ getprop ; PUBLIC rpstat
$libdef rpstat

: }rpstat ( cripped array -- value )  }array "/" array_join RPSYSTEM swap getprop ; PUBLIC }rpstat
$libdef }rpstat

: }rpinfo ( cripped array -- value )  }array "/" array_join RPSYSTEM swap getpropstr ; PUBLIC }rpinfo
$libdef }rpinfo

: enumType[ str:type -- arr:types ] RPSYSTEM { "/" type @ "/" }cat array_get_propdirs ; PUBLIC enumType
$libdef enumType

: envstat[ ref:target str:item -- ref:newtarget value ] target @ RPBASE item @ strcat envprop ; PUBLIC envstat
$libdef envstat

: envstatobj[ ref:target str:item -- ref:newtarget ] target @ item @ envstat pop ; PUBLIC envstatobj
$libdef envstatobj

: envstatval[ ref:target str:item -- value ] target @ item @ envstat swap pop ; PUBLIC envstatval
$libdef envstatval

: getstat[ ref:target str:item -- value ] target @ RPBASE item @ strcat getprop ; PUBLIC getstat
$libdef getstat

: getstatint[ ref:target str:item -- value ] target @ RPBASE item @ strcat getprop dup not if pop 0 else toint then ; PUBLIC getstatint
$libdef getstatint

: getstatfloat[ ref:target str:item -- value ] target @ RPBASE item @ strcat getprop dup not if pop 0.0 else tofloat then ; PUBLIC getstatfloat
$libdef getstatfloat

: getstatobj[ ref:target str:item -- value ] target @ RPBASE item @ strcat getprop dup not if pop #-1 else todbref then ; PUBLIC getstatobj
$libdef getstatobj

: getstatstr[ ref:target str:item -- value ] target @ RPBASE item @ strcat getprop dup not if pop "" else tostr then ; PUBLIC getstatstr
$libdef getstatstr

: findstat[ ref:target str:item -- ref:newtarget value ]
target @ item @ envstat dup if 
 exit 
else 
 pop pop 
 RPSYSTEM item @ getstat dup if
  RPSYSTEM swap
 else
  #-1 0
 then
then
; PUBLIC findstat
$libdef findstat

: findstatobj[ ref:target str:item  -- ref:newtarget ] findstat pop ; PUBLIC findstatobj
$libdef findstatobj

: findstatval[ ref:target str:item  -- value ] findstat swap pop ; PUBLIC findstatval
$libdef findstatval

: setstat[ ref:target str:item value -- ] target @ RPBASE item @ strcat value @ setprop ; PUBLIC setstat
$libdef setstat

: resetstat[ ref:target str:item -- ]
target @ "m/" item @ strcat getstat dup if
 target @ item @ rot setstat
then
; PUBLIC resetstat $libdef resetstat

: resetall[ ref:target -- ]
target @ "/@rp/m/" target @ "/@rp/" 1 copyprops
; PUBLIC resetall $libdef resetall

: todir[ s:input -- s:output ]
input @ "* (*)" smatch if
 input @ strip " (" split dup strlen -- strcut pop "/" swap strcat strcat
else
 input @
then
; PUBLIC todir $libdef todir

: fromdir[ s:input -- s:output ]
input @ "*/*" smatch if
 { input @ "/" split " (" swap ")" }join
else
 input @
then
; PUBLIC fromdir $libdef fromdir

: chopsub[ s:input -- s:output ]
input @ 
 dup "*/*" smatch if "/" split pop then
 dup "* (*)" smatch if " (" split pop then
; PUBLIC chopsub $libdef chopsub

: chopallsub[ a/s:input -- a/s:output ]
var isString
input @ string? if 
 1 isString !
 input @ ", " explode_array input !
then
{ input @ foreach swap pop chopsub repeat }array
isString @ if
 ", " array_join
then
; PUBLIC chopallsub $libdef chopallsub

: mklist[ str:input -- array:output ]
input @ dup string? if ", " explode_array then
; PUBLIC mklist $libdef mklist

: mkstr[ array:input -- str:output ]
input @ dup array? if ", " array_join then
; PUBLIC mkstr $libdef mkstr

: smatchstrlist[ str:input str:find -- int:pos ]
input @ ", " explode_array find @ array_matchval array_count
; PUBLIC smatchstrlist $libdef smatchstrlist

: smatcharrlist[ arr:input str:find -- int:pos ]
input @ find @ array_matchval array_count
; PUBLIC smatcharrlist $libdef smatcharrlist

: emerge[ str/arr:list1 str/arr:list2 -- b:result ]
list1 @ dup string? if ", " explode_array then
list2 @ dup string? if ", " explode_array then
array_intersect array_count
; PUBLIC emerge $libdef emerge

( Amber specific stuff )

: stuff      "stuff"        getstat ; PUBLIC stuff            $libdef stuff
: power      "power"        getstat ; PUBLIC power            $libdef power

: getCost[ i:point s:table -- f:cost ]
{ "System" table @ "Cost" point @ 1 10 limit tostr }rpinfo tofloat
; PUBLIC getCost $libdef getcost

: spend[ d:target f/i:amount -- i:errorcode ]
var tmp

( Cant spend if sheetlocked )
target @ "sheetlocked" getstat if 2 exit then
( Cant spend if enough Stuff isnt had )
amount @ target @ stuff > if 1 exit then

( Remove the purchase amount, spending DP first then stuff )
target @ "stuff" over over getstat amount @ - setstat

( Then add what was spent to Power )
target @ "power" over over getstat amount @ + setstat
0
; PUBLIC spend  $libdef spend

: spendstuff[ d:target f/i:amount -- i:errorcode ]
var tmp

( Cant spend if sheetlocked )
target @ "sheetlocked" getstat if 2 exit then
( Cant spend if enough stuff isnt had )
amount @ target @ stuff > if 1 exit then
( Deduct stuff )
target @ "stuff" over over getstat amount @ - setstat
( Then add what was spent to Power )
target @ "power" over over getstat amount @ + setstat
0
; PUBLIC spendstuff  $libdef spendstuff

: strength   "strength"     getstat ; PUBLIC strength         $libdef strength  
: endurance  "endurance"    getstat ; PUBLIC endurance        $libdef endurance    
: psyche     "psyche"       getstat ; PUBLIC psyche           $libdef psyche 
: warfare    "warfare"      getstat ; PUBLIC warfare          $libdef warfare    

: mstrength      dup "m/strength"   getstat swap "b/strength"  getstat + ; PUBLIC mstrength      $libdef mstrength  
: mendurance     dup "m/endurance"  getstat swap "b/endurance" getstat + ; PUBLIC mendurance     $libdef mendurance    
: mpsyche        dup "m/psyche"     getstat swap "b/psyche"    getstat + ; PUBLIC mpsyche        $libdef mpsyche 
: mwarfare       dup "m/warfare"    getstat swap "b/warfare"   getstat + ; PUBLIC mwarfare       $libdef mwarfare    

: getrank[ d:target s:stat -- s:rank ]
{ }dict var! ranks
target @ stat @ getstat var! x
1 var! rank
#-1 "*" "P" find_array #-1 "*" "TZ" find_array array_union var! chars
chars @ foreach var! chard pop
 chard @ stat @ getstat dup if
  ranks @ chard @ int ->[] ranks !
 else pop then
repeat
ranks @ foreach toint var! value var! item
 value @ x @ > if rank ++ then
repeat
{ "Rank " rank @ }cat
;

: rank[ d:target s:stat -- s:rank ]
target @ stat @ getstatint case
 -25 <= when "Human" end
 -10 <= when "Chaos" end
   0 <= when "Amber" end
 default pop target @ stat @ getrank end
endcase
; PUBLIC rank
$libdef rank