maps/perl/schmorp-neko.ext

#! perl
#CONVERSION: NONE

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