@program libPokeNav.muf
1 10000 d
i
$include $lib/rp
$include $lib/alynna
$include $lib/pokedex

$def }tell }cat tellme
$def }otell }cat tellhere
$def PKMN { "Pok" 233 itoc "mon" }cat
$def PKMNs { "pok" 233 itoc "mon" }cat
$def PK { "Pok" 233 itoc }cat
$def PKs { "pok" 233 itoc }cat
$def mp { "Pok" 233 itoc "NAV" strcat strcat rot strcat }cat pretty
lvar param

: fastlookup[ str:target -- ref:result ]
param @ not if
 "me" param !
then
param @ resolve dup int 0 < if pop "Can't find that player/puppet." "" mp tellme pid kill then
;

: nav.help
{ PKMN " Navigator v1.0 - by Alynna Trypnotk" }cat header tellme
{
{ "^GRAY^"   "+nav"                20 lj "^WHITE^Main menu (You are reading it)" }cat
{ "^GREEN^"  "+nav/map"            20 lj "^WHITE^Display a map of the region you're in" }cat
{ "^BLUE^"   "+nav/cond"           20 lj "^WHITE^Display pokemon condition, and next pokeblock due time" }cat
{ "^BLUE^"   "+nav/makeblock"      20 lj "^WHITE^Make a pokeblock (if theres a pokeblock machine present)" }cat
{ "^RED^"    "+nav/eyes"           20 lj "^WHITE^Display Trainer's Eyes (IC information) on someone" }cat
{ "^RED^"    "+nav/set/strategy"   20 lj "^WHITE^Set your 'eyes' information: Strategy" }cat
{ "^RED^"    "+nav/set/pokemon"    20 lj "^WHITE^Set your 'eyes' information: Pokemon summary" }cat
{ "^RED^"    "+nav/set/intro"      20 lj "^WHITE^Set your 'eyes' information: Self-Introduction" }cat
{ "^RED^"    "+nav/set/streetwise" 20 lj "^WHITE^Set your 'eyes' information: Streetwise" }cat
{ "^YELLOW^" "+nav/ribbon"         20 lj "^WHITE^Display ribbon information" }cat
{ "^YELLOW^" "+nav/ribbon/give"    20 lj "^WHITE^Give someone a ribbon you developed" }cat
{ "^YELLOW^" "+nav/ribbon/take"    20 lj "^WHITE^Take a ribbon away from someone" }cat
{ "^YELLOW^" "+nav/ribbon/remove"  20 lj "^WHITE^Discard one of your ribbons" }cat
}array atellme
{ PKMN " time: " "%X %x" systime timefmt }cat footer tellme
;

: nav.eyes
param @ fastlookup var! target
{ "Info for " target @ }cat header tellme
{ "^CYAN^" "Strategy" 20 lj "^YELLOW^" target @ "c/Strategy" getstat dup not if pop "^RED^<UNSET>^NORMAL^" then }tell
{ "^CYAN^" "Pokemon Summary" 20 lj "^YELLOW^" target @ "c/Pokemon" getstat dup not if pop "^RED^<UNSET>^NORMAL^" then }tell
{ "^CYAN^" "Self Introduction" 20 lj "^YELLOW^" target @ "c/Intro" getstat dup not if pop "^RED^<UNSET>^NORMAL^" then }tell
target @ "c/Streetwise" getstat dup not if pop { "^CYAN^" "Streetwise" 20 lj "^YELLOW^" "^RED^<UNSET>^NORMAL^" }tell else 
 { "Streetwise for " target @ }cat header tellme
 target @ "c/Streetwise" getstat wrap78 atellme
then
{ PK "NAV/Eyes 1.0" }cat footer tellme
;

: nav.set.strategy
param @ not if
 me @ "c/strategy" 0 setstat
 "Strategy cleared." "/set/stradegy" mp tellme exit
then
me @ "c/strategy" param @ setstat
"Strategy set." "/set/stradegy" mp tellme
;

: nav.set.intro
param @ not if
 me @ "c/intro" 0 setstat
 "Self-Introduction cleared." "/set/intro" mp tellme exit
then
me @ "c/intro" param @ setstat
"Self-Introduction set." "/set/intro" mp tellme
;

: nav.set.pokemon
param @ not if
 me @ "c/pokemon" 0 setstat
 "Pokemon summary cleared." "/set/pokemon" mp tellme exit
then
me @ "c/pokemon" param @ setstat
"Pokemon summary set." "/set/pokemon" mp tellme
;

: nav.set.streetwise
param @ not if
 me @ "c/streetwise" 0 setstat
 "Streetwise cleared." "/set/streetwise" mp tellme exit
then
me @ "c/streetwise" param @ setstat
"Streetwise set." "/set/streetwise" mp tellme
;

: nav.ribbon
var target
var ribbon
var item
var color
param @ fastlookup target !
{ "Ribbons on " target @ ": " target @ "@rp/c/ribbons/" array_get_propvals array_count }cat header tellme
target @ "@rp/c/ribbons/" array_get_propvals foreach ribbon ! item !
 { "^" ribbon @ "_color" getprop dup not if pop "NORMAL" then "^" }cat color ! 
 { color @
   item @ 6 lj 
   ribbon @ "_name" getprop dup not if pop ribbon @ name then 24 lj 
   " - Type: " ribbon @ "_type" getprop dup not if pop { "^RED^<UNSET>" color @ }cat then
   "; Subtype: " ribbon @ "_subtype" getprop dup not if pop { "^RED^<UNSET>" color @ }cat then
 }tell
 ribbon @ "_/de" getprop dup if wrap78 atellme else pop then
 repeat
{ PK "NAV/Ribbons v1.0" }cat footer tellme
;

: nav.ribbon.give
param @ not if
 "Syntax: +nav/ribbon/give <ribbon>=<someone>" "/ribbon/give" mp tellme exit 
then
param @ "=" split resolve var! target match var! ribbon
target @ int 0 < if "Cant find player" "/ribbon/give" mp tellme exit then
ribbon @ int 0 < if "Cant find ribbon" "/ribbon/give" mp tellme exit then
ribbon @ "_ribbon" getprop not if
 "It's not a ribbon." "/ribbon/give" mp tellme exit 
then
me @ ribbon @ controls not if
 "You don't control the ribbon matched." "/ribbon/give" mp tellme exit 
then
{ "^" ribbon @ "_color" getprop dup not if pop "NORMAL" then "^" }cat var! color 
target @ "c/ribbons/" ribbon @ int intostr strcat ribbon @ setstat
{ me @ " gave " color @ ribbon @ "_name" getprop dup not if pop ribbon @ name then "^NORMAL^ to " target @ "." }cat "/ribbon/give" mp tellme
;

: nav.ribbon.take
param @ not if
 "Syntax: +nav/ribbon/take <ribbon>=<someone>" "/ribbon/take" mp tellme exit 
then
param @ "=" split resolve var! target match var! ribbon
target @ int 0 < if "Cant find player" "/ribbon/take" mp tellme exit then
ribbon @ int 0 < if "Cant find ribbon" "/ribbon/take" mp tellme exit then
ribbon @ "_ribbon" getprop not if
 "It's not a ribbon." "/ribbon/take" mp tellme exit 
then
me @ ribbon @ controls not if
 "You don't control the ribbon matched." "/ribbon/take" mp tellme exit 
then
{ "^" ribbon @ "_color" getprop dup not if pop "NORMAL" then "^" }cat var! color 
target @ "c/ribbons/" ribbon @ int intostr strcat 0 setstat
{ me @ " took " color @ ribbon @ "_name" getprop dup not if pop ribbon @ name then "^NORMAL^ from " target @ "." }cat "/ribbon/take" mp tellme
;

: nav.ribbon.remove
param @ not if
 "Syntax: +nav/ribbon/remove <#>" "/ribbon/remove" mp tellme exit 
then
me @ "c/ribbons/" param @ strcat 0 setstat
{ me @ " threw away ribbon #" param @ "." }cat "/ribbon/remove" mp tellme
;

: nav.map
var target
var value
me @ location "_map#" envprop value ! target !
value @ not if
 "No map of this region." "/Map" mp tellme exit
then
target @ "~env/name" getprop header tellme
target @ "_map#" array_get_proplist atellme
{ PK "NAV Map v1.0" }cat footer tellme
;

: mkColor[ str:color -- str:result ]
color @ tolower case
 "red" smatch when "^RED^" end
 "blue" smatch when "^BLUE^" end
 "pink" smatch when "^PURPLE^" end
 "green" smatch when "^GREEN^" end
 "yellow" smatch when "^YELLOW^" end
endcase
;

: nav.makeblock
var berry1
var berry2
var berry1a
var berry2a
var berry1b
var berry2b
var berry1c
var berry2c
var pokeblock

param @ not if
 { "Syntax: +nav/makeblock <berry1>=<berry2>" }cat "PokeBlock" pretty tellme exit
then
me @ "pokeblock-blender" envstat swap pop not if
 { "There's no pokeblender here!" }cat "PokeBlock" pretty tellme exit
then
param @ "=" split berry2 ! berry1 !
berry1 @ "*berry" smatch not if berry1 @ " berry" strcat berry1 ! then
berry2 @ "*berry" smatch not if berry2 @ " berry" strcat berry2 ! then
me @ { "m/" berry1 @ }cat getstat 0 <= if 
 { "You dont have any " berry1 @ "!" }cat "PokeBlock" pretty tellme exit
else
 me @ { "m/" berry1 @ }cat over over getstat -- setstat
 { me @ " throws 1 " berry1 @ " into the blender... (Berry 1)" }cat "PokeBlock" pretty tellhere
 { "/item/" berry1 @ "/color" }cat getdex berry1c !
then
me @ { "m/" berry2 @ }cat getstat 0 <= if 
 { "You dont have any " berry2 @ "!" }cat "PokeBlock" pretty tellme exit
else
 me @ { "m/" berry2 @ }cat over over getstat -- setstat
 { me @ " throws 1 " berry2 @ " into the blender... (Berry 2)" }cat "PokeBlock" pretty tellhere
 { "/item/" berry2 @ "/color" }cat getdex berry2c ! 
then
berry1c @ "Wild" smatch if { "Red" "Blue" "Pink" "Green" "Yellow" }array array_random berry1c ! then
berry2c @ "Wild" smatch if { "Red" "Blue" "Pink" "Green" "Yellow" }array array_random berry2c ! then
0 dup berry1a ! berry2a !
 { "Berry 1 (" berry1c @ mkcolor berry1c @ "^NORMAL^) spins: "
   "Pokefood(" me @ "a/Pokefood" getstat toint dup berry1a ! ")+"
   "BerryConst(" 
    { "/item/" berry1 @ "/subtype" }cat getdex tolower case 
      atoi 0 > when { "/item/" berry1 @ "/subtype" }cat getdex atoi end
      "all" smatch when 200 end
      "pp" smatch when 150 end
      default pop 100 end
     endcase 
     dup berry1a @ + berry1a ! 
   ")+1d200("
     random 200 % 1 + dup berry1a @ + berry1a ! 
   ")=" berry1a @ " against 1d500(" random 500 % 1 + dup berry1b ! ") ... "
   berry1a @ berry1b @ >= if 
    "Berry mixed!"
   else
    "Berry cancelled out!" berry2c @ berry1c !
   then
 }cat "Pokeblock" pretty tellhere
 { "Berry 2 (" berry2c @ mkcolor berry2c @ "^NORMAL^) spins: "
   "Pokefood(" me @ "a/Pokefood" getstat toint dup berry1a ! ")+"
   "BerryConst(" 
    { "/item/" berry2 @ "/subtype" }cat getdex tolower case 
      atoi 0 > when { "/item/" berry1 @ "/subtype" }cat getdex atoi end
      "all" smatch when 200 end
      "pp" smatch when 150 end
      default pop 100 end
     endcase 
     dup berry2a @ + berry2a ! 
   ")+1d200("
     random 200 % 1 + dup berry2a @ + berry2a ! 
   ")=" berry2a @ " against 1d500(" random 500 % 1 + dup berry2b ! ") ... "
   berry2a @ berry2b @ >= if 
    "Berry mixed!"
   else
    "Berry cancelled out!" berry1c @ berry2c !
   then
 }cat "Pokeblock" pretty tellhere
{ "/berry/" berry1c @ "/" berry2c @ }cat getdex pokeblock !
{ "A " pokeblock @ " pokeblock was created and given to " me @ "!" }cat "Pokeblock" pretty tellhere
me @ { "m/" pokeblock @ " pokeblock" }cat over over getstat ++ setstat
;

: nav.condition
var target
var value
{ "Conditions of your " PKMNs }cat header tellme
me @ "@rp/p/" array_get_propvals foreach target ! pop
 { "^CYAN^" target @ name 15 lj
   "^RED^Cool ^CYAN^[^WHITE^" target @ "c/Cool" getstat tostr 1 lj "^CYAN^]   "
   "^BLUE^Beauty ^CYAN^[^WHITE^" target @ "c/Beauty" getstat tostr 1 lj "^CYAN^]   "
   "^PURPLE^Cute ^CYAN^[^WHITE^" target @ "c/Cute" getstat tostr 1 lj "^CYAN^]   "
   "^GREEN^Smart ^CYAN^[^WHITE^" target @ "c/Smart" getstat tostr 1 lj "^CYAN^]   "
   "^YELLOW^Tough ^CYAN^[^WHITE^" target @ "c/Tough" getstat tostr 1 lj "^CYAN^]"
 }cat tellme
 (
 { "               ^CYAN^Next " PK "block: " systime target @ "c/Next" getstat > if 
    "^GREEN^Now^NORMAL^"
   else
    "^RED^" target @ "c/Next" getstat systime - timex "^NORMAL^"
   then
 }cat tellme
 )
 repeat
{ PK "NAV/Condition v1.0" }cat footer tellme
;


: main[ str:arg -- results ]
arg @ param !
command @ tolower case
 "+nav/map"            smatch when nav.map end
 "+nav/cond"           smatch when nav.condition end
 "+nav/makeblock"      smatch when nav.makeblock end
 "+nav/eyes"           smatch when nav.eyes end
 "+nav/set/strategy"   smatch when nav.set.strategy end 
 "+nav/set/pokemon"    smatch when nav.set.pokemon end 
 "+nav/set/intro"      smatch when nav.set.intro end 
 "+nav/set/streetwise" smatch when nav.set.streetwise end 
 "+nav/ribbon"         smatch when nav.ribbon end
 "+nav/ribbon/give"    smatch when nav.ribbon.give end
 "+nav/ribbon/take"    smatch when nav.ribbon.take end
 "+nav/ribbon/remove"  smatch when nav.ribbon.remove end
 default nav.help end
endcase 
;

.
c
q