maps/perl/nimbus.ext

#! perl

# 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;
}

cf::register_attachment nimbus_exit =>
   on_trigger => sub {
      my ($self, $ob) = @_;

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

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

         if ($self->{nimbus_exit}{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 . ".pst";
      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");

      cf::override;
   },
;

cf::attach_to_maps #TODO#d# remove, onyl for upgrading old to new nimbus
   on_upgrade => sub {
      my ($map) = @_;

      if ($map->path =~ /\/nimbus$/) {
         warn "NIMBUS UPGRADE ", $map->path, "\n";

         (grep length $_->slaying, $map->at (11, 1))[0]->attach (nimbus_exit => restore => 1);

         for my $x (37 .. 58) {
            for my $y (32 .. 53) {
               $_->remove for $map->at ($x, $y);

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

               $portal->set_name    ("free ride, courtesy of your friendly upgrade script");
               $portal->set_slaying ($map->path);
               $portal->set_hp      (1);
               $portal->set_sp      (1);

               $portal->insert_ob_in_map_at ($map, undef, cf::INS_ABOVE_FLOOR_ONLY, $x, $y);
            }
         }
      }
   },
;

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