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