package TAEB::World::Monster;
use TAEB::OO;
use TAEB::Util qw/:colors align2str max min any all string_color/;

use overload %TAEB::Meta::Overload::default;

has glyph => (
    is       => 'ro',
    isa      => 'Str',
    required => 1,
);

has color => (
    is       => 'ro',
    isa      => 'Int',
    required => 1,
);

has tile => (
    is       => 'ro',
    isa      => 'TAEB::World::Tile',
    weak_ref => 1,
    handles  => [qw/x y z level in_shop in_temple in_los distance/],
);

has possibilities => (
    is       => 'rw',
    isa      => 'ArrayRef[TAEB::Spoilers::Monster]',
    auto_deref => 1,
    lazy     => 1,
    default  => sub {
        my $self = shift;
        return [TAEB::Spoilers::Monster->lookup(
            glyph => $self->glyph,
            color => $self->color,
        )];
    },
);

has disposition => (
    is  => 'rw',
    isa => 'Maybe[TAEB::Type::Disposition]',
);

sub maybe {
    my $self = shift;
    my $property = shift;
    return any { $_->$property } $self->possibilities;
}

sub definitely {
    my $self = shift;
    my $property = shift;
    return all { $_->$property } $self->possibilities;
}

sub definitely_known {
    my $self = shift;
    return @{ $self->possibilities } == 1;
}

sub spoiler {
    my $self = shift;
    return unless $self->definitely_known;
    return ($self->possibilities)[0];
}

sub set_possibilities {
    my $self = shift;
    $self->possibilities([TAEB::Spoilers::Monster->lookup(
        glyph => $self->glyph,
        color => $self->color,
        @_,
    )]);
}

sub farlook {
    my $self = shift;
    my $tile = $self->tile;
    my @description = TAEB->farlook($tile);
    # Return if we can't see the monster. This might happen if, for instance,
    # it's an I glyph rather than a monster we can see.
    return unless @description > 2;
    my $species = $description[2];
    my $disposition = 'hostile';
    $disposition    = 'tame'     if $species =~ s/^tame //;
    $disposition    = 'peaceful' if $species =~ s/^peaceful //;
    $self->disposition($disposition);
    # Coyotes have their farlook data in a different format. Yes, seriously.
    # NetHack has far too many special cases...
    $species =~ s/^(coyote).*/$1/;
    $self->set_possibilities(name => $species);
}

sub is_shk {
    my $self = shift;

    return 1 if $self->definitely_known
             && $self->spoiler->name eq 'shopkeeper';
    # if we've seen a nurse recently, then this monster is probably that nurse
    # we really need proper monster tracking! :)
    return 0 if TAEB->turn < (TAEB->last_seen_nurse || -100) + 3;

    return 0 unless $self->glyph eq '@' && $self->color == COLOR_WHITE;

    # a shk isn't a shk if it's outside of its shop!
    # this also catches angry shks, but that's not too big of a deal
    return 0 unless $self->tile->type eq 'obscured'
                 || $self->tile->type eq 'floor';
    return unless $self->in_shop;
    $self->set_possibilities(name => 'shopkeeper');
    return 1;
}

sub is_priest {
    my $self = shift;
    return 1 if $self->definitely_known
             && $self->spoiler->name =~ /priest/;
    return 0 unless $self->glyph eq '@' && $self->color == COLOR_WHITE;
    return unless $self->in_temple;
    $self->set_possibilities(name => 'priest');
    return 1;
}

sub is_oracle {
    my $self = shift;

    return 1 if $self->definitely_known
             && $self->spoiler->name eq 'Oracle';
    # we know the oracle level.. is it this one?
    if (my $oracle_level = TAEB->dungeon->special_level->{oracle}) {
        return 0 if $self->level != $oracle_level;
    }
    # if we don't know the oracle level, well, is this level in the right range?
    else {
        return 0 if $self->z < 5 || $self->z > 9;
    }

    return 0 unless $self->x == 39 && $self->y == 12;
    if (TAEB->is_hallucinating
     || ($self->glyph eq '@' && $self->color == COLOR_BRIGHT_BLUE)) {
       $self->set_possibilities(name => 'Oracle');
       return 1;
    }
    return 0;
}

sub is_vault_guard {
    my $self = shift;
    return 1 if $self->definitely_known
             && $self->spoiler->name eq 'guard';
    return 0 unless TAEB->following_vault_guard;
    if ($self->glyph eq '@' && $self->color == COLOR_BLUE) {
        $self->set_possibilities(name => 'guard');
        return 1;
    }
    return 0;
}

sub is_quest_friendly {
    my $self = shift;

    # Attacking @s in quest level 1 will screw up your quest. So...don't.
    return 1 if $self->level->known_branch
             && $self->level->branch eq 'quest'
             && $self->z == 1
             && $self->glyph eq '@';
    return 0;
}

sub is_quest_nemesis {
    return 0; #XXX
}

sub is_enemy {
    my $self = shift;
    return 0 if $self->is_oracle;
    return 0 if $self->is_coaligned_unicorn;
    return 0 if $self->is_vault_guard;
    return 0 if $self->is_peaceful_watchman;
    return 0 if $self->is_quest_friendly;
    return 0 if $self->is_shk || $self->is_priest;
    return unless (defined $self->is_shk || defined $self->is_priest);
    return 1;
}

# Yes, this is different from is_enemy.  Enemies are monsters we should
# attack, hostiles are monsters we expect to attack us.  Even if they
# were perfect they'd be different, pick-wielding dwarves for instance.
#
# But they're not perfect, which makes the difference bigger.  If we
# decide to ignore the wrong monster, it will kill us, so is_enemy
# has to be liberal.  If we let a peaceful monster chase us, we'll
# starve, so is_hostile has to be conservative.

sub is_hostile {
    my $self = shift;

    # Otherwise, 1 if the monster is guaranteed hostile
    return 1 if $self->maybe('always_hostile');
    return 0 if $self->definitely('always_peaceful');
    return 0 if $self->is_quest_friendly;
    return 1 if $self->is_quest_nemesis;

    my $race = TAEB->race;
    return 1 if $self->maybe('is_elf')   && ($race eq 'Orc');
    return 1 if $self->maybe('is_dwarf') && ($race eq 'Orc');
    return 1 if $self->maybe('is_gnome') && ($race eq 'Hum');
    return 1 if $self->maybe('is_human') && ($race eq 'Gno' || $race eq 'Orc');
    return 1 if $self->maybe('is_orc')   && ($race eq 'Hum' || $race eq 'Elf'
                                                            || $race eq 'Dwa');

    return 1 if any { align2str($_->alignment) ne TAEB->align }
                    $self->possibilities;

    # do you have the amulet? is it a minion?  is it cross-aligned?
    return;
}

sub probably_sleeping {
    my $self = shift;

    return 0 if TAEB->noisy_turn && TAEB->noisy_turn + 40 > TAEB->turn;
    return 1 if $self->is_nymph || $self->is_leprechaun;
    return 1 if TAEB->is_stealthy;
    return 0;
}

# Would this monster chase us if it wanted to and noticed us?
sub would_chase {
    my $self = shift;

    # Unicorns won't step next to us anyway
    return 0 if $self->is_unicorn;

    # Leprechauns avoid the player once they have gold
    return 0 if $self->is_leprechaun;

    # Monsters that can't move won't take initiative
    return 0 unless $self->can_move;

    return 1;
}

sub will_chase {
    my $self = shift;

    return $self->would_chase
        && $self->is_hostile
        && !$self->probably_sleeping;
}

# XXX: should be ai?
sub is_meleeable {
    my $self = shift;

    return 0 unless $self->is_enemy;

    return 0 if (any { $_->name eq 'floating eye'    } $self->possibilities)
             && !TAEB->is_blind;

    return 0 if (any { $_->name eq 'blue jelly'      } $self->possibilities)
             && !TAEB->cold_resistant;

    return 0 if (any { $_->name eq 'spotted jelly'   } $self->possibilities);

    return 0 if (any { $_->name eq 'gelatinous cube' } $self->possibilities)
             && $self->level->has_enemies > 1;

    return 1;
}

# Yes, I know the name is long, but I couldn't think of anything better.
#  -Sebbe.
sub is_seen_through_warning {
    my $self = shift;
    return $self->glyph =~ /[1-5]/;
}

sub is_sleepable {
    my $self = shift;
    return $self->is_meleeable;
}

sub respects_elbereth {
    my $self = shift;
    return !$self->maybe('ignores_elbereth');
}

sub is_minotaur {
    my $self = shift;
    return any { $_->name eq 'minotaur' } $self->possibilities;
}

sub is_nymph {
    my $self = shift;
    return $self->glyph eq 'n';
}

sub is_leprechaun {
    my $self = shift;
    return $self->glyph eq 'l';
}

sub is_unicorn {
    my $self = shift;
    # unicorns have unique appearances
    return $self->definitely_known
        && $self->spoiler->is_unicorn;
}

sub is_coaligned_unicorn {
    my $self = shift;
    my $uni = $self->is_unicorn;

    return $uni && $uni eq TAEB->align;
}

sub is_peaceful_watchman {
    my $self = shift;
    return 0 unless $self->level->is_minetown;
    return 0 if $self->level->angry_watch;
    return 0 unless $self->glyph eq '@';

    return $self->color == COLOR_GRAY || $self->color == COLOR_GREEN;
}

sub is_ghost {
    my $self = shift;

    return $self->glyph eq ' ' if $self->level->is_rogue;
    return $self->glyph eq 'X';
}

sub can_move {
    my $self = shift;

    return 0 if all { $_->speed == 0 } $self->possibilities;
    return 0 if $self->is_oracle;
    return 1;
}

sub debug_line {
    my $self = shift;
    my @bits;

    push @bits, sprintf '(%d,%d)', $self->x, $self->y;
    my ($name) = map { $_->name } $self->possibilities;
    push @bits, $name if $self->definitely_known;
    push @bits, 'g<' . $self->glyph . '>';
    push @bits, 'c<' . string_color($self->color) . '>';

    return join ' ', @bits;
}

sub can_be_outrun {
    my $self = shift;

    my ($min_taeb_speed, $max_taeb_speed) = TAEB->speed;
    my $mon_speed = max map { $_->speed } $self->possibilities;

    return $mon_speed < $min_taeb_speed
        || ($mon_speed == $min_taeb_speed && $mon_speed < $max_taeb_speed);
}

sub can_be_infraseen {
    my $self = shift;
    return TAEB->has_infravision && $self->maybe('infravision_detectable');
}

sub speed {
    max map { $_->{speed} } shift->spoiler;
}

sub maximum_melee_damage {
    return max map { ($_->_read_attack_string)[1] } shift->possibilities;
}

sub average_melee_damage {
    return max map { ($_->_read_attack_string)[0] } shift->possibilities;
}

__PACKAGE__->meta->make_immutable;

1;

__END__

=head2 can_be_outrun :: bool

Return true if the player can definitely outrun the monster.

=head2 can_be_infraseen :: Bool

Returns true if the player could see this monster using infravision.

=head2 speed :: Int

Returns the (base for now) speed of this monster.  If we can't exactly
tell what it is, return the speed of the fastest possibility.

=head2 maximum_melee_damage :: Int

How much damage can this monster do in a single round of attacks if it
connects and does full damage with each hit?

=head2 average_melee_damage :: Int

How much damage can this monster do in a single round of attacks in
the average case, accounting for AC?

=cut

