root/veekun/trunk/lib/Vee/Dex.pm

Revision 465, 25.3 KB (checked in by eevee, 8 months ago)

Added support for Platinum moves, some boilerplate, and the Platinum sprite on main Pokémon pages.
Line 
1package Vee::Dex;
2
3use strict;
4use warnings;
5use Exporter 'import';
6our @EXPORT;
7
8use String::Approx 'adist';
9=head1 NAME
10
11Vee::Dex - Pokedex data structures, caching, and utilities
12
13=head1 SYNOPSIS
14
15You should probably just look at the source.
16
17=head1 DESCRIPTION
18
19Contains some arbitrary Pokedex data that doesn't belong in the database, as
20well as some short useful functions and some caches of oft-used database data.
21
22=cut
23
24################################################################################
25# STATIC STUFF
26
27# versions
28
29our %Icons = ( gr => 'Green', r => 'Red', b => 'Blue', rb => 'Red/Blue', y => 'Yellow', rby => 'Red/Blue/Yellow',
30           g => 'Gold', s => 'Silver', gs => 'Gold/Silver', c => 'Crystal', gsc => 'Gold/Silver/Crystal',
31           ru => 'Ruby', sa => 'Sapphire', e => 'Emerald', rusa => 'Ruby/Sapphire', rse => 'Ruby/Sapphire/Emerald',
32           fr => 'Fire Red', lg => 'Leaf Green', frlg => 'Fire Red/Leaf Green',
33           rsfl => 'Ruby/Sapphire/Fire/Leaf', rsefl => 'Ruby/Sapphire/Emerald/Fire/Leaf',
34           d => 'Diamond', p => 'Pearl', dp => 'Diamond/Pearl', pt => 'Platinum', dppt => 'Diamond/Pearl/Platinum' );
35for my $k (keys %Icons) { $Icons{$k} = qq'<img src="/dex-images/balls/$k.png" class="pokeball" alt="$Icons{$k}" title="$Icons{$k}"/>' }
36
37our @Generations = (
38    { 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/], },
39    { games => 'Gold/Silver/Crystal',             short => 'new',  abbr => 'gsc', maxid => 251, maxmoveid => 251, region => 'Johto', },
40    { 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/], },
41    { 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/], },
42);
43
44# pokemon misc
45
46our @GrowthRates = qw/Slow Medium Fast Cubic Ultrafast Ultraslow/;
47
48# breeding
49
50our @BreedingGroups = (
51    'None',       'Monster', 'Water 1', 'Bug',
52    'Flying',     'Ground',  'Fairy',   'Plant',
53    'Humanshape', 'Water 3', 'Mineral', 'Indeterminate',
54    'Water 2',    'Ditto',   'Dragon',  'No Eggs',
55);
56
57# natures..
58
59# TODO: this numbering thing is really fucking awful; use named keys please!
60our %Natures = (
61    adamant => { up => 1, down => 3 },
62    bashful => undef,
63    bold    => { up => 2, down => 1 },
64    brave   => { up => 1, down => 5 },
65    calm    => { up => 4, down => 1 },
66    careful => { up => 4, down => 3 },
67    docile  => undef,
68    gentle  => { up => 4, down => 2 },
69    hardy   => undef,
70    hasty   => { up => 5, down => 2 },
71    impish  => { up => 2, down => 3 },
72    jolly   => { up => 5, down => 3 },
73    lax     => { up => 2, down => 4 },
74    lonely  => { up => 1, down => 2 },
75    mild    => { up => 3, down => 2 },
76    modest  => { up => 3, down => 1 },
77    naive   => { up => 5, down => 4 },
78    naughty => { up => 1, down => 4 },
79    quiet   => { up => 3, down => 5 },
80    quirky  => undef,
81    rash    => { up => 3, down => 4 },
82    relaxed => { up => 2, down => 5 },
83    sassy   => { up => 4, down => 5 },
84    serious => undef,
85    timid   => { up => 5, down => 1 },
86);
87
88our @StatFlavors = ( undef, qw/ spicy sour dry bitter sweet / );
89
90# moves
91
92our @ContestTypes = qw/beauty smart cool cute tough/;
93
94our %MoveKinds = (
95    '#' =>  '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',
96    '%' =>  'Accuracy decreases by half after each use until attacking Pok&eacute;mon is switched',
97    '*' =>  'Hits some unusual number of times in one turn',
98    '+' =>  'Some condition must be met for move to work',
99    '-' =>  'Removes some sort of status effect',
100    '.' =>  'Effect caused lasts a set number of turns',
101    '/' =>  'Triggers some other move',
102    '1' =>  'Always goes first; if other Pok&eacute;mon also uses a first-hit move, the one with higher Speed goes first',
103    '2' =>  'Always goes second; if other Pok&eacute;mon also uses a second-hit move, the one with higher Speed goes first',
104    ':' =>  'Damage is doubled under certain conditions',
105    '=' =>  'Damage is HP-based and calculated by some formula',
106    '?' =>  'Damage is HP-based and depends on received damage',
107    '@' =>  'Does no damage but creates a shield of some sort',
108     a  =>  'Status effect is applied to attacking Pok&eacute;mon',
109     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',
110     c  =>  'Increased chance for a critical hit',
111     d  =>  'Status effect is applied to defending Pok&eacute;mon',
112     e  =>  'Has some unique special effect',
113     f  =>  'Deals a fixed amount of HP-based damage',
114     g  =>  'Cannot miss',
115     h  =>  'Heals the attacking Pok&eacute;mon',
116     i  =>  'Ignores ineffectivenesses such as normal vs. ghost',
117     k  =>  'One-hit KO',
118     l  =>  'Damage is HP-based and equal to the level of the attacking Pok&eacute;mon',
119     m  =>  'Hits 2-5 times in one turn; 3/8 chance of twice or thrice, 1/8 chance of quince or quice',
120     n  =>  'Damage calculated normally',
121     o  =>  'Has an overworld use',
122     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',
123     q  =>  'Changed between generations',
124     r  =>  'Requires sacrificing a turn',
125     s  =>  'May inflict damage on the attacking Pok&eacute;mon',
126     t  =>  'Hits twice in one turn',
127     v  =>  'Damage is calculated some wacky way',
128     w  =>  'Hits 2-3 times in one turn',
129     z  =>  'Does no damage',
130    '~' =>  'Changes the weather',
131);
132
133our %MoveEffects = (
134    at => 'Attack', de => 'Defense', sa => 'Special Attack', sd => 'Special Defense', sp => 'Speed', hp => 'HP', ac => 'Accuracy', ev => 'Evasion',
135    cfz => 'Confusion', par => 'Paralysis', psn => 'Poison', brn => 'Burns', frz => 'Freezing', fln => 'Flinching', lsd => 'Leech Seed', slp => 'Sleep', tox => 'bad Poison',
136    tar => 'targeting', ter => 'depends on terrain', trp => 'trapping', tri => 'Freezing or Paralysis or Burns', att => 'Attraction',
137);
138
139our %MoveAmounts = (
140    '+' => 'rises', '++' => 'greatly rises',
141    '-' => 'falls', '--' => 'greatly falls',
142    '^' => 'maxes out',
143);
144
145our %MoveRanges = (
146    all         => 'All Pok&eacute;mon on the field',
147    allies      => 'Allied Pok&eacute;mon',
148    ally        => 'One allied Pok&eacute;mon',
149    enemies     => 'All enemy Pok&eacute;mon',
150    enemy       => 'One enemy Pok&eacute;mon',
151    others      => 'All other Pok&eacute;mon on the field',
152    randenemy   => 'One enemy Pok&eacute;mon at random',
153    user        => 'The Pok&eacute;mon that used the move',
154);
155
156our @PowerLabels = (
157    { pattern => 'D|A', label => '0, status' },
158    { pattern => '@',   label => '0, shield' },
159    { pattern => '-',   label => '0, -effect' },
160    { pattern => 'H',   label => '0, heals' },
161    { pattern => 'E',   label => '0, effect' },
162    { pattern => '~',   label => '0, weather' },
163    { pattern => '=',   label => 'formula' },
164    { pattern => 'L',   label => 'level' },
165    { pattern => 'V',   label => 'varies' },
166    { pattern => 'F',   label => 'fixed' },
167    { pattern => 'K',   label => 'OHKO' },
168    { pattern => '\?',  label => 'reflects' },
169    { pattern => '\/',  label => 'borrows' },
170    { pattern => 'Z',   label => 'useless' },
171);
172
173our %OtherMoveSources = (
174    pokecenter      => 'Given away on a premade a Pokemon as a New York Pokemon Center promotion',
175    pikalightball   => 'Appears as an egg move if one of the parents is holding a Light Ball',
176    box             => 'Comes on an egg given in Pokemon Box RS after storing some number of Pokemon from a single game',
177    event           => 'On a special Pokemon given away at a one-time Nintendo event',
178    stadium1        => 'Obtained via Pokemon Stadium',
179    stadium2        => 'Obtained via Pokemon Stadium 2',
180    xd              => 'Obtained via Pokemon XD',
181    crystal         => 'Obtained via Pokemon Crystal',
182);
183
184# types
185
186our %ModLabels = ( 400 => '4', 200 => '2', 100 => '1', 50 => '&frac12;', 25 => '&frac14;', 0 => '0' );
187our %ModEffect = ( n => 10, h => 5, d => 20, z => 0 );
188
189# statistics
190# TODO: this needs a gigantic overhaul, and HP needs to be first
191
192our @StatNames = ( 'HP', 'Attack', 'Defense', 'Special Attack', 'Special Defense', 'Speed' );
193our @StatShortNames = ( 'HP', 'Attack', 'Defense', 'Sp. Att', 'Sp. Def', 'Speed' );
194our @StatColumns = qw/ stat_hp stat_at stat_de stat_sa stat_sd stat_sp /;
195our %StatColors = (
196    stat_at => 'e84040', stat_de => '4040e8',
197    stat_sa => 'ffc000', stat_sd => '00c0ff',
198    stat_sp => 'ff8000', stat_hp => '40e840',
199    stat_avg => '000000'
200);
201
202################################################################################
203# DB CACHED STUFF
204
205# You must call initialize with a $schema object to load all this, as this code
206# is used by both Catalyst and an outside app!
207
208our (@PokemonNames, @PokemonRomaji, @PokemonKana);
209our (@PokemonJohto, @PokemonHoenn, @PokemonSinnoh);
210our (@MoveData, $DamagingMoveCount);
211our (%TypeData, @TypeNames, %OldTypeOrder, @NewTypeOrder);
212our (@AbilityNames, @ItemNames);
213our (@TMs, %MoveTMs);
214our %FuzzyMatches;
215
216sub initialize {
217    my ($schema) = @_;
218
219    my @pokenames = $schema->resultset('Pokemon')->search({
220        id => { '<=', $Generations[-1]{maxid} },
221    }, {
222        order_by => 'id ASC',
223        columns => [qw/id name name_romaji name_jp/],
224    });
225    @PokemonNames  = map { $_->name        } @pokenames;
226    @PokemonRomaji = map { $_->name_romaji } @pokenames;
227    @PokemonKana   = map { $_->name_jp     } @pokenames;
228
229    @PokemonJohto  = $schema->resultset('Pokemon')->search({ id_johto  => { '>', 0 }, id => { '<=', $Generations[-1]{maxid} } }, { order_by => 'id_johto',  columns => ['id'] })->get_column('id')->all;
230    @PokemonHoenn  = $schema->resultset('Pokemon')->search({ id_hoenn  => { '>', 0 }, id => { '<=', $Generations[-1]{maxid} } }, { order_by => 'id_hoenn',  columns => ['id'] })->get_column('id')->all;
231    @PokemonSinnoh = $schema->resultset('Pokemon')->search({ id_sinnoh => { '>', 0 }, id => { '<=', $Generations[-1]{maxid} } }, { order_by => 'id_sinnoh', columns => ['id'] })->get_column('id')->all;
232
233    # TODO: investigate DBIC caching; possibly turn this into a boring hash and change all references to it
234    @MoveData = $schema->resultset('Moves')->search(undef, { order_by => 'me.id ASC', prefetch => 'effect' });
235    $DamagingMoveCount = $schema->resultset('Moves')->search({ power => { '!=' => undef } })->count;
236
237    %TypeData = map { $_->name => $_ } $schema->resultset('Types')->search({ internal_id => { '!=' => -1 } });
238    @TypeNames = sort keys %TypeData;
239    %OldTypeOrder = map { $_->internal_id + 1 => $_->name } values %TypeData;  # for Compat.pm
240    @NewTypeOrder = map { $_->name } sort { $a->id <=> $b->id } grep { $_->id >= 0 } values %TypeData;
241
242    @AbilityNames = $schema->resultset('Abilities')->search({ id => { '<', 200 } }, { order_by => 'id ASC', columns => ['name'] })->get_column('name')->all;
243    @ItemNames    = $schema->resultset('Items')    ->search(undef,                  { order_by => 'id ASC', columns => ['name'] })->get_column('name')->all;
244
245    # so I can use one-based ids with these
246    unshift @PokemonNames, undef;
247    unshift @PokemonJohto, undef;
248    unshift @PokemonHoenn, undef;
249    unshift @PokemonSinnoh, undef;
250    unshift @PokemonKana, undef;
251    unshift @PokemonRomaji, undef;
252    unshift @MoveData, {};
253    unshift @AbilityNames, undef;
254    unshift @ItemNames, undef;
255
256    # machines
257    my @tms = $schema->resultset('Machines')->search(undef, { columns => ['id', 'generation', 'move_id'], order_by => 'id ASC' });
258    for my $row (@tms) {
259        $TMs[ $row->generation ][ $row->id ] = $row->move_id
260    }
261
262    for my $gen (0 .. $#Generations) {
263        for my $tm (1 .. $#{$TMs[$gen]}) {
264            next unless $TMs[$gen][$tm];
265            $MoveTMs{ $TMs[$gen][$tm] }[ $gen ] = $tm;
266        }
267    }
268
269    # ------------------------------------------------------------------------------
270    # fuzzy cache
271
272    # temporary, just for the below code; possibly to be promoted later
273    my @movenames = $schema->resultset('Moves')->search(undef, { order_by => 'id ASC', columns => [qw/name_romaji name_jp/] });
274    my @movekana   = ( undef, map { $_->name_jp     } @movenames );
275    my @moveromaji = ( undef, map { $_->name_romaji } @movenames );
276
277    # create an index of fuzzy matches
278    our %FuzzyMatches;
279    $FuzzyMatches{ lc $_->name_jp          } =
280    $FuzzyMatches{ lc $_->name_romaji      } =
281    $FuzzyMatches{ lc $_->name             } = { type => 'pokemon', id => $_->id, name => $_->name } for @pokenames;
282
283    $FuzzyMatches{ lc $movekana[$_]        } =
284    $FuzzyMatches{ lc $moveromaji[$_]      } =
285    $FuzzyMatches{ lc $MoveData[$_]->name  } = { type => 'move',    id => $_, name => $MoveData[$_]->name  } for 1 .. $#MoveData;
286
287    $FuzzyMatches{ lc $TypeNames[$_]       } = { type => 'type',    id => $_, name => $TypeNames[$_]       } for 0 .. $#TypeNames;
288    $FuzzyMatches{ lc $AbilityNames[$_]    } = { type => 'ability', id => $_, name => $AbilityNames[$_]    } for 1 .. $#AbilityNames;
289    $FuzzyMatches{ lc $ItemNames[$_]       } = { type => 'item',    id => $_, name => $ItemNames[$_]       } for 1 .. $#ItemNames;
290
291    # TODO: hack!  remove this when I get kana/romaji for everything
292    delete $FuzzyMatches{''};
293
294    return 1;
295}
296
297################################################################################
298# FUNCTIONS
299
300my %pokenames = map { lc $PokemonNames[$_] => $_ } 1 .. $#PokemonNames;
301my %movenames = map { lc $MoveData[$_]->name => $_ } 1 .. $#MoveData;
302
303=head2 get_pokemon
304
305Finds a Pokemon id given one of the following:
306- a Pokemon id
307- a Pokemon name in English, kana, or Romaji
308- a string of the form "kanto ###", "johto ###", "hoenn ###", or "shin'oo ###"
309
310if the input matches one of these formats but is still invalid, get_pokemon will
311return a scalerref to a brief error description.  If nothing at all is found,
312get_pokemon will simply return undef.
313
314=cut
315
316sub get_pokemon {
317    my $input = lc shift;
318
319    return undef if !$input;  # shouldn't be necessary except that a lot of Pokemon have no kana/romaji
320   
321    if ($input =~ /^(?:kanto ?)?(\d{1,3})$/) {
322        # id
323        return \ "$1 is out of range for Kanto." unless $PokemonNames[$1];
324        return $1
325
326    } elsif ($input =~ /^johto ?(\d{1,3})$/) {
327        # johto id
328        return \ "$1 is out of range for Johto." unless $PokemonJohto[$1];
329        return $PokemonJohto[$1]
330
331    } elsif ($input =~ /^hoenn ?(\d{1,3})$/) {
332        # hoenn id
333        return \ "$1 is out of range for Hoenn." unless $PokemonHoenn[$1];
334        return $PokemonHoenn[$1]
335
336    } elsif ($input =~ /^sinnoh ?(\d{1,3})$/) {
337        # shin'ou id
338        return \ "$1 is out of range for Sinnoh." unless $PokemonSinnoh[$1];
339        return $PokemonSinnoh[$1]
340
341    } elsif (exists $FuzzyMatches{$input} and $FuzzyMatches{$input}{type} eq 'pokemon') {
342        # name in whatever format
343        return $FuzzyMatches{$input}{id}
344    }
345
346    # I hate implied returns but this is far more dramatic.
347    undef;
348}
349
350=head2 get_move
351
352Finds a move id given one of the following:
353- a move id in the form "move ###"
354- a move name in English, kana, or Romaji
355
356If the input matches one of these formats but is still invalid, get_move will
357return a scalerref to a brief error description.  If nothing at all is found,
358get_move will simply return undef.
359
360=cut
361
362sub get_move {
363    my $input = lc shift;
364   
365    if ($input =~ /^(?:move ?)?(\d{1,3})$/) {
366        # id
367        return \ "$1 is out of range for Kanto." unless $MoveData[$1];
368        return $1
369
370    } elsif (exists $FuzzyMatches{$input} and $FuzzyMatches{$input}{type} eq 'move') {
371        # name in whatever format
372        return $FuzzyMatches{$input}{id}
373    }
374
375    # I hate implied returns but this is far more dramatic.
376    undef;
377}
378
379=head2 get_type
380
381Finds a type NAME given one of the following:
382- a type id in the form "type ###" -- well, actually, not at the moment
383- a type name alone, followed by "-type", or preceded by "type"
384
385If the input matches one of these formats but is still invalid, get_type will
386return a scalerref to a brief error description.  If nothing at all is found,
387get_type will simply return undef.
388
389=cut
390
391sub get_type {
392    my $input = lc shift;
393
394    if ($input =~ /^type (\w+)$/) {
395        # id
396        return \ "$1 is not a type." unless $TypeData{$1};
397        return $1
398
399    } elsif ($input =~ /^(\w+)[- ]type$/) {
400        # id
401        return \ "$1 is not a type." unless $TypeData{$1};
402        return $1
403
404    } elsif (exists $TypeData{$input}) {
405        # name in whatever format
406        return $input
407    }
408
409    # I hate implied returns but this is far more dramatic.
410    undef;
411}
412
413=head2 get_fuzzy
414
415Performs a fuzzy search.  The first parameter is the input to search on;
416subsequent parameters are treated as restrictions on what kind of search you
417want, out of 'pokemon', 'move', and 'type'.  If there is only one parameter,
418get_fuzzy will return anything that matches.
419
420Return value is an array of matching hashrefs equivalent to those in the
421%FuzzyMatches hash, plus a {dist} key specifying how well the hashref matches
422the input.  The array is sorted by this distance.
423
424get_fuzzy will return undef in the event of an error.  The only possible error,
425of course, is that the input is less than four characters and thus unsuited for
426fuzzy matching.
427
428=cut
429
430# I should read this comic more
431sub get_fuzzy {
432    my $input = lc shift;
433   
434    # restrictions
435    my %classes = map { $_ => 0 } qw/pokemon move type/;
436    my $check_classes = 0;
437    for (@_) {
438        $check_classes = $classes{$_} = 1 if exists $classes{$_};
439    }
440   
441    # don't fuzzysearch on less than four characters or more than 24
442    my $len = length $input;
443    if ($len < 4 or $len > 24) {
444        return;
445    }
446
447    # meat of fuzzy search
448    my @matches = keys %FuzzyMatches;
449    @matches = grep { $classes{ $FuzzyMatches{$_}{type} } } @matches if $check_classes;
450    my @dists = map { abs } adist $input, @matches;
451    my $max_dist = length($input) / 3;
452    my @results;
453   
454    for my $m (0 .. $#matches) {
455        next unless $dists[$m] <= $max_dist;
456        my %hash = %{ $FuzzyMatches{ $matches[$m] } };
457        $hash{key} = $matches[$m];
458        push @results, \%hash;
459        $results[-1]{dist} = $dists[$m];
460    }
461
462    @results = sort {
463        $a->{dist} <=> $b->{dist} or
464        abs(length($input) - length $a->{key}) <=> abs(length($input) - length $b->{key}) or
465        $a->{key} cmp $b->{key}
466    } @results;
467    return @results;
468}
469
470# make Pokedex data etc presentable
471sub polish_desc {
472    my ($c, $data, $avoid) = @_;
473    $data =~ s/\x0a/<br\/>/g;
474    $avoid = lc $avoid;
475    $data =~ s/Pokemon/Pok&eacute;mon/g;
476    $data =~ s/é|\x82|é/&eacute;/g;
477    my @replace;
478    while ($data =~ /([A-Z][a-z]+(?: [A-Z][a-z]+)?)/g) {
479        my $try = lc $1;
480        next if $try eq $avoid;
481        if ($pokenames{$try}) { unshift @replace, [ $-[1], $+[1] - $-[1], '<a href="' . $c->uri('Dex', 'pokemon', lc $try) . qq'">$1</a>' ] }
482        if ($movenames{$try}) { unshift @replace, [ $-[1], $+[1] - $-[1], '<a href="' . $c->uri('Dex', 'moves', lc $try) . qq'">$1</a>' ] }
483        if (chop $try eq 's') {
484            if ($pokenames{$try}) { unshift @replace, [ $-[1], $+[1] - $-[1], '<a href="' . $c->uri('Dex', 'pokemon', lc $try) . qq'">$1</a>' ] }
485            if ($movenames{$try}) { unshift @replace, [ $-[1], $+[1] - $-[1], '<a href="' . $c->uri('Dex', 'moves', lc $try) . qq'">$1</a>' ] }
486        }
487    }
488    for (@replace) { substr($data, $_->[0], $_->[1]) = $_->[2] }
489    return $data;
490}
491
492# useful template sortings
493sub sort_by_level {
494    $_[0] = [
495        sort { ($$a[0] <=> $$b[0]) or ($MoveData[$$a[1]]->name cmp $MoveData[$$b[1]]->name) } @{ $_[0] }
496    ];
497}
498
499sub sort_by_move {
500    $_[0] = [ sort { ($MoveData[$a]->name cmp $MoveData[$b]->name) } @{ $_[0] } ];
501}
502
503=head2 height_imperial
504=head2 weight_imperial
505=head2 height_metric
506=head2 weight_metric
507
508Converts tenths of a kilogram or meter to formatted height/weight in either system.
509
510=cut
511
512sub height_imperial {
513    my $in = Vee::Utils::round($_[0] / 0.254, 1);
514    my $feet   = int($in / 12);
515    my $inches = Vee::Utils::round($in - $feet * 12, 1);
516    $feet    = $feet ? "$feet'" : "";
517    $inches .= '"';
518    return $feet . $inches;
519}
520sub weight_imperial { Vee::Utils::round($_[0] / 4.536, 1) . ' lb' }
521sub height_metric { $_[0] / 10 . ' m' }
522sub weight_metric { $_[0] / 10 . ' kg' }
523
524=head2 plural
525
526It is sad that it has come to this.
527
528=cut
529
530my %plurals = ( move => 'moves', pokemon => 'pokemon', type => 'types', ability => 'abilities', item => 'items' );
531sub plural {
532    $plurals{+shift}
533}
534
535=head2 tm_name
536
537Returns the correct naming for a given TM number, i.e. TM41 or HM03.
538
539=cut
540
541sub tm_name {
542    my $tm = shift;
543    my $cat = 'TM';
544    if ($tm > 100) {
545        $tm -= 100;
546        $cat = 'HM';
547    }
548    return sprintf "$cat%02d", $tm;
549}
550
551=head2 gender_text
552
553Convert a gender code into readable Englilsh.  If the second parameter is true,
554the text will be used as a title for the icon rather than displayed next to it.
555
556=cut
557
558my @gender_fractions = ('no', '&#x215B;', '&frac14;', '&#x215C;', '&frac12;', '&#x215D;', '&frac34;', '&#x215E;', 'all');
559sub gender_text {
560    my $gender_rate = shift;
561    my $compact = shift;
562
563    my $gender = int($gender_rate / 32 + 0.5);
564    my ($img, $text);
565    if ($gender_rate == 255) {
566        $img = 'x'; $text = 'No gender';
567    } else {
568        $img = $gender;
569        if ($gender == 0) {
570            $text = 'Always male'
571        } elsif ($gender == 8) {
572            $text = 'Always female'
573        } else {
574            $text = "$gender_fractions[8 - $gender] male; $gender_fractions[$gender] female"
575        }
576    }
577   
578    if ($compact) {
579        return qq'<img src="/dex-images/gender/$img.png" alt="" title="$text"/>';
580    } else {
581        return qq'<img src="/dex-images/gender/$img.png" alt=""/> $text';
582    }
583}
584
585=head2 _type_effect_general
586
587Generalization of the new and old type calculation functions. 
588
589=cut
590
591sub _type_effect_general {
592    my ($field, $type_atk, $type_def1, $type_def2) = @_;
593
594    return 100 unless defined $type_atk and exists $TypeData{$type_atk};
595    my $effect = 1;
596    my $fx = $TypeData{$type_atk}->$field;
597
598    if (defined $type_def1 and exists $TypeData{$type_def1}) {
599        $effect *= $ModEffect{ substr $fx, $TypeData{$type_def1}->id, 1 };
600    } else {
601        $effect *= 10;
602    }
603   
604    if (defined $type_def2 and exists $TypeData{$type_def2}) {
605        $effect *= $ModEffect{ substr $fx, $TypeData{$type_def2}->id, 1 };
606    } else {
607        $effect *= 10;
608    }
609   
610    return $effect;
611}
612
613=head2 type_effect
614
615Takes an attacking type and up to two defending types and returns the percent damage taken.
616
617=cut
618
619sub type_effect {
620    unshift @_, 'new_effects';
621    goto &_type_effect_general;
622}
623
624=head2 type_effect_old
625
626Takes an attacking type and up to two defending types and returns the percent damage taken for R/B/Y.
627
628=cut
629
630sub type_effect_old {
631    unshift @_, 'old_effects';
632    goto &_type_effect_general;
633}
634
635sub hex_blurb { Vee::Utils::isnum($_[0]) && length $_[0] ? "$_[0] or 0x" . Vee::Utils::tohex($_[0]) : "n/a" }
636sub stat_color { Vee::Utils::hsv2rgb($_[0], 64, 224) }
637
638################################################################################
639# In-game formulae
640
641# 31-base statistics
642# Natures not included!
643# (base * 2 + iv + effort / 4) * level / 100 + 5
644sub ingame_stats {
645    my ($base, $level, $iv, $effort) = @_;
646
647    return int(($base * 2 + $iv + int($effort / 4)) * $level / 100) + 5;
648}
649
650# 31-base HP
651# (base * 2 + iv + effort / 4) * level / 100 + 5
652sub ingame_hp {
653    my ($base, $level, $iv, $effort) = @_;
654
655    # special exception for Shedinja
656    return 1 if $base == 1;
657
658    return int(($base * 2 + $iv + int($effort / 4)) * $level / 100) + 10 + $level;
659}
660
661# 31-base hidden power power
662sub ingame_hp_power {
663    my (@ivs) = @_;
664
665    # speed is in the middle as far as the game is concerned
666    @ivs = @ivs[ 0, 1, 2, 5, 3, 4 ];
667
668    my $sum = 0;
669    for my $i (0 .. 5) {
670        $sum += (($ivs[$i] & 0x02) >> 1) << $i;
671    }
672
673    return int($sum * 40 / 63) + 30;
674}
675
676# 31-base hidden power type
677sub ingame_hp_type {
678    my (@ivs) = @_;
679
680    # speed is in the middle as far as the game is concerned
681    @ivs = @ivs[ 0, 1, 2, 5, 3, 4 ];
682
683    my $sum = 0;
684    for my $i (0 .. 5) {
685        $sum += ($ivs[$i] & 0x01) << $i;
686    }
687
688    # +1 is to skip normal and make fighting (normally 1) be zero
689    return $NewTypeOrder[ int($sum * 15 / 63) + 1 ];
690}
691
692################################################################################
693# Create a hash of every our'd variable in the package, for TT inclusion
694
695our %all;
696my %vartypes = ( ARRAY => '@', HASH => '%', SCALAR => '$', CODE => '' );
697for my $var (keys %Vee::Dex::) {
698    next if $var =~ /^_/ or grep { $var eq $_ } qw/EXPORT_FAIL EXPORT import all initialize/;
699   
700    my @valid_types = grep { defined *{ $Vee::Dex::{$var} }{$_} } keys %vartypes;
701    next unless @valid_types;
702    $all{$var} = *{ $Vee::Dex::{$var} }{ $valid_types[0] };
703    if ($valid_types[0] eq 'SCALAR') { $all{$var} = ${ $all{$var} }; }
704   
705    push @EXPORT, $vartypes{ $valid_types[0] } . $var;
706}
707
708=head1 AUTHOR
709
710Maintainer: Alex "Eevee" Munroe (C<veekun@veekun.com>)
711
712See the included F<AUTHORS> file for a full list of contributers.
713
714=head1 LICENSE
715
716See the included F<LICENSE> file.
717
718=cut
719
7201;
Note: See TracBrowser for help on using the browser.