ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra/Deliantra.pm
(Generate patch)

Comparing deliantra/Deliantra/Deliantra.pm (file contents):
Revision 1.9 by root, Sun Feb 5 21:18:07 2006 UTC vs.
Revision 1.10 by elmex, Mon Feb 6 23:01:31 2006 UTC

12 12
13use base 'Exporter'; 13use base 'Exporter';
14 14
15use Storable; 15use Storable;
16 16
17our @EXPORT = qw(read_pak read_arch arch2map $ARCH TILESIZE); 17our @EXPORT = qw(read_pak read_arch arch2map $ARCH TILESIZE editor_archs arch2pickmap arch_extends);
18 18
19our $LIB = $ENV{CROSSFIRE_LIBDIR} 19our $LIB = $ENV{CROSSFIRE_LIBDIR}
20 or die "\$CROSSFIRE_LIBDIR must be set\n"; 20 or die "\$CROSSFIRE_LIBDIR must be set\n";
21 21
22sub TILESIZE (){ 32 } 22sub TILESIZE (){ 32 }
124 124
125 \%arc 125 \%arc
126 } 126 }
127} 127}
128 128
129# put all archs into a hash with editor_face as it's key
130# NOTE: the arrays in the hash values are references to
131# the archs from $ARCH
132sub editor_archs {
133 my %paths;
134
135 for (keys %$ARCH) {
136 my $arch = $ARCH->{$_};
137 push @{$paths{$arch->{editor_folder}}}, \$arch;
138 }
139
140 return \%paths;
141}
142
143# arch_extends determines how the arch looks like on the map,
144# bigfaces, linked faces and single faces are handled here
145# it returns (<xoffset>, <yoffset>, <width>, <height>)
146# NOTE: non rectangular linked faces are not considered
147sub arch_extends {
148 my ($a) = @_;
149
150 my $TC = \%Crossfire::Tilecache::TILECACHE;
151
152 my $facename =
153 $a->{face} || $ARCH->{$a->{_name}}->{face}
154 or return ();
155
156 my $tile = $TC->{$facename}
157 or (warn "no gfx found for arch '$facename' in arch_size ()"), return;
158
159 if ($tile->{w} > 1 || $tile->{h} > 1) {
160 # bigfaces
161 return (0, 0, $tile->{w}, $tile->{h});
162
163 } elsif ($a->{more}) {
164 # linked faces
165 my ($miw, $mih, $maw, $mah) = (0, 0, 0, 0);
166 do {
167 $miw > (0 + $a->{x}) and $miw = $a->{x};
168 $mih > (0 + $a->{y}) and $mih = $a->{y};
169 $maw < (0 + $a->{x}) and $maw = $a->{x};
170 $mah < (0 + $a->{y}) and $mah = $a->{y};
171 } while $a = $a->{more};
172
173 return ($miw, $mih, ($maw - $miw) + 1, ($mah - $mih) + 1)
174
175 } else {
176 # single face
177 return (0, 0, 1, 1);
178 }
179}
180
181# arch2pickmap forms a list of archs to a pickmap
182sub arch2pickmap {
183 my ($archs, $w) = @_;
184
185 # sort archs alphabetiacally
186 my $archs = [ sort { ${$a}->{_name} cmp ${$b}->{_name} } @$archs ];
187
188 $w ||= 10; # default width
189 my $num = @$archs;
190 my $map = { };
191 # overall placement coords
192 my $x = 0;
193 my $y = 0;
194
195 my ($maxh, $maxw) = (0, 0); # maximum sizes, to set map width/height later
196 my $drawn_archs = 1; # line-break counter
197 my $max_line_height = 1;
198
199 for (my $i = 0; $i < $num; $i++) {
200
201 defined ${$archs->[$i]}->{face} or next;
202
203 # check whether this tile was already written (see below at (b))
204 unless (defined $map->{map}[$x][$y]) {
205
206 my ($xoffs, $yoffs, $arch_w, $arch_h) = arch_extends (${$archs->[$i]});
207
208 # these are special placement coords, for chained faces which
209 # have a special placement offset
210 my ($place_x, $place_y) = ($x, $y);
211 $xoffs < 0 and
212 $place_x += -$xoffs;
213 $yoffs < 0 and
214 $place_y += -$yoffs;
215
216 # iterate over the tiles this arch takes
217 # NOTE: Chained archs are maybe not a rectangle, but i don't care
218 # much for that on pickmaps
219
220 for (my $xi = 0; $xi < $arch_w; $xi++) {
221 for (my $yi = 0; $yi < $arch_h; $yi++) {
222
223 my ($lx, $ly) = ($x + $xi, $y + $yi);
224
225 if ($lx == $place_x and $ly == $place_y) {
226 push @{$map->{map}[$place_x][$place_y]}, my $a = ${$archs->[$i]};
227
228 } else {
229
230 # (b): here we set occupied tiles, but without the arch
231 $map->{map}[$lx][$ly] = [];
232 }
233 }
234 }
235 $drawn_archs++;
236
237 $x += $arch_w - 1;
238 $max_line_height < $arch_h
239 and $max_line_height = $arch_h;
240
241 } else {
242 $i--;
243 }
244
245
246 $x++;
247
248 if ($x > $w) {
249
250 $y += $max_line_height;
251 $max_line_height = 1;
252 $x = 0;
253 }
254
255 $maxw < ($x + 1) and $maxw = $x + 1;
256 $maxh < ($y + 1) and $maxh = $y + 1;
257 }
258
259 $map->{height} = $maxh;
260 $map->{width} = $maxw;
261
262 return $map;
263}
264
129sub arch2map($;$) { 265sub arch2map($;$) {
130 my ($mapa) = @_; 266 my ($mapa) = @_;
131 267
132 my %meta; 268 my %meta;
133 269

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines