--- cf.schmorp.de/maps/perl/schmorp-neko.ext	2006/02/08 04:32:42	1.1
+++ cf.schmorp.de/maps/perl/schmorp-neko.ext	2006/03/31 22:47:20	1.16
@@ -1,74 +1,13 @@
 #! 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
+# 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);
@@ -79,35 +18,117 @@
    $portal->free;
 }
 
+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_move {
-   my ($data) = @_;
+   my ($event, $who) = @_;
+
+   if (my $pl = find_target_player $who) {
+      my ($d, undef, undef, $dir, undef) = $who->rangevector ($pl);
 
-   if (my $pl = $data->{who}->nearest_player) {
-      my (undef, undef, undef, $dir, undef) = $data->{who}->direction ($pl);
-      $data->{who}->move ($data->{who}, $dir);
+      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->set_sp (0); # makes casting work
+               $spell->set_gp (0); # on unholy/nomagic ground
+
+               $spell->set_hp (0);
+               $spell->set_dam (($pl->maxhp - $pl->hp) * 0.5); # normal hp heal
+               $spell->set_food (50); # fill food
+               $spell->set_last_sp (100); # fill sp
+               $spell->set_last_grace (100); # fill gr
+               $spell->set_attacktype (cf::AT_CONFUSION | cf::AT_POISON | cf::AT_BLIND | cf::AT_DISEASE);
+
+               $pl->message ("(Neko-san makes strange noises)");
+               $pl->cast_spell ($who, $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->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_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;
+      }
+
+      $who->move ($dir);
    }
 
    1
 }
 
 sub on_attack {
-   my ($data) = @_;
+   my ($event, $ob, $who) = @_;
 
-   cf::LOG cf::llevDebug, sprintf "QBERT Neko-san was attacked by %s!", $data->{activator}->name;
+   $who->{neko_attack}++
+      or cf::LOG cf::llevDebug, sprintf "QBERT Neko-san was attacked by %s!\n", $who->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.");
+   $who->message ("Meoow! (Please do not hurt me)")
+      if !($who->{neko_attack} & 15);
 
-   0
+   if ($who->{neko_attack} > 512) {
+      $who->{neko_attack} -= 128;
+      $who->message ("Neko-san is suddenly gone!");
+      teleport $who, "/scorn/misc/scorn_illusions", 15, 7;
+      $who->message ("You hear strange noises all around you...");
+      $who->message ("You feel dumb.");
+   }
+
+   1
 }
 
 sub on_say {
-   my ($data) = @_;
-
-   cf::LOG cf::llevDebug, "QBERT [Neko-fon] $data->{message}";
+   my ($event, $ob, $who, $msg) = @_;
 
-   0
+   cf::LOG cf::llevDebug, sprintf "QBERT [Neko-fon] %s: %s\n", $who->name, $msg;
 }