[ViewVC] Diff of: cvs/deliantra/Deliantra/Deliantra.pm

Comparing deliantra/Deliantra/Deliantra.pm (file contents):
Revision 1.15 by root, Sun Feb 12 04:50:24 2006 UTC vs.
Revision 1.29 by root, Thu Feb 23 13:22:10 2006 UTC

…		…
12		12
13	use base 'Exporter';	13	use base 'Exporter';
14		14
15	use Carp ();	15	use Carp ();
16	use Storable;	16	use Storable;
		17	use File::Spec;
17	use List::Util qw(min max);	18	use List::Util qw(min max);
18		19
19	#XXX: The map_* procedures scream for a map-object	20	#XXX: The map_* procedures scream for a map-object
20		21
21	our @EXPORT =	22	our @EXPORT =
…		…
24	our $LIB = $ENV{CROSSFIRE_LIBDIR}	25	our $LIB = $ENV{CROSSFIRE_LIBDIR}
25	or Carp::croak "\$CROSSFIRE_LIBDIR must be set\n";	26	or Carp::croak "\$CROSSFIRE_LIBDIR must be set\n";
26		27
27	sub TILESIZE (){ 32 }	28	sub TILESIZE (){ 32 }
28		29
29	our $CACHEDIR;	30	our $VARDIR;
30	our %ARCH;	31	our %ARCH;
31	our %FACE;	32	our %FACE;
32	our $TILE;	33	our $TILE;
33		34
34	our %FIELD_MULTILINE = (	35	our %FIELD_MULTILINE = (
…		…
43	sub MOVE_FLY_LOW (){ 0x2 }	44	sub MOVE_FLY_LOW (){ 0x2 }
44	sub MOVE_FLY_HIGH (){ 0x4 }	45	sub MOVE_FLY_HIGH (){ 0x4 }
45	sub MOVE_FLYING (){ 0x6 }	46	sub MOVE_FLYING (){ 0x6 }
46	sub MOVE_SWIM (){ 0x8 }	47	sub MOVE_SWIM (){ 0x8 }
47	sub MOVE_ALL (){ 0xf }	48	sub MOVE_ALL (){ 0xf }
		49
		50	sub load_ref($) {
		51	my ($path) = @_;
		52
		53	open my $fh, "<:raw", "$path~"
		54	or die "$path~: $!";
		55	local $/;
		56	Storable::thaw <$fh>
		57	}
		58
		59	sub save_ref($$) {
		60	my ($ref, $path) = @_;
		61
		62	open my $fh, ">:raw", "$path~"
		63	or die "$path~: $!";
		64	print $fh Storable::nfreeze $ref;
		65	close $fh;
		66	rename "$path~", $path
		67	or die "$path: $!";
		68	}
48		69
49	sub normalize_arch($) {	70	sub normalize_arch($) {
50	my ($ob) = @_;	71	my ($ob) = @_;
51		72
52	my $arch = $ARCH{$ob->{_name}}	73	my $arch = $ARCH{$ob->{_name}}
…		…
113	my ($path, $cache) = @_;	134	my ($path, $cache) = @_;
114		135
115	eval {	136	eval {
116	defined $cache	137	defined $cache
117	&& -M $cache < -M $path	138	&& -M $cache < -M $path
118	&& Storable::retrieve $cache	139	&& load_ref $cache
119	} or do {	140	} or do {
120	my %pak;	141	my %pak;
121		142
122	open my $fh, "<:raw", $path	143	open my $fh, "<:raw", $path
123	or Carp::croak "$_[0]: $!";	144	or Carp::croak "$_[0]: $!";
…		…
125	my ($type, $id, $len, $path) = split;	146	my ($type, $id, $len, $path) = split;
126	$path =~ s/.*\///;	147	$path =~ s/.*\///;
127	read $fh, $pak{$path}, $len;	148	read $fh, $pak{$path}, $len;
128	}	149	}
129		150
130	Storable::nstore \%pak, $cache	151	save_ref \%pak, $cache
131	if defined $cache;	152	if defined $cache;
132		153
133	\%pak	154	\%pak
134	}	155	}
135	}	156	}
…		…
138	my ($path, $cache) = @_;	159	my ($path, $cache) = @_;
139		160
140	eval {	161	eval {
141	defined $cache	162	defined $cache
142	&& -M $cache < -M $path	163	&& -M $cache < -M $path
143	&& Storable::retrieve $cache	164	&& load_ref $cache
144	} or do {	165	} or do {
145	my %arc;	166	my %arc;
146	my ($more, $prev);	167	my ($more, $prev);
147		168
148	open my $fh, "<:raw", $path	169	open my $fh, "<:raw", $path
…		…
203	}	224	}
204	}	225	}
205		226
206	undef $parse_block; # work around bug in perl not freeing $fh etc.	227	undef $parse_block; # work around bug in perl not freeing $fh etc.
207		228
208	Storable::nstore \%arc, $cache	229	save_ref \%arc, $cache
209	if defined $cache;	230	if defined $cache;
210		231
211	\%arc	232	\%arc
212	}	233	}
213	}	234	}
…		…
224	}	245	}
225		246
226	\%paths	247	\%paths
227	}	248	}
228		249
		250	=item ($minx, $miny, $maxx, $maxy) = arch_extents $arch
		251
229	# arch_extents determines the extents of a given arch	252	arch_extents determines the extents of the given arch's face(s), linked
230	# bigfaces, linked faces and single faces are handled here	253	faces and single faces are handled here it returns (minx, miny, maxx,
231	# it returns (minx, miny, maxx, maxy)	254	maxy)
		255
		256	=cut
		257
232	sub arch_extents {	258	sub arch_extents {
233	my ($a) = @_;	259	my ($a) = @_;
234		260
235	my $o = $ARCH{$a->{_name}}	261	my $o = $ARCH{$a->{_name}}
236	or return;	262	or return;
…		…
259	# single face	285	# single face
260	return (0, 0, 0, 0);	286	return (0, 0, 0, 0);
261	}	287	}
262	}	288	}
263		289
		290	=item $type = arch_attr $arch
		291
		292	Returns a hashref describing the object and its attributes. It can contain
		293	the following keys:
		294
		295	name the name, suitable for display purposes
		296	ignore
		297	attr
		298	desc
		299	use
		300	section => [name => \%attr, name => \%attr]
		301	import
		302
		303	=cut
		304
		305	sub arch_attr($) {
		306	my ($arch) = @_;
		307
		308	require Crossfire::Data;
		309
		310	my $attr;
		311
		312	if ($arch->{type} > 0) {
		313	$attr = $Crossfire::Data::ATTR{$arch->{type}+0};
		314	} else {
		315	$attr = $Crossfire::Data::TYPE{Misc};
		316
		317	type:
		318	for (@Crossfire::Data::ATTR0) {
		319	my $req = $_->{required}
		320	or die "internal error: ATTR0 without 'required'";
		321
		322	while (my ($k, $v) = each %$req) {
		323	next type
		324	unless $arch->{$k} == $v;
		325	}
		326
		327	$attr = $_;
		328	}
		329	}
		330
		331	$attr \|\| \%Crossfire::Data::DEFAULT_ATTR;
		332	}
		333
		334	sub arch_edit_sections {
		335	# if (edit_type == IGUIConstants.TILE_EDIT_NONE)
		336	# edit_type = 0;
		337	# else if (edit_type != 0) {
		338	# // all flags from 'check_type' must be unset in this arch because they get recalculated now
		339	# edit_type &= ~check_type;
		340	# }
		341	#
		342	# }
		343	# if ((check_type & IGUIConstants.TILE_EDIT_MONSTER) != 0 &&
		344	# getAttributeValue("alive", defarch) == 1 &&
		345	# (getAttributeValue("monster", defarch) == 1 \|\|
		346	# getAttributeValue("generator", defarch) == 1)) {
		347	# // Monster: monsters/npcs/generators
		348	# edit_type \|= IGUIConstants.TILE_EDIT_MONSTER;
		349	# }
		350	# if ((check_type & IGUIConstants.TILE_EDIT_WALL) != 0 &&
		351	# arch_type == 0 && getAttributeValue("no_pass", defarch) == 1) {
		352	# // Walls
		353	# edit_type \|= IGUIConstants.TILE_EDIT_WALL;
		354	# }
		355	# if ((check_type & IGUIConstants.TILE_EDIT_CONNECTED) != 0 &&
		356	# getAttributeValue("connected", defarch) != 0) {
		357	# // Connected Objects
		358	# edit_type \|= IGUIConstants.TILE_EDIT_CONNECTED;
		359	# }
		360	# if ((check_type & IGUIConstants.TILE_EDIT_EXIT) != 0 &&
		361	# arch_type == 66 \|\| arch_type == 41 \|\| arch_type == 95) {
		362	# // Exit: teleporter/exit/trapdoors
		363	# edit_type \|= IGUIConstants.TILE_EDIT_EXIT;
		364	# }
		365	# if ((check_type & IGUIConstants.TILE_EDIT_TREASURE) != 0 &&
		366	# getAttributeValue("no_pick", defarch) == 0 && (arch_type == 4 \|\|
		367	# arch_type == 5 \|\| arch_type == 36 \|\| arch_type == 60 \|\|
		368	# arch_type == 85 \|\| arch_type == 111 \|\| arch_type == 123 \|\|
		369	# arch_type == 124 \|\| arch_type == 130)) {
		370	# // Treasure: randomtreasure/money/gems/potions/spellbooks/scrolls
		371	# edit_type \|= IGUIConstants.TILE_EDIT_TREASURE;
		372	# }
		373	# if ((check_type & IGUIConstants.TILE_EDIT_DOOR) != 0 &&
		374	# arch_type == 20 \|\| arch_type == 23 \|\| arch_type == 26 \|\|
		375	# arch_type == 91 \|\| arch_type == 21 \|\| arch_type == 24) {
		376	# // Door: door/special door/gates + keys
		377	# edit_type \|= IGUIConstants.TILE_EDIT_DOOR;
		378	# }
		379	# if ((check_type & IGUIConstants.TILE_EDIT_EQUIP) != 0 &&
		380	# getAttributeValue("no_pick", defarch) == 0 && ((arch_type >= 13 &&
		381	# arch_type <= 16) \|\| arch_type == 33 \|\| arch_type == 34 \|\|
		382	# arch_type == 35 \|\| arch_type == 39 \|\| arch_type == 70 \|\|
		383	# arch_type == 87 \|\| arch_type == 99 \|\| arch_type == 100 \|\|
		384	# arch_type == 104 \|\| arch_type == 109 \|\| arch_type == 113 \|\|
		385	# arch_type == 122 \|\| arch_type == 3)) {
		386	# // Equipment: weapons/armour/wands/rods
		387	# edit_type \|= IGUIConstants.TILE_EDIT_EQUIP;
		388	# }
		389	#
		390	# return(edit_type);
		391	#
		392	#
		393	}
		394
264	sub init($) {	395	sub init($) {
265	my ($cachedir) = @_;	396	my ($cachedir) = @_;
266		397
267	return if %ARCH;	398	return if %ARCH;
268		399
		400	mkdir $cachedir, 0777;
269	*ARCH = read_arch "$LIB/archetypes", "$cachedir/archetypes.pst";	401	*ARCH = read_arch "$LIB/archetypes", "$cachedir/archetypes.pst";
270	}	402	}
271		403
272	$CACHEDIR \|\|= "$ENV{HOME}/.crossfire";	404	$VARDIR \|\|= $ENV{HOME} ? "$ENV{HOME}/.crossfire" : File::Spec->tmpdir . "/crossfire";
273		405
274	init $CACHEDIR;	406	init $VARDIR;
275		407
276	=head1 AUTHOR	408	=head1 AUTHOR
277		409
278	Marc Lehmann <schmorp@schmorp.de>	410	Marc Lehmann <schmorp@schmorp.de>
279	http://home.schmorp.de/	411	http://home.schmorp.de/

Diff Legend

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

Comparing deliantra/Deliantra/Deliantra.pm (file contents): Revision 1.15 by root, Sun Feb 12 04:50:24 2006 UTC vs. Revision 1.29 by root, Thu Feb 23 13:22:10 2006 UTC

Diff Legend

Comparing deliantra/Deliantra/Deliantra.pm (file contents):
Revision 1.15 by root, Sun Feb 12 04:50:24 2006 UTC vs.
Revision 1.29 by root, Thu Feb 23 13:22:10 2006 UTC