ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/cf.schmorp.de/maps/perl/cfplus_build.ext
Revision: 1.4
Committed: Fri Dec 15 19:11:46 2006 UTC (17 years, 7 months ago) by root
Branch: MAIN
CVS Tags: HEAD
Changes since 1.3: +0 -0 lines
State: FILE REMOVED
Log Message:
move .ext to server

File Contents

# Content
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 }