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);
         $top->destroy if $top;
      } 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->destroy;
            }
         }
      }
   }

   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->destroy;
         } elsif ($ob->type == cf::FLOOR || $ob->flag (cf::FLAG_IS_FLOOR)) {
            undef $above_floor if $above_floor == $ob;
            $above_floor = $ob->above;
            $ob->destroy;
         }
      }

      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->destroy;
         $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.3
Committed:	Tue Dec 12 16:59:34 2006 UTC (17 years, 5 months ago) by root
Branch:	MAIN
Changes since 1.2:	+5 -10 lines
Log Message:	* empty log message *
#	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	root	1.3	$top->destroy if $top;
63	elmex	1.2	} else {
64			for my $ob ($pl->ob->map->at ($x, $y)) {
65			unless ($ob->type == cf::WALL \|\| $ob->type == cf::FLOOR \|\| $ob->flag (cf::FLAG_IS_FLOOR)) {
66	root	1.3	$ob->destroy;
67	elmex	1.2	}
68	elmex	1.1	}
69			}
70			}
71
72			return unless $msg->{item};
73
74	elmex	1.2	return unless $pl->cell_visible ($dx, $dy);
75			my $arch = cf::arch::find $msg->{item};
76	elmex	1.1
77	elmex	1.2	if ($arch->clone->subtype == cf::ST_MAT_FLOOR) {
78			my $above_floor;
79			for my $ob ($pl->ob->map->at ($x, $y)) {
80			if ($ob->type == cf::WALL) {
81			undef $above_floor if $above_floor == $ob;
82	root	1.3	$ob->destroy;
83	elmex	1.2	} elsif ($ob->type == cf::FLOOR \|\| $ob->flag (cf::FLAG_IS_FLOOR)) {
84			undef $above_floor if $above_floor == $ob;
85			$above_floor = $ob->above;
86	root	1.3	$ob->destroy;
87	elmex	1.2	}
88			}
89
90			my $floor = cf::object::new $arch->clone->slaying;
91			$floor->flag (cf::FLAG_IS_BUILDABLE, 1);
92			$floor->flag (cf::FLAG_UNIQUE, 1);
93			$floor->flag (cf::FLAG_IS_FLOOR, 1);
94			$floor->type (cf::FLOOR);
95			$floor->insert_ob_in_map_at ($pl->ob->map, $above_floor, ($above_floor ? cf::INS_BELOW_ORIGINATOR : cf::INS_ON_TOP), $x, $y);
96
97			$pl->ob->map->fix_walls_around ($x, $y);
98
99			} elsif ($arch->clone->subtype == cf::ST_MAT_WALL) {
100			my @obs = $pl->ob->map->at ($x, $y);
101			my $prev_wall;
102			for (@obs) {
103			if ($_->type == cf::WALL) {
104			$prev_wall = $_;
105			last;
106	elmex	1.1	}
107	elmex	1.2	}
108	elmex	1.1
109	elmex	1.2	my ($floor) =
110			grep { $_->type == cf::FLOOR \|\| $_->flag (cf::FLAG_IS_FLOOR) }
111			$pl->ob->map->at ($x, $y);
112	elmex	1.1
113	elmex	1.2	my $above_floor = $floor->above;
114			if ($above_floor) {
115			return;
116			}
117	elmex	1.1
118	elmex	1.2	my $wall = cf::object::new $arch->clone->slaying;
119			$wall->type (cf::WALL);
120			$wall->flag (cf::FLAG_IS_BUILDABLE, 1);
121			$wall->insert_ob_in_map_at ($pl->ob->map, undef, cf::INS_ABOVE_FLOOR_ONLY, $x, $y);
122			if ($prev_wall) {
123	root	1.3	$prev_wall->destroy;
124	elmex	1.2	$pl->ob->map->fix_walls ($pl->ob->x + $dx, $pl->ob->y + $dy);
125			} else {
126			$pl->ob->map->fix_walls_around ($pl->ob->x + $dx, $pl->ob->y + $dy);
127			}
128	elmex	1.1
129	elmex	1.2	} elsif ($arch->clone->subtype == cf::ST_MAT_ITEM) {
130			my ($floor) =
131			grep { $_->type == cf::FLOOR \|\| $_->flag (cf::FLAG_IS_FLOOR) }
132			$pl->ob->map->at ($x, $y);
133	elmex	1.1
134	elmex	1.2	unless ($floor) {
135			return;
136			}
137	elmex	1.1
138	elmex	1.2	if ($floor->above) {
139			return;
140			}
141	elmex	1.1
142	elmex	1.2	my $ob = cf::object::new $arch->clone->slaying;
143			$ob->flag (cf::FLAG_IS_BUILDABLE, 1);
144			$ob->flag (cf::FLAG_NO_PICK, 1);
145			$ob->insert_ob_in_map_at ($pl->ob->map, undef, cf::INS_ABOVE_FLOOR_ONLY, $x, $y);
146	elmex	1.1
147	elmex	1.2	if (defined $msg->{connection}) {
148			$ob->add_button_link ($pl->ob->map, $msg->{connection});
149			}
150			if (defined $msg->{text}) {
151			$ob->msg ($msg->{text});
152			}
153			if (defined $msg->{name}) {
154			my $name = $msg->{name};
155			$ob->name ($msg->{name});
156			}
157			if ((grep { $ob->type == $_ } @READABLE) && $ob->invisible) {
158			$ob->name ("talking " . $ob->name);
159			$ob->invisible (0);
160	elmex	1.1	}
161			}
162			};
163
164			my $farch = cf::arch::first;
165			while ($farch) {
166			if ($farch->clone->type == cf::MATERIAL) {
167	elmex	1.2	if (cf::arch::find $farch->clone->slaying) {
168			$materials{$farch->name} = $farch;
169			} else {
170			warn "Undefined build archetype '".($farch->clone->slaying)."' for build material '".($farch->name)."'\n";
171			}
172	elmex	1.1	}
173			$farch = $farch->next;
174			}