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.14 by root, Sat Feb 11 16:17:14 2006 UTC vs.
Revision 1.15 by root, Sun Feb 12 04:50:24 2006 UTC

… …
12 12
13use base 'Exporter'; 13use base 'Exporter';
14 14
15use Carp (); 15use Carp ();
16use Storable; 16use Storable;
17use List::Util qw(min max);
17 18
18#XXX: The map_* procedures scream for a map-object 19#XXX: The map_* procedures scream for a map-object
19 20
20our @EXPORT = 21our @EXPORT =
21 qw(read_pak read_arch $ARCH TILESIZE editor_archs 22 qw(read_pak read_arch %ARCH TILESIZE $TILE %FACE editor_archs arch_extents);
22 arch_extends
23 map_get_tile_stack map_push_tile_stack map_pop_tile_stack
24 );
25 23
26our $LIB = $ENV{CROSSFIRE_LIBDIR} 24our $LIB = $ENV{CROSSFIRE_LIBDIR}
27 or Carp::croak "\$CROSSFIRE_LIBDIR must be set\n"; 25 or Carp::croak "\$CROSSFIRE_LIBDIR must be set\n";
28 26
29sub TILESIZE (){ 32 } 27sub TILESIZE (){ 32 }
30 28
29our $CACHEDIR;
31our $ARCH; 30our %ARCH;
31our %FACE;
32our $TILE;
32 33
33our %FIELD_MULTILINE = ( 34our %FIELD_MULTILINE = (
34 msg => "endmsg", 35 msg => "endmsg",
35 lore => "endlore", 36 lore => "endlore",
36); 37);
… …
46sub MOVE_ALL (){ 0xf } 47sub MOVE_ALL (){ 0xf }
47 48
48sub normalize_arch($) { 49sub normalize_arch($) {
49 my ($ob) = @_; 50 my ($ob) = @_;
50 51
51 my $arch = $ARCH->{$ob->{_name}} 52 my $arch = $ARCH{$ob->{_name}}
52 or (warn "$ob->{_name}: no such archetype", return $ob); 53 or (warn "$ob->{_name}: no such archetype", return $ob);
53 54
54 delete $ob->{$_} for qw(can_knockback can_parry can_impale can_cut can_dam_armour can_apply); 55 delete $ob->{$_} for qw(can_knockback can_parry can_impale can_cut can_dam_armour can_apply);
55 56
56 if ($arch->{type} == 22) { # map 57 if ($arch->{type} == 22) { # map
… …
98 } 99 }
99 100
100 # if value matches archetype default, delete 101 # if value matches archetype default, delete
101 while (my ($k, $v) = each %$ob) { 102 while (my ($k, $v) = each %$ob) {
102 if (exists $arch->{$k} and $arch->{$k} eq $v) { 103 if (exists $arch->{$k} and $arch->{$k} eq $v) {
104 next if $k eq "_name";
103 delete $ob->{$k}; 105 delete $ob->{$k};
104 } 106 }
105 } 107 }
106 108
107 $ob 109 $ob
… …
208 210
209 \%arc 211 \%arc
210 } 212 }
211} 213}
212 214
213# returns the arch/object stack from a tile on a map
214sub map_get_tile_stack {
215 my ($map, $x, $y) = @_;
216 my $as;
217
218 if ($x > 0 || $x < $map->{width}
219 || $y > 0 || $y < $map->{height}) {
220
221 $as = $map->{map}{map}[$x][$y] || [];
222 }
223
224 return $as;
225}
226
227# pop the topmost arch/object from the stack of a tile on a map
228sub map_pop_tile_stack {
229 my ($map, $x, $y) = @_;
230
231 if ($x > 0 || $x < $map->{width}
232 || $y > 0 || $y < $map->{height}) {
233
234 pop @{$map->{map}{map}[$x][$y]};
235 }
236}
237
238# pushes the arch/object on the stack of a tile on a map
239sub map_push_tile_stack {
240 my ($map, $x, $y, $arch) = @_;
241
242 if ($x > 0 || $x < $map->{width}
243 || $y > 0 || $y < $map->{height}) {
244
245 push @{$map->{map}{map}[$x][$y]}, $arch;
246 }
247}
248
249
250# put all archs into a hash with editor_face as it's key 215# put all archs into a hash with editor_face as it's key
251# NOTE: the arrays in the hash values are references to 216# NOTE: the arrays in the hash values are references to
252# the archs from $ARCH 217# the archs from $ARCH
253sub editor_archs { 218sub editor_archs {
254 my %paths; 219 my %paths;
255 220
256 for (keys %$ARCH) { 221 for (keys %ARCH) {
257 my $arch = $ARCH->{$_}; 222 my $arch = $ARCH{$_};
258 push @{$paths{$arch->{editor_folder}}}, \$arch; 223 push @{$paths{$arch->{editor_folder}}}, \$arch;
259 } 224 }
260 225
261 return \%paths; 226 \%paths
262} 227}
263 228
264# arch_extends determines how the arch looks like on the map, 229# arch_extents determines the extents of a given arch
265# bigfaces, linked faces and single faces are handled here 230# bigfaces, linked faces and single faces are handled here
266# it returns (<xoffset>, <yoffset>, <width>, <height>) 231# it returns (minx, miny, maxx, maxy)
267# NOTE: non rectangular linked faces are not considered
268sub arch_extends { 232sub arch_extents {
269 my ($a) = @_; 233 my ($a) = @_;
270 234
271 my $TC = \%Crossfire::Tilecache::TILECACHE; 235 my $o = $ARCH{$a->{_name}}
272
273 my $facename =
274 $a->{face} || $ARCH->{$a->{_name}}->{face}
275 or return (); 236 or return;
276 237
277 my $tile = $TC->{$facename} 238 my $face = $FACE{$a->{face} || $o->{face}}
278 or (warn "no gfx found for arch '$facename' in arch_size ()"), return; 239 or (warn "no face data found for arch '$a->{_name}'"), return;
279 240
280 if ($tile->{w} > 1 || $tile->{h} > 1) { 241 if ($face->{w} > 1 || $face->{h} > 1) {
281 # bigfaces 242 # bigface
282 return (0, 0, $tile->{w}, $tile->{h}); 243 return (0, 0, $face->{w} - 1, $face->{h} - 1);
283 244
284 } elsif ($a->{more}) { 245 } elsif ($o->{more}) {
285 # linked faces 246 # linked face
286 my ($miw, $mih, $maw, $mah) = (0, 0, 0, 0); 247 my ($minx, $miny, $maxx, $maxy) = ($o->{x}, $o->{y}) x 2;
287 do {
288 $miw > (0 + $a->{x}) and $miw = $a->{x};
289 $mih > (0 + $a->{y}) and $mih = $a->{y};
290 $maw < (0 + $a->{x}) and $maw = $a->{x};
291 $mah < (0 + $a->{y}) and $mah = $a->{y};
292 } while $a = $a->{more};
293 248
294 return ($miw, $mih, ($maw - $miw) + 1, ($mah - $mih) + 1) 249 for (; $o; $o = $o->{more}) {
250 $minx = min $minx, $o->{x};
251 $miny = min $miny, $o->{y};
252 $maxx = max $maxx, $o->{x};
253 $maxy = max $maxy, $o->{y};
254 }
255
256 return ($minx, $miny, $maxx, $maxy);
295 257
296 } else { 258 } else {
297 # single face 259 # single face
298 return (0, 0, 1, 1); 260 return (0, 0, 0, 0);
299 } 261 }
300} 262}
301 263
302sub init($) { 264sub init($) {
303 my ($cachedir) = @_; 265 my ($cachedir) = @_;
304 266
267 return if %ARCH;
268
305 $ARCH = read_arch "$LIB/archetypes", "$cachedir/archetypes.pst"; 269 *ARCH = read_arch "$LIB/archetypes", "$cachedir/archetypes.pst";
306} 270}
271
272$CACHEDIR ||= "$ENV{HOME}/.crossfire";
273
274init $CACHEDIR;
307 275
308=head1 AUTHOR 276=head1 AUTHOR
309 277
310 Marc Lehmann <schmorp@schmorp.de> 278 Marc Lehmann <schmorp@schmorp.de>
311 http://home.schmorp.de/ 279 http://home.schmorp.de/

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines