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 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 ($event, $who) = @_;

   if (my $pl = find_target_player $who) {
      my ($d, undef, undef, $dir, undef) = $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_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 ($event, $ob, $who) = @_;

   if ($who->{neko_last_attack} < time - 300) {
      $who->{neko_attack} = 0;
   }

   $who->{neko_last_attack} = time;
   $who->{neko_attack}++
      or do {
         cf::LOG cf::llevDebug, my $n = sprintf "QBERT Neko-san was attacked by %s!\n", $who->name;
         cf::ext::schmorp_irc::do_notice ($n);
      };

   $who->message ("Meoow! (Please do not hurt me)")
      if !($who->{neko_attack} & 15);

   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 ($event, $ob, $who, $msg) = @_;

   cf::LOG cf::llevDebug, sprintf "QBERT [Neko-fon] %s: %s\n", $who->name, $msg;
   cf::ext::schmorp_irc::do_notice (sprintf "[Neko-fon] %s: %s\n", $who->name, $msg);
}

Revision:	1.18
Committed:	Wed Aug 2 16:59:48 2006 UTC (17 years, 9 months ago) by elmex
Branch:	MAIN
Changes since 1.17:	+5 -1 lines
Log Message:	added irc gateway extension
#	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	root	1.12	sub find_target_player {
22			my ($obj) = @_;
23
24	root	1.14	my ($time, $pl) = (time + 120, undef);
25	root	1.12
26			for (map $_->ob, cf::player::list) {
27			next unless $obj->on_same_map_as ($_);
28
29			my $ptime = List::Util::max $_->{neko_next_pester}, $_->{neko_next_cast};
30
31	root	1.13	($time, $pl) = ($ptime, $_)
32	root	1.12	if $time > $ptime;
33			}
34
35			$pl
36			}
37
38	root	1.1	sub on_move {
39	root	1.16	my ($event, $who) = @_;
40	root	1.1
41	root	1.16	if (my $pl = find_target_player $who) {
42			my ($d, undef, undef, $dir, undef) = $who->rangevector ($pl);
43	root	1.9
44	root	1.10	if ($d < 1.5) {
45			if (grep $_->type == cf::FORCE && $_->slaying eq "schmorp-neko-gave-fish", $pl->inv) {
46			# she likes us!
47	root	1.12	if ($pl->{neko_next_pester} < time) {
48			$pl->{neko_next_pester} = time + 120 + rand 300;
49	root	1.10	$pl->message ("Purr. (Purr)");
50			}
51
52	root	1.12	if ($pl->{neko_next_cast} < time) {
53			$pl->{neko_next_cast} = time + 40 + rand 60;
54
55			# so heal her
56			my $spell = cf::object::new "spell_heal";
57	root	1.10
58	root	1.14	$spell->set_sp (0); # makes casting work
59	root	1.12	$spell->set_gp (0); # on unholy/nomagic ground
60	root	1.10
61	root	1.12	$spell->set_hp (0);
62	root	1.14	$spell->set_dam (($pl->maxhp - $pl->hp) * 0.5); # normal hp heal
63			$spell->set_food (50); # fill food
64			$spell->set_last_sp (100); # fill sp
65			$spell->set_last_grace (100); # fill gr
66	root	1.12	$spell->set_attacktype (cf::AT_CONFUSION \| cf::AT_POISON \| cf::AT_BLIND \| cf::AT_DISEASE);
67
68			$pl->message ("(Neko-san makes strange noises)");
69	root	1.16	$pl->cast_spell ($who, $dir, $spell);
70	root	1.12
71			$spell->free;
72	root	1.10	}
73
74			} else {
75			# check for fish in his inv and steal it
76			if (my $fish = (grep $_->archetype->name eq "fishfood", $pl->inv)[0]) {
77			# add force
78			my $gave_fish = cf::object::new "force";
79			$gave_fish->set_slaying ("schmorp-neko-gave-fish");
80			$gave_fish->set_speed (0);
81			$gave_fish->insert_ob_in_ob ($pl);
82
83			# remove fish
84			$fish->remove;
85			$fish->free;
86
87			# be nice
88			$pl->message ("Meoww! (Thank you)");
89
90			} else {
91			# pester user
92	root	1.12	if ($pl->{neko_next_pester} < time) {
93			$pl->{neko_next_pester} = time + 60 + rand 300;
94	root	1.10	$pl->message ("Meow. (Please bring me fish)");
95			}
96			}
97			}
98
99			# circular movement
100			$dir = $dir % 8 + 1 unless $d > 1.5;
101			}
102	root	1.9
103	root	1.16	$who->move ($dir);
104	root	1.1	}
105
106			1
107			}
108
109			sub on_attack {
110	root	1.16	my ($event, $ob, $who) = @_;
111	root	1.1
112	root	1.17	if ($who->{neko_last_attack} < time - 300) {
113			$who->{neko_attack} = 0;
114			}
115
116			$who->{neko_last_attack} = time;
117	root	1.16	$who->{neko_attack}++
118	elmex	1.18	or do {
119			cf::LOG cf::llevDebug, my $n = sprintf "QBERT Neko-san was attacked by %s!\n", $who->name;
120			cf::ext::schmorp_irc::do_notice ($n);
121			};
122	root	1.1
123	root	1.16	$who->message ("Meoow! (Please do not hurt me)")
124			if !($who->{neko_attack} & 15);
125	root	1.1
126	root	1.16	if ($who->{neko_attack} > 512) {
127			$who->{neko_attack} -= 128;
128			$who->message ("Neko-san is suddenly gone!");
129			teleport $who, "/scorn/misc/scorn_illusions", 15, 7;
130			$who->message ("You hear strange noises all around you...");
131			$who->message ("You feel dumb.");
132	root	1.4	}
133
134			1
135	root	1.1	}
136
137			sub on_say {
138	root	1.16	my ($event, $ob, $who, $msg) = @_;
139	root	1.1
140	root	1.16	cf::LOG cf::llevDebug, sprintf "QBERT [Neko-fon] %s: %s\n", $who->name, $msg;
141	elmex	1.18	cf::ext::schmorp_irc::do_notice (sprintf "[Neko-fon] %s: %s\n", $who->name, $msg);
142	root	1.1	}
143