#! perl # archetype nekosan use Data::Dumper; sub teleport { my ($pl, $map, $x, $y) = @_; my $portal = cf::object::new "exit"; $portal->set_slaying ($map); $portal->set_hp ($x); $portal->set_sp ($y); $portal->apply ($pl); $portal->free; } sub on_move { my ($data) = @_; if (my $pl = $data->{who}->nearest_player) { my ($d, undef, undef, $dir, undef) = $data->{who}->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_fish} < time) { $pl->{neko_fish} = time + 120 + rand 300; $pl->message ("Purr. (Purr)"); } # so heal her my $spell = cf::object::new "spell_heal"; $spell->set_hp (0); $spell->set_dam (0); # normal hp heal (none to aovid message) $spell->set_food (999); # fill food $spell->set_last_sp (9999); # fill sp $spell->set_last_grace (9999); # fill gr $spell->set_attacktype (cf::AT_CONFUSION | cf::AT_POISON | cf::AT_BLIND | cf::AT_DISEASE); if ($data->{who}->cast_spell ($data->{who}, $dir, $spell)) { $pl->message ("... (Neko-san makes strange noises)"); } $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->set_slaying ("schmorp-neko-gave-fish"); $gave_fish->set_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_fish} < time) { $pl->{neko_fish} = time + 60 + rand 300; $pl->message ("Meow. (Please bring me fish)"); } } } # circular movement $dir = $dir % 8 + 1 unless $d > 1.5; } $data->{who}->move ($dir); } 1 } sub on_attack { my ($data) = @_; $data->{activator}{neko_attack}++ or cf::LOG cf::llevDebug, sprintf "QBERT Neko-san was attacked by %s!\n", $data->{activator}->name; $data->{activator}->message ("Meoow! (Please do not hurt me)") if !($data->{activator}{neko_attack} & 15); if ($data->{activator}{neko_attack} > 512) { $data->{activator}{neko_attack} -= 128; $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."); } 1 } sub on_say { my ($data) = @_; cf::LOG cf::llevDebug, sprintf "QBERT [Neko-fon] %s: %s\n", $data->{activator}->name, $data->{message}; 0 }