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

Comparing deliantra/Deliantra/Deliantra.pm (file contents):
Revision 1.5 by root, Sun Feb 5 00:25:33 2006 UTC vs.
Revision 1.22 by root, Thu Feb 23 01:55:54 2006 UTC

…		…
8		8
9	our $VERSION = '0.1';	9	our $VERSION = '0.1';
10		10
11	use strict;	11	use strict;
12		12
		13	use base 'Exporter';
		14
		15	use Carp ();
13	use Storable;	16	use Storable;
		17	use File::Spec;
		18	use List::Util qw(min max);
		19
		20	#XXX: The map_* procedures scream for a map-object
		21
		22	our @EXPORT =
		23	qw(read_pak read_arch %ARCH TILESIZE $TILE %FACE editor_archs arch_extents);
14		24
15	our $LIB = $ENV{CROSSFIRE_LIBDIR}	25	our $LIB = $ENV{CROSSFIRE_LIBDIR}
16	or die "\$CROSSFIRE_LIBDIR must be set\n";	26	or Carp::croak "\$CROSSFIRE_LIBDIR must be set\n";
17		27
18	sub T (){ 32 }	28	sub TILESIZE (){ 32 }
19		29
		30	our $CACHEDIR;
20	our $ARCH;	31	our %ARCH;
		32	our %FACE;
21	our $TILE;	33	our $TILE;
		34
		35	our %FIELD_MULTILINE = (
		36	msg => "endmsg",
		37	lore => "endlore",
		38	);
		39
		40	# not used yet, maybe alphabetical is ok
		41	our @FIELD_ORDER = (qw(name name_pl));
		42
		43	sub MOVE_WALK (){ 0x1 }
		44	sub MOVE_FLY_LOW (){ 0x2 }
		45	sub MOVE_FLY_HIGH (){ 0x4 }
		46	sub MOVE_FLYING (){ 0x6 }
		47	sub MOVE_SWIM (){ 0x8 }
		48	sub MOVE_ALL (){ 0xf }
		49
		50	sub normalize_arch($) {
		51	my ($ob) = @_;
		52
		53	my $arch = $ARCH{$ob->{_name}}
		54	or (warn "$ob->{_name}: no such archetype", return $ob);
		55
		56	delete $ob->{$_} for qw(can_knockback can_parry can_impale can_cut can_dam_armour can_apply);
		57
		58	if ($arch->{type} == 22) { # map
		59	my %normalize = (
		60	"enter_x" => "hp",
		61	"enter_y" => "sp",
		62	"width" => "x",
		63	"height" => "y",
		64	"reset_timeout" => "weight",
		65	"swap_time" => "value",
		66	"difficulty" => "level",
		67	"darkness" => "invisible",
		68	"fixed_resettime" => "stand_still",
		69	);
		70
		71	while (my ($k2, $k1) = each %normalize) {
		72	if (defined (my $v = delete $ob->{$k1})) {
		73	$ob->{$k2} = $v;
		74	}
		75	}
		76	}
		77
		78	if (defined (my $v = delete $ob->{no_pass})) {
		79	$ob->{move_block} = $v ? MOVE_ALL : 0;
		80	}
		81	if (defined (my $v = delete $ob->{walk_on})) {
		82	$ob->{move_on} = $v ? $ob->{move_on} \| MOVE_WALK
		83	: $ob->{move_on} & ~MOVE_WALK;
		84	}
		85	if (defined (my $v = delete $ob->{walk_off})) {
		86	$ob->{move_off} = $v ? $ob->{move_off} \| MOVE_WALK
		87	: $ob->{move_off} & ~MOVE_WALK;
		88	}
		89	if (defined (my $v = delete $ob->{fly_on})) {
		90	$ob->{move_on} = $v ? $ob->{move_on} \| MOVE_FLY_LOW
		91	: $ob->{move_on} & ~MOVE_FLY_LOW;
		92	}
		93	if (defined (my $v = delete $ob->{fly_off})) {
		94	$ob->{move_off} = $v ? $ob->{move_off} \| MOVE_FLY_LOW
		95	: $ob->{move_off} & ~MOVE_FLY_LOW;
		96	}
		97	if (defined (my $v = delete $ob->{flying})) {
		98	$ob->{move_type} = $v ? $ob->{move_type} \| MOVE_FLY_LOW
		99	: $ob->{move_type} & ~MOVE_FLY_LOW;
		100	}
		101
		102	# if value matches archetype default, delete
		103	while (my ($k, $v) = each %$ob) {
		104	if (exists $arch->{$k} and $arch->{$k} eq $v) {
		105	next if $k eq "_name";
		106	delete $ob->{$k};
		107	}
		108	}
		109
		110	$ob
		111	}
22		112
23	sub read_pak($;$) {	113	sub read_pak($;$) {
24	my ($path, $cache) = @_;	114	my ($path, $cache) = @_;
25		115
26	eval {	116	eval {
…		…
29	&& Storable::retrieve $cache	119	&& Storable::retrieve $cache
30	} or do {	120	} or do {
31	my %pak;	121	my %pak;
32		122
33	open my $fh, "<:raw", $path	123	open my $fh, "<:raw", $path
34	or die "$_[0]: $!";	124	or Carp::croak "$_[0]: $!";
35	while (<$fh>) {	125	while (<$fh>) {
36	my ($type, $id, $len, $path) = split;	126	my ($type, $id, $len, $path) = split;
37	$path =~ s/.*\///;	127	$path =~ s/.*\///;
38	read $fh, $pak{$path}, $len;	128	read $fh, $pak{$path}, $len;
39	}	129	}
…		…
55	} or do {	145	} or do {
56	my %arc;	146	my %arc;
57	my ($more, $prev);	147	my ($more, $prev);
58		148
59	open my $fh, "<:raw", $path	149	open my $fh, "<:raw", $path
60	or die "$path: $!";	150	or Carp::croak "$path: $!";
61		151
62	my $parse_block; $parse_block = sub {	152	my $parse_block; $parse_block = sub {
63	my %arc = @_;	153	my %arc = @_;
64		154
65	while (<$fh>) {	155	while (<$fh>) {
66	s/\s+$//;	156	s/\s+$//;
67	if (/^end$/i) {	157	if (/^end$/i) {
68	last;	158	last;
69	} elsif (/^arch (\S+)$/) {	159	} elsif (/^arch (\S+)$/) {
70	push @{ $arc{inventory} }, $parse_block->(_name => $1);	160	push @{ $arc{inventory} }, normalize_arch $parse_block->(_name => $1);
71	} elsif (/^lore$/) {	161	} elsif (/^lore$/) {
72	while (<$fh>) {	162	while (<$fh>) {
73	last if /^endlore\s*$/i;	163	last if /^endlore\s*$/i;
74	$arc{lore} .= $_;	164	$arc{lore} .= $_;
75	}	165	}
…		…
104	$arc{$name} = $arc;	194	$arc{$name} = $arc;
105	}	195	}
106	$prev = $arc;	196	$prev = $arc;
107	$more = undef;	197	$more = undef;
108	} elsif (/^arch (\S+)$/i) {	198	} elsif (/^arch (\S+)$/i) {
109	push @{ $arc{arch} }, $parse_block->(_name => $1);	199	push @{ $arc{arch} }, normalize_arch $parse_block->(_name => $1);
110	} elsif (/^\s*($\|#)/) {	200	} elsif (/^\s*($\|#)/) {
111	#	201	#
112	} else {	202	} else {
113	warn "$path: unparseable top-level line '$_'";	203	warn "$path: unparseable top-level line '$_'";
114	}	204	}
…		…
121		211
122	\%arc	212	\%arc
123	}	213	}
124	}	214	}
125		215
126	sub arch2map($;$) {	216	# put all archs into a hash with editor_face as it's key
		217	# NOTE: the arrays in the hash values are references to
		218	# the archs from $ARCH
		219	sub editor_archs {
		220	my %paths;
		221
		222	for (keys %ARCH) {
		223	my $arch = $ARCH{$_};
		224	push @{$paths{$arch->{editor_folder}}}, \$arch;
		225	}
		226
		227	\%paths
		228	}
		229
		230	=item ($minx, $miny, $maxx, $maxy) = arch_extents $arch
		231
		232	arch_extents determines the extents of the given arch's face(s), linked
		233	faces and single faces are handled here it returns (minx, miny, maxx,
		234	maxy)
		235
		236	=cut
		237
		238	sub arch_extents {
127	my ($mapa) = @_;	239	my ($a) = @_;
128		240
129	my %meta;	241	my $o = $ARCH{$a->{_name}}
		242	or return;
130		243
131	my ($mapx, $mapy);	244	my $face = $FACE{$a->{face} \|\| $o->{face}}
		245	or (warn "no face data found for arch '$a->{_name}'"), return;
132		246
133	my $map;	247	if ($face->{w} > 1 \|\| $face->{h} > 1) {
		248	# bigface
		249	return (0, 0, $face->{w} - 1, $face->{h} - 1);
134		250
135	for (@{ $mapa->{arch} }) {	251	} elsif ($o->{more}) {
136	my ($x, $y) = ($_->{x}, $_->{y});	252	# linked face
		253	my ($minx, $miny, $maxx, $maxy) = ($o->{x}, $o->{y}) x 2;
137		254
138	if ($_->{_name} eq "map") {	255	for (; $o; $o = $o->{more}) {
139	$meta{info} = $_;	256	$minx = min $minx, $o->{x};
		257	$miny = min $miny, $o->{y};
		258	$maxx = max $maxx, $o->{x};
		259	$maxy = max $maxy, $o->{y};
		260	}
140		261
141	$mapx = $_->{width} \|\| $x;	262	return ($minx, $miny, $maxx, $maxy);
142	$mapy = $_->{height} \|\| $y;	263
143	} else {	264	} else {
144	push @{ $map->[$x][$y] }, $_;	265	# single face
145		266	return (0, 0, 0, 0);
146	# arch map is unreliable w.r.t. width and height
147	$mapx = $x + 1 if $mapx <= $x;
148	$mapy = $y + 1 if $mapy <= $y;
149	#$mapx = $a->{x} + 1, warn "$mapname: arch '$a->{_name}' outside map width at ($a->{x}\|$a->{y})\n" if $mapx <= $a->{x};
150	#$mapy = $a->{y} + 1, warn "$mapname: arch '$a->{_name}' outside map height at ($a->{x}\|$a->{y})\n" if $mapy <= $a->{y};
151	}
152	}	267	}
153
154	$meta{width} = $mapx;
155	$meta{height} = $mapy;
156
157	\%meta
158	}	268	}
159		269
160	sub init($) {	270	sub init($) {
161	my ($cachedir) = @_;	271	my ($cachedir) = @_;
162		272
		273	return if %ARCH;
		274
		275	mkdir 0777, $cachedir;
163	$ARCH = read_arch "$LIB/archetypes", "$cachedir/archetypes.pst";	276	*ARCH = read_arch "$LIB/archetypes", "$cachedir/archetypes.pst";
164	$TILE = read_pak "$LIB/crossfire.0", "$cachedir/crossfire.0.pst";
165	}	277	}
		278
		279	=item $type = arch_attr $arch
		280
		281	Returns a hashref describing the object and its attributes. It can contain
		282	the following keys:
		283
		284	name the name, suitable for display purposes
		285	ignore
		286	attr
		287	desc
		288	use
		289	section => [name => \%attr, name => \%attr]
		290	import
		291
		292	=cut
		293
		294	sub arch_attr($) {
		295	my ($arch) = @_;
		296
		297	require Crossfire::Data;
		298
		299	my $attr;
		300
		301	if ($arch->{type} > 0) {
		302	$attr = $Crossfire::Data::ATTR{$arch->{type}+0};
		303	} else {
		304	$attr = $Crossfire::Data::TYPE{Misc};
		305
		306	type:
		307	for (@Crossfire::Data::ATTR0) {
		308	my $req = $_->{required}
		309	or die "internal error: ATTR0 without 'required'";
		310
		311	while (my ($k, $v) = each %$req) {
		312	next type
		313	unless $arch->{$k} == $v;
		314	}
		315
		316	$attr = $_;
		317	}
		318	}
		319
		320	$attr \|\| \%Crossfire::Data::DEFAULT_ATTR;
		321	}
		322
		323	sub arch_edit_sections {
		324	# if (edit_type == IGUIConstants.TILE_EDIT_NONE)
		325	# edit_type = 0;
		326	# else if (edit_type != 0) {
		327	# // all flags from 'check_type' must be unset in this arch because they get recalculated now
		328	# edit_type &= ~check_type;
		329	# }
		330	#
		331	# }
		332	# if ((check_type & IGUIConstants.TILE_EDIT_MONSTER) != 0 &&
		333	# getAttributeValue("alive", defarch) == 1 &&
		334	# (getAttributeValue("monster", defarch) == 1 \|\|
		335	# getAttributeValue("generator", defarch) == 1)) {
		336	# // Monster: monsters/npcs/generators
		337	# edit_type \|= IGUIConstants.TILE_EDIT_MONSTER;
		338	# }
		339	# if ((check_type & IGUIConstants.TILE_EDIT_WALL) != 0 &&
		340	# arch_type == 0 && getAttributeValue("no_pass", defarch) == 1) {
		341	# // Walls
		342	# edit_type \|= IGUIConstants.TILE_EDIT_WALL;
		343	# }
		344	# if ((check_type & IGUIConstants.TILE_EDIT_CONNECTED) != 0 &&
		345	# getAttributeValue("connected", defarch) != 0) {
		346	# // Connected Objects
		347	# edit_type \|= IGUIConstants.TILE_EDIT_CONNECTED;
		348	# }
		349	# if ((check_type & IGUIConstants.TILE_EDIT_EXIT) != 0 &&
		350	# arch_type == 66 \|\| arch_type == 41 \|\| arch_type == 95) {
		351	# // Exit: teleporter/exit/trapdoors
		352	# edit_type \|= IGUIConstants.TILE_EDIT_EXIT;
		353	# }
		354	# if ((check_type & IGUIConstants.TILE_EDIT_TREASURE) != 0 &&
		355	# getAttributeValue("no_pick", defarch) == 0 && (arch_type == 4 \|\|
		356	# arch_type == 5 \|\| arch_type == 36 \|\| arch_type == 60 \|\|
		357	# arch_type == 85 \|\| arch_type == 111 \|\| arch_type == 123 \|\|
		358	# arch_type == 124 \|\| arch_type == 130)) {
		359	# // Treasure: randomtreasure/money/gems/potions/spellbooks/scrolls
		360	# edit_type \|= IGUIConstants.TILE_EDIT_TREASURE;
		361	# }
		362	# if ((check_type & IGUIConstants.TILE_EDIT_DOOR) != 0 &&
		363	# arch_type == 20 \|\| arch_type == 23 \|\| arch_type == 26 \|\|
		364	# arch_type == 91 \|\| arch_type == 21 \|\| arch_type == 24) {
		365	# // Door: door/special door/gates + keys
		366	# edit_type \|= IGUIConstants.TILE_EDIT_DOOR;
		367	# }
		368	# if ((check_type & IGUIConstants.TILE_EDIT_EQUIP) != 0 &&
		369	# getAttributeValue("no_pick", defarch) == 0 && ((arch_type >= 13 &&
		370	# arch_type <= 16) \|\| arch_type == 33 \|\| arch_type == 34 \|\|
		371	# arch_type == 35 \|\| arch_type == 39 \|\| arch_type == 70 \|\|
		372	# arch_type == 87 \|\| arch_type == 99 \|\| arch_type == 100 \|\|
		373	# arch_type == 104 \|\| arch_type == 109 \|\| arch_type == 113 \|\|
		374	# arch_type == 122 \|\| arch_type == 3)) {
		375	# // Equipment: weapons/armour/wands/rods
		376	# edit_type \|= IGUIConstants.TILE_EDIT_EQUIP;
		377	# }
		378	#
		379	# return(edit_type);
		380	#
		381	#
		382	}
		383
		384	$CACHEDIR \|\|= $ENV{HOME} ? "$ENV{HOME}/.crossfire" : File::Spec->tmpdir;
		385
		386	init $CACHEDIR;
166		387
167	=head1 AUTHOR	388	=head1 AUTHOR
168		389
169	Marc Lehmann <schmorp@schmorp.de>	390	Marc Lehmann <schmorp@schmorp.de>
170	http://home.schmorp.de/	391	http://home.schmorp.de/

Diff Legend

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

Comparing deliantra/Deliantra/Deliantra.pm (file contents): Revision 1.5 by root, Sun Feb 5 00:25:33 2006 UTC vs. Revision 1.22 by root, Thu Feb 23 01:55:54 2006 UTC

Diff Legend

Comparing deliantra/Deliantra/Deliantra.pm (file contents):
Revision 1.5 by root, Sun Feb 5 00:25:33 2006 UTC vs.
Revision 1.22 by root, Thu Feb 23 01:55:54 2006 UTC