$include $lib/rp
$include $lib/alynna
$def RPSYS RPSYSTEM
lvar param
lvar itype
lvar iname
 
: ADDITEM[ str:string -- str:result ] string @ ", " swap strcat strcat ;
: rpinfo-chopper[ str:string -- str:result ] string @ dup "/" instr 1 = if 1 strcut swap pop then
                dup "/" rinstr over strlen = if dup "/" rinstr 1 - strcut pop then ;
: l[ str:string int:chars -- str:result ] string @ chars @ swap dup not if pop "" then tostr swap lj ;
: r[ str:string int:chars -- str:result ] string @ chars @ swap dup not if pop "" then tostr swap rj ;
: l0[ str:string int:chars -- str:result ] string @ chars @ swap dup not if pop "0" then tostr swap lj ;
: r0[ str:string int:chars -- str:result ] string @ chars @ swap dup not if pop "0" then tostr swap rj ;
: neg[ num:value -- num:result ] value @ 0 swap - ;
: votes2cp[ num:value -- num:result ] value @ toint dup 5 / 5 * swap 5 % 2.0 / + ;
: stou[ str:string -- str:result ] string @ "_" " " subst ;
: utos[ str:string -- str:result ] string @ " " "_" subst ;
: ayb RPSYS { "/" itype @ "/" iname @ "/" } array_make "" array_join ;
: smatch_array[ str:string -- str:result ] string @ ", " explode_array "|" array_join "{" swap "}" strcat strcat ;
: eTYPE me @ "_prefs/FFa2rps/entry-type" getprop dup string? not if pop "" then ;
: eNAME me @ "_prefs/FFa2rps/entry-name" getprop dup string? not if pop "" then ;
: eTARGET "/" etype "/" ename "/" strcat strcat strcat strcat ;
 
$libdef find-prop-in
$pubdef find-prop "" find-prop-in
$pubdef find-nameprop "/name" strcat "" find-prop-in pop "" "/name" subst
$pubdef find-nameprop-in swap "/name" strcat swap find-prop-in pop "" "/name" subst
$def find-prop "" find-prop-in
$def find-nameprop "/name" strcat "" find-prop-in pop "" "/name" subst
$def find-nameprop-in swap "/name" strcat swap find-prop-in pop "" "/name" subst
: find-prop-in[ str:search str:section -- s x ]
var item
var value
var value2
RPSYS { section @ "/" search @ }cat getprop if
 { section @ "/" search @ }cat RPSYS over getprop exit
then
RPSYS section @ "/" strcat array_get_propdirs foreach value ! pop
 RPSYS { section @ "/" value @ "/" search @ }cat getprop if
  { section @ "/" value @ "/" search @ }cat RPSYS over getprop exit
 then
 RPSYS { section @ "/" value @ "/" }cat array_get_propdirs foreach value2 ! pop
  RPSYS { section @ "/" value @ "/" value2 @ "/" search @ }cat getprop if
   { section @ "/" value @ "/" value2 @ "/" search @ }cat RPSYS over getprop exit
  then
 repeat
repeat
"" 0
; PUBLIC find-prop-in
 
$libdef find-propdir-in
$pubdef find-propdir "" find-propdir-in
$def find-propdir "" find-propdir-in
: find-propdir-in[ str:search str:section -- s ]
var item
var value
var value2
 
RPSYS { section @ "/" search @ "/" }cat propdir? if
 { section @ "/" search @ capitalize }cat exit
then
RPSYS { section @ "/" }cat array_get_propdirs foreach value ! pop
 RPSYS { section @ "/" value @ "/" search @ "/" }cat propdir? if
  { section @ "/" value @ capitalize "/" search @ capitalize }cat exit
 then
 RPSYS { section @ "/" value @ "/" }cat array_get_propdirs foreach value2 ! pop
  RPSYS {  section @ "/" value @ "/" value2 @ "/" search @ "/" }cat propdir? if
   { section @ "/" value @ capitalize "/" value2 @ capitalize "/" search @ capitalize }cat exit
  then
 repeat
repeat
""
; PUBLIC find-propdir-in
 
$libdef find-stat
: find-stat[ dbref:target dbref:search -- s ? ]
var item
var value
var value2
 
target @ search @ getstat if
 search @ target @ search @ getstat exit
then
target @ "/@rp/" array_get_propdirs foreach value ! pop
 target @ { value @ "/" search @ }cat getstat if
  { value @ "/" search @ }cat target @ over getstat exit
 then
 RPSYS { "/@rp/" value @ "/" }cat array_get_propdirs foreach value2 ! pop
  target @ { value @ "/" value2 @ "/" search @ }cat getstat if
   { value @ "/" value2 @ "/" search @ }cat target @ over getstat exit
  then
 repeat
repeat
"" 0
; PUBLIC find-stat
 
: showindex
var count
var linestore
var item
var function
var idxperline
var itemsize
param @ function !
 
( dump an index )
{ "RPinfo item type: " function @ }cat header tellme
RPSYS function @ "/desc" strcat getpropstr if
 RPSYS function @ "/desc" strcat getpropstr wrap74 atellme
 "Items" header tellme
then
-1 count !
"" linestore !
RPSYS function @ array_get_propdirs maxstrlen case
 10 <= when 7 11 end
 11 <= when 6 13 end
 13 <= when 5 15 end
 17 <= when 4 19 end
 24 <= when 3 26 end
 default 2 39 end
endcase
itemsize ! idxperline !
RPSYS function @ array_get_propdirs foreach item !
item @ "_*" smatch not if
count @ 1 + count ! linestore @
{
 RPSYS function @ "/" item @ strcat strcat array_get_propdirs array_count if "^CYAN^" else "^YELLOW^" then
 item @ tostr capitalize itemsize @ lj
 "^NORMAL^"
}cat strcat linestore !
count @ idxperline @ % idxperline @ -- = if linestore @ tellme "" linestore ! then
then
repeat
count @ idxperline @ % idxperline @ -- < if linestore @ tellme "" linestore ! then
{ "FFa2RPS RPinfo v1.0 by Alynna" }cat footer tellme
;
 
: rpinfo
var item
var value
var value2
var count
var linestore
var function
var propdirmatch
var section
var idxperline
var itemsize
 
param !
command @ "?rpinfo" smatch if "" section ! else { command @ "" "+" subst "" "@" subst }cat section ! then
param @ not if
 section @ not if
  "/" param ! showindex exit
 else
  section @ param ! showindex exit
 then
then
"" itype ! "" iname !
 
param @ section @ find-nameprop-in dup if
 rpinfo-chopper "/" split iname ! itype !
else
 pop param @ section @ find-propdir-in dup if
  rpinfo-chopper param ! showindex exit
 else
  "Couldn't find that item." "RPinfo" pretty tellme exit
 then
then
 
{ iname @ capitalize " (" itype @ capitalize ")" }cat header tellme
ayb "desc" strcat getpropstr wrap74 atellme
{ "Other information" }cat header tellme
ayb array_get_propvals foreach value ! item !
item @ "_*" smatch not item @ "{desc|name}" smatch not and if
 { "^YELLOW^" item @ capitalize 16 lj "^GREEN^" value @ }cat tellme
then
repeat
ayb array_get_propdirs array_count 0 > if
"Subitems" header tellme
param @ function !
-1 count !
"" linestore !
ayb array_get_propdirs maxstrlen case
 10 <= when 7 11 end
 11 <= when 6 13 end
 13 <= when 5 15 end
 17 <= when 4 19 end
 24 <= when 3 26 end
 default 2 39 end
endcase
itemsize ! idxperline !
ayb array_get_propdirs foreach item !
item @ "_*" smatch not if
count @ 1 + count ! linestore @
{
 "^GREEN^"
 item @ tostr capitalize itemsize @ lj
 "^NORMAL^"
}cat strcat linestore !
count @ idxperline @ % idxperline @ -- = if linestore @ tellme "" linestore ! then
then
repeat
count @ idxperline @ % idxperline @ -- < if linestore @ tellme "" linestore ! then
then
{ "FFa2RPS RPinfo v1.0 by Alynna" }cat footer tellme
;
 
: entry
var item
var value
param !
 
command @ tolower case
 ".type" smatch when
  me @ "_prefs/FFa2rps/entry-type" param @ setprop
  { "Target:^YELLOW^ " eTARGET "^NORMAL^" }cat "Data" pretty tellhere
  end
 ".name" smatch when
  me @ "_prefs/FFa2rps/entry-name" param @ setprop
  RPSYS eTARGET "name" strcat param @ dup "/" instr if "/" rsplit swap pop then setprop
  { "Target:^YELLOW^ " eTARGET "^NORMAL^, name prop set" }cat "Data" pretty tellhere
  end
 ".desc" smatch when
  param @ value !
  RPSYS eTARGET "desc" strcat value @ setprop
  { "^GREEN^Property set, ^YELLOW^" eTARGET "desc:^CYAN^" value @ }cat "Data" pretty tellhere
  end
 ".set" smatch when
  param @ " " split value ! item !
  RPSYS eTARGET item @ strcat value @ setprop
  { "^GREEN^Property set, ^YELLOW^" eTARGET item @ ":^CYAN^" value @ }cat "Data" pretty tellhere
  end
endcase
;
 
: main
command @ case
 "+*" smatch when rpinfo end
 "@*" smatch when rpinfo end
 ".*" smatch when entry end
endcase
;