#! perl

# /var/crossfire/unique-items/world@world_105_115.v00

# arch neko
# face neko.115
# friendly 1
# unaggressive 1
# level 200
# hp 10000
# exp 1
# wc -120
# ac -120
# wis 100
# str 100
# dex 100
# con 100
# int 100
# pow 100
# cha 100
# hitback 0
# reflect_missile 1
# reflect_spells 1
# resist_death 100
# resist_physical 100
# resist_magic 100
# resist_fire 100
# resist_electricity 100
# resist_cold 100
# resist_confusion 100
# resist_acid 100
# resist_drain 100
# resist_weaponmagic 100
# resist_ghosthit 100
# resist_poison 100
# resist_slow 100
# resist_paralyze 100
# resist_fear 100
# resist_deplete 100
# resist_turn_undead 100
# resist_death 100
# resist_chaos 100
# resist_blind 100
# resist_holyword 100
# resist_godpower 100
# x 4
# y 37
# speed_left -0.699994
# direction 5
# unique 1
# sleep 0
# arch event_say
# title perl
# slaying schmorp-neko
# end
# arch event_attack
# title perl
# slaying schmorp-neko
# end
# arch event_move
# title perl
# slaying schmorp-neko
# end
# end

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 (undef, undef, undef, $dir, undef) = $data->{who}->direction ($pl);
      $data->{who}->move ($data->{who}, $dir);
   }

   1
}

sub on_attack {
   my ($data) = @_;

   cf::LOG cf::llevDebug, sprintf "QBERT Neko-san was attacked by %s!", $data->{activator}->name;

   $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.");

   0
}

sub on_say {
   my ($data) = @_;

   cf::LOG cf::llevDebug, "QBERT [Neko-fon] $data->{message}";

   0
}