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

Comparing deliantra/Deliantra/Deliantra.pm (file contents):
Revision 1.82 by root, Tue Feb 6 23:53:26 2007 UTC vs.
Revision 1.109 by elmex, Sun May 27 08:08:59 2007 UTC

…		…
4		4
5	=cut	5	=cut
6		6
7	package Crossfire;	7	package Crossfire;
8		8
9	our $VERSION = '0.96';	9	our $VERSION = '0.98';
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	24	use JSON::XS qw(from_json to_json);
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		25
36	our $LIB = $ENV{CROSSFIRE_LIBDIR};	26	our $LIB = $ENV{CROSSFIRE_LIBDIR};
37		27
38	our $VARDIR = $ENV{HOME} ? "$ENV{HOME}/.crossfire"	28	our $VARDIR = $ENV{HOME} ? "$ENV{HOME}/.crossfire"
39	: $ENV{AppData} ? "$ENV{APPDATA}/crossfire"	29	: $ENV{AppData} ? "$ENV{APPDATA}/crossfire"
…		…
58	qw(move_type move_block move_allow move_on move_off move_slow);	48	qw(move_type move_block move_allow move_on move_off move_slow);
59		49
60	# same as in server save routine, to (hopefully) be compatible	50	# same as in server save routine, to (hopefully) be compatible
61	# to the other editors.	51	# to the other editors.
62	our @FIELD_ORDER_MAP = (qw(	52	our @FIELD_ORDER_MAP = (qw(
		53	file_format_version
63	name attach swap_time reset_timeout fixed_resettime difficulty region	54	name attach swap_time reset_timeout fixed_resettime difficulty region
64	shopitems shopgreed shopmin shopmax shoprace	55	shopitems shopgreed shopmin shopmax shoprace
65	darkness width height enter_x enter_y msg maplore	56	darkness width height enter_x enter_y msg maplore
66	unique template	57	unique template
67	outdoor temp pressure humid windspeed winddir sky nosmooth	58	outdoor temp pressure humid windspeed winddir sky nosmooth
68	tile_path_1 tile_path_2 tile_path_3 tile_path_4	59	tile_path_1 tile_path_2 tile_path_3 tile_path_4
69	));	60	));
70		61
71	our @FIELD_ORDER = (qw(	62	our @FIELD_ORDER = (qw(
		63	inherit
		64
72	elevation	65	elevation
73		66
74	name name_pl custom_name attach title race	67	name name_pl custom_name attach title race
75	slaying skill msg lore other_arch face	68	slaying skill msg lore other_arch
76	#todo-events
77	animation is_animated	69	face animation is_animated
		70	magicmap smoothlevel smoothface
78	str dex con wis pow cha int	71	str dex con wis pow cha int
79	hp maxhp sp maxsp grace maxgrace	72	hp maxhp sp maxsp grace maxgrace
80	exp perm_exp expmul	73	exp perm_exp expmul
81	food dam luck wc ac x y speed speed_left move_state attack_movement	74	food dam luck wc ac x y speed speed_left move_state attack_movement
82	nrof level direction type subtype attacktype	75	nrof level direction type subtype attacktype
…		…
90	resist_life_stealing resist_disease	83	resist_life_stealing resist_disease
91		84
92	path_attuned path_repelled path_denied material materialname	85	path_attuned path_repelled path_denied material materialname
93	value carrying weight invisible state magic	86	value carrying weight invisible state magic
94	last_heal last_sp last_grace last_eat	87	last_heal last_sp last_grace last_eat
95	connected glow_radius randomitems npx_status npc_program	88	connected glow_radius randomitems tresure_env npx_status npc_program
96	run_away pick_up container will_apply smoothlevel	89	run_away pick_up container will_apply smoothlevel
97	current_weapon_script weapontype tooltype elevation client_type	90	current_weapon_script weapontype tooltype elevation client_type
98	item_power duration range	91	item_power duration range
99	range_modifier duration_modifier dam_modifier gen_sp_armour	92	range_modifier duration_modifier dam_modifier gen_sp_armour
100	move_type move_block move_allow move_on move_off move_on move_slow move_slow_penalty	93	move_type move_block move_allow move_on move_off move_on move_slow move_slow_penalty
…		…
111	known_magical known_cursed can_use_skill been_applied has_ready_scroll	104	known_magical known_cursed can_use_skill been_applied has_ready_scroll
112	can_use_rod can_use_horn make_invisible inv_locked is_wooded is_hilly	105	can_use_rod can_use_horn make_invisible inv_locked is_wooded is_hilly
113	has_ready_skill has_ready_weapon no_skill_ident is_blind can_see_in_dark	106	has_ready_skill has_ready_weapon no_skill_ident is_blind can_see_in_dark
114	is_cauldron is_dust no_steal one_hit berserk neutral no_attack no_damage	107	is_cauldron is_dust no_steal one_hit berserk neutral no_attack no_damage
115	activate_on_push activate_on_release is_water use_content_on_gen is_buildable	108	activate_on_push activate_on_release is_water use_content_on_gen is_buildable
		109	precious
116		110
117	body_range body_arm body_torso body_head body_neck body_skill	111	body_range body_arm body_torso body_head body_neck body_skill
118	body_finger body_shoulder body_foot body_hand body_wrist body_waist	112	body_finger body_shoulder body_foot body_hand body_wrist body_waist
119	));	113	));
120		114
…		…
137	sub MOVE_FLY_LOW (){ 0x02 }	131	sub MOVE_FLY_LOW (){ 0x02 }
138	sub MOVE_FLY_HIGH (){ 0x04 }	132	sub MOVE_FLY_HIGH (){ 0x04 }
139	sub MOVE_FLYING (){ 0x06 }	133	sub MOVE_FLYING (){ 0x06 }
140	sub MOVE_SWIM (){ 0x08 }	134	sub MOVE_SWIM (){ 0x08 }
141	sub MOVE_BOAT (){ 0x10 }	135	sub MOVE_BOAT (){ 0x10 }
		136	sub MOVE_SHIP (){ 0x20 }
142	sub MOVE_KNOWN (){ 0x1f } # all of above	137	sub MOVE_KNOWN (){ 0x3f } # all of above
143	sub MOVE_ALLBIT (){ 0x10000 }
144	sub MOVE_ALL (){ 0x1001f } # very special value, more PITA	138	sub MOVE_ALL (){ 0x10000 } # very special value
		139
		140	our %MOVE_TYPE = (
		141	walk => MOVE_WALK,
		142	fly_low => MOVE_FLY_LOW,
		143	fly_high => MOVE_FLY_HIGH,
		144	flying => MOVE_FLYING,
		145	swim => MOVE_SWIM,
		146	boat => MOVE_BOAT,
		147	ship => MOVE_SHIP,
		148	all => MOVE_ALL,
		149	);
		150
		151	our @MOVE_TYPE = keys %MOVE_TYPE;
		152
		153	{
		154	package Crossfire::MoveType;
		155
		156	use overload
		157	'=' => sub { bless [@{$_[0]}], ref $_[0] },
		158	'""' => \&as_string,
		159	'>=' => sub { $_[0][0] & $MOVE_TYPE{$_[1]} ? $_[0][1] & $MOVE_TYPE{$_[1]} : undef },
		160	'+=' => sub { $_[0][0] \|= $MOVE_TYPE{$_[1]}; $_[0][1] \|= $MOVE_TYPE{$_[1]}; &normalise },
		161	'-=' => sub { $_[0][0] \|= $MOVE_TYPE{$_[1]}; $_[0][1] &= ~$MOVE_TYPE{$_[1]}; &normalise },
		162	'/=' => sub { $_[0][0] &= ~$MOVE_TYPE{$_[1]}; &normalise },
		163	'x=' => sub {
		164	my $cur = $_[0] >= $_[1];
		165	if (!defined $cur) {
		166	if ($_[0] >= "all") {
		167	$_[0] -= $_[1];
		168	} else {
		169	$_[0] += $_[1];
		170	}
		171	} elsif ($cur) {
		172	$_[0] -= $_[1];
		173	} else {
		174	$_[0] /= $_[1];
		175	}
		176
		177	$_[0]
		178	},
		179	'eq' => sub { "$_[0]" eq "$_[1]" },
		180	'ne' => sub { "$_[0]" ne "$_[1]" },
		181	;
		182	}
		183
		184	sub Crossfire::MoveType::new {
		185	my ($class, $string) = @_;
		186
		187	my $mask;
		188	my $value;
		189
		190	if ($string =~ /^\s\d+\s$/) {
		191	$mask = MOVE_ALL;
		192	$value = $string+0;
		193	} else {
		194	for (split /\s+/, lc $string) {
		195	if (s/^-//) {
		196	$mask \|= $MOVE_TYPE{$_};
		197	$value &= ~$MOVE_TYPE{$_};
		198	} else {
		199	$mask \|= $MOVE_TYPE{$_};
		200	$value \|= $MOVE_TYPE{$_};
		201	}
		202	}
		203	}
		204
		205	(bless [$mask, $value], $class)->normalise
		206	}
		207
		208	sub Crossfire::MoveType::normalise {
		209	my ($self) = @_;
		210
		211	if ($self->[0] & MOVE_ALL) {
		212	my $mask = ~(($self->[1] & MOVE_ALL ? $self->[1] : ~$self->[1]) & $self->[0] & ~MOVE_ALL);
		213	$self->[0] &= $mask;
		214	$self->[1] &= $mask;
		215	}
		216
		217	$self->[1] &= $self->[0];
		218
		219	$self
		220	}
		221
		222	sub Crossfire::MoveType::as_string {
		223	my ($self) = @_;
		224
		225	my @res;
		226
		227	my ($mask, $value) = @$self;
		228
		229	for (@Crossfire::MOVE_TYPE) {
		230	my $bit = $Crossfire::MOVE_TYPE{$_};
		231	if (($mask & $bit) == $bit && (($value & $bit) == $bit \|\| ($value & $bit) == 0)) {
		232	$mask &= ~$bit;
		233	push @res, $value & $bit ? $_ : "-$_";
		234	}
		235	}
		236
		237	join " ", @res
		238	}
145		239
146	sub load_ref($) {	240	sub load_ref($) {
147	my ($path) = @_;	241	my ($path) = @_;
148		242
149	open my $fh, "<:raw:perlio", $path	243	open my $fh, "<:raw:perlio", $path
…		…
213	adamant => 256,	307	adamant => 256,
214	liquid => 512,	308	liquid => 512,
215	tin => 1024,	309	tin => 1024,
216	bone => 2048,	310	bone => 2048,
217	ice => 4096,	311	ice => 4096,
		312
		313	# guesses
		314	runestone => 12,
		315	bronze => 18,
		316	"ancient wood" => 20,
		317	glass => 36,
		318	marble => 66,
		319	ice => 68,
		320	stone => 70,
		321	stone => 80,
		322	cloth => 136,
		323	ironwood => 144,
		324	adamantium => 258,
		325	glacium => 260,
		326	blood => 544,
218	;	327	;
219		328
220	# object as in "Object xxx", i.e. archetypes	329	# object as in "Object xxx", i.e. archetypes
221	sub normalize_object($) {	330	sub normalize_object($) {
222	my ($ob) = @_;	331	my ($ob) = @_;
…		…
230	delete $ob->{material};	339	delete $ob->{material};
231	} else {	340	} else {
232	warn "object $ob->{_name} has both materialname ($ob->{materialname}) and material ($ob->{material}) set.\n";	341	warn "object $ob->{_name} has both materialname ($ob->{materialname}) and material ($ob->{material}) set.\n";
233	delete $ob->{material}; # assume materilname is more specific and nuke material	342	delete $ob->{material}; # assume materilname is more specific and nuke material
234	}	343	}
		344	} elsif (my $name = $MATERIAL{$ob->{material}}) {
		345	delete $ob->{material};
		346	$ob->{materialname} = $name;
235	} else {	347	} else {
236	if (my $name = $MATERIAL{$ob->{material}}) {	348	warn "object $ob->{_name} has unknown material ($ob->{material}) set.\n";
237	delete $ob->{material};
238	$ob->{materialname} = $name;
239	}	349	}
240	}
241	}	350	}
		351
		352	# check whether attachment is the same as in the archetype
		353	if (exists $ob->{attach}) {
		354	my $arch = $ARCH{$ob->{_name}};
		355	my $js = JSON::XS->new->utf8->canonical (1);
		356
		357	if (defined $arch->{attach}
		358	&& $js->encode ($js->decode ($ob->{attach})) eq $js->encode ($arch->{attach})) {
		359	delete $ob->{attach}
		360	}
		361	}
		362
		363	# color_fg is used as default for magicmap if magicmap does not exist
		364	$ob->{magicmap} \|\|= delete $ob->{color_fg} if exists $ob->{color_fg};
242		365
243	# nuke outdated or never supported fields	366	# nuke outdated or never supported fields
244	delete @$ob{qw(	367	delete @$ob{qw(
245	can_knockback can_parry can_impale can_cut can_dam_armour	368	can_knockback can_parry can_impale can_cut can_dam_armour
246	can_apply pass_thru can_pass_thru	369	can_apply pass_thru can_pass_thru color_bg color_fg
247	)};	370	)};
248		371
249	if (my $mask = delete $ob->{immune} ) { _add_resist $ob, $mask, 100; }	372	if (my $mask = delete $ob->{immune} ) { _add_resist $ob, $mask, 100; }
250	if (my $mask = delete $ob->{protected} ) { _add_resist $ob, $mask, 30; }	373	if (my $mask = delete $ob->{protected} ) { _add_resist $ob, $mask, 30; }
251	if (my $mask = delete $ob->{vulnerable}) { _add_resist $ob, $mask, -100; }	374	if (my $mask = delete $ob->{vulnerable}) { _add_resist $ob, $mask, -100; }
252		375
253	# convert movement strings to bitsets	376	# convert movement strings to bitsets
254	for my $attr (keys %FIELD_MOVEMENT) {	377	for my $attr (keys %FIELD_MOVEMENT) {
255	next unless exists $ob->{$attr};	378	next unless exists $ob->{$attr};
256		379
257	$ob->{$attr} = MOVE_ALL if $ob->{$attr} == 255; #d# compatibility	380	$ob->{$attr} = new Crossfire::MoveType $ob->{$attr};
258
259	next if $ob->{$attr} =~ /^\d+$/;
260
261	my $flags = 0;
262
263	# assume list
264	for my $flag (map lc, split /\s+/, $ob->{$attr}) {
265	$flags \|= MOVE_WALK if $flag eq "walk";
266	$flags \|= MOVE_FLY_LOW if $flag eq "fly_low";
267	$flags \|= MOVE_FLY_HIGH if $flag eq "fly_high";
268	$flags \|= MOVE_FLYING if $flag eq "flying";
269	$flags \|= MOVE_SWIM if $flag eq "swim";
270	$flags \|= MOVE_BOAT if $flag eq "boat";
271	$flags \|= MOVE_ALL if $flag eq "all";
272
273	$flags &= ~MOVE_WALK if $flag eq "-walk";
274	$flags &= ~MOVE_FLY_LOW if $flag eq "-fly_low";
275	$flags &= ~MOVE_FLY_HIGH if $flag eq "-fly_high";
276	$flags &= ~MOVE_FLYING if $flag eq "-flying";
277	$flags &= ~MOVE_SWIM if $flag eq "-swim";
278	$flags &= ~MOVE_BOAT if $flag eq "-boat";
279	$flags &= ~MOVE_ALL if $flag eq "-all";
280	}
281
282	$ob->{$attr} = $flags;
283	}	381	}
284		382
285	# convert outdated movement flags to new movement sets	383	# convert outdated movement flags to new movement sets
286	if (defined (my $v = delete $ob->{no_pass})) {	384	if (defined (my $v = delete $ob->{no_pass})) {
287	$ob->{move_block} = $v ? MOVE_ALL : 0;	385	$ob->{move_block} = new Crossfire::MoveType $v ? "all" : "";
288	}	386	}
289	if (defined (my $v = delete $ob->{slow_move})) {	387	if (defined (my $v = delete $ob->{slow_move})) {
290	$ob->{move_slow} \|= MOVE_WALK;	388	$ob->{move_slow} += "walk";
291	$ob->{move_slow_penalty} = $v;	389	$ob->{move_slow_penalty} = $v;
292	}	390	}
293	if (defined (my $v = delete $ob->{walk_on})) {	391	if (defined (my $v = delete $ob->{walk_on})) {
294	$ob->{move_on} = MOVE_ALL unless exists $ob->{move_on};	392	$ob->{move_on} \|\|= new Crossfire::MoveType; if ($v) { $ob->{move_on} += "walk" } else { $ob->{move_on} -= "walk" }
295	$ob->{move_on} = $v ? $ob->{move_on} \| MOVE_WALK
296	: $ob->{move_on} & ~MOVE_WALK;
297	}	393	}
298	if (defined (my $v = delete $ob->{walk_off})) {	394	if (defined (my $v = delete $ob->{walk_off})) {
299	$ob->{move_off} = MOVE_ALL unless exists $ob->{move_off};	395	$ob->{move_off} \|\|= new Crossfire::MoveType; if ($v) { $ob->{move_off} += "walk" } else { $ob->{move_off} -= "walk" }
300	$ob->{move_off} = $v ? $ob->{move_off} \| MOVE_WALK
301	: $ob->{move_off} & ~MOVE_WALK;
302	}	396	}
303	if (defined (my $v = delete $ob->{fly_on})) {	397	if (defined (my $v = delete $ob->{fly_on})) {
304	$ob->{move_on} = MOVE_ALL unless exists $ob->{move_on};	398	$ob->{move_on} \|\|= new Crossfire::MoveType; if ($v) { $ob->{move_on} += "fly_low" } else { $ob->{move_on} -= "fly_low" }
305	$ob->{move_on} = $v ? $ob->{move_on} \| MOVE_FLY_LOW
306	: $ob->{move_on} & ~MOVE_FLY_LOW;
307	}	399	}
308	if (defined (my $v = delete $ob->{fly_off})) {	400	if (defined (my $v = delete $ob->{fly_off})) {
309	$ob->{move_off} = MOVE_ALL unless exists $ob->{move_off};	401	$ob->{move_off} \|\|= new Crossfire::MoveType; if ($v) { $ob->{move_off} += "fly_low" } else { $ob->{move_off} -= "fly_low" }
310	$ob->{move_off} = $v ? $ob->{move_off} \| MOVE_FLY_LOW
311	: $ob->{move_off} & ~MOVE_FLY_LOW;
312	}	402	}
313	if (defined (my $v = delete $ob->{flying})) {	403	if (defined (my $v = delete $ob->{flying})) {
314	$ob->{move_type} = MOVE_ALL unless exists $ob->{move_type};	404	$ob->{move_type} \|\|= new Crossfire::MoveType; if ($v) { $ob->{move_type} += "fly_low" } else { $ob->{move_type} -= "fly_low" }
315	$ob->{move_type} = $v ? $ob->{move_type} \| MOVE_FLY_LOW
316	: $ob->{move_type} & ~MOVE_FLY_LOW;
317	}	405	}
318		406
319	# convert idiotic event_xxx things into objects	407	# convert idiotic event_xxx things into objects
320	while (my ($event, $subtype) = each %EVENT_TYPE) {	408	while (my ($event, $subtype) = each %EVENT_TYPE) {
321	if (exists $ob->{"event_${event}_plugin"}) {	409	if (exists $ob->{"event_${event}_plugin"}) {
…		…
552		640
553	my $inv = delete $a{inventory};	641	my $inv = delete $a{inventory};
554	my $more = delete $a{more}; # arches do not support 'more', but old maps can contain some	642	my $more = delete $a{more}; # arches do not support 'more', but old maps can contain some
555	my $anim = delete $a{anim};	643	my $anim = delete $a{anim};
556		644
		645	if ($a{_atype} eq 'object') {
		646	$str .= join "\n", "anim", @$anim, "mina\n"
		647	if $anim;
		648	}
		649
557	my @kv;	650	my @kv;
558		651
559	for ($a{_name} eq "map"	652	for ($a{_name} eq "map"
560	? @Crossfire::FIELD_ORDER_MAP	653	? @Crossfire::FIELD_ORDER_MAP
561	: @Crossfire::FIELD_ORDER) {	654	: @Crossfire::FIELD_ORDER) {
…		…
572	my ($k, $v) = @$_;	665	my ($k, $v) = @$_;
573		666
574	if (my $end = $Crossfire::FIELD_MULTILINE{$k}) {	667	if (my $end = $Crossfire::FIELD_MULTILINE{$k}) {
575	$v =~ s/\n$//;	668	$v =~ s/\n$//;
576	$str .= "$k\n$v\n$end\n";	669	$str .= "$k\n$v\n$end\n";
577	} elsif (exists $Crossfire::FIELD_MOVEMENT{$k}) {
578	if ($v & ~Crossfire::MOVE_ALL or !$v) {
579	$str .= "$k $v\n";
580
581	} elsif ($v & Crossfire::MOVE_ALLBIT) {
582	$str .= "$k all";
583
584	$str .= " -walk" unless $v & Crossfire::MOVE_WALK;
585	$str .= " -fly_low" unless $v & Crossfire::MOVE_FLY_LOW;
586	$str .= " -fly_high" unless $v & Crossfire::MOVE_FLY_HIGH;
587	$str .= " -swim" unless $v & Crossfire::MOVE_SWIM;
588	$str .= " -boat" unless $v & Crossfire::MOVE_BOAT;
589
590	$str .= "\n";
591
592	} else {
593	$str .= $k;
594
595	$str .= " walk" if $v & Crossfire::MOVE_WALK;
596	$str .= " fly_low" if $v & Crossfire::MOVE_FLY_LOW;
597	$str .= " fly_high" if $v & Crossfire::MOVE_FLY_HIGH;
598	$str .= " swim" if $v & Crossfire::MOVE_SWIM;
599	$str .= " boat" if $v & Crossfire::MOVE_BOAT;
600
601	$str .= "\n";
602	}
603	} else {	670	} else {
604	$str .= "$k $v\n";	671	$str .= "$k $v\n";
605	}	672	}
606	}	673	}
607		674
608	if ($inv) {	675	if ($inv) {
609	$append->($_) for @$inv;	676	$append->($_) for @$inv;
610	}
611
612	if ($a{_atype} eq 'object') {
613	$str .= join "\n", "anim", @$anim, "mina\n"
614	if $anim;
615	}	677	}
616		678
617	$str .= "end\n";	679	$str .= "end\n";
618		680
619	if ($a{_atype} eq 'object') {	681	if ($a{_atype} eq 'object') {
…		…
780	];	842	];
781		843
782	$attr	844	$attr
783	}	845	}
784		846
785	sub arch_edit_sections {
786	# if (edit_type == IGUIConstants.TILE_EDIT_NONE)
787	# edit_type = 0;
788	# else if (edit_type != 0) {
789	# // all flags from 'check_type' must be unset in this arch because they get recalculated now
790	# edit_type &= ~check_type;
791	# }
792	#
793	# }
794	# if ((check_type & IGUIConstants.TILE_EDIT_MONSTER) != 0 &&
795	# getAttributeValue("alive", defarch) == 1 &&
796	# (getAttributeValue("monster", defarch) == 1 \|\|
797	# getAttributeValue("generator", defarch) == 1)) {
798	# // Monster: monsters/npcs/generators
799	# edit_type \|= IGUIConstants.TILE_EDIT_MONSTER;
800	# }
801	# if ((check_type & IGUIConstants.TILE_EDIT_WALL) != 0 &&
802	# arch_type == 0 && getAttributeValue("no_pass", defarch) == 1) {
803	# // Walls
804	# edit_type \|= IGUIConstants.TILE_EDIT_WALL;
805	# }
806	# if ((check_type & IGUIConstants.TILE_EDIT_CONNECTED) != 0 &&
807	# getAttributeValue("connected", defarch) != 0) {
808	# // Connected Objects
809	# edit_type \|= IGUIConstants.TILE_EDIT_CONNECTED;
810	# }
811	# if ((check_type & IGUIConstants.TILE_EDIT_EXIT) != 0 &&
812	# arch_type == 66 \|\| arch_type == 41 \|\| arch_type == 95) {
813	# // Exit: teleporter/exit/trapdoors
814	# edit_type \|= IGUIConstants.TILE_EDIT_EXIT;
815	# }
816	# if ((check_type & IGUIConstants.TILE_EDIT_TREASURE) != 0 &&
817	# getAttributeValue("no_pick", defarch) == 0 && (arch_type == 4 \|\|
818	# arch_type == 5 \|\| arch_type == 36 \|\| arch_type == 60 \|\|
819	# arch_type == 85 \|\| arch_type == 111 \|\| arch_type == 123 \|\|
820	# arch_type == 124 \|\| arch_type == 130)) {
821	# // Treasure: randomtreasure/money/gems/potions/spellbooks/scrolls
822	# edit_type \|= IGUIConstants.TILE_EDIT_TREASURE;
823	# }
824	# if ((check_type & IGUIConstants.TILE_EDIT_DOOR) != 0 &&
825	# arch_type == 20 \|\| arch_type == 23 \|\| arch_type == 26 \|\|
826	# arch_type == 91 \|\| arch_type == 21 \|\| arch_type == 24) {
827	# // Door: door/special door/gates + keys
828	# edit_type \|= IGUIConstants.TILE_EDIT_DOOR;
829	# }
830	# if ((check_type & IGUIConstants.TILE_EDIT_EQUIP) != 0 &&
831	# getAttributeValue("no_pick", defarch) == 0 && ((arch_type >= 13 &&
832	# arch_type <= 16) \|\| arch_type == 33 \|\| arch_type == 34 \|\|
833	# arch_type == 35 \|\| arch_type == 39 \|\| arch_type == 70 \|\|
834	# arch_type == 87 \|\| arch_type == 99 \|\| arch_type == 100 \|\|
835	# arch_type == 104 \|\| arch_type == 109 \|\| arch_type == 113 \|\|
836	# arch_type == 122 \|\| arch_type == 3)) {
837	# // Equipment: weapons/armour/wands/rods
838	# edit_type \|= IGUIConstants.TILE_EDIT_EQUIP;
839	# }
840	#
841	# return(edit_type);
842	#
843	#
844	}
845
846	sub cache_file($$&&) {	847	sub cache_file($$&&) {
847	my ($src, $cache, $load, $create) = @_;	848	my ($src, $cache, $load, $create) = @_;
848		849
849	my ($size, $mtime) = (stat $src)[7,9]	850	my ($size, $mtime) = (stat $src)[7,9]
850	or Carp::croak "$src: $!";	851	or Carp::croak "$src: $!";
…		…
898	}, sub {	899	}, sub {
899	read_arch "$LIB/archetypes"	900	read_arch "$LIB/archetypes"
900	};	901	};
901	}	902	}
902		903
		904	sub construct_tilecache_pb {
		905	my ($idx, $cache) = @_;
		906
		907	my $pb = new Gtk2::Gdk::Pixbuf "rgb", 1, 8, 64 * TILESIZE, TILESIZE * int +($idx + 63) / 64;
		908
		909	while (my ($name, $tile) = each %$cache) {
		910	my $tpb = delete $tile->{pb};
		911	my $ofs = $tile->{idx};
		912
		913	for my $x (0 .. $tile->{w} - 1) {
		914	for my $y (0 .. $tile->{h} - 1) {
		915	my $idx = $ofs + $x + $y * $tile->{w};
		916	$tpb->copy_area ($x * TILESIZE, $y * TILESIZE, TILESIZE, TILESIZE,
		917	$pb, ($idx % 64) * TILESIZE, TILESIZE * int $idx / 64);
		918	}
		919	}
		920	}
		921
		922	$pb->save ("$VARDIR/tilecache.png", "png", compression => 1);
		923
		924	$cache
		925	}
		926
		927	sub use_tilecache {
		928	my ($face) = @_;
		929	$TILE = new_from_file Gtk2::Gdk::Pixbuf "$VARDIR/tilecache.png"
		930	or die "$VARDIR/tilecache.png: $!";
		931	*FACE = $_[0];
		932	}
		933
903	=item load_tilecache	934	=item load_tilecache
904		935
905	(Re-)Load %TILE and %FACE.	936	(Re-)Load %TILE and %FACE.
906		937
907	=cut	938	=cut
908		939
909	sub load_tilecache() {	940	sub load_tilecache() {
910	require Gtk2;	941	require Gtk2;
911		942
		943	if (-e "$LIB/crossfire.0") { # Crossfire1 version
912	cache_file "$LIB/crossfire.0", "$VARDIR/tilecache.pst", sub {	944	cache_file "$LIB/crossfire.0", "$VARDIR/tilecache.pst", \&use_tilecache,
913	$TILE = new_from_file Gtk2::Gdk::Pixbuf "$VARDIR/tilecache.png"	945	sub {
914	or die "$VARDIR/tilecache.png: $!";
915	*FACE = $_[0];
916	}, sub {
917	my $tile = read_pak "$LIB/crossfire.0";	946	my $tile = read_pak "$LIB/crossfire.0";
918		947
919	my %cache;	948	my %cache;
920		949
921	my $idx = 0;	950	my $idx = 0;
922		951
923	for my $name (sort keys %$tile) {	952	for my $name (sort keys %$tile) {
924	my $pb = new Gtk2::Gdk::PixbufLoader;	953	my $pb = new Gtk2::Gdk::PixbufLoader;
925	$pb->write ($tile->{$name});	954	$pb->write ($tile->{$name});
926	$pb->close;	955	$pb->close;
927	my $pb = $pb->get_pixbuf;	956	my $pb = $pb->get_pixbuf;
928		957
929	my $tile = $cache{$name} = {	958	my $tile = $cache{$name} = {
930	pb => $pb,	959	pb => $pb,
931	idx => $idx,	960	idx => $idx,
932	w => int $pb->get_width / TILESIZE,	961	w => int $pb->get_width / TILESIZE,
933	h => int $pb->get_height / TILESIZE,	962	h => int $pb->get_height / TILESIZE,
		963	};
		964
		965	$idx += $tile->{w} * $tile->{h};
		966	}
		967
		968	construct_tilecache_pb $idx, \%cache;
		969
		970	\%cache
934	};	971	};
		972
		973	} else { # Crossfire+ version
		974	cache_file "$LIB/facedata", "$VARDIR/tilecache.pst", \&use_tilecache,
		975	sub {
		976	my %cache;
		977	my $facedata = Storable::retrieve "$LIB/facedata";
		978
		979	$facedata->{version} == 2
		980	or die "$LIB/facedata: version mismatch, cannot proceed.";
		981
		982	my $faces = $facedata->{faceinfo};
		983	my $idx = 0;
		984
		985	for (sort keys %$faces) {
		986	my ($face, $info) = ($_, $faces->{$_});
		987
		988	my $pb = new Gtk2::Gdk::PixbufLoader;
		989	$pb->write ($info->{data32});
		990	$pb->close;
		991	my $pb = $pb->get_pixbuf;
		992
		993	my $tile = $cache{$face} = {
		994	pb => $pb,
		995	idx => $idx,
		996	w => int $pb->get_width / TILESIZE,
		997	h => int $pb->get_height / TILESIZE,
935		998	};
936		999
937	$idx += $tile->{w} * $tile->{h};	1000	$idx += $tile->{w} * $tile->{h};
938	}
939
940	my $pb = new Gtk2::Gdk::Pixbuf "rgb", 1, 8, 64 * TILESIZE, TILESIZE * int +($idx + 63) / 64;
941
942	while (my ($name, $tile) = each %cache) {
943	my $tpb = delete $tile->{pb};
944	my $ofs = $tile->{idx};
945
946	for my $x (0 .. $tile->{w} - 1) {
947	for my $y (0 .. $tile->{h} - 1) {
948	my $idx = $ofs + $x + $y * $tile->{w};
949	$tpb->copy_area ($x * TILESIZE, $y * TILESIZE, TILESIZE, TILESIZE,
950	$pb, ($idx % 64) * TILESIZE, TILESIZE * int $idx / 64);
951	}	1001	}
		1002
		1003	construct_tilecache_pb $idx, \%cache;
		1004
		1005	\%cache
952	}	1006	};
953	}
954
955	$pb->save ("$VARDIR/tilecache.png", "png", compression => 1);
956
957	\%cache
958	};	1007	}
959	}	1008	}
960		1009
961	=head1 AUTHOR	1010	=head1 AUTHOR
962		1011
963	Marc Lehmann <schmorp@schmorp.de>	1012	Marc Lehmann <schmorp@schmorp.de>

Diff Legend

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

Comparing deliantra/Deliantra/Deliantra.pm (file contents): Revision 1.82 by root, Tue Feb 6 23:53:26 2007 UTC vs. Revision 1.109 by elmex, Sun May 27 08:08:59 2007 UTC

Diff Legend

Comparing deliantra/Deliantra/Deliantra.pm (file contents):
Revision 1.82 by root, Tue Feb 6 23:53:26 2007 UTC vs.
Revision 1.109 by elmex, Sun May 27 08:08:59 2007 UTC