--- cf.schmorp.de/maps/perl/schmorp-neko.ext 2006/02/08 06:22:43 1.3 +++ cf.schmorp.de/maps/perl/schmorp-neko.ext 2006/09/08 17:33:55 1.29 @@ -2,53 +2,143 @@ # archetype nekosan -use Data::Dumper; - sub teleport { my ($pl, $map, $x, $y) = @_; - my $portal = cf::object::new ("exit"); + my $portal = cf::object::new "exit"; - $portal->set_slaying ($map); - $portal->set_hp ($x); - $portal->set_sp ($y); + $portal->slaying ($map); + $portal->stats->hp ($x); + $portal->stats->sp ($y); $portal->apply ($pl); $portal->free; } -sub on_move { - my ($data) = @_; +sub find_target_player { + my ($obj) = @_; + + my ($time, $pl) = (time + 120, undef); + + for (map $_->ob, cf::player::list) { + next unless $obj->on_same_map_as ($_); + + my $ptime = List::Util::max $_->{neko_next_pester}, $_->{neko_next_cast}; + + ($time, $pl) = ($ptime, $_) + if $time > $ptime; + } + + $pl +} + +sub on_monster_move { + my ($self, $enemy) = @_; - if (my $pl = $data->{who}->nearest_player) { - if ($pl->exp >= 200000) { - my (undef, undef, undef, $dir, undef) = $data->{who}->direction ($pl); - $data->{who}->move ($data->{who}, $dir); + if (my $pl = find_target_player $self) { + my ($d, undef, undef, $dir, undef) = $self->rangevector ($pl); + + if ($d < 1.5) { + if (grep $_->type == cf::FORCE && $_->slaying eq "schmorp-neko-gave-fish", $pl->inv) { + # she likes us! + if ($pl->{neko_next_pester} < time) { + $pl->{neko_next_pester} = time + 120 + rand 300; + $pl->message ("Purr. (Purr)"); + } + + if ($pl->{neko_next_cast} < time) { + $pl->{neko_next_cast} = time + 40 + rand 60; + + # so heal her + my $spell = cf::object::new "spell_heal"; + + $spell->stats->sp (0); # makes casting work + $spell->stats->grace (0); # on unholy/nomagic ground + + $spell->stats->hp (0); + $spell->stats->dam (($pl->stats->maxhp - $pl->stats->hp) * 0.5); # normal hp heal + $spell->stats->food (50); # fill food + $spell->last_sp (100); # fill sp + $spell->last_grace (100); # fill gr + $spell->attacktype (cf::AT_CONFUSION | cf::AT_POISON | cf::AT_BLIND | cf::AT_DISEASE); + + $pl->message ("(Neko-san makes strange noises)"); + $pl->cast_spell ($self, $dir, $spell); + + $spell->free; + } + + } else { + # check for fish in his inv and steal it + if (my $fish = (grep $_->archetype->name eq "fishfood", $pl->inv)[0]) { + # add force + my $gave_fish = cf::object::new "force"; + $gave_fish->slaying ("schmorp-neko-gave-fish"); + $gave_fish->speed (0); + $gave_fish->insert_ob_in_ob ($pl); + + # remove fish + $fish->remove; + $fish->free; + + # be nice + $pl->message ("Meoww! (Thank you)"); + + } else { + # pester user + if ($pl->{neko_next_pester} < time) { + $pl->{neko_next_pester} = time + 60 + rand 300; + $pl->message ("Meow. (Please bring me fish)"); + } + } + } + + # circular movement + $dir = $dir % 8 + 1 unless $d > 1.5; } + + $self->move ($dir); } - 1 + cf::override; } sub on_attack { - my ($data) = @_; + my ($self, $hitter) = @_; - cf::LOG cf::llevDebug, sprintf "QBERT Neko-san was attacked by %s!", $data->{activator}->name; + if ($hitter->type == cf::PLAYER) { + if ($hitter->{neko_last_attack} < time - 300) { + $hitter->{neko_attack} = 0; + } - $data->{activator}->message ("Neko-san is suddenly gone!"); - teleport $data->{activator}, "/scorn/misc/scorn_illusions", 15, 7; - $data->{activator}->message ("You hear strange noises all around you..."); - $data->{activator}->message ("You feel dumb."); + $hitter->{neko_last_attack} = time; + $hitter->{neko_attack}++ + or ext::schmorp_irc::do_notice "Neko-san was attacked by ". $hitter->name . "!\n"; + + $hitter->message ("Meoow! (Please do not hurt me)") + if !($hitter->{neko_attack} & 15); + + if ($hitter->{neko_attack} > 512) { + $hitter->{neko_attack} -= 128; + $hitter->message ("Neko-san is suddenly gone!"); + teleport $hitter, "/scorn/misc/scorn_illusions", 15, 7; + $hitter->message ("You hear strange noises all around you..."); + $hitter->message ("You feel dumb."); + } + } else { + $hitter->hp (-1); + $hitter->kill_object; + } - 0 + cf::override; } sub on_say { - my ($data) = @_; + my ($self, $pl, $msg) = @_; - cf::LOG cf::llevDebug, "QBERT [Neko-fon] $data->{message}"; - - 0 + ext::schmorp_irc::do_notice (sprintf "[Neko-fon] %s: %s\n", $pl->ob->name, $msg); } +cf::register_attachment "Nekosan", package => __PACKAGE__; +