| 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 |
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 |
|
| 34 |
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 |
}; |
| 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 |
$top->destroy if $top; |
| 63 |
} 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 |
$ob->destroy; |
| 67 |
} |
| 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 |
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 |
$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 |
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 |
} |
| 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 |
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 |
$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 |
} 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 |
|
| 134 |
unless ($floor) { |
| 135 |
return; |
| 136 |
} |
| 137 |
|
| 138 |
if ($floor->above) { |
| 139 |
return; |
| 140 |
} |
| 141 |
|
| 142 |
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 |
|
| 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 |
my $farch = cf::arch::first; |
| 165 |
while ($farch) { |
| 166 |
if ($farch->clone->type == cf::MATERIAL) { |
| 167 |
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 |
} |
| 173 |
$farch = $farch->next; |
| 174 |
} |
