#!perl

require "~common.pl";
require "~dex.common.pl";
require "~sql.dex.pl";

my $id = $cmn::GQuery->get('id');
if (!defined $id) { layout::fatal('Pokédex Error', 'No Pokémon id given.') }
my %this = sql::dex::pokemon_info($id - 1);
if (!%this) { layout::fatal('Pokédex Error', qq'Pokémon id "$id" is invalid.') }

$this{hid} = $this{id} + 1;
$this{pid} = cmn::pad($this{hid}, 3);
$this{generation} = ($this{id} < 151) ? 0 : ( ($this{id} < 251) ? 1 : 2 );

my %evchain = sql::dex::evchain_info($this{evid});
my @ranked_types = sql::dex::type_ranked;

layout::header(title => "$this{name} - Pok&eacute;mon #$this{hid}", heading => $this{name}, linkname => 'dex');

################################################################################

print <<END;
<span style="float: right;"><a href="/dex.pl?$dex::PokeNames[($this{id} + 1) % $dex::PokeCount]"> $dex::PokeNames[($this{id} + 1) % $dex::PokeCount] &gt; </a></span>
<a href="/dex.pl?$dex::PokeNames[($this{id} - 1) % $dex::PokeCount]"> &lt; $dex::PokeNames[($this{id} - 1) % $dex::PokeCount] </a>

<h1>Basic Data</h1>
<table class="dex_basic">
<tr> <td class="dex_basic_name">Name:</td> <td class="dex_basic_value">$this{name}</td> <td class="dex_basic_name">Height:</td> <td class="dex_basic_value">@{[int($this{height} / 12)]}'@{[$this{height} % 12]}" or @{[cmn::round($this{height} * 0.0254, 1)]} m</td> <td class="dex_basic_name">R/B/Y code:</td> <td class="dex_basic_value">@{[dex::hexstr($this{oldgs})]}</td> </tr>
<tr> <td class="dex_basic_name">Number:</td> <td class="dex_basic_value">$this{hid}</td> <td class="dex_basic_name">Weight:</td> <td class="dex_basic_value">$this{weight} lb or @{[cmn::round($this{weight} * 0.4536, 1)]} kg</td> <td class="dex_basic_name">G/S/C code:</td> <td class="dex_basic_value">@{[dex::hexstr($this{generation} < 2 ? $this{hid} : undef)]}</td> </tr>
<tr> <td class="dex_basic_name">RuSa Number:</td> <td class="dex_basic_value">@{[ $this{newid} + 1 ]}</td> <td class="dex_basic_name">Type:</td> <td class="dex_basic_value"><span class="type-$this{type1}"><a href="/dex.pl?$this{type1}-type">$this{type1}</a></span>@{[ $this{type2} ? qq' / <span class="type-$this{type2}" style="padding: 1px;"><a href="/dex.pl?$this{type2}-type">$this{type2}</a></span>' : '' ]}</td> <td class="dex_basic_name">Base EXP:</td> <td class="dex_basic_value">@{[dex::hexstr($this{baseexp})]}</td> </tr>
<tr> <td class="dex_basic_name">Generation:</td> <td class="dex_basic_value"><a href="/dex.search.pl?gen=$dex::Generations[$this{generation}]{abbr}">$dex::Generations[$this{generation}]{games}</a></td> <td class="dex_basic_name">Kind:</td> <td class="dex_basic_value">\U$this{kind}\E</td> <td class="dex_basic_name">Capture rate:</td> <td class="dex_basic_value">@{[dex::hexstr($this{caprate})]}</td> </tr>
<tr> <td class="dex_basic_name">Romaji:</td> <td class="dex_basic_value">$this{japname}</td> <td class="dex_basic_name">Color:</td> <td class="dex_basic_value"><a href="/dex.search.pl?color=$this{color}">\U$this{color}\E</a></td> <td class="dex_basic_name">Breeding code:</td> <td class="dex_basic_value"><a href="/dex.search.pl?brdmode=code&amp;brdcode=@{[cmn::tohex($this{brdcode})]}">@{[dex::hexstr($this{brdcode})]}</a></td> </tr>
<tr> <td class="dex_basic_name">Katakana:</td> <td class="dex_basic_value">$this{japkana}</td> <td class="dex_basic_name">Growth rate:</td> <td class="dex_basic_value">$dex::GrowthRates[$evchain{growth}]</td> <td class="dex_basic_name">Gender code:</td> <td class="dex_basic_value">@{[dex::hexstr($this{gender})]}</td> </tr>
END

{
    # abilities
    print qq'<tr> <td class="dex_basic_name">Abilities:</td> <td class="dex_basic_value" colspan="3">';
    my @abilities = split / /, $this{ability};
    my @abildata = ();
    for (@abilities) {
        my %abil = sql::dex::ability_info($_);
        push @abildata, qq#<a href="/dex.search.pl?ability=$abil{name}">\U$abil{name}\E</a>: # . dex::fixpoke($abil{effect});
    }
    print join ' <br/> ', @abildata;
    if (!defined $evchain{steps}) { $evchain{steps} = 'n/a'; } else { $evchain{steps} =~ s/(\d\d\d)$/,$1/; }
    print qq'</td> <td class="dex_basic_name">Steps to hatch:</td> <td class="dex_basic_value">$evchain{steps}</td> </tr>\n';


    # breeding code
    my ($a, $b) = split //, cmn::tohex($this{brdcode});
    my @brdgrpnames = sql::dex::breed_names;

    print qq'<tr> <td class="dex_basic_name">Breeding groups:</td> <td class="dex_basic_value" colspan="5">';
    print qq'<a href="/dex.search.pl?brdmode=group&amp;brdgroup=$a">$a - $brdgrpnames[hex $a]</a>';
    print qq' <br/> <a href="/dex.search.pl?brdmode=group&amp;brdgroup=$b">$b - $brdgrpnames[hex $b]</a>' unless $a eq $b;
    print qq'</td> </tr>\n';

    # gender distro
    print qq'<tr> <td class="dex_basic_name">Gender distro:</td> <td class="dex_basic_value" colspan="5">';

    my @frac = qw/0 &#x215B; &frac14; &#x215C; &frac12; &#x215D; &frac34; &#x215E; all/;
    my $gen = $this{gender};
    my $g = cmn::round( $gen / 32 );
    if ($gen == 255) { print "No gender"; }
    elsif ($g == 0) { print "Always male"; }
    elsif ($g == 8) { print "Always female"; }
    else { print qq'$frac[$g] female, $frac[8 - $g] male; females have an Attack DV of @{[ $g * 2 - 1 ]} or lower'; }
    print qq'</td> </tr>\n';


    # effort points
    print qq'<tr> <td class="dex_basic_name">Effort Points:</td> <td class="dex_basic_value" colspan="5">';
    my @pts;
    for my $i (0 .. 5) {
        my $pt = substr $this{effort}, $i, 1;
        if ($pt) { push @pts, "$pt $dex::StatNames[$i]"; }
    }
    print (join(', ', @pts) or 'none (you should NOT see this)');
    print qq'</td> </tr>\n';
}

print <<END;
</table>

END

# ---------------------------------------------------------------------------- #

print <<END;
<h1>Evolution Chain</h1>
<table class="dex_basic dex-evchain">
END

# evolution chain
# I love this.  this is the greatest thing ever.
{
    my $ev = eval $evchain{chain};
    my $orig = eval $evchain{chain};
    my $rows = &ev_countrows($ev);
    my $levs = &ev_countlevels($ev);
    my $newev = &ev_addrows($ev, 1);
    my $has_baby = ($levs > 1 and $orig->[0] > $orig->[2][0]);

    print qq'<tr>';
    print qq'<th>Baby</th>' if $has_baby;
    print qq'<th>Basic</th>';
    print qq'<th>Stage 1</th>' if $levs - ($has_baby?1:0) >= 2;
    print qq'<th>Stage 2</th>' if $levs - ($has_baby?1:0) >= 3;
    print qq'</tr>';
    
    for $i (1 .. $rows) {
        my $evptr = $newev;
        print "<tr>\n";
        for $j (1 .. $levs) {
            if ($evptr->[2] == $i) {
                my $tmprows = &ev_countrows($evptr, 1);
                my $rspan = $tmprows == 1 ? '' : ' rowspan="' . $tmprows . '"';
                my $pnum = cmn::pad($evptr->[0] + 1, 3);
                my $hnum = $evptr->[0] + 1;
                my $item = $evptr->[1] ? &ev_item($evptr->[1]) : ($has_baby ? 'lucky-egg' : 'pokeball');
                my $s = ($evptr->[0] == $this{id}) ? '<strong>' : '';
                my $e = ($evptr->[0] == $this{id}) ? '</strong>' : '';
                my $method = &ev_type($evptr->[1]) || 'Base form';
                $method = "<br/><em>$method</em>";
                print qq' <td$rspan>';
                print qq' <a href="/dex.pl?$dex::PokeNames[$evptr->[0]]">' if $evptr->[0] != $this{id};
                print qq' <div class="dex-evchain-icons"><img src="/dex-images/items/$item.png" alt=""/><img src="/dex-images/icons/$pnum.png" alt="$hnum"/></div>';
                print qq' <div class="dex-evchain-text">$s$dex::PokeNames[$evptr->[0]]$e$method</div>';
                print qq' </a>' if $evptr->[0] != $this{id};
                print qq' </td>\n';
            }
            last if $j == $levs;
            for $k (0 .. $#$evptr-3) {
                if ($k == $#$evptr-3 or $evptr->[$k+4][2] > $i) { $evptr = $evptr->[$k+3]; last; }
            }
        }
        print "</tr>\n";
    }
}

print <<END;
</table>

END

# ---------------------------------------------------------------------------- #

print <<END;
<h1>Type Modifiers</h1>
Types are arranged by how much damage they do against this Pok&eacute;mon. <br/>
Note that one or two type effects changed in G/S/C, and this chart uses the NEW effects. <br/>
<table class="dex_types" cellspacing="0">
END

{
    my $t1 = $dex::TypeData{ $this{type1} }{id};
    my $t2 = defined $this{type2} ? $dex::TypeData{ $this{type2} }{id} : -1;
    my @nums = sort { $dex::TypeNames[$a] cmp $dex::TypeNames[$b] } 0 .. $#dex::TypeNames;
    my (@tbl, @cnt, $tname);
    for $i (@nums) {
        $ef1 = $dex::ModEffect{ substr $dex::TypeData{$dex::TypeNames[$i]}{new_effects}, $t1, 1 };
        $ef2 = ($t2 == -1) ? 10 : $dex::ModEffect{ substr $dex::TypeData{$dex::TypeNames[$i]}{new_effects}, $t2, 1 };
        $ef = $ef1 * $ef2;
        $tbl[$i] = $dex::ModAmt{$ef};
        $cnt[ $dex::ModAmt{$ef} ]++;
    }
    for $i (0 .. 5) {
        next unless $cnt[$i];
        print qq'<tr style="background: #$dex::ModColors[$i];"> <th> $dex::ModAmt[$i]: </th>\n';
        for $j (@nums) {
            if ($tbl[$j] == $i) {
                $tname = $dex::TypeNames[$j];
                print qq' <td><span class="type-$tname"><a href="/dex.pl?$tname-type">$dex::TypeData{$tname}{abbr}</a></span></td>\n';
            } else { print qq' <td></td>\n'; }
        }
        print qq'</tr>\n';
    }
}

print <<END;
</table>

END

# ---------------------------------------------------------------------------- #

print <<END;
<h1>Pok&eacute;dex Data</h1>
<table>
END

if ($this{generation} == 0) {
    print qq'<tr><td>$dex::Icons{rb}</td><td>' . dex::fixpoke($this{dexrb}) .  qq'</td></tr>\n';
    print qq'<tr><td>$dex::Icons{y}</td><td>' . dex::fixpoke($this{dexy}) .  qq'</td></tr>\n';
}
if ($this{generation} <= 1) {
    print qq'<tr><td>$dex::Icons{g}</td><td>' . dex::fixpoke($this{dexg}) .  qq'</td></tr>\n';
    print qq'<tr><td>$dex::Icons{s}</td><td>' . dex::fixpoke($this{dexs}) .  qq'</td></tr>\n';
    print qq'<tr><td>$dex::Icons{c}</td><td>' . dex::fixpoke($this{dexc}) .  qq'</td></tr>\n';
    print qq'<tr><td>$dex::Icons{rusa}</td><td>' . dex::fixpoke($this{dexsa}) .  qq'</td></tr>\n';
} else {
    print qq'<tr><td>$dex::Icons{ru}</td><td>' . dex::fixpoke($this{dexru}) .  qq'</td></tr>\n';
    print qq'<tr><td>$dex::Icons{sa}</td><td>' . dex::fixpoke($this{dexsa}) .  qq'</td></tr>\n';
}

print <<END;
</table>

END

# ---------------------------------------------------------------------------- #

print <<END;
<h1>Locations</h1>
This is...  in the works, but whatever is shown here ought to be accurate. <br/>
It only shows limited stuff from R/B right now, but I'm working on that.  When finished, there will be a link to a more detailed chart of the levels of the Pok&eacute;mon in each area and the chances of seeing them. <br/>
<h2>Wild</h2>
<table class="dex_basic dex_locations">
END

my %locfreq = sql::dex::get_frequencies;
my @loccolumns = (
    [qw/walking:grass walking:cave/],
    [],
    [qw/walking:grass walking:cave fishing:old fishing:good fishing:super surfing/]
);

my %loc;
for my $ver (qw/red blue yellow/) { $loc{$ver} = { sql::dex::get_locations_summary($this{id}, $ver, $dex::LocPercents[0]) }; }
for my $ver (qw/ruby sapphire/)   { $loc{$ver} = { sql::dex::get_locations_summary($this{id}, $ver, $dex::LocPercents[2]) }; }

if (&loc_equal($loc{red}, $loc{blue})) {
    if (&loc_equal($loc{red}, $loc{yellow})) {
        &loc_print($loc{red},       'rby',  '999', $loccolumns[0]);
    } else {
        &loc_print($loc{red},       'rb',   '949', $loccolumns[0]);
        &loc_print($loc{yellow},    'y',    'CC0', $loccolumns[0]);
    }
} else {
    &loc_print($loc{red},       'r',    '944', $loccolumns[0]);
    &loc_print($loc{blue},      'b',    '449', $loccolumns[0]);
    &loc_print($loc{yellow},    'y',    'CC0', $loccolumns[0]);
}
if (&loc_equal($loc{ruby}, $loc{sapphire})) {
    &loc_print($loc{ruby},      'rusa', 'C6F', $loccolumns[2]);
} else {
    &loc_print($loc{ruby},      'ru',   'F99', $loccolumns[2]);
    &loc_print($loc{sapphire},  'sa',   '99F', $loccolumns[2]);
}

print <<END;
</table>

END

# ---------------------------------------------------------------------------- #

print <<END;
<h1>Pok&eacute;dex Images</h1>
<table class="big center middle">
END

if ($this{generation} == 0) {
print <<END;
<tr>
 <td> <img src="/dex-images/green/$this{pid}.png" alt="Green version"/> <br/> $dex::Icons{gr} "Green" </td>
 <td> <img src="/dex-images/redblue/$this{pid}.png" alt="Red/Blue versions"/> <br/> $dex::Icons{rb} Red / Blue </td>
 <td> <img src="/dex-images/yellow/$this{pid}.png" alt="Yellow version"/> <br/> $dex::Icons{y} Yellow </td>
 <td> <img src="/dex-images/frlg/$this{pid}.png" alt="FrLg versions"/> <img src="/dex-images/frlg/shiny/$this{pid}.png" alt="FrLg shiny version"/> <br/> $dex::Icons{frlg} Fire Red/Leaf Green </td>
</tr>
END
}
if ($this{generation} <= 1) {
print <<END;
<tr>
 <td> <img src="/dex-images/gold/$this{pid}.png" alt="Gold version"/> <img src="/dex-images/gold/shiny/$this{pid}.png" alt="Gold shiny version"/> <br/> $dex::Icons{g} Gold </td>
 <td> <img src="/dex-images/silver/$this{pid}.png" alt="Silver version"/> <img src="/dex-images/silver/shiny/$this{pid}.png" alt="Silver shiny version"/> <br/> $dex::Icons{s} Silver </td>
 <td> <img src="/dex-images/crystal/$this{pid}.gif" alt="Crystal version"/> <img src="/dex-images/crystal/shiny/$this{pid}.gif" alt="Crystal shiny version"/> <br/> $dex::Icons{c} Crystal </td>
 <td> <img src="/dex-images/newback/$this{pid}.png" alt="Reversed GSC versions"/> <img src="/dex-images/newback/shiny/$this{pid}.png" alt="Reversed GSC shiny versions"/> <br/> $dex::Icons{gsc} GSC back </td>
</tr>
END
}
print <<END;
<tr>
 <td> <img src="/dex-images/rusa/$this{pid}.png" alt="RuSa versions"/> <img src="/dex-images/rusa/shiny/$this{pid}.png" alt="RuSa shiny version"/> <br/> $dex::Icons{rusa} RuSa </td>
 <td> <img src="/dex-images/rusaback/$this{pid}.png" alt="Reversed Ru/Sa/FR/LG versions"/> <img src="/dex-images/rusaback/shiny/$this{pid}.png" alt="Reversed Ru/Sa/FR/LG shiny version"/> <br/> $dex::Icons{rsfl} Ru/Sa/FR/LG back </td>
 <td> <img src="/dex-images/icons/$this{pid}.png" alt="RuSa Icon"/> <br/> RuSa Icon </td>
 <td> <img src="/dex-images/icons/old/$this{pid}.gif" alt="Old Icon"/> <br/> Old Icon </td>
</tr>
</table>

END

# ---------------------------------------------------------------------------- #

print <<END;
<h1>Stats</h1>
See also: DV Calulator, Stat Calculator
<table class="dex_stats big" cellspacing="0">
<tr><th>Stat</th><th>Base Amount</th><th>%ile</th></tr>
END

my $avg_stat = 0;
for my $i (0 .. $#dex::StatCols) {
    &stat_row($dex::StatNames[$i], $this{$dex::StatCols[$i]},
        sql::dex::stat_percentile($dex::StatCols[$i], $this{$dex::StatCols[$i]}));
    $avg_stat += $this{$dex::StatCols[$i]};
}
$avg_stat /= @dex::StatCols;
&stat_row("<em>Average</em>", cmn::round($avg_stat, 1), sql::dex::stat_avg_percentile($avg_stat));

print <<END;
</table>

END

# ---------------------------------------------------------------------------- #

print <<END;
<h1>Breeding Compatibility</h1>
END

{
    if ($this{id} == 131) {
        print qq#Ditto can breed with any breeding Pok&eacute;mon (sorry, no baby Lugia) to produce an egg of that specie.\n#;
    } elsif ($this{brdcode} == 255) {
        print qq#Pok&eacute;mon with a breeding code of FF cannot produce eggs.  This unfortunately includes anything good.\n#;
    } elsif ($this{gender} == 255) {
        print qq#Genderless Pok&eacute;mon can only breed with Ditto.\n#;
    } else {
        print qq'Only base Pok&eacute;mon are shown; in general any evolution also applies, with the known exception of Nidoran F (Nidorina and Nidoqueen cannot breed).<br/>\n';
        print qq'If your browser has CSS3 support, some Pok&eacute;mon may be faded out; these are genderless and thus can only breed with Ditto, but are technically still valid partners.<br/>\n';
        print qq'Also keep in mind that any gendered Pok&eacute;mon can breed with Ditto.\n';
        my @t = sql::dex::compatible($this{brdcode});
        for (@t) { print qq'<a href="/dex.pl?$dex::PokeNames[$_->[0]]" class="dex_pokelist@{[ $_->[1] ? " genderless" : "" ]}"><img src="/dex-images/icons/@{[ cmn::pad($_->[0] + 1, 3) ]}.png" alt="$dex::PokeNames[$_]" title="$dex::PokeNames[$_->[0]]"/></a>\n'; }
        print "<div class=\"total\">" . scalar(@t) . " families total</div>\n";
    }
}

print "\n";

# ---------------------------------------------------------------------------- #

print <<END;
<h1>Move List</h1>
Note: accuracies are for G/S/C and RuSa.  Keep in mind that R/B/Y accuracies are about 0.4% (1 in 255) lower than those shown. <br/>
<table class="dex" cellspacing="0">
<tr>
END

local (@rb, @y, @gs, @c, @rusa);
for my $ver (qw/rb y gs c rusa frlg/) {
    next unless defined $this{'moves' . $ver};
    for my $mv (split / /, $this{'moves' . $ver}) { push @$ver, [ split(/-/, $mv) ] }
}
my @moves = sort by_level @frlg;

# nab baby/tutor crap
my @babyrusa = sort { $dex::MoveData[$a]{name} cmp $dex::MoveData[$b]{name} } split / /, ( $evchain{babyrusa} || '' );
my @babygs   = sort { $dex::MoveData[$a]{name} cmp $dex::MoveData[$b]{name} } split / /, ( $evchain{babygs} || '' );
my @babyc    = sort { $dex::MoveData[$a]{name} cmp $dex::MoveData[$b]{name} } split / /, ( $evchain{babyc} || '' );
my @tutor = split / /, $this{tutormoves} || '';

# determine whether to merge level columns
my $combine_rby = 1;
my $combine_gsc = 1;
my $combine_rsfl = 1;

# merge gold/silver/crystal
if ($this{generation} <= 1) {
    @rusa = sort by_level @rusa;
    if ($#rusa != $#frlg) { $combine_rsfl = 0; }
    else { for (0 .. $#rusa) { if ($rusa[$_][0] != $frlg[$_][0] or $rusa[$_][1] != $frlg[$_][1]) { $combine_rsfl = 0; last; } } }
    &mergemoves( \@moves, \@rusa ) unless $combine_rsfl;
}

# merge gold/silver/crystal
if ($this{generation} <= 1) {
    @c  = sort by_level @c;
    @gs = sort by_level @gs;
    if ($#c != $#gs or $#babygs != $#babyc) { $combine_gsc = 0; }
    else {
        for (0 .. $#gs) { if ($gs[$_][0] != $c[$_][0] or $gs[$_][1] != $c[$_][1]) { $combine_gsc = 0; last; } }
        for (0 .. $#babygs) { if ($babygs[$_] != $babyc[$_]) { $combine_gsc = 0; last; } }
    }
    &mergemoves( \@moves, \@c );
    &mergemoves( \@moves, \@gs ) unless $combine_gsc;
}

# merge red/blue/yellow
if ($this{generation} == 0) {
    @y  = sort by_level @y;
    @rb = sort by_level @rb;
    if ($#y != $#rb) { $combine_rby = 0; }
    else { for (0 .. $#rb) { if ($rb[$_][0] != $y[$_][0] or $rb[$_][1] != $y[$_][1]) { $combine_rby = 0; last; } } }
    &mergemoves( \@moves, \@y );
    &mergemoves( \@moves, \@rb ) unless $combine_rby;
}

my $move_columns = 0;
my $move_header = sub { qq' <th class="dextbl_level">$dex::Icons{$_[0]}</th>\n' };

# print level headers
if ($this{generation} == 0) {
    if ($combine_rby) {
        print &$move_header('rby');
        $move_columns++;
    } else {
        print &$move_header('rb'), &$move_header('y');
        $move_columns += 2;
    }
}
if ($this{generation} <= 1) {
    if ($combine_gsc) {
        print &$move_header('gsc');
        $move_columns++;
    } else {
        print &$move_header('gs'), &$move_header('c');
        $move_columns += 2;
    }
}
if ($combine_rsfl) {
    print &$move_header('rsfl');
    $move_columns++;
} else {
    print &$move_header('rusa'), &$move_header('frlg');
    $move_columns += 2;
}

print <<END;
 <th class="dextbl_name"> Move </th> <th class="dextbl_type"> Type </th> <th class="dextbl_pp"> PP </th>
 <th class="dextbl_power"> Power </th> <th class="dextbl_acc"> Acc. </th> <th class="dextbl_blurb"> Description </th>
</tr>
END

my $all_columns = $move_columns + 6;

my $color = 1;

# Level moves
for my $i (0 .. $#moves) {
    my $anum = $moves[ $i ][ -1 ];
    print qq'<tr class="color$color">\n';
    for my $j (reverse 0 .. $#{ $moves[0] } - 1) {
        $moves[$i][$j] += 0;
        if ($moves[$i][$j] == 0) { print ' <td> &nbsp; </td>' }
        elsif ($moves[$i][$j] == 1) { print ' <td> -- </td>' }
        else { print qq' <td> $moves[$i][$j] </td>' }
    }
    print "\n", dex::move_cells($anum), "</tr>\n";
    $color = 3 - $color;
}

# Inherited moves
my %baby;
for (@babyrusa) { $baby{$_} = 1 } @babyrusa{ @babyrusa } = @babyrusa;
for (@babygs)   { $baby{$_} = 1 } @babygs  { @babygs   } = @babygs;
for (@babyc)    { $baby{$_} = 1 } @babyc   { @babyc    } = @babyc;
print qq'<tr>\n <th colspan="$all_columns" class="dextbl_divider"> Inherited moves ' if %baby;
print "(Pok&eacute;mon can also inherit any TMs they are compatible with) " if ($this{newtm} or $this{rusatm}) and %baby;
print " </th>\n</tr>\n" if %baby;
for $anum (sort { $dex::MoveData[$a]{name} cmp $dex::MoveData[$b]{name} } keys %baby) {
    print qq'<tr class="color$color">\n';
    print qq' <td> </td>' if $this{generation} == 0;
    print qq' <td> </td>' if $this{generation} == 0 and !$combine_rby;
    print "\n";
    if ($this{generation} <= 1) {
        if ($combine_gsc) { print ' <td> ', ($babygs{$anum} ? 'GSC' : ''), ' </td>'; }
        else { print ' <td> ', ($babygs{$anum} ? 'GS' : ''), ' </td> <td> ', ($babyc{$anum} ? 'C' : ''), ' </td>'; }
    }
    print ' <td', ($combine_rsfl ? '' : ' colspan="2"'), '> ', ($babyrusa{$anum} ? 'RSFL' : ''), ' </td>';
    print dex::move_cells($anum), "</tr>\n";
    $color = 3 - $color;
}

# Tutor moves
print qq'<tr> <th colspan="$all_columns" class="dextbl_divider"> Move Tutor (Crystal only) </th> </tr>\n' if @tutor;
for $anum (@tutor) {
    print qq'<tr class="color$color">\n  <td colspan="$move_columns"> </td>\n';
    print dex::move_cells($anum), "</tr>\n";
    $color = 3 - $color;
}

# TMs
for $tm (reverse 0 .. $#dex::Generations) {
    my $tmgen = $dex::Generations[$tm]{short};
    next unless defined $this{$tmgen . 'tm'} and $this{$tmgen . 'tm'} !~ /^0+$/;
    print qq'<tr> <th colspan="$all_columns" class="dextbl_divider"> $dex::Icons{(qw/rby gsc rsfl/)[$tm]} $dex::Generations[$tm]{tms} TMs and HMs $dex::Icons{(qw/rby gsc rsfl/)[$tm]} </th> </tr>\n';
    for my $i (0 .. length $this{$tmgen . 'tm'}) {
        next unless substr($this{$tmgen . 'tm'}, $i, 1);
        my $anum = $dex::TMs[$tm][$i + 1];
        print qq'<tr class="color$color">\n';
        print qq'  <td colspan="$move_columns"> ';
        if (substr($this{$tmgen . 'tm'}, $i, 1) eq '1') { print dex::tmname($i + 1); } else { print "<strong>", dex::tmname($i + 1), "</strong>"; }
        print qq' </td>\n';
        print dex::move_cells($anum), "</tr>\n";
        $color = 3 - $color;
    }
}

print <<END;
</table>
END

# ---------------------------------------------------------------------------- #

layout::footer();

################################################################################

# count the depth of an evolution chain
sub ev_countlevels {
    my $ev = shift;
    my $lev = 0;
    while (1) {
        $lev++;
        last if $#$ev <= 1;
        $ev = $ev->[2];
    }
    return $lev;
}

# count the number of table rows a chain requires
sub ev_countrows {
    my $ev = shift;
    my $offset = shift || 0;
    my $r = 0; my $i;
    if ($#$ev == 1 + $offset) { return 1; }
    for $i (2 + $offset .. $#$ev) {
        $r += &ev_countrows($ev->[$i], $offset);
    }
    return $r;
}

# adds the rows number of each link into the chain structure
sub ev_addrows {
    my ($ev, $start) = @_;
    my $newev = [ @$ev[0,1], $start ];
    my $i; my $cnt = 0;
    for $i (0 .. $#$ev-2) {
        push @$newev, &ev_addrows($ev->[$i+2], $start + $cnt);
        $cnt += &ev_countrows($ev->[$i+2]);
    }
    return $newev;
}

# decode an evolution..  code
sub ev_type {
    my $evtype = shift;
    my $evcode = substr($evtype, 0, 1);
    my $evparam = length($evtype) ? substr($evtype, 1) : '';
    if (!$evcode) { return; }
    elsif ($evcode eq 'F') { return 'Use a Fire Stone' }
    elsif ($evcode eq 'M') { return 'Use a Moon Stone' }
    elsif ($evcode eq 'W') { return 'Use a Water Stone' }
    elsif ($evcode eq 'S') { return 'Use a Sun Stone' }
    elsif ($evcode eq 'P') { return 'Use a Leaf Stone' }
    elsif ($evcode eq 'T') { return 'Use a Thunderstone' }
    elsif ($evcode eq 'L') { return "Raise to level $evparam" }
    elsif ($evcode eq 'H') { return 'Happiness + level up' }
    elsif ($evcode eq 'B') { return 'Beauty + level up' }
    elsif ($evcode eq 'D') { return &ev_type($evparam) . ' during daytime' }
    elsif ($evcode eq 'N') { return &ev_type($evparam) . ' at night' }
    elsif ($evcode eq 'R') { return 'Trade' }
    elsif ($evcode eq 'I') { return "Trade with $evparam attached" }
    elsif ($evcode eq 'E') { return "Appears in open slot after a $poke_name[$evparam] is evolved to" }
    elsif ($evcode eq 'a') { return "Level $evparam; attack &gt; def" }
    elsif ($evcode eq 'd') { return "Level $evparam; attack &lt; def" }
    elsif ($evcode eq 'e') { return "Level $evparam; attack = def" }
    else { return "[error]" }
}

# decode an evolution code and return 
sub ev_item {
    my $evtype = shift;
    my $evcode = substr($evtype, 0, 1);
    my $evparam = length($evtype) ? substr($evtype, 1) : '';
    if (!$evcode) { return; }
    elsif ($evcode eq 'F') { return 'fire-stone' }
    elsif ($evcode eq 'M') { return 'moon-stone' }
    elsif ($evcode eq 'W') { return 'water-stone' }
    elsif ($evcode eq 'S') { return 'sun-stone' }
    elsif ($evcode eq 'P') { return 'leaf-stone' }
    elsif ($evcode eq 'T') { return 'thunderstone' }
    elsif ($evcode eq 'L') { return 'rare-candy' }
    elsif ($evcode eq 'H') { return 'heart-scale' }
    elsif ($evcode eq 'B') { return 'blue-scarf' }
    elsif ($evcode eq 'D') { return 'light-ball' }
    elsif ($evcode eq 'N') { return 'blackglasses' }
    elsif ($evcode eq 'R') { return 'scanner' }
    elsif ($evcode eq 'I') { ($evparam = lc $evparam) =~ s/ /-/g; return $evparam }
    elsif ($evcode eq 'E') { return 'premier-ball' }
    elsif ($evcode eq 'a') { return 'x-attack' }
    elsif ($evcode eq 'd') { return 'x-defend' }
    elsif ($evcode eq 'e') { return 'x-speed' }
    else { return "[error]" }
}

# print a stat..  row.
sub stat_row {
    my ($name, $value, $percentile) = @_;
    my ($width);

    $width = int ($value / 255 * 100 + .5);
    print qq'<tr><td class="dex_stats_name">$name</td><td class="dex_stats_bar"><div style="width: $width%; background: #@{[ cmn::hsv2rgb(int($value / 255 * 360), 96, 255) ]};">$value</div></td><td class="dex_stats_data">$percentile</td></tr>\n';
}

# merge routine for the movelist
# I have no idea how this works
sub mergemoves {
    my @a = @{ $_[0] };
    my @b = @{ $_[1] };
    my ($pos, $tpos, $i, $j, $temppos, $w, @b2);

    $w = $#{ $a[ 0 ] };  # Columns of moves in the base array
    # Make room for the second array
    for $i (0 .. $#a) { $a[ $i ] = [ @{ $a[ $i ] }[0 .. ($w - 1)], 0, $a[$i][ -1 ] ] }
    $epos = $pos = 0;
    # Add the moves from the second list to the first list where they fit
    for $i (0 .. $#b) {
        while ($pos <= $#a and ($a[ $pos ][ -2 ] == 0 or $a[ $pos ][ -2 ] <= $b[ $i ][ -2 ])) { $pos++; }
        while ($pos > 0 and ($a[ $pos - 1 ][ -2 ] == 0 or $a[ $pos - 1 ][ -2 ] == $b[ $i ][ -2 ])) { $pos--; }

        $tpos = -1;
        for $temppos ($pos .. $#a) { if ($a[ $temppos ][ -1 ] == $b[ $i ][ -1 ]) { $tpos = $temppos; last; } }
        if ($tpos == -1 or (($tpos > $#a / 2) and ($i < $#b / 2))) { push @b2, $b[ $i ]; next; }
        $pos = $tpos; $a[ $pos ][ -2 ] = $b[ $i ][ 0 ];
    }
    @b = @b2; @b2 = ();

    # Add the rest!
    REST: for $i (0 .. $#b) {
        $pos = 0;
        while ($pos <= $#a and $a[ $pos ][ -2 ] <= $b[ $i ][ -2 ]) {
            if ($a[ $pos ][ -1 ] == $b[ $i ][ -1 ]) { push @b2, $b[ $i ]; next REST; }
            $pos++;
        }
        splice @a, $pos, 0, [ split(//, '0' x $w), $b[ $i ][ -2 ], $b[ $i ][ -1 ] ];
    }
    if (@b2) {
        @b = @b2;
        REST: for $i (0 .. $#b) {
            $pos = 0;
            while ($pos <= $#a) {
                if ($a[ $pos ][ -1 ] == $b[ $i ][ -1 ]) {
                    $temppos = 100; $tpos = $pos; while ($tpos <= $#a and ($temppos = $a[ $tpos ][ -2 ]) == 0) { $tpos++; }
                    if ($temppos >= $b[ $i ][ -2 ]) { $a[ $pos ][ -2 ] = $b[ $i ][ -2 ]; $b[$i] = ""; next REST; }
                } else {
                    if ($a[ $pos ][ -2 ] != 0 and $a[ $pos ][ -2 ] > $b[ $i ][ 0 ]) { splice @a, $pos, 0, [ split(//, '0' x $w), $b[ $i ][ 0 ], $b[ $i ][ 1 ] ]; $b[$i] = ""; next REST; }
                }
                $pos++;
            }
            splice @a, $pos, 0, [ split(//, '0' x $w), $b[ $i ][ 0 ], $b[ $i ][ 1 ] ]; $b[$i] = "";
        }
    }
    # Toss it back
    @{ $_[0] } = @a;
}

sub loc_equal {
    my ($a, $b) = @_;
    return &hashref_equal($a, $b);
}

# out: hash of mode => { category => { areas } }
sub loc_print {
    my ($loc, $icon, $color, $cols) = @_;
    return unless %$loc;
    my $rows = 1 + scalar keys %$loc;
    print qq'<tr style="background-color: #$color !important;"><th class="dex_locations_icon" colspan="3">$dex::Icons{$icon}</th></tr>\n';
    for my $mode (sort dex::by_area keys %$loc) {
        for my $cat (sort keys %{ $loc->{$mode} }) {
            print '<tr>';
            if ($cat eq 'default') { print qq'<td class="dex_locations_mode type-$dex::LocModes{$mode}" colspan="2">$mode</td>'; }
            else { print qq'<td class="dex_locations_mode type-$dex::LocModes{$mode}">$mode</td><td class="dex_locations_mode type-$dex::LocModes{"$mode:$cat"}">$cat</td>'; }
            print '<td>', join(', ', sort dex::by_area keys %{ $loc->{$mode}{$cat} }), qq'</td></tr>\n';
        }
    }
}

sub hashref_equal {
    my ($a, $b) = @_;
    if (scalar(keys %$a) != scalar(keys %$b)) { return 0; }
    if (sort keys %$a != sort keys %$b) { return 0; }
    for my $i (keys %$a) {
        if (ref $a->{$i} ne ref $b->{$i}) { return 0; }
        if (!ref $a->{$i} and $a->{$i} ne $b->{$i}) { return 0; }
        if (ref $a->{$i} eq 'ARRAY') { return &arrayref_equal($a->{$i}, $b->{$i}); }
        if (ref $a->{$i} eq 'HASH') { return &hashref_equal($a->{$i}, $b->{$i}); }
    }
    return 1;
}

sub arrayref_equal {
    my ($a, $b) = @_;
    if ($#$a != $#$b) { return 0; }
    for my $i (0 .. $#$a) {
        if (ref $a->[$i] ne ref $b->[$i]) { return 0; }
        if (!ref $a->[$i] and $a->[$i] ne $b->[$i]) { return 0; }
        if (ref $a->[$i] eq 'ARRAY') { return &arrayref_equal($a->[$i], $b->[$i]); }
        if (ref $a->[$i] eq 'HASH') { return &hashref_equal($a->[$i], $b->[$i]); }
    }
    return 1;
}

sub by_level { return (($$a[0] <=> $$b[0]) or ($cmn::MoveData[$$a[1]]{name} cmp $cmn::MoveData[$$b[1]]{name})) }

exit;