[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.31 by root, Thu Feb 23 15:01:43 2006 UTC

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