package Vee::Dex;

use strict;
use warnings;
use Exporter 'import';
our @EXPORT;

use String::Approx 'adist';
=head1 NAME

Vee::Dex - Pokedex data structures, caching, and utilities

=head1 SYNOPSIS

You should probably just look at the source.

=head1 DESCRIPTION

Contains some arbitrary Pokedex data that doesn't belong in the database, as
well as some short useful functions and some caches of oft-used database data.

=cut

################################################################################
# STATIC STUFF

# versions

our %Icons = ( gr => 'Green', r => 'Red', b => 'Blue', rb => 'Red/Blue', y => 'Yellow', rby => 'Red/Blue/Yellow',
           g => 'Gold', s => 'Silver', gs => 'Gold/Silver', c => 'Crystal', gsc => 'Gold/Silver/Crystal',
           ru => 'Ruby', sa => 'Sapphire', e => 'Emerald', rusa => 'Ruby/Sapphire', rse => 'Ruby/Sapphire/Emerald',
           fr => 'Fire Red', lg => 'Leaf Green', frlg => 'Fire Red/Leaf Green',
           rsfl => 'Ruby/Sapphire/Fire/Leaf', rsefl => 'Ruby/Sapphire/Emerald/Fire/Leaf',
           d => 'Diamond', p => 'Pearl', dp => 'Diamond/Pearl', pt => 'Platinum', dppt => 'Diamond/Pearl/Platinum' );
for my $k (keys %Icons) { $Icons{$k} = qq'<img src="/dex-images/balls/$k.png" class="pokeball" alt="$Icons{$k}" title="$Icons{$k}"/>' }

our @Generations = (
    { games => 'Red/Blue/Yellow',                 short => 'old',  abbr => 'rby', maxid => 151, maxmoveid => 165, region => 'Kanto', locpercents => [qw/25 15 15 10 10 10 5 5 4 1/], },
    { games => 'Gold/Silver/Crystal',             short => 'new',  abbr => 'gsc', maxid => 251, maxmoveid => 251, region => 'Johto', },
    { games => 'Ruby/Sapphire/Emerald/Fire/Leaf', short => 'rusa', abbr => 'rse', maxid => 386, maxmoveid => 354, region => 'Hoenn', locpercents => [qw/20 20 10 10 10 10 5 5 4 4 1 1/], },
    { games => 'Diamond/Pearl/Platinum',          short => 'dppt', abbr => 'dppt',maxid => 493, maxmoveid => 467, region => 'Sinnoh', locpercents => [qw/20 20 10 10 10 10 5 5 4 4 1 1/], locsurfpercents => [qw/60 30 5 4 1/], },
);

# pokemon misc

our @GrowthRates = qw/Slow Medium Fast Cubic Ultrafast Ultraslow/;

# breeding

our @BreedingGroups = (
    'None',       'Monster', 'Water 1', 'Bug',
    'Flying',     'Ground',  'Fairy',   'Plant',
    'Humanshape', 'Water 3', 'Mineral', 'Indeterminate',
    'Water 2',    'Ditto',   'Dragon',  'No Eggs',
);

# natures..

# TODO: this numbering thing is really fucking awful; use named keys please!
our %Natures = (
    adamant => { up => 1, down => 3 },
    bashful => undef,
    bold    => { up => 2, down => 1 },
    brave   => { up => 1, down => 5 },
    calm    => { up => 4, down => 1 },
    careful => { up => 4, down => 3 },
    docile  => undef,
    gentle  => { up => 4, down => 2 },
    hardy   => undef,
    hasty   => { up => 5, down => 2 },
    impish  => { up => 2, down => 3 },
    jolly   => { up => 5, down => 3 },
    lax     => { up => 2, down => 4 },
    lonely  => { up => 1, down => 2 },
    mild    => { up => 3, down => 2 },
    modest  => { up => 3, down => 1 },
    naive   => { up => 5, down => 4 },
    naughty => { up => 1, down => 4 },
    quiet   => { up => 3, down => 5 },
    quirky  => undef,
    rash    => { up => 3, down => 4 },
    relaxed => { up => 2, down => 5 },
    sassy   => { up => 4, down => 5 },
    serious => undef,
    timid   => { up => 5, down => 1 },
);

our @StatFlavors = ( undef, qw/ spicy sour dry bitter sweet / );

# moves

our @ContestTypes = qw/beauty smart cool cute tough/;

our %MoveKinds = (
    '#' =>  'Exploding move; automatically faints attacking Pok&eacute;mon (unless defending Pok&eacute;mon has a Substitute) and halves defending Pok&eacute;mon\'s Defense for damage calculation',
    '%' =>  'Accuracy decreases by half after each use until attacking Pok&eacute;mon is switched',
    '*' =>  'Hits some unusual number of times in one turn',
    '+' =>  'Some condition must be met for move to work',
    '-' =>  'Removes some sort of status effect',
    '.' =>  'Effect caused lasts a set number of turns',
    '/' =>  'Triggers some other move',
    '1' =>  'Always goes first; if other Pok&eacute;mon also uses a first-hit move, the one with higher Speed goes first',
    '2' =>  'Always goes second; if other Pok&eacute;mon also uses a second-hit move, the one with higher Speed goes first',
    ':' =>  'Damage is doubled under certain conditions',
    '=' =>  'Damage is HP-based and calculated by some formula',
    '?' =>  'Damage is HP-based and depends on received damage',
    '@' =>  'Does no damage but creates a shield of some sort',
     a  =>  'Status effect is applied to attacking Pok&eacute;mon',
     b  =>  'Binding move; hits 2-5 times in one turn, first turn does normal damage and the others 1/16 of max HP, prevents attacking in RBY, prevents switching/running in others',
     c  =>  'Increased chance for a critical hit',
     d  =>  'Status effect is applied to defending Pok&eacute;mon',
     e  =>  'Has some unique special effect',
     f  =>  'Deals a fixed amount of HP-based damage',
     g  =>  'Cannot miss',
     h  =>  'Heals the attacking Pok&eacute;mon',
     i  =>  'Ignores ineffectivenesses such as normal vs. ghost',
     k  =>  'One-hit KO',
     l  =>  'Damage is HP-based and equal to the level of the attacking Pok&eacute;mon',
     m  =>  'Hits 2-5 times in one turn; 3/8 chance of twice or thrice, 1/8 chance of quince or quice',
     n  =>  'Damage calculated normally',
     o  =>  'Has an overworld use',
     p  =>  'Damage is progressive; every successive use after the first the base power will double, but resets after five uses, if it misses, or if another move is used',
     q  =>  'Changed between generations',
     r  =>  'Requires sacrificing a turn',
     s  =>  'May inflict damage on the attacking Pok&eacute;mon',
     t  =>  'Hits twice in one turn',
     v  =>  'Damage is calculated some wacky way',
     w  =>  'Hits 2-3 times in one turn',
     z  =>  'Does no damage',
    '~' =>  'Changes the weather',
);

our %MoveEffects = (
    at => 'Attack', de => 'Defense', sa => 'Special Attack', sd => 'Special Defense', sp => 'Speed', hp => 'HP', ac => 'Accuracy', ev => 'Evasion',
    cfz => 'Confusion', par => 'Paralysis', psn => 'Poison', brn => 'Burns', frz => 'Freezing', fln => 'Flinching', lsd => 'Leech Seed', slp => 'Sleep', tox => 'bad Poison',
    tar => 'targeting', ter => 'depends on terrain', trp => 'trapping', tri => 'Freezing or Paralysis or Burns', att => 'Attraction',
);

our %MoveAmounts = (
    '+' => 'rises', '++' => 'greatly rises',
    '-' => 'falls', '--' => 'greatly falls',
    '^' => 'maxes out',
);

our %MoveRanges = (
    all         => 'All Pok&eacute;mon on the field',
    allies      => 'Allied Pok&eacute;mon',
    ally        => 'One allied Pok&eacute;mon',
    enemies     => 'All enemy Pok&eacute;mon',
    enemy       => 'One enemy Pok&eacute;mon',
    others      => 'All other Pok&eacute;mon on the field',
    randenemy   => 'One enemy Pok&eacute;mon at random',
    user        => 'The Pok&eacute;mon that used the move',
);

our @PowerLabels = (
    { pattern => 'D|A', label => '0, status' },
    { pattern => '@',   label => '0, shield' },
    { pattern => '-',   label => '0, -effect' },
    { pattern => 'H',   label => '0, heals' },
    { pattern => 'E',   label => '0, effect' },
    { pattern => '~',   label => '0, weather' },
    { pattern => '=',   label => 'formula' },
    { pattern => 'L',   label => 'level' },
    { pattern => 'V',   label => 'varies' },
    { pattern => 'F',   label => 'fixed' },
    { pattern => 'K',   label => 'OHKO' },
    { pattern => '\?',  label => 'reflects' },
    { pattern => '\/',  label => 'borrows' },
    { pattern => 'Z',   label => 'useless' },
);

our %OtherMoveSources = (
    pokecenter      => 'Given away on a premade a Pokemon as a New York Pokemon Center promotion',
    pikalightball   => 'Appears as an egg move if one of the parents is holding a Light Ball',
    box             => 'Comes on an egg given in Pokemon Box RS after storing some number of Pokemon from a single game',
    event           => 'On a special Pokemon given away at a one-time Nintendo event',
    stadium1        => 'Obtained via Pokemon Stadium',
    stadium2        => 'Obtained via Pokemon Stadium 2',
    xd              => 'Obtained via Pokemon XD',
    crystal         => 'Obtained via Pokemon Crystal',
);

# types

our %ModLabels = ( 400 => '4', 200 => '2', 100 => '1', 50 => '&frac12;', 25 => '&frac14;', 0 => '0' );
our %ModEffect = ( n => 10, h => 5, d => 20, z => 0 );

# statistics
# TODO: this needs a gigantic overhaul, and HP needs to be first

our @StatNames = ( 'HP', 'Attack', 'Defense', 'Special Attack', 'Special Defense', 'Speed' );
our @StatShortNames = ( 'HP', 'Attack', 'Defense', 'Sp. Att', 'Sp. Def', 'Speed' );
our @StatColumns = qw/ stat_hp stat_at stat_de stat_sa stat_sd stat_sp /;
our %StatColors = (
    stat_at => 'e84040', stat_de => '4040e8',
    stat_sa => 'ffc000', stat_sd => '00c0ff',
    stat_sp => 'ff8000', stat_hp => '40e840',
    stat_avg => '000000'
);

################################################################################
# DB CACHED STUFF

# You must call initialize with a $schema object to load all this, as this code
# is used by both Catalyst and an outside app!

our (@PokemonNames, @PokemonRomaji, @PokemonKana);
our (@PokemonJohto, @PokemonHoenn, @PokemonSinnoh);
our (@MoveData, $DamagingMoveCount);
our (%TypeData, @TypeNames, %OldTypeOrder, @NewTypeOrder);
our (@AbilityNames, @ItemNames);
our (@TMs, %MoveTMs);
our %FuzzyMatches;

sub initialize {
    my ($schema) = @_;

    my @pokenames = $schema->resultset('Pokemon')->search({
        id => { '<=', $Generations[-1]{maxid} },
    }, {
        order_by => 'id ASC',
        columns => [qw/id name name_romaji name_jp/],
    });
    @PokemonNames  = map { $_->name        } @pokenames;
    @PokemonRomaji = map { $_->name_romaji } @pokenames;
    @PokemonKana   = map { $_->name_jp     } @pokenames;

    @PokemonJohto  = $schema->resultset('Pokemon')->search({ id_johto  => { '>', 0 }, id => { '<=', $Generations[-1]{maxid} } }, { order_by => 'id_johto',  columns => ['id'] })->get_column('id')->all;
    @PokemonHoenn  = $schema->resultset('Pokemon')->search({ id_hoenn  => { '>', 0 }, id => { '<=', $Generations[-1]{maxid} } }, { order_by => 'id_hoenn',  columns => ['id'] })->get_column('id')->all;
    @PokemonSinnoh = $schema->resultset('Pokemon')->search({ id_sinnoh => { '>', 0 }, id => { '<=', $Generations[-1]{maxid} } }, { order_by => 'id_sinnoh', columns => ['id'] })->get_column('id')->all;

    # TODO: investigate DBIC caching; possibly turn this into a boring hash and change all references to it
    @MoveData = $schema->resultset('Moves')->search(undef, { order_by => 'me.id ASC', prefetch => 'effect' });
    $DamagingMoveCount = $schema->resultset('Moves')->search({ power => { '!=' => undef } })->count;

    %TypeData = map { $_->name => $_ } $schema->resultset('Types')->search({ internal_id => { '!=' => -1 } });
    @TypeNames = sort keys %TypeData;
    %OldTypeOrder = map { $_->internal_id + 1 => $_->name } values %TypeData;  # for Compat.pm
    @NewTypeOrder = map { $_->name } sort { $a->id <=> $b->id } grep { $_->id >= 0 } values %TypeData;

    @AbilityNames = $schema->resultset('Abilities')->search({ id => { '<', 200 } }, { order_by => 'id ASC', columns => ['name'] })->get_column('name')->all;
    @ItemNames    = $schema->resultset('Items')    ->search(undef,                  { order_by => 'id ASC', columns => ['name'] })->get_column('name')->all;

    # so I can use one-based ids with these
    unshift @PokemonNames, undef;
    unshift @PokemonJohto, undef;
    unshift @PokemonHoenn, undef;
    unshift @PokemonSinnoh, undef;
    unshift @PokemonKana, undef;
    unshift @PokemonRomaji, undef;
    unshift @MoveData, {};
    unshift @AbilityNames, undef;
    unshift @ItemNames, undef;

    # machines
    my @tms = $schema->resultset('Machines')->search(undef, { columns => ['id', 'generation', 'move_id'], order_by => 'id ASC' });
    for my $row (@tms) {
        $TMs[ $row->generation ][ $row->id ] = $row->move_id
    }

    for my $gen (0 .. $#Generations) {
        for my $tm (1 .. $#{$TMs[$gen]}) {
            next unless $TMs[$gen][$tm];
            $MoveTMs{ $TMs[$gen][$tm] }[ $gen ] = $tm;
        }
    }

    # ------------------------------------------------------------------------------
    # fuzzy cache

    # temporary, just for the below code; possibly to be promoted later
    my @movenames = $schema->resultset('Moves')->search(undef, { order_by => 'id ASC', columns => [qw/name_romaji name_jp/] });
    my @movekana   = ( undef, map { $_->name_jp     } @movenames );
    my @moveromaji = ( undef, map { $_->name_romaji } @movenames );

    # create an index of fuzzy matches
    our %FuzzyMatches;
    $FuzzyMatches{ lc $_->name_jp          } =
    $FuzzyMatches{ lc $_->name_romaji      } =
    $FuzzyMatches{ lc $_->name             } = { type => 'pokemon', id => $_->id, name => $_->name } for @pokenames;

    $FuzzyMatches{ lc $movekana[$_]        } =
    $FuzzyMatches{ lc $moveromaji[$_]      } =
    $FuzzyMatches{ lc $MoveData[$_]->name  } = { type => 'move',    id => $_, name => $MoveData[$_]->name  } for 1 .. $#MoveData;

    $FuzzyMatches{ lc $TypeNames[$_]       } = { type => 'type',    id => $_, name => $TypeNames[$_]       } for 0 .. $#TypeNames;
    $FuzzyMatches{ lc $AbilityNames[$_]    } = { type => 'ability', id => $_, name => $AbilityNames[$_]    } for 1 .. $#AbilityNames;
    $FuzzyMatches{ lc $ItemNames[$_]       } = { type => 'item',    id => $_, name => $ItemNames[$_]       } for 1 .. $#ItemNames;

    # TODO: hack!  remove this when I get kana/romaji for everything
    delete $FuzzyMatches{''};

    return 1;
}

################################################################################
# FUNCTIONS

my %pokenames = map { lc $PokemonNames[$_] => $_ } 1 .. $#PokemonNames;
my %movenames = map { lc $MoveData[$_]->name => $_ } 1 .. $#MoveData;

=head2 get_pokemon

Finds a Pokemon id given one of the following:
- a Pokemon id
- a Pokemon name in English, kana, or Romaji
- a string of the form "kanto ###", "johto ###", "hoenn ###", or "shin'oo ###"

if the input matches one of these formats but is still invalid, get_pokemon will
return a scalerref to a brief error description.  If nothing at all is found,
get_pokemon will simply return undef.

=cut

sub get_pokemon {
    my $input = lc shift;

    return undef if !$input;  # shouldn't be necessary except that a lot of Pokemon have no kana/romaji
    
    if ($input =~ /^(?:kanto ?)?(\d{1,3})$/) {
        # id
        return \ "$1 is out of range for Kanto." unless $PokemonNames[$1];
        return $1

    } elsif ($input =~ /^johto ?(\d{1,3})$/) {
        # johto id
        return \ "$1 is out of range for Johto." unless $PokemonJohto[$1];
        return $PokemonJohto[$1]

    } elsif ($input =~ /^hoenn ?(\d{1,3})$/) {
        # hoenn id
        return \ "$1 is out of range for Hoenn." unless $PokemonHoenn[$1];
        return $PokemonHoenn[$1]

    } elsif ($input =~ /^sinnoh ?(\d{1,3})$/) {
        # shin'ou id
        return \ "$1 is out of range for Sinnoh." unless $PokemonSinnoh[$1];
        return $PokemonSinnoh[$1]

    } elsif (exists $FuzzyMatches{$input} and $FuzzyMatches{$input}{type} eq 'pokemon') {
        # name in whatever format
        return $FuzzyMatches{$input}{id}
    }

    # I hate implied returns but this is far more dramatic.
    undef;
}

=head2 get_move

Finds a move id given one of the following:
- a move id in the form "move ###"
- a move name in English, kana, or Romaji

If the input matches one of these formats but is still invalid, get_move will
return a scalerref to a brief error description.  If nothing at all is found,
get_move will simply return undef.

=cut

sub get_move {
    my $input = lc shift;
    
    if ($input =~ /^(?:move ?)?(\d{1,3})$/) {
        # id
        return \ "$1 is out of range for Kanto." unless $MoveData[$1];
        return $1

    } elsif (exists $FuzzyMatches{$input} and $FuzzyMatches{$input}{type} eq 'move') {
        # name in whatever format
        return $FuzzyMatches{$input}{id}
    }

    # I hate implied returns but this is far more dramatic.
    undef;
}

=head2 get_type

Finds a type NAME given one of the following:
- a type id in the form "type ###" -- well, actually, not at the moment
- a type name alone, followed by "-type", or preceded by "type"

If the input matches one of these formats but is still invalid, get_type will
return a scalerref to a brief error description.  If nothing at all is found,
get_type will simply return undef.

=cut

sub get_type {
    my $input = lc shift;

    if ($input =~ /^type (\w+)$/) {
        # id
        return \ "$1 is not a type." unless $TypeData{$1};
        return $1

    } elsif ($input =~ /^(\w+)[- ]type$/) {
        # id
        return \ "$1 is not a type." unless $TypeData{$1};
        return $1

    } elsif (exists $TypeData{$input}) {
        # name in whatever format
        return $input
    }

    # I hate implied returns but this is far more dramatic.
    undef;
}

=head2 get_fuzzy

Performs a fuzzy search.  The first parameter is the input to search on;
subsequent parameters are treated as restrictions on what kind of search you
want, out of 'pokemon', 'move', and 'type'.  If there is only one parameter,
get_fuzzy will return anything that matches.

Return value is an array of matching hashrefs equivalent to those in the
%FuzzyMatches hash, plus a {dist} key specifying how well the hashref matches
the input.  The array is sorted by this distance.

get_fuzzy will return undef in the event of an error.  The only possible error,
of course, is that the input is less than four characters and thus unsuited for
fuzzy matching.

=cut

# I should read this comic more
sub get_fuzzy {
    my $input = lc shift;
    
    # restrictions
    my %classes = map { $_ => 0 } qw/pokemon move type/;
    my $check_classes = 0;
    for (@_) {
        $check_classes = $classes{$_} = 1 if exists $classes{$_};
    }
    
    # don't fuzzysearch on less than four characters or more than 24
    my $len = length $input;
    if ($len < 4 or $len > 24) {
        return;
    }

    # meat of fuzzy search
    my @matches = keys %FuzzyMatches;
    @matches = grep { $classes{ $FuzzyMatches{$_}{type} } } @matches if $check_classes;
    my @dists = map { abs } adist $input, @matches;
    my $max_dist = length($input) / 3;
    my @results;
    
    for my $m (0 .. $#matches) {
        next unless $dists[$m] <= $max_dist;
        my %hash = %{ $FuzzyMatches{ $matches[$m] } };
        $hash{key} = $matches[$m];
        push @results, \%hash;
        $results[-1]{dist} = $dists[$m];
    }

    @results = sort {
        $a->{dist} <=> $b->{dist} or
        abs(length($input) - length $a->{key}) <=> abs(length($input) - length $b->{key}) or
        $a->{key} cmp $b->{key}
    } @results;
    return @results;
}

# make Pokedex data etc presentable
sub polish_desc {
    my ($c, $data, $avoid) = @_;
    $data =~ s/\x0a/<br\/>/g;
    $avoid = lc $avoid;
    $data =~ s/Pokemon/Pok&eacute;mon/g;
    $data =~ s/é|\x82|é/&eacute;/g;
    my @replace;
    while ($data =~ /([A-Z][a-z]+(?: [A-Z][a-z]+)?)/g) {
        my $try = lc $1;
        next if $try eq $avoid;
        if ($pokenames{$try}) { unshift @replace, [ $-[1], $+[1] - $-[1], '<a href="' . $c->uri('Dex', 'pokemon', lc $try) . qq'">$1</a>' ] }
        if ($movenames{$try}) { unshift @replace, [ $-[1], $+[1] - $-[1], '<a href="' . $c->uri('Dex', 'moves', lc $try) . qq'">$1</a>' ] }
        if (chop $try eq 's') {
            if ($pokenames{$try}) { unshift @replace, [ $-[1], $+[1] - $-[1], '<a href="' . $c->uri('Dex', 'pokemon', lc $try) . qq'">$1</a>' ] }
            if ($movenames{$try}) { unshift @replace, [ $-[1], $+[1] - $-[1], '<a href="' . $c->uri('Dex', 'moves', lc $try) . qq'">$1</a>' ] }
        }
    }
    for (@replace) { substr($data, $_->[0], $_->[1]) = $_->[2] }
    return $data;
}

# useful template sortings
sub sort_by_level {
    $_[0] = [
        sort { ($$a[0] <=> $$b[0]) or ($MoveData[$$a[1]]->name cmp $MoveData[$$b[1]]->name) } @{ $_[0] }
    ];
}

sub sort_by_move {
    $_[0] = [ sort { ($MoveData[$a]->name cmp $MoveData[$b]->name) } @{ $_[0] } ];
}

=head2 height_imperial
=head2 weight_imperial
=head2 height_metric
=head2 weight_metric

Converts tenths of a kilogram or meter to formatted height/weight in either system.

=cut

sub height_imperial {
    my $in = Vee::Utils::round($_[0] / 0.254, 1);
    my $feet   = int($in / 12);
    my $inches = Vee::Utils::round($in - $feet * 12, 1);
    $feet    = $feet ? "$feet'" : "";
    $inches .= '"';
    return $feet . $inches;
}
sub weight_imperial { Vee::Utils::round($_[0] / 4.536, 1) . ' lb' }
sub height_metric { $_[0] / 10 . ' m' }
sub weight_metric { $_[0] / 10 . ' kg' }

=head2 plural

It is sad that it has come to this.

=cut

my %plurals = ( move => 'moves', pokemon => 'pokemon', type => 'types', ability => 'abilities', item => 'items' );
sub plural {
    $plurals{+shift}
}

=head2 tm_name

Returns the correct naming for a given TM number, i.e. TM41 or HM03.

=cut

sub tm_name {
    my $tm = shift;
    my $cat = 'TM';
    if ($tm > 100) {
        $tm -= 100;
        $cat = 'HM';
    }
    return sprintf "$cat%02d", $tm;
}

=head2 gender_text

Convert a gender code into readable Englilsh.  If the second parameter is true,
the text will be used as a title for the icon rather than displayed next to it.

=cut

my @gender_fractions = ('no', '&#x215B;', '&frac14;', '&#x215C;', '&frac12;', '&#x215D;', '&frac34;', '&#x215E;', 'all');
sub gender_text {
    my $gender_rate = shift;
    my $compact = shift;

    my $gender = int($gender_rate / 32 + 0.5);
    my ($img, $text);
    if ($gender_rate == 255) {
        $img = 'x'; $text = 'No gender';
    } else {
        $img = $gender;
        if ($gender == 0) {
            $text = 'Always male'
        } elsif ($gender == 8) {
            $text = 'Always female'
        } else {
            $text = "$gender_fractions[8 - $gender] male; $gender_fractions[$gender] female"
        }
    }
    
    if ($compact) {
        return qq'<img src="/dex-images/gender/$img.png" alt="" title="$text"/>';
    } else {
        return qq'<img src="/dex-images/gender/$img.png" alt=""/> $text';
    }
}

=head2 _type_effect_general

Generalization of the new and old type calculation functions.  

=cut

sub _type_effect_general {
    my ($field, $type_atk, $type_def1, $type_def2) = @_;

    return 100 unless defined $type_atk and exists $TypeData{$type_atk};
    my $effect = 1;
    my $fx = $TypeData{$type_atk}->$field;

    if (defined $type_def1 and exists $TypeData{$type_def1}) {
        $effect *= $ModEffect{ substr $fx, $TypeData{$type_def1}->id, 1 };
    } else {
        $effect *= 10;
    }
    
    if (defined $type_def2 and exists $TypeData{$type_def2}) {
        $effect *= $ModEffect{ substr $fx, $TypeData{$type_def2}->id, 1 };
    } else {
        $effect *= 10;
    }
    
    return $effect;
}

=head2 type_effect

Takes an attacking type and up to two defending types and returns the percent damage taken.

=cut

sub type_effect {
    unshift @_, 'new_effects';
    goto &_type_effect_general;
}

=head2 type_effect_old

Takes an attacking type and up to two defending types and returns the percent damage taken for R/B/Y.

=cut

sub type_effect_old {
    unshift @_, 'old_effects';
    goto &_type_effect_general;
}

sub hex_blurb { Vee::Utils::isnum($_[0]) && length $_[0] ? "$_[0] or 0x" . Vee::Utils::tohex($_[0]) : "n/a" }
sub stat_color { Vee::Utils::hsv2rgb($_[0], 64, 224) }

################################################################################
# In-game formulae

# 31-base statistics
# Natures not included!
# (base * 2 + iv + effort / 4) * level / 100 + 5
sub ingame_stats {
    my ($base, $level, $iv, $effort) = @_;

    return int(($base * 2 + $iv + int($effort / 4)) * $level / 100) + 5;
}

# 31-base HP
# (base * 2 + iv + effort / 4) * level / 100 + 5
sub ingame_hp {
    my ($base, $level, $iv, $effort) = @_;

    # special exception for Shedinja
    return 1 if $base == 1;

    return int(($base * 2 + $iv + int($effort / 4)) * $level / 100) + 10 + $level;
}

# 31-base hidden power power
sub ingame_hp_power {
    my (@ivs) = @_;

    # speed is in the middle as far as the game is concerned
    @ivs = @ivs[ 0, 1, 2, 5, 3, 4 ];

    my $sum = 0;
    for my $i (0 .. 5) {
        $sum += (($ivs[$i] & 0x02) >> 1) << $i;
    }

    return int($sum * 40 / 63) + 30;
}

# 31-base hidden power type
sub ingame_hp_type {
    my (@ivs) = @_;

    # speed is in the middle as far as the game is concerned
    @ivs = @ivs[ 0, 1, 2, 5, 3, 4 ];

    my $sum = 0;
    for my $i (0 .. 5) {
        $sum += ($ivs[$i] & 0x01) << $i;
    }

    # +1 is to skip normal and make fighting (normally 1) be zero
    return $NewTypeOrder[ int($sum * 15 / 63) + 1 ];
}

################################################################################
# Create a hash of every our'd variable in the package, for TT inclusion

our %all;
my %vartypes = ( ARRAY => '@', HASH => '%', SCALAR => '$', CODE => '' );
for my $var (keys %Vee::Dex::) {
    next if $var =~ /^_/ or grep { $var eq $_ } qw/EXPORT_FAIL EXPORT import all initialize/;
    
    my @valid_types = grep { defined *{ $Vee::Dex::{$var} }{$_} } keys %vartypes;
    next unless @valid_types;
    $all{$var} = *{ $Vee::Dex::{$var} }{ $valid_types[0] };
    if ($valid_types[0] eq 'SCALAR') { $all{$var} = ${ $all{$var} }; }
    
    push @EXPORT, $vartypes{ $valid_types[0] } . $var;
}

=head1 AUTHOR

Maintainer: Alex "Eevee" Munroe (C<veekun@veekun.com>)

See the included F<AUTHORS> file for a full list of contributers.

=head1 LICENSE

See the included F<LICENSE> file.

=cut

1;