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

Comparing deliantra/Deliantra/Deliantra.pm (file contents):
Revision 1.61 by root, Mon Mar 27 17:38:18 2006 UTC vs.
Revision 1.84 by root, Wed Feb 7 00:22:34 2007 UTC

…		…
4		4
5	=cut	5	=cut
6		6
7	package Crossfire;	7	package Crossfire;
8		8
9	our $VERSION = '0.1';	9	our $VERSION = '0.96';
10		10
11	use strict;	11	use strict;
12		12
13	use base 'Exporter';	13	use base 'Exporter';
14		14
…		…
19		19
20	our @EXPORT = qw(	20	our @EXPORT = qw(
21	read_pak read_arch ARCH TILESIZE $TILE FACE editor_archs arch_extents	21	read_pak read_arch ARCH TILESIZE $TILE FACE editor_archs arch_extents
22	);	22	);
23		23
		24	use JSON::Syck (); #TODO#d# replace by JSON::PC when it becomes available == working
		25
		26	sub from_json($) {
		27	$JSON::Syck::ImplicitUnicode = 1;
		28	JSON::Syck::Load $_[0]
		29	}
		30
		31	sub to_json($) {
		32	$JSON::Syck::ImplicitUnicode = 0;
		33	JSON::Syck::Dump $_[0]
		34	}
		35
24	our $LIB = $ENV{CROSSFIRE_LIBDIR};	36	our $LIB = $ENV{CROSSFIRE_LIBDIR};
25		37
26	our $VARDIR = $ENV{HOME} ? "$ENV{HOME}/.crossfire" : File::Spec->tmpdir . "/crossfire";	38	our $VARDIR = $ENV{HOME} ? "$ENV{HOME}/.crossfire"
		39	: $ENV{AppData} ? "$ENV{APPDATA}/crossfire"
		40	: File::Spec->tmpdir . "/crossfire";
27		41
28	mkdir $VARDIR, 0777;	42	mkdir $VARDIR, 0777;
29		43
30	sub TILESIZE (){ 32 }	44	sub TILESIZE (){ 32 }
31		45
…		…
44	qw(move_type move_block move_allow move_on move_off move_slow);	58	qw(move_type move_block move_allow move_on move_off move_slow);
45		59
46	# same as in server save routine, to (hopefully) be compatible	60	# same as in server save routine, to (hopefully) be compatible
47	# to the other editors.	61	# to the other editors.
48	our @FIELD_ORDER_MAP = (qw(	62	our @FIELD_ORDER_MAP = (qw(
49	name swap_time reset_timeout fixed_resettime difficulty region	63	name attach swap_time reset_timeout fixed_resettime difficulty region
50	shopitems shopgreed shopmin shopmax shoprace	64	shopitems shopgreed shopmin shopmax shoprace
51	darkness width height enter_x enter_y msg maplore	65	darkness width height enter_x enter_y msg maplore
52	unique template	66	unique template
53	outdoor temp pressure humid windspeed winddir sky nosmooth	67	outdoor temp pressure humid windspeed winddir sky nosmooth
54	tile_path_1 tile_path_2 tile_path_3 tile_path_4	68	tile_path_1 tile_path_2 tile_path_3 tile_path_4
55	));	69	));
56		70
57	our @FIELD_ORDER = (qw(	71	our @FIELD_ORDER = (qw(
58	elevation	72	elevation
59		73
60	name name_pl custom_name title race	74	name name_pl custom_name attach title race
61	slaying skill msg lore other_arch face	75	slaying skill msg lore other_arch face
62	#todo-events	76	#todo-events
63	animation is_animated	77	animation is_animated
64	str dex con wis pow cha int	78	str dex con wis pow cha int
65	hp maxhp sp maxsp grace maxgrace	79	hp maxhp sp maxsp grace maxgrace
…		…
102		116
103	body_range body_arm body_torso body_head body_neck body_skill	117	body_range body_arm body_torso body_head body_neck body_skill
104	body_finger body_shoulder body_foot body_hand body_wrist body_waist	118	body_finger body_shoulder body_foot body_hand body_wrist body_waist
105	));	119	));
106		120
		121	our %EVENT_TYPE = (
		122	apply => 1,
		123	attack => 2,
		124	death => 3,
		125	drop => 4,
		126	pickup => 5,
		127	say => 6,
		128	stop => 7,
		129	time => 8,
		130	throw => 9,
		131	trigger => 10,
		132	close => 11,
		133	timer => 12,
		134	);
		135
107	sub MOVE_WALK (){ 0x01 }	136	sub MOVE_WALK (){ 0x01 }
108	sub MOVE_FLY_LOW (){ 0x02 }	137	sub MOVE_FLY_LOW (){ 0x02 }
109	sub MOVE_FLY_HIGH (){ 0x04 }	138	sub MOVE_FLY_HIGH (){ 0x04 }
110	sub MOVE_FLYING (){ 0x06 }	139	sub MOVE_FLYING (){ 0x06 }
111	sub MOVE_SWIM (){ 0x08 }	140	sub MOVE_SWIM (){ 0x08 }
…		…
115	sub MOVE_ALL (){ 0x1001f } # very special value, more PITA	144	sub MOVE_ALL (){ 0x1001f } # very special value, more PITA
116		145
117	sub load_ref($) {	146	sub load_ref($) {
118	my ($path) = @_;	147	my ($path) = @_;
119		148
120	open my $fh, "<", $path	149	open my $fh, "<:raw:perlio", $path
121	or die "$path: $!";	150	or die "$path: $!";
122	binmode $fh;
123	local $/;	151	local $/;
124		152
125	thaw <$fh>	153	thaw <$fh>
126	}	154	}
127		155
128	sub save_ref($$) {	156	sub save_ref($$) {
129	my ($ref, $path) = @_;	157	my ($ref, $path) = @_;
130		158
131	open my $fh, ">", "$path~"	159	open my $fh, ">:raw:perlio", "$path~"
132	or die "$path~: $!";	160	or die "$path~: $!";
133	binmode $fh;
134	print $fh freeze $ref;	161	print $fh freeze $ref;
135	close $fh;	162	close $fh;
136	rename "$path~", $path	163	rename "$path~", $path
137	or die "$path: $!";	164	or die "$path: $!";
138	}	165	}
139		166
		167	my %attack_mask = (
		168	physical => 0x00000001,
		169	magic => 0x00000002,
		170	fire => 0x00000004,
		171	electricity => 0x00000008,
		172	cold => 0x00000010,
		173	confusion => 0x00000020,
		174	acid => 0x00000040,
		175	drain => 0x00000080,
		176	weaponmagic => 0x00000100,
		177	ghosthit => 0x00000200,
		178	poison => 0x00000400,
		179	slow => 0x00000800,
		180	paralyze => 0x00001000,
		181	turn_undead => 0x00002000,
		182	fear => 0x00004000,
		183	cancellation => 0x00008000,
		184	deplete => 0x00010000,
		185	death => 0x00020000,
		186	chaos => 0x00040000,
		187	counterspell => 0x00080000,
		188	godpower => 0x00100000,
		189	holyword => 0x00200000,
		190	blind => 0x00400000,
		191	internal => 0x00800000,
		192	life_stealing => 0x01000000,
		193	disease => 0x02000000,
		194	);
		195
		196	sub _add_resist($$$) {
		197	my ($ob, $mask, $value) = @_;
		198
		199	while (my ($k, $v) = each %attack_mask) {
		200	$ob->{"resist_$k"} = min 100, max -100, $ob->{"resist_$k"} + $value if $mask & $v;
		201	}
		202	}
		203
		204	my %MATERIAL = reverse
		205	paper => 1,
		206	iron => 2,
		207	glass => 4,
		208	leather => 8,
		209	wood => 16,
		210	organic => 32,
		211	stone => 64,
		212	cloth => 128,
		213	adamant => 256,
		214	liquid => 512,
		215	tin => 1024,
		216	bone => 2048,
		217	ice => 4096,
		218
		219	# guesses
		220	runestone => 12,
		221	bronze => 18,
		222	"ancient wood" => 20,
		223	glass => 36,
		224	marble => 66,
		225	ice => 68,
		226	stone => 70,
		227	stone => 80,
		228	cloth => 136,
		229	ironwood => 144,
		230	glacium => 260,
		231	blood => 544,
		232	;
		233
		234	# object as in "Object xxx", i.e. archetypes
140	sub normalize_object($) {	235	sub normalize_object($) {
141	my ($ob) = @_;	236	my ($ob) = @_;
142		237
		238	# convert material bitset to materialname, if possible
		239	if (exists $ob->{material}) {
		240	if (!$ob->{material}) {
		241	delete $ob->{material};
		242	} elsif (exists $ob->{materialname}) {
		243	if ($MATERIAL{$ob->{material}} eq $ob->{materialname}) {
		244	delete $ob->{material};
		245	} else {
		246	warn "object $ob->{_name} has both materialname ($ob->{materialname}) and material ($ob->{material}) set.\n";
		247	delete $ob->{material}; # assume materilname is more specific and nuke material
		248	}
		249	} elsif (my $name = $MATERIAL{$ob->{material}}) {
		250	delete $ob->{material};
		251	$ob->{materialname} = $name;
		252	} else {
		253	warn "object $ob->{_name} has unknown material ($ob->{material}) set.\n";
		254	}
		255	}
		256
		257	# nuke outdated or never supported fields
143	delete $ob->{$_} for qw(	258	delete @$ob{qw(
144	can_knockback can_parry can_impale can_cut can_dam_armour	259	can_knockback can_parry can_impale can_cut can_dam_armour
145	can_apply pass_thru can_pass_thru	260	can_apply pass_thru can_pass_thru
146	);	261	)};
147		262
		263	if (my $mask = delete $ob->{immune} ) { _add_resist $ob, $mask, 100; }
		264	if (my $mask = delete $ob->{protected} ) { _add_resist $ob, $mask, 30; }
		265	if (my $mask = delete $ob->{vulnerable}) { _add_resist $ob, $mask, -100; }
		266
		267	# convert movement strings to bitsets
148	for my $attr (keys %FIELD_MOVEMENT) {	268	for my $attr (keys %FIELD_MOVEMENT) {
149	next unless exists $ob->{$attr};	269	next unless exists $ob->{$attr};
150		270
151	$ob->{$attr} = MOVE_ALL if $ob->{$attr} == 255; #d# compatibility	271	$ob->{$attr} = MOVE_ALL if $ob->{$attr} == 255; #d# compatibility
152		272
…		…
174	}	294	}
175		295
176	$ob->{$attr} = $flags;	296	$ob->{$attr} = $flags;
177	}	297	}
178		298
		299	# convert outdated movement flags to new movement sets
179	if (defined (my $v = delete $ob->{no_pass})) {	300	if (defined (my $v = delete $ob->{no_pass})) {
180	$ob->{move_block} = $v ? MOVE_ALL : 0;	301	$ob->{move_block} = $v ? MOVE_ALL : 0;
181	}	302	}
182	if (defined (my $v = delete $ob->{slow_move})) {	303	if (defined (my $v = delete $ob->{slow_move})) {
183	$ob->{move_slow} \|= MOVE_WALK;	304	$ob->{move_slow} \|= MOVE_WALK;
184	$ob->{move_slow_penalty} = $v;	305	$ob->{move_slow_penalty} = $v;
185	}	306	}
186	if (defined (my $v = delete $ob->{walk_on})) {	307	if (defined (my $v = delete $ob->{walk_on})) {
		308	$ob->{move_on} = MOVE_ALL unless exists $ob->{move_on};
187	$ob->{move_on} = $v ? $ob->{move_on} \| MOVE_WALK	309	$ob->{move_on} = $v ? $ob->{move_on} \| MOVE_WALK
188	: $ob->{move_on} & ~MOVE_WALK;	310	: $ob->{move_on} & ~MOVE_WALK;
189	}	311	}
190	if (defined (my $v = delete $ob->{walk_off})) {	312	if (defined (my $v = delete $ob->{walk_off})) {
		313	$ob->{move_off} = MOVE_ALL unless exists $ob->{move_off};
191	$ob->{move_off} = $v ? $ob->{move_off} \| MOVE_WALK	314	$ob->{move_off} = $v ? $ob->{move_off} \| MOVE_WALK
192	: $ob->{move_off} & ~MOVE_WALK;	315	: $ob->{move_off} & ~MOVE_WALK;
193	}	316	}
194	if (defined (my $v = delete $ob->{fly_on})) {	317	if (defined (my $v = delete $ob->{fly_on})) {
		318	$ob->{move_on} = MOVE_ALL unless exists $ob->{move_on};
195	$ob->{move_on} = $v ? $ob->{move_on} \| MOVE_FLY_LOW	319	$ob->{move_on} = $v ? $ob->{move_on} \| MOVE_FLY_LOW
196	: $ob->{move_on} & ~MOVE_FLY_LOW;	320	: $ob->{move_on} & ~MOVE_FLY_LOW;
197	}	321	}
198	if (defined (my $v = delete $ob->{fly_off})) {	322	if (defined (my $v = delete $ob->{fly_off})) {
		323	$ob->{move_off} = MOVE_ALL unless exists $ob->{move_off};
199	$ob->{move_off} = $v ? $ob->{move_off} \| MOVE_FLY_LOW	324	$ob->{move_off} = $v ? $ob->{move_off} \| MOVE_FLY_LOW
200	: $ob->{move_off} & ~MOVE_FLY_LOW;	325	: $ob->{move_off} & ~MOVE_FLY_LOW;
201	}	326	}
202	if (defined (my $v = delete $ob->{flying})) {	327	if (defined (my $v = delete $ob->{flying})) {
		328	$ob->{move_type} = MOVE_ALL unless exists $ob->{move_type};
203	$ob->{move_type} = $v ? $ob->{move_type} \| MOVE_FLY_LOW	329	$ob->{move_type} = $v ? $ob->{move_type} \| MOVE_FLY_LOW
204	: $ob->{move_type} & ~MOVE_FLY_LOW;	330	: $ob->{move_type} & ~MOVE_FLY_LOW;
205	}	331	}
206		332
		333	# convert idiotic event_xxx things into objects
		334	while (my ($event, $subtype) = each %EVENT_TYPE) {
		335	if (exists $ob->{"event_${event}_plugin"}) {
		336	push @{$ob->{inventory}}, {
		337	_name => "event_$event",
		338	title => delete $ob->{"event_${event}_plugin"},
		339	slaying => delete $ob->{"event_${event}"},
		340	name => delete $ob->{"event_${event}_options"},
		341	};
		342	}
		343	}
		344
		345	# some archetypes had "+3" instead of the canonical "3", so fix
		346	$ob->{dam} *= 1 if exists $ob->{dam};
		347
207	$ob	348	$ob
208	}	349	}
209		350
		351	# arch as in "arch xxx", ie.. objects
210	sub normalize_arch($) {	352	sub normalize_arch($) {
211	my ($ob) = @_;	353	my ($ob) = @_;
212		354
213	normalize_object $ob;	355	normalize_object $ob;
214		356
…		…
251	}	393	}
252		394
253	$ob	395	$ob
254	}	396	}
255		397
		398	sub attr_thaw($) {
		399	my ($ob) = @_;
		400
		401	$ob->{attach} = from_json $ob->{attach}
		402	if exists $ob->{attach};
		403
		404	$ob
		405	}
		406
		407	sub attr_freeze($) {
		408	my ($ob) = @_;
		409
		410	$ob->{attach} = Crossfire::to_json $ob->{attach}
		411	if exists $ob->{attach};
		412
		413	$ob
		414	}
		415
256	sub read_pak($) {	416	sub read_pak($) {
257	my ($path) = @_;	417	my ($path) = @_;
258		418
259	my %pak;	419	my %pak;
260		420
261	open my $fh, "<", $path	421	open my $fh, "<:raw:perlio", $path
262	or Carp::croak "$_[0]: $!";	422	or Carp::croak "$_[0]: $!";
263	binmode $fh;	423	binmode $fh;
264	while (<$fh>) {	424	while (<$fh>) {
265	my ($type, $id, $len, $path) = split;	425	my ($type, $id, $len, $path) = split;
266	$path =~ s/.*\///;	426	$path =~ s/.*\///;
…		…
268	}	428	}
269		429
270	\%pak	430	\%pak
271	}	431	}
272		432
273	sub read_arch($) {	433	sub read_arch($;$) {
274	my ($path) = @_;	434	my ($path, $toplevel) = @_;
275		435
276	my %arc;	436	my %arc;
277	my ($more, $prev);	437	my ($more, $prev);
		438	my $comment;
278		439
279	open my $fh, "<", $path	440	open my $fh, "<:raw:perlio:utf8", $path
280	or Carp::croak "$path: $!";	441	or Carp::croak "$path: $!";
281		442
282	binmode $fh;	443	# binmode $fh;
283		444
284	my $parse_block; $parse_block = sub {	445	my $parse_block; $parse_block = sub {
285	my %arc = @_;	446	my %arc = @_;
286		447
287	while (<$fh>) {	448	while (<$fh>) {
288	s/\s+$//;	449	s/\s+$//;
289	if (/^end$/i) {	450	if (/^end$/i) {
290	last;	451	last;
		452
291	} elsif (/^arch (\S+)$/i) {	453	} elsif (/^arch (\S+)$/i) {
292	push @{ $arc{inventory} }, normalize_arch $parse_block->(_name => $1);	454	push @{ $arc{inventory} }, attr_thaw normalize_arch $parse_block->(_name => $1);
		455
293	} elsif (/^lore$/i) {	456	} elsif (/^lore$/i) {
294	while (<$fh>) {	457	while (<$fh>) {
295	last if /^endlore\s*$/i;	458	last if /^endlore\s*$/i;
296	$arc{lore} .= $_;	459	$arc{lore} .= $_;
297	}	460	}
298	} elsif (/^msg$/i) {	461	} elsif (/^msg$/i) {
299	while (<$fh>) {	462	while (<$fh>) {
300	last if /^endmsg\s*$/i;	463	last if /^endmsg\s*$/i;
301	$arc{msg} .= $_;	464	$arc{msg} .= $_;
302	}	465	}
		466	} elsif (/^anim$/i) {
		467	while (<$fh>) {
		468	last if /^mina\s*$/i;
		469	chomp;
		470	push @{ $arc{anim} }, $_;
		471	}
303	} elsif (/^(\S+)\s(.)$/) {	472	} elsif (/^(\S+)\s(.)$/) {
304	$arc{lc $1} = $2;	473	$arc{lc $1} = $2;
305	} elsif (/^\s*($\|#)/) {	474	} elsif (/^\s*#/) {
		475	$arc{_comment} .= "$_\n";
		476
		477	} elsif (/^\s*$/) {
306	#	478	#
307	} else {	479	} else {
308	warn "$path: unparsable line '$_' in arch $arc{_name}";	480	warn "$path: unparsable line '$_' in arch $arc{_name}";
309	}	481	}
310	}	482	}
…		…
316	s/\s+$//;	488	s/\s+$//;
317	if (/^more$/i) {	489	if (/^more$/i) {
318	$more = $prev;	490	$more = $prev;
319	} elsif (/^object (\S+)$/i) {	491	} elsif (/^object (\S+)$/i) {
320	my $name = $1;	492	my $name = $1;
321	my $arc = normalize_object $parse_block->(_name => $name);	493	my $arc = attr_thaw normalize_object $parse_block->(_name => $name, _comment => $comment);
		494	undef $comment;
		495	delete $arc{_comment} unless length $arc{_comment};
		496	$arc->{_atype} = 'object';
322		497
323	if ($more) {	498	if ($more) {
324	$more->{more} = $arc;	499	$more->{more} = $arc;
325	} else {	500	} else {
326	$arc{$name} = $arc;	501	$arc{$name} = $arc;
327	}	502	}
328	$prev = $arc;	503	$prev = $arc;
329	$more = undef;	504	$more = undef;
330	} elsif (/^arch (\S+)$/i) {	505	} elsif (/^arch (\S+)$/i) {
331	my $name = $1;	506	my $name = $1;
332	my $arc = normalize_arch $parse_block->(_name => $name);	507	my $arc = attr_thaw normalize_arch $parse_block->(_name => $name, _comment => $comment);
		508	undef $comment;
		509	delete $arc{_comment} unless length $arc{_comment};
		510	$arc->{_atype} = 'arch';
333		511
334	if ($more) {	512	if ($more) {
335	$more->{more} = $arc;	513	$more->{more} = $arc;
336	} else {	514	} else {
337	push @{ $arc{arch} }, $arc;	515	push @{ $arc{arch} }, $arc;
338	}	516	}
339	$prev = $arc;	517	$prev = $arc;
340	$more = undef;	518	$more = undef;
		519	} elsif ($toplevel && /^(\S+)\s+(.*)$/) {
		520	if ($1 eq "lev_array") {
		521	while (<$fh>) {
		522	last if /^endplst\s*$/;
		523	push @{$toplevel->{lev_array}}, $_+0;
		524	}
		525	} else {
		526	$toplevel->{$1} = $2;
		527	}
		528	} elsif (/^\s*#/) {
		529	$comment .= "$_\n";
341	} elsif (/^\s*($\|#)/) {	530	} elsif (/^\s*($\|#)/) {
342	#	531	#
343	} else {	532	} else {
344	warn "$path: unparseable top-level line '$_'";	533	die "$path: unparseable top-level line '$_'";
345	}	534	}
346	}	535	}
347		536
348	undef $parse_block; # work around bug in perl not freeing $fh etc.	537	undef $parse_block; # work around bug in perl not freeing $fh etc.
349		538
350	\%arc	539	\%arc
		540	}
		541
		542	sub archlist_to_string {
		543	my ($arch) = @_;
		544
		545	my $str;
		546
		547	my $append; $append = sub {
		548	my %a = %{$_[0]};
		549
		550	Crossfire::attr_freeze \%a;
		551	Crossfire::normalize_arch \%a;
		552
		553	# undo the bit-split we did before
		554	if (exists $a{attack_movement_bits_0_3} or exists $a{attack_movement_bits_4_7}) {
		555	$a{attack_movement} = (delete $a{attack_movement_bits_0_3})
		556	\| (delete $a{attack_movement_bits_4_7});
		557	}
		558
		559	if (my $comment = delete $a{_comment}) {
		560	if ($comment =~ /[^\n\s#]/) {
		561	$str .= $comment;
		562	}
		563	}
		564
		565	$str .= ((exists $a{_atype}) ? $a{_atype} : 'arch'). " $a{_name}\n";
		566
		567	my $inv = delete $a{inventory};
		568	my $more = delete $a{more}; # arches do not support 'more', but old maps can contain some
		569	my $anim = delete $a{anim};
		570
		571	my @kv;
		572
		573	for ($a{_name} eq "map"
		574	? @Crossfire::FIELD_ORDER_MAP
		575	: @Crossfire::FIELD_ORDER) {
		576	push @kv, [$_, delete $a{$_}]
		577	if exists $a{$_};
		578	}
		579
		580	for (sort keys %a) {
		581	next if /^_/; # ignore our _-keys
		582	push @kv, [$_, delete $a{$_}];
		583	}
		584
		585	for (@kv) {
		586	my ($k, $v) = @$_;
		587
		588	if (my $end = $Crossfire::FIELD_MULTILINE{$k}) {
		589	$v =~ s/\n$//;
		590	$str .= "$k\n$v\n$end\n";
		591	} elsif (exists $Crossfire::FIELD_MOVEMENT{$k}) {
		592	if ($v & ~Crossfire::MOVE_ALL or !$v) {
		593	$str .= "$k $v\n";
		594
		595	} elsif ($v & Crossfire::MOVE_ALLBIT) {
		596	$str .= "$k all";
		597
		598	$str .= " -walk" unless $v & Crossfire::MOVE_WALK;
		599	$str .= " -fly_low" unless $v & Crossfire::MOVE_FLY_LOW;
		600	$str .= " -fly_high" unless $v & Crossfire::MOVE_FLY_HIGH;
		601	$str .= " -swim" unless $v & Crossfire::MOVE_SWIM;
		602	$str .= " -boat" unless $v & Crossfire::MOVE_BOAT;
		603
		604	$str .= "\n";
		605
		606	} else {
		607	$str .= $k;
		608
		609	$str .= " walk" if $v & Crossfire::MOVE_WALK;
		610	$str .= " fly_low" if $v & Crossfire::MOVE_FLY_LOW;
		611	$str .= " fly_high" if $v & Crossfire::MOVE_FLY_HIGH;
		612	$str .= " swim" if $v & Crossfire::MOVE_SWIM;
		613	$str .= " boat" if $v & Crossfire::MOVE_BOAT;
		614
		615	$str .= "\n";
		616	}
		617	} else {
		618	$str .= "$k $v\n";
		619	}
		620	}
		621
		622	if ($inv) {
		623	$append->($_) for @$inv;
		624	}
		625
		626	if ($a{_atype} eq 'object') {
		627	$str .= join "\n", "anim", @$anim, "mina\n"
		628	if $anim;
		629	}
		630
		631	$str .= "end\n";
		632
		633	if ($a{_atype} eq 'object') {
		634	if ($more) {
		635	$str .= "more\n";
		636	$append->($more) if $more;
		637	} else {
		638	$str .= "\n";
		639	}
		640	}
		641	};
		642
		643	for (@$arch) {
		644	$append->($_);
		645	}
		646
		647	$str
351	}	648	}
352		649
353	# put all archs into a hash with editor_face as it's key	650	# put all archs into a hash with editor_face as it's key
354	# NOTE: the arrays in the hash values are references to	651	# NOTE: the arrays in the hash values are references to
355	# the archs from $ARCH	652	# the archs from $ARCH
356	sub editor_archs {	653	sub editor_archs {
357	my %paths;	654	my %paths;
358		655
359	for (keys %ARCH) {	656	for (keys %ARCH) {
360	my $arch = $ARCH{$_};	657	my $arch = $ARCH{$_};
361	push @{$paths{$arch->{editor_folder}}}, \$arch;	658	push @{$paths{$arch->{editor_folder}}}, $arch;
362	}	659	}
363		660
364	\%paths	661	\%paths
365	}	662	}
366		663
…		…
376	my ($a) = @_;	673	my ($a) = @_;
377		674
378	my $o = $ARCH{$a->{_name}}	675	my $o = $ARCH{$a->{_name}}
379	or return;	676	or return;
380		677
381	my $face = $FACE{$a->{face} \|\| $o->{face} \|\| "blank.111"}	678	my $face = $FACE{$a->{face} \|\| $o->{face} \|\| "blank.111"};
		679	unless ($face) {
		680	$face = $FACE{"blank.x11"}
382	or (warn "no face data found for arch '$a->{_name}'"), return;	681	or (warn "no face data found for arch '$a->{_name}'"), return;
		682	}
383		683
384	if ($face->{w} > 1 \|\| $face->{h} > 1) {	684	if ($face->{w} > 1 \|\| $face->{h} > 1) {
385	# bigface	685	# bigface
386	return (0, 0, $face->{w} - 1, $face->{h} - 1);	686	return (0, 0, $face->{w} - 1, $face->{h} - 1);
387		687

Diff Legend

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

Comparing deliantra/Deliantra/Deliantra.pm (file contents): Revision 1.61 by root, Mon Mar 27 17:38:18 2006 UTC vs. Revision 1.84 by root, Wed Feb 7 00:22:34 2007 UTC

Diff Legend

Comparing deliantra/Deliantra/Deliantra.pm (file contents):
Revision 1.61 by root, Mon Mar 27 17:38:18 2006 UTC vs.
Revision 1.84 by root, Wed Feb 7 00:22:34 2007 UTC