server/ext/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->slaying);
         my $h = { value => $arch->value, build_arch_name => $buildarch->archname };

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

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

         $arch->archname => $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 and $top->flag (cf::FLAG_IS_BUILDABLE));
      } else {
         for my $ob ($pl->ob->map->at ($x, $y)) {
            unless ($ob->type == cf::BUILDABLE_WALL || $ob->type == cf::FLOOR || $ob->flag (cf::FLAG_IS_FLOOR)) {
               $ob->destroy if $ob->flag (cf::FLAG_IS_BUILDABLE);
            }
         }
      }
   }

   return unless $msg->{item};

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

   if ($arch->subtype == cf::ST_MAT_FLOOR) {
      my $above_floor;
      for my $ob ($pl->ob->map->at ($x, $y)) {
         if ($ob->type == cf::BUILDABLE_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->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->subtype == cf::ST_MAT_WALL) {
      my @obs = $pl->ob->map->at ($x, $y);
      my $prev_wall;
      for (@obs) {
         if ($_->type == cf::BUILDABLE_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->slaying;
      $wall->type (cf::BUILDABLE_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->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->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);
      }
   }
};

for (0 .. cf::arch::archetypes_size - 1) {
   my $farch = cf::arch::archetypes $_;

   if ($farch->type == cf::MATERIAL) {
      if (cf::arch::find $farch->slaying) {
         $materials{$farch->archname} = $farch;
      } else {
         warn "Undefined build archetype '" . $farch->slaying . "' for build material '" . $farch->archname . "'\n";
      }
   }
}
Revision:	1.4
Committed:	Sat Jul 21 16:06:22 2007 UTC (16 years, 10 months ago) by elmex
Branch:	MAIN
Changes since 1.3:	+5 -5 lines
Log Message:	fixed jeweler skill, returnvalue of arch->name changed, needing to use arch->archname now.
#	User	Rev	Content
1	root	1.1	#!perl
2
3			our %materials;
4
5			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			$cf::CFG{"editor_builder_ui"}
18			or return;
19
20			cf::register_extcmd builder_player_items => sub {
21			my ($pl, $msg) = @_;
22
23			(items => {
24			map {
25			my $arch = $_;
26	root	1.3	my $buildarch = cf::arch::find ($arch->slaying);
27	elmex	1.4	my $h = { value => $arch->value, build_arch_name => $buildarch->archname };
28	root	1.1
29	root	1.3	if (((grep { $buildarch->type == $_ } @CONNECTABLE) > 0)
30	elmex	1.4	\|\| ($buildarch->archname eq 'magic_mouth' && $buildarch->type == cf::SIGN)) {
31	root	1.1	$h->{has_connection} = 1;
32			}
33
34	root	1.3	if (grep { $buildarch->type == $_ } @READABLE) {
35	root	1.1	$h->{has_name} = 1;
36			$h->{has_text} = 1;
37			}
38
39	elmex	1.4	$arch->archname => $h
40	root	1.1	} values %materials
41			})
42			};
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			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			}
57			}
58
59			if ($msg->{do_erase}) {
60			if ($pl->ob->flag (cf::FLAG_WIZ)) {
61			my ($top) = reverse $pl->ob->map->at ($x, $y);
62	elmex	1.2	$top->destroy if ($top and $top->flag (cf::FLAG_IS_BUILDABLE));
63	root	1.1	} else {
64			for my $ob ($pl->ob->map->at ($x, $y)) {
65	elmex	1.2	unless ($ob->type == cf::BUILDABLE_WALL \|\| $ob->type == cf::FLOOR \|\| $ob->flag (cf::FLAG_IS_FLOOR)) {
66			$ob->destroy if $ob->flag (cf::FLAG_IS_BUILDABLE);
67	root	1.1	}
68			}
69			}
70			}
71
72			return unless $msg->{item};
73
74			return unless $pl->cell_visible ($dx, $dy);
75			my $arch = cf::arch::find $msg->{item};
76
77	root	1.3	if ($arch->subtype == cf::ST_MAT_FLOOR) {
78	root	1.1	my $above_floor;
79			for my $ob ($pl->ob->map->at ($x, $y)) {
80	elmex	1.2	if ($ob->type == cf::BUILDABLE_WALL) {
81	root	1.1	undef $above_floor if $above_floor == $ob;
82			$ob->destroy;
83			} 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			$ob->destroy;
87			}
88			}
89
90	root	1.3	my $floor = cf::object::new $arch->slaying;
91	root	1.1	$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	root	1.3	} elsif ($arch->subtype == cf::ST_MAT_WALL) {
100	root	1.1	my @obs = $pl->ob->map->at ($x, $y);
101			my $prev_wall;
102			for (@obs) {
103	elmex	1.2	if ($_->type == cf::BUILDABLE_WALL) {
104	root	1.1	$prev_wall = $_;
105			last;
106			}
107			}
108
109			my ($floor) =
110			grep { $_->type == cf::FLOOR \|\| $_->flag (cf::FLAG_IS_FLOOR) }
111			$pl->ob->map->at ($x, $y);
112
113			my $above_floor = $floor->above;
114			if ($above_floor) {
115			return;
116			}
117
118	root	1.3	my $wall = cf::object::new $arch->slaying;
119	elmex	1.2	$wall->type (cf::BUILDABLE_WALL);
120	root	1.1	$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			$prev_wall->destroy;
124			$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
129	root	1.3	} elsif ($arch->subtype == cf::ST_MAT_ITEM) {
130	root	1.1	my ($floor) =
131			grep { $_->type == cf::FLOOR \|\| $_->flag (cf::FLAG_IS_FLOOR) }
132			$pl->ob->map->at ($x, $y);
133
134			unless ($floor) {
135			return;
136			}
137
138			if ($floor->above) {
139			return;
140			}
141
142	root	1.3	my $ob = cf::object::new $arch->slaying;
143	root	1.1	$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
147			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			}
161			}
162			};
163
164	root	1.3	for (0 .. cf::arch::archetypes_size - 1) {
165			my $farch = cf::arch::archetypes $_;
166
167			if ($farch->type == cf::MATERIAL) {
168			if (cf::arch::find $farch->slaying) {
169	elmex	1.4	$materials{$farch->archname} = $farch;
170	root	1.1	} else {
171	elmex	1.4	warn "Undefined build archetype '" . $farch->slaying . "' for build material '" . $farch->archname . "'\n";
172	root	1.1	}
173			}
174			}