maps/perl/cfplus_build.ext

#!perl

our %materials;

our @CONNECTABLE = (
   cf::DOOR,
   cf::GATE,
   cf::BUTTON,
   cf::DETECTOR,
   cf::TIMED_GATE,
   cf::PEDESTAL,
   cf::CF_HANDLE,
   cf::MAGIC_EAR
);
our @READABLE = (cf::SIGN, cf::MAGIC_EAR);

$cf::CFG{"editor_builder_ui"}
   or return;

cf::register_extcmd builder_player_items => sub {
   my ($pl, $msg) = @_;

   (items => {
      map {
         my $arch = $_;
         my $buildarch = cf::arch::find ($arch->clone->slaying);
         my $h = { value => $arch->clone->value, build_arch_name => $buildarch->name };

         if (((grep { $buildarch->clone->type == $_ } @CONNECTABLE) > 0)
             || ($buildarch->name eq 'magic_mouth' && $buildarch->clone->type == cf::SIGN)) {
            $h->{has_connection} = 1;
         }

         if (grep { $buildarch->clone->type == $_ } @READABLE) {
            $h->{has_name} = 1;
            $h->{has_text} = 1;
         }

         $arch->name => $h
      } values %materials
   })
};

cf::register_extcmd builder_build => sub {
   my ($pl, $msg) = @_;
   my ($dx, $dy) = @$msg{qw(dx dy)};
   my ($x, $y) = ($pl->ob->x + $dx, $pl->ob->y + $dy);

   my $buildable = 0;

   unless ($pl->ob->flag (cf::FLAG_WIZ)) {
      for ($pl->ob->map->at ($x, $y)) {
         unless ($_->flag (cf::FLAG_IS_BUILDABLE)) {
            return;
         }
      }
   }

   if ($msg->{do_erase}) {
      if ($pl->ob->flag (cf::FLAG_WIZ)) {
         my ($top) = reverse $pl->ob->map->at ($x, $y);
         if ($top) { $top->remove; $top->free }

      } else {
         for my $ob ($pl->ob->map->at ($x, $y)) {
            unless ($ob->type == cf::WALL || $ob->type == cf::FLOOR || $ob->flag (cf::FLAG_IS_FLOOR)) {
               $ob->remove;
               $ob->free;
            }
         }
      }
   }

   return unless $msg->{item};

   return unless $pl->cell_visible ($dx, $dy);
   my $arch = cf::arch::find $msg->{item};

   if ($arch->clone->subtype == cf::ST_MAT_FLOOR) {
      my $above_floor;
      for my $ob ($pl->ob->map->at ($x, $y)) {
         if ($ob->type == cf::WALL) {
            undef $above_floor if $above_floor == $ob;
            $ob->remove;
            $ob->free;
         } elsif ($ob->type == cf::FLOOR || $ob->flag (cf::FLAG_IS_FLOOR)) {
            undef $above_floor if $above_floor == $ob;
            $above_floor = $ob->above;
            $ob->remove;
            $ob->free;
         }
      }

      my $floor = cf::object::new $arch->clone->slaying;
      $floor->flag (cf::FLAG_IS_BUILDABLE, 1);
      $floor->flag (cf::FLAG_UNIQUE, 1);
      $floor->flag (cf::FLAG_IS_FLOOR, 1);
      $floor->type (cf::FLOOR);
      $floor->insert_ob_in_map_at ($pl->ob->map, $above_floor, ($above_floor ? cf::INS_BELOW_ORIGINATOR : cf::INS_ON_TOP), $x, $y);

      $pl->ob->map->fix_walls_around ($x, $y);

   } elsif ($arch->clone->subtype == cf::ST_MAT_WALL) {
      my @obs = $pl->ob->map->at ($x, $y);
      my $prev_wall;
      for (@obs) {
         if ($_->type == cf::WALL) {
            $prev_wall = $_;
            last;
         }
      }

      my ($floor) =
         grep { $_->type == cf::FLOOR || $_->flag (cf::FLAG_IS_FLOOR) }
            $pl->ob->map->at ($x, $y);

      my $above_floor = $floor->above;
      if ($above_floor) {
         return;
      }

      my $wall = cf::object::new $arch->clone->slaying;
      $wall->type (cf::WALL);
      $wall->flag (cf::FLAG_IS_BUILDABLE, 1);
      $wall->insert_ob_in_map_at ($pl->ob->map, undef, cf::INS_ABOVE_FLOOR_ONLY, $x, $y);
      if ($prev_wall) {
         $prev_wall->remove;
         $prev_wall->free;
         $pl->ob->map->fix_walls ($pl->ob->x + $dx, $pl->ob->y + $dy);
      } else {
         $pl->ob->map->fix_walls_around ($pl->ob->x + $dx, $pl->ob->y + $dy);
      }

   } elsif ($arch->clone->subtype == cf::ST_MAT_ITEM) {
      my ($floor) =
         grep { $_->type == cf::FLOOR || $_->flag (cf::FLAG_IS_FLOOR) }
            $pl->ob->map->at ($x, $y);

      unless ($floor) {
         return;
      }

      if ($floor->above) {
         return;
      }

      my $ob = cf::object::new $arch->clone->slaying;
      $ob->flag (cf::FLAG_IS_BUILDABLE, 1);
      $ob->flag (cf::FLAG_NO_PICK, 1);
      $ob->insert_ob_in_map_at ($pl->ob->map, undef, cf::INS_ABOVE_FLOOR_ONLY, $x, $y);

      if (defined $msg->{connection}) {
         $ob->add_button_link ($pl->ob->map, $msg->{connection});
      }
      if (defined $msg->{text}) {
         $ob->msg ($msg->{text});
      }
      if (defined $msg->{name}) {
         my $name = $msg->{name};
         $ob->name ($msg->{name});
      }
      if ((grep { $ob->type == $_ } @READABLE) && $ob->invisible) {
         $ob->name ("talking " . $ob->name);
         $ob->invisible (0);
      }
   }
};

my $farch = cf::arch::first;
while ($farch) {
   if ($farch->clone->type == cf::MATERIAL) {
      if (cf::arch::find $farch->clone->slaying) {
         $materials{$farch->name} = $farch;
      } else {
         warn "Undefined build archetype '".($farch->clone->slaying)."' for build material '".($farch->name)."'\n";
      }
   }
   $farch = $farch->next;
}
Revision:	1.2
Committed:	Tue Dec 5 16:53:02 2006 UTC (17 years, 5 months ago) by elmex
Branch:	MAIN
Changes since 1.1:	+129 -88 lines
Log Message:	implemented connection handling for buildables.
#	User	Rev	Content
1	elmex	1.1	#!perl
2
3			our %materials;
4
5	elmex	1.2	our @CONNECTABLE = (
6			cf::DOOR,
7			cf::GATE,
8			cf::BUTTON,
9			cf::DETECTOR,
10			cf::TIMED_GATE,
11			cf::PEDESTAL,
12			cf::CF_HANDLE,
13			cf::MAGIC_EAR
14			);
15			our @READABLE = (cf::SIGN, cf::MAGIC_EAR);
16
17	elmex	1.1	$cf::CFG{"editor_builder_ui"}
18			or return;
19
20			cf::register_extcmd builder_player_items => sub {
21			my ($pl, $msg) = @_;
22
23	elmex	1.2	(items => {
24			map {
25			my $arch = $_;
26			my $buildarch = cf::arch::find ($arch->clone->slaying);
27			my $h = { value => $arch->clone->value, build_arch_name => $buildarch->name };
28
29			if (((grep { $buildarch->clone->type == $_ } @CONNECTABLE) > 0)
30			\|\| ($buildarch->name eq 'magic_mouth' && $buildarch->clone->type == cf::SIGN)) {
31			$h->{has_connection} = 1;
32			}
33	elmex	1.1
34	elmex	1.2	if (grep { $buildarch->clone->type == $_ } @READABLE) {
35			$h->{has_name} = 1;
36			$h->{has_text} = 1;
37			}
38
39			$arch->name => $h
40			} values %materials
41			})
42	elmex	1.1	};
43
44			cf::register_extcmd builder_build => sub {
45			my ($pl, $msg) = @_;
46			my ($dx, $dy) = @$msg{qw(dx dy)};
47			my ($x, $y) = ($pl->ob->x + $dx, $pl->ob->y + $dy);
48
49			my $buildable = 0;
50
51	elmex	1.2	unless ($pl->ob->flag (cf::FLAG_WIZ)) {
52			for ($pl->ob->map->at ($x, $y)) {
53			unless ($_->flag (cf::FLAG_IS_BUILDABLE)) {
54			return;
55			}
56	elmex	1.1	}
57			}
58
59			if ($msg->{do_erase}) {
60	elmex	1.2	if ($pl->ob->flag (cf::FLAG_WIZ)) {
61			my ($top) = reverse $pl->ob->map->at ($x, $y);
62			if ($top) { $top->remove; $top->free }
63
64			} else {
65			for my $ob ($pl->ob->map->at ($x, $y)) {
66			unless ($ob->type == cf::WALL \|\| $ob->type == cf::FLOOR \|\| $ob->flag (cf::FLAG_IS_FLOOR)) {
67			$ob->remove;
68			$ob->free;
69			}
70	elmex	1.1	}
71			}
72			}
73
74			return unless $msg->{item};
75
76	elmex	1.2	return unless $pl->cell_visible ($dx, $dy);
77			my $arch = cf::arch::find $msg->{item};
78	elmex	1.1
79	elmex	1.2	if ($arch->clone->subtype == cf::ST_MAT_FLOOR) {
80			my $above_floor;
81			for my $ob ($pl->ob->map->at ($x, $y)) {
82			if ($ob->type == cf::WALL) {
83			undef $above_floor if $above_floor == $ob;
84			$ob->remove;
85			$ob->free;
86			} elsif ($ob->type == cf::FLOOR \|\| $ob->flag (cf::FLAG_IS_FLOOR)) {
87			undef $above_floor if $above_floor == $ob;
88			$above_floor = $ob->above;
89			$ob->remove;
90			$ob->free;
91			}
92			}
93
94			my $floor = cf::object::new $arch->clone->slaying;
95			$floor->flag (cf::FLAG_IS_BUILDABLE, 1);
96			$floor->flag (cf::FLAG_UNIQUE, 1);
97			$floor->flag (cf::FLAG_IS_FLOOR, 1);
98			$floor->type (cf::FLOOR);
99			$floor->insert_ob_in_map_at ($pl->ob->map, $above_floor, ($above_floor ? cf::INS_BELOW_ORIGINATOR : cf::INS_ON_TOP), $x, $y);
100
101			$pl->ob->map->fix_walls_around ($x, $y);
102
103			} elsif ($arch->clone->subtype == cf::ST_MAT_WALL) {
104			my @obs = $pl->ob->map->at ($x, $y);
105			my $prev_wall;
106			for (@obs) {
107			if ($_->type == cf::WALL) {
108			$prev_wall = $_;
109			last;
110	elmex	1.1	}
111	elmex	1.2	}
112	elmex	1.1
113	elmex	1.2	my ($floor) =
114			grep { $_->type == cf::FLOOR \|\| $_->flag (cf::FLAG_IS_FLOOR) }
115			$pl->ob->map->at ($x, $y);
116	elmex	1.1
117	elmex	1.2	my $above_floor = $floor->above;
118			if ($above_floor) {
119			return;
120			}
121	elmex	1.1
122	elmex	1.2	my $wall = cf::object::new $arch->clone->slaying;
123			$wall->type (cf::WALL);
124			$wall->flag (cf::FLAG_IS_BUILDABLE, 1);
125			$wall->insert_ob_in_map_at ($pl->ob->map, undef, cf::INS_ABOVE_FLOOR_ONLY, $x, $y);
126			if ($prev_wall) {
127			$prev_wall->remove;
128			$prev_wall->free;
129			$pl->ob->map->fix_walls ($pl->ob->x + $dx, $pl->ob->y + $dy);
130			} else {
131			$pl->ob->map->fix_walls_around ($pl->ob->x + $dx, $pl->ob->y + $dy);
132			}
133	elmex	1.1
134	elmex	1.2	} elsif ($arch->clone->subtype == cf::ST_MAT_ITEM) {
135			my ($floor) =
136			grep { $_->type == cf::FLOOR \|\| $_->flag (cf::FLAG_IS_FLOOR) }
137			$pl->ob->map->at ($x, $y);
138	elmex	1.1
139	elmex	1.2	unless ($floor) {
140			return;
141			}
142	elmex	1.1
143	elmex	1.2	if ($floor->above) {
144			return;
145			}
146	elmex	1.1
147	elmex	1.2	my $ob = cf::object::new $arch->clone->slaying;
148			$ob->flag (cf::FLAG_IS_BUILDABLE, 1);
149			$ob->flag (cf::FLAG_NO_PICK, 1);
150			$ob->insert_ob_in_map_at ($pl->ob->map, undef, cf::INS_ABOVE_FLOOR_ONLY, $x, $y);
151	elmex	1.1
152	elmex	1.2	if (defined $msg->{connection}) {
153			$ob->add_button_link ($pl->ob->map, $msg->{connection});
154			}
155			if (defined $msg->{text}) {
156			$ob->msg ($msg->{text});
157			}
158			if (defined $msg->{name}) {
159			my $name = $msg->{name};
160			$ob->name ($msg->{name});
161			}
162			if ((grep { $ob->type == $_ } @READABLE) && $ob->invisible) {
163			$ob->name ("talking " . $ob->name);
164			$ob->invisible (0);
165	elmex	1.1	}
166			}
167			};
168
169			my $farch = cf::arch::first;
170			while ($farch) {
171			if ($farch->clone->type == cf::MATERIAL) {
172	elmex	1.2	if (cf::arch::find $farch->clone->slaying) {
173			$materials{$farch->name} = $farch;
174			} else {
175			warn "Undefined build archetype '".($farch->clone->slaying)."' for build material '".($farch->name)."'\n";
176			}
177	elmex	1.1	}
178			$farch = $farch->next;
179			}