| 1 |
#!perl |
| 2 |
|
| 3 |
our %materials; |
| 4 |
|
| 5 |
$cf::CFG{"editor_builder_ui"} |
| 6 |
or return; |
| 7 |
|
| 8 |
cf::register_extcmd builder_player_items => sub { |
| 9 |
my ($pl, $msg) = @_; |
| 10 |
|
| 11 |
# my @builditems = ext::reseller::find_rec ($pl->ob, sub { |
| 12 |
# my ($item) = @_; |
| 13 |
# return $item->type == cf::MATERIAL |
| 14 |
# }); |
| 15 |
|
| 16 |
(items => { map { $_->name => { value => $_->clone->value } } values %materials }) |
| 17 |
}; |
| 18 |
|
| 19 |
cf::register_extcmd builder_build => sub { |
| 20 |
my ($pl, $msg) = @_; |
| 21 |
my ($dx, $dy) = @$msg{qw(dx dy)}; |
| 22 |
my ($x, $y) = ($pl->ob->x + $dx, $pl->ob->y + $dy); |
| 23 |
|
| 24 |
my $near = (abs $dx) <= 2 && (abs $dy) <= 2; |
| 25 |
|
| 26 |
return unless $near; |
| 27 |
|
| 28 |
my $buildable = 0; |
| 29 |
|
| 30 |
for ($pl->ob->map->at ($x, $y)) { |
| 31 |
unless ($_->flag (cf::FLAG_IS_BUILDABLE)) { |
| 32 |
return; |
| 33 |
} |
| 34 |
} |
| 35 |
|
| 36 |
if ($msg->{do_erase}) { |
| 37 |
for my $ob ($pl->ob->map->at ($x, $y)) { |
| 38 |
unless ($ob->type == cf::WALL || $ob->type == cf::FLOOR || $ob->flag (cf::FLAG_IS_FLOOR)) { |
| 39 |
$ob->remove; |
| 40 |
$ob->free; |
| 41 |
} |
| 42 |
} |
| 43 |
} |
| 44 |
|
| 45 |
return unless $msg->{item}; |
| 46 |
|
| 47 |
if ($pl->cell_visible ($dx, $dy)) { |
| 48 |
my $arch = cf::arch::find $msg->{item}; |
| 49 |
|
| 50 |
if ($arch->clone->subtype == cf::ST_MAT_FLOOR) { |
| 51 |
my $above_floor; |
| 52 |
for my $ob ($pl->ob->map->at ($x, $y)) { |
| 53 |
if ($ob->type == cf::WALL) { |
| 54 |
undef $above_floor if $above_floor == $ob; |
| 55 |
$ob->remove; |
| 56 |
$ob->free; |
| 57 |
} elsif ($ob->type == cf::FLOOR || $ob->flag (cf::FLAG_IS_FLOOR)) { |
| 58 |
undef $above_floor if $above_floor == $ob; |
| 59 |
$above_floor = $ob->above; |
| 60 |
$ob->remove; |
| 61 |
$ob->free; |
| 62 |
} |
| 63 |
} |
| 64 |
|
| 65 |
# my @obs = $pl->ob->map->at ($x, $y); |
| 66 |
# for (@obs) { $_->remove; $_->free } |
| 67 |
|
| 68 |
my $floor = cf::object::new $arch->clone->slaying; |
| 69 |
$floor->flag (cf::FLAG_IS_BUILDABLE, 1); |
| 70 |
$floor->flag (cf::FLAG_UNIQUE, 1); |
| 71 |
$floor->flag (cf::FLAG_IS_FLOOR, 1); |
| 72 |
$floor->type (cf::FLOOR); |
| 73 |
$floor->insert_ob_in_map_at ($pl->ob->map, $above_floor, ($above_floor ? cf::INS_BELOW_ORIGINATOR : cf::INS_ON_TOP), $x, $y); |
| 74 |
|
| 75 |
$pl->ob->map->fix_walls_around ($x, $y); |
| 76 |
|
| 77 |
} elsif ($arch->clone->subtype == cf::ST_MAT_WALL) { |
| 78 |
my @obs = $pl->ob->map->at ($x, $y); |
| 79 |
my $prev_wall; |
| 80 |
for (@obs) { |
| 81 |
if ($_->type == cf::WALL) { |
| 82 |
$prev_wall = $_; |
| 83 |
last; |
| 84 |
} |
| 85 |
} |
| 86 |
|
| 87 |
my ($floor) = |
| 88 |
grep { $_->type == cf::FLOOR || $_->flag (cf::FLAG_IS_FLOOR) } |
| 89 |
$pl->ob->map->at ($x, $y); |
| 90 |
|
| 91 |
my $above_floor = $floor->above; |
| 92 |
if ($above_floor) { |
| 93 |
return; |
| 94 |
} |
| 95 |
|
| 96 |
my $wall = cf::object::new $arch->clone->slaying; |
| 97 |
$wall->type (cf::WALL); |
| 98 |
$wall->flag (cf::FLAG_IS_BUILDABLE, 1); |
| 99 |
$wall->insert_ob_in_map_at ($pl->ob->map, undef, cf::INS_ABOVE_FLOOR_ONLY, $x, $y); |
| 100 |
if ($prev_wall) { |
| 101 |
$prev_wall->remove; |
| 102 |
$prev_wall->free; |
| 103 |
$pl->ob->map->fix_walls ($pl->ob->x + $dx, $pl->ob->y + $dy); |
| 104 |
} else { |
| 105 |
$pl->ob->map->fix_walls_around ($pl->ob->x + $dx, $pl->ob->y + $dy); |
| 106 |
} |
| 107 |
|
| 108 |
} elsif ($arch->clone->subtype == cf::ST_MAT_ITEM) { |
| 109 |
my ($floor) = |
| 110 |
grep { $_->type == cf::FLOOR || $_->flag (cf::FLAG_IS_FLOOR) } |
| 111 |
$pl->ob->map->at ($x, $y); |
| 112 |
|
| 113 |
unless ($floor) { |
| 114 |
return; |
| 115 |
} |
| 116 |
|
| 117 |
my $above_floor = $floor->above; |
| 118 |
if ($above_floor) { |
| 119 |
return; |
| 120 |
} |
| 121 |
|
| 122 |
my $ob = cf::object::new $arch->clone->slaying; |
| 123 |
$ob->flag (cf::FLAG_IS_BUILDABLE, 1); |
| 124 |
$ob->flag (cf::FLAG_NO_PICK, 1); |
| 125 |
$ob->insert_ob_in_map_at ($pl->ob->map, undef, cf::INS_ABOVE_FLOOR_ONLY, $x, $y); |
| 126 |
} |
| 127 |
} |
| 128 |
|
| 129 |
# my $arch = cf::arch::find ($msg->{item}); |
| 130 |
}; |
| 131 |
|
| 132 |
my $farch = cf::arch::first; |
| 133 |
while ($farch) { |
| 134 |
if ($farch->clone->type == cf::MATERIAL) { |
| 135 |
$materials{$farch->name} = $farch; |
| 136 |
} |
| 137 |
$farch = $farch->next; |
| 138 |
} |
