maps/perl/schmorp-neko.ext

#! 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 avoid 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
}

Revision:	1.11
Committed:	Fri Feb 17 19:39:11 2006 UTC (18 years, 3 months ago) by root
Branch:	MAIN
Changes since 1.10:	+1 -1 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	#! perl
2
3	root	1.2	# archetype nekosan
4	root	1.1
5			use Data::Dumper;
6
7			sub teleport {
8			my ($pl, $map, $x, $y) = @_;
9
10	root	1.10	my $portal = cf::object::new "exit";
11	root	1.1
12			$portal->set_slaying ($map);
13			$portal->set_hp ($x);
14			$portal->set_sp ($y);
15
16			$portal->apply ($pl);
17
18			$portal->free;
19			}
20
21			sub on_move {
22			my ($data) = @_;
23
24			if (my $pl = $data->{who}->nearest_player) {
25	root	1.9	my ($d, undef, undef, $dir, undef) = $data->{who}->rangevector ($pl);
26
27	root	1.10	if ($d < 1.5) {
28			if (grep $_->type == cf::FORCE && $_->slaying eq "schmorp-neko-gave-fish", $pl->inv) {
29			# she likes us!
30			if ($pl->{neko_fish} < time) {
31			$pl->{neko_fish} = time + 120 + rand 300;
32			$pl->message ("Purr. (Purr)");
33			}
34
35			# so heal her
36			my $spell = cf::object::new "spell_heal";
37
38			$spell->set_hp (0);
39	root	1.11	$spell->set_dam (0); # normal hp heal (none to avoid message)
40	root	1.10	$spell->set_food (999); # fill food
41			$spell->set_last_sp (9999); # fill sp
42			$spell->set_last_grace (9999); # fill gr
43			$spell->set_attacktype (cf::AT_CONFUSION \| cf::AT_POISON \| cf::AT_BLIND \| cf::AT_DISEASE);
44
45			if ($data->{who}->cast_spell ($data->{who}, $dir, $spell)) {
46			$pl->message ("... (Neko-san makes strange noises)");
47			}
48
49			$spell->free;
50
51			} else {
52			# check for fish in his inv and steal it
53			if (my $fish = (grep $_->archetype->name eq "fishfood", $pl->inv)[0]) {
54			# add force
55			my $gave_fish = cf::object::new "force";
56			$gave_fish->set_slaying ("schmorp-neko-gave-fish");
57			$gave_fish->set_speed (0);
58			$gave_fish->insert_ob_in_ob ($pl);
59
60			# remove fish
61			$fish->remove;
62			$fish->free;
63
64			# be nice
65			$pl->message ("Meoww! (Thank you)");
66
67			} else {
68			# pester user
69			if ($pl->{neko_fish} < time) {
70			$pl->{neko_fish} = time + 60 + rand 300;
71			$pl->message ("Meow. (Please bring me fish)");
72			}
73			}
74			}
75
76			# circular movement
77			$dir = $dir % 8 + 1 unless $d > 1.5;
78			}
79	root	1.9
80	root	1.6	$data->{who}->move ($dir);
81	root	1.1	}
82
83			1
84			}
85
86			sub on_attack {
87			my ($data) = @_;
88
89	root	1.4	$data->{activator}{neko_attack}++
90	root	1.6	or cf::LOG cf::llevDebug, sprintf "QBERT Neko-san was attacked by %s!\n", $data->{activator}->name;
91	root	1.1
92	root	1.8	$data->{activator}->message ("Meoow! (Please do not hurt me)")
93	root	1.4	if !($data->{activator}{neko_attack} & 15);
94	root	1.1
95	root	1.8	if ($data->{activator}{neko_attack} > 512) {
96	root	1.7	$data->{activator}{neko_attack} -= 128;
97	root	1.4	$data->{activator}->message ("Neko-san is suddenly gone!");
98			teleport $data->{activator}, "/scorn/misc/scorn_illusions", 15, 7;
99			$data->{activator}->message ("You hear strange noises all around you...");
100			$data->{activator}->message ("You feel dumb.");
101			}
102
103			1
104	root	1.1	}
105
106			sub on_say {
107			my ($data) = @_;
108
109	root	1.7	cf::LOG cf::llevDebug, sprintf "QBERT [Neko-fon] %s: %s\n", $data->{activator}->name, $data->{message};
110	root	1.1
111			0
112			}
113