File Coverage

blib/lib/Games/SMTNocturne/Demons/FusionChart.pm

Criterion	Covered	Total	%
statement	58	72	80.5
branch	36	46	78.2
condition	10	14	71.4
subroutine	10	12	83.3
pod	0	7	0.0
total	114	151	75.5

package Games::SMTNocturne::Demons::FusionChart;
BEGIN {
  $Games::SMTNocturne::Demons::FusionChart::AUTHORITY = 'cpan:DOY';
}
$Games::SMTNocturne::Demons::FusionChart::VERSION = '0.02';
use strict;
use warnings;

use JSON::PP;

my %FUSION_DATA = %{ decode_json(do { local $/;  }) };
my %TYPES = %{ $FUSION_DATA{normal_fusions} };
my %SPECIAL = %{ $FUSION_DATA{special_fusions} };

sub fuse {
    my ($type1, $type2) = @_;

    die "unknown demon type $type1" unless $TYPES{$type1};
    die "unknown demon type $type2" unless $TYPES{$type2};

    return $TYPES{$type1}{fusions}{$type2};
}

sub unfuse {
    my ($type) = @_;

    die "unknown demon type $type" unless $TYPES{$type};

    my @combinations;
    for my $type1 (keys %TYPES) {
        for my $type2 (grep { $_ ge $type1 } keys %TYPES) {
            push @combinations, [ $type1, $type2 ]
                if ($TYPES{$type1}{fusions}{$type2} || '') eq $type;
        }
    }

    return @combinations;
}

sub fuse_element {
    my ($type) = @_;

    return $TYPES{$type}{self_fusion};
}

sub element_fusion {
    my ($type, $element) = @_;

    return $TYPES{$type}{element_fusions}{$element};
}

sub fuse_mitama {
    my ($element1, $element2) = @_;

    # XXX move this into actual data somewhere
    my %mitama_fusions = (
        Erthys => {
            Aeros => 'Nigi Mitama',
            Aquans => 'Ara Mitama',
            Flaemis => 'Kusi Mitama',
        },
        Aeros => {
            Erthys => 'Nigi Mitama',
            Aquans => 'Kusi Mitama',
            Flaemis => 'Ara Mitama',
        },
        Aquans => {
            Erthys => 'Ara Mitama',
            Aeros => 'Kusi Mitama',
            Flaemis => 'Saki Mitama',
        },
        Flaemis => {
            Erthys => 'Kusi Mitama',
            Aeros => 'Ara Mitama',
            Aquans => 'Saki Mitama',
        },
    );

    return $mitama_fusions{$element1}{$element2};
}

sub special_fusion {
    my ($demon1, $demon2, $options) = @_;

    my $find = sub {
        my ($need, @have) = @_;

        if (my $name = $need->{name}) {
            return (grep { $_->name eq $name } @have)[0];
        }
        elsif (my $type = $need->{type}) {
            my @types = ref($need->{type}) ? @$type : ($type);
            return (
                grep { my $d = $_; grep { $d->type eq $_ } @types } @have
            )[0];
        }
        else {
            return undef;
        }
    };

    DEMON: for my $demon (keys %SPECIAL) {
        my $conditions = $SPECIAL{$demon};

        if ($conditions->{deathstone}) {
            next unless $options->{deathstone};
        }

        if (my $phases = $conditions->{kagutsuchi}) {
            next unless defined $options->{kagutsuchi}
                     && grep { $_ == $options->{kagutsuchi} } @$phases;
        }

        if (my $sacrifice = $conditions->{sacrifice}) {
            next unless $find->(
                $sacrifice,
                ($options->{sacrifice} ? ($options->{sacrifice}) : ())
            );
        }

        if (my $target = $conditions->{target}) {
            if (my $type = $target->{type}) {
                my $fused_type = fuse($demon1->type, $demon2->type);
                next unless $fused_type && $fused_type eq $type;
            }
            elsif (my $name = $target->{name}) {
                require Games::SMTNocturne::Demons;
                my $fused = Games::SMTNocturne::Demons::fuse(
                    $demon1, $demon2, { %$options, basic => 1 }
                );
                next unless $fused && $fused->name eq $name;
            }
            else {
                next;
            }
        }

        my @have = ($demon1, $demon2);
        push @have, $options->{sacrifice}
            if $conditions->{demon3} && $options->{sacrifice};

        for my $key (qw(demon1 demon2 demon3)) {
            if ($conditions->{$key}) {
                my $found = $find->($conditions->{$key}, @have);
                next DEMON unless $found;
                @have = grep { $_ ne $found } @have;
            }
        }

        return $demon;
    }

    return;
}

sub special_fusion_for {
    my ($demon) = @_;

    return unless $SPECIAL{$demon};
    return { %{ $SPECIAL{$demon} } };
}

=for Pod::Coverage
  element_fusion
  fuse
  fuse_element
  fuse_mitama
  special_fusion
  special_fusion_for
  unfuse

=cut

1;

__DATA__