maps/perl/nimbus.ext

#! perl
#CONVERSION: PARTIAL

# handle the nimbus map and other stuff

my @STATS = qw(
   Str Dex Con Wis Cha Int Pow
   wc ac hp maxhp sp maxsp grace maxgrace
   exp food dam luck
);

sub stats_get($) {
   my ($stats, $save) = @_;

   for my $stat (@STATS) {
      $save->{$stat} = $stats->$stat;
   }
   
   $save
}

sub stats_set($$) {
   my ($stats, $save) = @_;

   for my $stat (@STATS) {
      $stats->$stat ($save->{$stat});
   }

   $stats->hp    ($stats->maxhp);
   $stats->grace ($stats->maxgrace);
   $stats->food  (999);
}

sub skills_get($) {
   my ($ob) = @_;

   +{
      map +($_->skill => $_->stats->exp),
         grep $_->type == cf::SKILL,
            $ob->inv
   }
}

sub skills_set($$) {
   my ($ob, $skills) = @_;

   for my $skill (grep $_->type == cf::SKILL, $ob->inv) {
      my $name = $skill->skill;

      if ($skill->stats->exp < $skills->{$name}) {
         $skill->stats->exp ($skills->{$name});
         $ob->player_lvl_adj ($skill);
      }
   }
}

# called when the player will likely die (modulo explore mode)
# but before any stats/exp is changed
cf::attach_to_players
   on_death => sub {
      my ($pl) = @_;
      my $ob = $pl->ob;

      # save player stats and experience to restore it later

      unless ($ob->{in_nimbus}) {
         my $save = {
            stats      => stats_get $ob->stats,
            orig_stats => stats_get $pl->orig_stats,
            savebed    => [$pl->get_savebed],
            skill_exp  => skills_get $ob,
         };

         $ob->{in_nimbus} = $save;

         $ob->message ("\n");
         $ob->message ("You start to feel dizzy.\n");
         $ob->message ("The world around you blurs.\n");
         $ob->message ("\n");
      }

      my $path = sprintf "%s/%s/%s/%s",
         cf::localdir, cf::playerdir, $ob->name, "nimbus";

      if ($ob->map->path ne $path) {
         my $nimbus = cf::map::get_map "/schmorp/nimbus";
         $nimbus->set_path ($path);
         $nimbus->set_unique (1);
         
         $pl->set_savebed ($path, 24, 12);
      }
   },
;

sub teleport {
   my ($pl, $map, $x, $y) = @_;

   return if $pl->ob->map->path eq $map
          && abs ($pl->ob->x - $x) <= 1
          && abs ($pl->ob->y - $y) <= 1;

   my $portal = cf::object::new "exit";

   $portal->set_slaying ($map);
   $portal->set_hp      ($x);
   $portal->set_sp      ($y);

   $portal->apply ($pl->ob);

   $portal->free;
}

sub on_trigger {
   my ($event, $porter, $ob) = @_;

   my $options = $event->options;
   my $pl = $ob->contr;
   my @savebed;

   if (my $save = delete $ob->{in_nimbus}) {
      @savebed = @{$save->{savebed}};

      if ($options eq "restore") {
         $ob->message ("The gods acknowledge your success.\n");
         stats_set $ob->stats, $save->{stats};
         stats_set $pl->orig_stats, $save->{orig_stats};
         $ob->player_lvl_adj; # update overall level
         skills_set $ob, $save->{skill_exp};
      } else {
         $ob->message ("The gods are disappointed with you.\n");
      }

   } else {
      @savebed = ("/scorn/taverns/inn", 10, 5);
   }

   $pl->set_savebed (@savebed);

   my $map = $ob->map;

   teleport $pl, @savebed;

   # should make this a temporary map and let cf deal with it
   unlink $map->path;
   unlink $map->path . ".cfperl";
   $map->delete_map;

   $pl->play_sound_player_only (cf::SOUND_PLAYER_DIES);

   $ob->message ("You feel as if you woke up from a dream.\n");
   $ob->message ("You have a headache.\n");
   $ob->message ("Maybe you should have a drink.\n");

   1
}

Revision:	1.12
Committed:	Fri Aug 25 15:07:43 2006 UTC (17 years, 8 months ago) by root
Branch:	MAIN
Changes since 1.11:	+34 -34 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.12	#CONVERSION: PARTIAL
3	root	1.1
4			# handle the nimbus map and other stuff
5
6			my @STATS = qw(
7			Str Dex Con Wis Cha Int Pow
8			wc ac hp maxhp sp maxsp grace maxgrace
9	root	1.6	exp food dam luck
10	root	1.1	);
11
12			sub stats_get($) {
13			my ($stats, $save) = @_;
14
15			for my $stat (@STATS) {
16			$save->{$stat} = $stats->$stat;
17			}
18
19			$save
20			}
21
22			sub stats_set($$) {
23			my ($stats, $save) = @_;
24
25			for my $stat (@STATS) {
26			$stats->$stat ($save->{$stat});
27			}
28	root	1.2
29			$stats->hp ($stats->maxhp);
30			$stats->grace ($stats->maxgrace);
31			$stats->food (999);
32	root	1.1	}
33
34			sub skills_get($) {
35			my ($ob) = @_;
36
37	root	1.2	+{
38	root	1.3	map +($_->skill => $_->stats->exp),
39	root	1.2	grep $_->type == cf::SKILL,
40			$ob->inv
41			}
42	root	1.1	}
43
44	root	1.2	sub skills_set($$) {
45	root	1.6	my ($ob, $skills) = @_;
46	root	1.2
47	root	1.6	for my $skill (grep $_->type == cf::SKILL, $ob->inv) {
48			my $name = $skill->skill;
49	root	1.5
50	root	1.6	if ($skill->stats->exp < $skills->{$name}) {
51			$skill->stats->exp ($skills->{$name});
52			$ob->player_lvl_adj ($skill);
53	root	1.5	}
54	root	1.2	}
55	root	1.1	}
56
57			# called when the player will likely die (modulo explore mode)
58			# but before any stats/exp is changed
59	root	1.12	cf::attach_to_players
60			on_death => sub {
61			my ($pl) = @_;
62			my $ob = $pl->ob;
63
64			# save player stats and experience to restore it later
65
66			unless ($ob->{in_nimbus}) {
67			my $save = {
68			stats => stats_get $ob->stats,
69			orig_stats => stats_get $pl->orig_stats,
70			savebed => [$pl->get_savebed],
71			skill_exp => skills_get $ob,
72			};
73
74			$ob->{in_nimbus} = $save;
75
76			$ob->message ("\n");
77			$ob->message ("You start to feel dizzy.\n");
78			$ob->message ("The world around you blurs.\n");
79			$ob->message ("\n");
80			}
81	root	1.1
82	root	1.12	my $path = sprintf "%s/%s/%s/%s",
83			cf::localdir, cf::playerdir, $ob->name, "nimbus";
84	root	1.1
85	root	1.12	if ($ob->map->path ne $path) {
86			my $nimbus = cf::map::get_map "/schmorp/nimbus";
87			$nimbus->set_path ($path);
88			$nimbus->set_unique (1);
89
90			$pl->set_savebed ($path, 24, 12);
91			}
92			},
93			;
94	root	1.1
95	root	1.7	sub teleport {
96			my ($pl, $map, $x, $y) = @_;
97
98			return if $pl->ob->map->path eq $map
99			&& abs ($pl->ob->x - $x) <= 1
100			&& abs ($pl->ob->y - $y) <= 1;
101
102			my $portal = cf::object::new "exit";
103
104			$portal->set_slaying ($map);
105			$portal->set_hp ($x);
106			$portal->set_sp ($y);
107
108			$portal->apply ($pl->ob);
109
110			$portal->free;
111			}
112
113	root	1.1	sub on_trigger {
114	root	1.10	my ($event, $porter, $ob) = @_;
115
116			my $options = $event->options;
117	root	1.1	my $pl = $ob->contr;
118			my @savebed;
119
120	root	1.5	if (my $save = delete $ob->{in_nimbus}) {
121	root	1.1	@savebed = @{$save->{savebed}};
122
123	root	1.7	if ($options eq "restore") {
124	root	1.6	$ob->message ("The gods acknowledge your success.\n");
125	root	1.2	stats_set $ob->stats, $save->{stats};
126			stats_set $pl->orig_stats, $save->{orig_stats};
127	root	1.6	$ob->player_lvl_adj; # update overall level
128	root	1.2	skills_set $ob, $save->{skill_exp};
129	root	1.6	} else {
130			$ob->message ("The gods are disappointed with you.\n");
131	root	1.2	}
132
133	root	1.1	} else {
134			@savebed = ("/scorn/taverns/inn", 10, 5);
135			}
136
137			$pl->set_savebed (@savebed);
138
139	root	1.5	my $map = $ob->map;
140
141	root	1.7	teleport $pl, @savebed;
142	root	1.1
143	root	1.7	# should make this a temporary map and let cf deal with it
144			unlink $map->path;
145			unlink $map->path . ".cfperl";
146	root	1.5	$map->delete_map;
147
148	root	1.7	$pl->play_sound_player_only (cf::SOUND_PLAYER_DIES);
149
150	root	1.6	$ob->message ("You feel as if you woke up from a dream.\n");
151			$ob->message ("You have a headache.\n");
152			$ob->message ("Maybe you should have a drink.\n");
153	root	1.1
154			1
155			}
156