@program badgeos.muf
1 1000 d
i
$include $lib/rp
$include $lib/rps
$include $lib/rps2
$include $lib/alynna
$include $lib/pokedex
$def EVERYTHING_ARRAY #-1 "*" "" find_array
$def everything_with_prop everything @ swap value @ array_filter_prop
lvar param
lvar type

: getbadge
"$pokedex" match "/badge/" type @ strcat "/" strcat rot getprop
;

: leaderdbref ( s -- d )
var target target !
var value
target @ string? if target @ resolve dup ok? if target ! then else target @ exit then 
"$pokedex" match "/badge/" type @ "/leader" strcat strcat target @ setprop
target @
;

: give
var target
var tmp

param @ not if str "Format: " command @ " <person>" cat "Badges" pretty tellme exit then
param @ resolve target !
target @ int 0 < if "Insoluable reference." "Badges" pretty tellme exit then
me @ "gymleader" getstat type !
type @ string? not if "You arent a gym leader, duh." "Badges" pretty tellme exit then
target @ "b/" "/badge/" type @ "/name" strcat strcat getdex strcat type @ capitalize setstat
str me @ " gave a " type @ capitalize " badge to " target @ "!" cat "Badges" pretty tellhere
"/badge/" type @ "/TM" strcat strcat getdex tmp !
target @ "m/" tmp @ strcat over over getstat ++ setstat
str me @ " gave " tmp @ " to " target @ "!" cat "Badges" pretty tellhere
;

: givehm
var target
var tmp
param @ not if str "Format: " command @ " <person>" cat "GiveHM" pretty tellme exit then
param @ resolve target !
target @ int 0 < if "Insoluable reference." "GiveHM" pretty tellme exit then
me @ "hmprotect" getstat type !
type @ string? not if "You arent an HM protector." "GiveHM" pretty tellme exit then
target @ "m/" type @ strcat over over getstat ++ setstat
str me @ " gave " type @ " to " target @ "!" cat "GiveHM" pretty tellhere
;


: take
var target
param @ not if str "Format: " command @ " <person>" cat "Badges" pretty tellme exit then
param @ resolve target !
target @ int 0 < if "Insoluable reference." "Badges" pretty tellme exit then
me @ "gymleader" getstat type !
type @ string? not if "You arent a gym leader, duh." "Badges" pretty tellme exit then
target @ "b/" "/badge/" type @ "/name" strcat strcat getdex strcat 0 setstat
str me @ " took a " type @ capitalize " badge away from " target @ "!" cat "Badges" pretty tellhere
;


: badges
var target
var value
var types
var badge
var retarget
param @ if param @ resolve ok? if param @ resolve retarget ! else me @ retarget ! then else me @ retarget ! then
"Gym leaders and badges" header tellme
"$pokedex" match "/badge/" array_get_propdirs types !
types @ foreach value ! pop value @ type ! 
"/badge/" value @ "/leader" strcat strcat getdex leaderdbref target !
"/badge/" value @ "/name" strcat strcat getdex badge !
 str
 "^GREEN^" target @ name 16 lj
 str
 "^CYAN^" badge @ capitalize tostr "^NORMAL^/"
 "^GREEN^" value @ capitalize 
 cat 24 lj
 "^YELLOW^" target @ "xp" getstat level 2 fchop 5 rj " "
 "^WHITE^" retarget @ "b/" badge @ strcat getstat if retarget @ name " has this badge." strcat then
 cat tellme
repeat
"Badges" footer tellme
;

: list
var target
var item
var value
var everything
var types
var damn
var badge
"Badge listings" header tellme
EVERYTHING_ARRAY everything ! 
"$pokedex" match "/badge/" array_get_propdirs types !
types @ foreach value ! pop "/@rp/b/" "/badge/" value @ "/name" strcat strcat getdex dup badge ! strcat everything_with_prop damn !
damn @ array_count 0 > if
 str "Type: " value @ capitalize " - " "/badge/" value @ "/name" strcat strcat getdex " Badge - Leader: " "/badge/" value @ "/leader" strcat strcat getdex value @ type ! leaderdbref 
 cat header tellme
 damn @ foreach target ! pop
 target @ character? if
 str
 target @ "gymleader" getstat if "^CYAN^" target @ name 20 lj else 
  target @ "gym" getstat if "^GREEN^" target @ name 20 lj else
   "^YELLOW^" target @ name 20 lj then then
 str
 "^CYAN^" badge @ capitalize tostr "^NORMAL^/"
 "^GREEN^" value @ capitalize 
 cat 24 lj
 "^YELLOW^" target @ "xp" getstat level 2 fchop 5 rj " "
 "^WHITE^"
 target @ "gymleader" getstat if "Leader: " target @ "gymleader" getstat "; " then
 target @ "gym" getstat if "Member: " target @ "gym" getstat "; " then
 target @ "gymnote" getstat dup int? if pop "" then
 cat 
 param @ if dup "*" param @ "*" strcat strcat smatch if tellme else pop then else tellme then
 then
 repeat
then
repeat
"Hall of fame" footer tellme
;

: gymlist
var target
var item
var value
var everything
var types
var damn
var badge
"Gym index" header tellme
EVERYTHING_ARRAY everything ! 
"$pokedex" match "/badge/" array_get_propdirs types !
types @ foreach value ! pop "/@rp/gymleader" everything_with_prop "/@rp/gym" everything_with_prop array_union damn !
damn @ array_count 0 > if
 str "Type: " value @ capitalize " - " "/badge/" value @ "/name" strcat strcat getdex dup badge ! " Badge - Leader: " "/badge/" value @ "/leader" strcat strcat getdex value @ type ! leaderdbref 
 cat header param @ if dup "*" param @ "*" strcat strcat smatch if tellme else pop then else tellme then
 damn @ foreach target ! pop
 target @ character? if
 str
 target @ "gymleader" getstat if "^CYAN^" target @ name 20 lj else 
  target @ "gym" getstat if "^GREEN^" target @ name 20 lj else
   "^YELLOW^" target @ name 20 lj then then
 str
 "^CYAN^" badge @ capitalize tostr "^NORMAL^/"
 "^GREEN^" value @ capitalize 
 cat 24 lj
 "^YELLOW^" target @ "xp" getstat level 2 fchop 5 rj " "
 "^WHITE^"
 target @ "gymleader" getstat if "Leader: " target @ "gymleader" getstat "; " then
 target @ "gym" getstat if "Member: " target @ "gym" getstat "; " then
 target @ "b/" value @ "/name" strcat strcat getstat if "Has gym badge; " then
 target @ "gymnote" getstat dup int? if pop "" then
 cat 
 param @ if dup "*" param @ "*" strcat strcat smatch if tellme else pop then else tellme then
 then
 repeat
then
repeat
"Pokemon Gyms" footer tellme
;


: convert
var target
var types
var badge
var item
var value

1 dbtop int 1 - 1 for dbref target !
 target @ character? if
  "$pokedex" match "/badge/" array_get_propdirs types !
  types @ foreach swap pop "/badge/" swap dup type ! "/name" strcat strcat getdex badge !
  target @ "m/" badge @ " badge" strcat strcat getstat if
   target @ "m/" badge @ " badge" strcat strcat 0 setstat
   target @ "b/" badge @ strcat type @ setstat
   str target @ "'s " badge @ " badge was converted." cat "Badges" pretty tellhere
   then 
  repeat
 then
repeat
;

: admit
var target
param @ not if str "Format: " command @ " <person>" cat "Badges" pretty tellme exit then
param @ resolve target !
target @ int 0 < if "Insoluable reference." "Badges" pretty tellme exit then
 
me @ "gymleader" getstat type !
type @ string? not if "You arent a gym leader, duh." "Gym" pretty tellme exit then
 
target @ "gym" getstat if
 "They're already IN a gym!  Tell them to leave first." "Gym" pretty tellme exit then
 
me @ "gymleader" getstat target @ "gym" rot setstat
str target @ " has been made part of the " type @ " gym by " me @ "." cat "Gym" pretty tellhere
;

: expel
var target
param @ not if str "Format: " command @ " <person>" cat "Badges" pretty tellme exit then
param @ resolve target !
target @ int 0 < if "Insoluable reference." "Badges" pretty tellme exit then
 
me @ "gymleader" getstat type !
type @ string? not if "You arent a gym leader, duh." "Gym" pretty tellme exit then
 
target @ "gym" getstat tostr type @ smatch not if
 "They arent in your gym!" "Gym" pretty tellme exit then
 
target @ "gym" 0 setstat
str target @ " has been kicked out of the " type @ " gym by " me @ "!" cat "Gym" pretty tellhere
;

: leave
str "You just left the " me @ "gym" getstat " gym." cat "Gym" pretty tellme
me @ "gym" 0 setstat
;

: help
{
"Gym badges - Alynna Trypnotk 2003"
" "
"+badge #help"
"+gym #help"
" This text."
"+badges <person>"
" Display all the gyms, gym leaders, and whether you have their badge."
"+badge <filter>"
" Shows all people with a badge, spammy without a filter"
"+badge/give <person>"
" (Gym leaders) Give a person the badge for your gym."
"+badge/take <person>"
" (Gym leaders) Take the badge away."
"+gym <filter>"
" Show information about gyms, spammy without a filter"
"+gym/admit <person>"
" (Gym leaders) Makes them part of your gym."
"+gym/expel <person>"
" (Gym leaders) Kicks them to the curb."
"+gym/leave"
" Leave whatever gym you're in."
"+givehm <person>"
" (HM Protectors) Give a person your HM or TM"
} array_make atellme
;

: main
param !
command @ tolower case
 "*#h*" smatch when help end
 "+badges" smatch when badges end
 "+badge" smatch when list end
 "+badge/give" smatch when give end
 "+badge/take" smatch when take end
 "+gym" smatch when gymlist end
 "+gym/admit" smatch when admit end
 "+gym/expel" smatch when expel end
 "+gym/leave" smatch when leave end
 "+givehm" smatch when givehm end
 "*/convert" smatch when convert end
 default help end
endcase
;
.
c
q