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

Comparing deliantra/Deliantra/Deliantra.pm (file contents):
Revision 1.85 by root, Wed Feb 7 00:44:18 2007 UTC vs.
Revision 1.106 by root, Mon Apr 23 19:09:48 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
…		…
137	sub MOVE_FLY_LOW (){ 0x02 }	130	sub MOVE_FLY_LOW (){ 0x02 }
138	sub MOVE_FLY_HIGH (){ 0x04 }	131	sub MOVE_FLY_HIGH (){ 0x04 }
139	sub MOVE_FLYING (){ 0x06 }	132	sub MOVE_FLYING (){ 0x06 }
140	sub MOVE_SWIM (){ 0x08 }	133	sub MOVE_SWIM (){ 0x08 }
141	sub MOVE_BOAT (){ 0x10 }	134	sub MOVE_BOAT (){ 0x10 }
		135	sub MOVE_SHIP (){ 0x20 }
142	sub MOVE_KNOWN (){ 0x1f } # all of above	136	sub MOVE_KNOWN (){ 0x3f } # all of above
143	sub MOVE_ALLBIT (){ 0x10000 }
144	sub MOVE_ALL (){ 0x1001f } # very special value, more PITA	137	sub MOVE_ALL (){ 0x10000 } # very special value
		138
		139	our %MOVE_TYPE = (
		140	walk => MOVE_WALK,
		141	fly_low => MOVE_FLY_LOW,
		142	fly_high => MOVE_FLY_HIGH,
		143	flying => MOVE_FLYING,
		144	swim => MOVE_SWIM,
		145	boat => MOVE_BOAT,
		146	ship => MOVE_SHIP,
		147	all => MOVE_ALL,
		148	);
		149
		150	our @MOVE_TYPE = keys %MOVE_TYPE;
		151
		152	{
		153	package Crossfire::MoveType;
		154
		155	use overload
		156	'=' => sub { bless [@{$_[0]}], ref $_[0] },
		157	'""' => \&as_string,
		158	'>=' => sub { $_[0][0] & $MOVE_TYPE{$_[1]} ? $_[0][1] & $MOVE_TYPE{$_[1]} : undef },
		159	'+=' => sub { $_[0][0] \|= $MOVE_TYPE{$_[1]}; $_[0][1] \|= $MOVE_TYPE{$_[1]}; &normalise },
		160	'-=' => sub { $_[0][0] \|= $MOVE_TYPE{$_[1]}; $_[0][1] &= ~$MOVE_TYPE{$_[1]}; &normalise },
		161	'/=' => sub { $_[0][0] &= ~$MOVE_TYPE{$_[1]}; &normalise },
		162	'x=' => sub {
		163	my $cur = $_[0] >= $_[1];
		164	if (!defined $cur) {
		165	if ($_[0] >= "all") {
		166	$_[0] -= $_[1];
		167	} else {
		168	$_[0] += $_[1];
		169	}
		170	} elsif ($cur) {
		171	$_[0] -= $_[1];
		172	} else {
		173	$_[0] /= $_[1];
		174	}
		175
		176	$_[0]
		177	},
		178	'eq' => sub { "$_[0]" eq "$_[1]" },
		179	'ne' => sub { "$_[0]" ne "$_[1]" },
		180	;
		181	}
		182
		183	sub Crossfire::MoveType::new {
		184	my ($class, $string) = @_;
		185
		186	my $mask;
		187	my $value;
		188
		189	if ($string =~ /^\s\d+\s$/) {
		190	$mask = MOVE_ALL;
		191	$value = $string+0;
		192	} else {
		193	for (split /\s+/, lc $string) {
		194	if (s/^-//) {
		195	$mask \|= $MOVE_TYPE{$_};
		196	$value &= ~$MOVE_TYPE{$_};
		197	} else {
		198	$mask \|= $MOVE_TYPE{$_};
		199	$value \|= $MOVE_TYPE{$_};
		200	}
		201	}
		202	}
		203
		204	(bless [$mask, $value], $class)->normalise
		205	}
		206
		207	sub Crossfire::MoveType::normalise {
		208	my ($self) = @_;
		209
		210	if ($self->[0] & MOVE_ALL) {
		211	my $mask = ~(($self->[1] & MOVE_ALL ? $self->[1] : ~$self->[1]) & $self->[0] & ~MOVE_ALL);
		212	$self->[0] &= $mask;
		213	$self->[1] &= $mask;
		214	}
		215
		216	$self->[1] &= $self->[0];
		217
		218	$self
		219	}
		220
		221	sub Crossfire::MoveType::as_string {
		222	my ($self) = @_;
		223
		224	my @res;
		225
		226	my ($mask, $value) = @$self;
		227
		228	for (@Crossfire::MOVE_TYPE) {
		229	my $bit = $Crossfire::MOVE_TYPE{$_};
		230	if (($mask & $bit) == $bit && (($value & $bit) == $bit \|\| ($value & $bit) == 0)) {
		231	$mask &= ~$bit;
		232	push @res, $value & $bit ? $_ : "-$_";
		233	}
		234	}
		235
		236	join " ", @res
		237	}
145		238
146	sub load_ref($) {	239	sub load_ref($) {
147	my ($path) = @_;	240	my ($path) = @_;
148		241
149	open my $fh, "<:raw:perlio", $path	242	open my $fh, "<:raw:perlio", $path
…		…
253	} else {	346	} else {
254	warn "object $ob->{_name} has unknown material ($ob->{material}) set.\n";	347	warn "object $ob->{_name} has unknown material ($ob->{material}) set.\n";
255	}	348	}
256	}	349	}
257		350
		351	# color_fg is used as default for magicmap if magicmap does not exist
		352	$ob->{magicmap} \|\|= delete $ob->{color_fg} if exists $ob->{color_fg};
		353
258	# nuke outdated or never supported fields	354	# nuke outdated or never supported fields
259	delete @$ob{qw(	355	delete @$ob{qw(
260	can_knockback can_parry can_impale can_cut can_dam_armour	356	can_knockback can_parry can_impale can_cut can_dam_armour
261	can_apply pass_thru can_pass_thru	357	can_apply pass_thru can_pass_thru color_bg color_fg
262	)};	358	)};
263		359
264	if (my $mask = delete $ob->{immune} ) { _add_resist $ob, $mask, 100; }	360	if (my $mask = delete $ob->{immune} ) { _add_resist $ob, $mask, 100; }
265	if (my $mask = delete $ob->{protected} ) { _add_resist $ob, $mask, 30; }	361	if (my $mask = delete $ob->{protected} ) { _add_resist $ob, $mask, 30; }
266	if (my $mask = delete $ob->{vulnerable}) { _add_resist $ob, $mask, -100; }	362	if (my $mask = delete $ob->{vulnerable}) { _add_resist $ob, $mask, -100; }
267		363
268	# convert movement strings to bitsets	364	# convert movement strings to bitsets
269	for my $attr (keys %FIELD_MOVEMENT) {	365	for my $attr (keys %FIELD_MOVEMENT) {
270	next unless exists $ob->{$attr};	366	next unless exists $ob->{$attr};
271		367
272	$ob->{$attr} = MOVE_ALL if $ob->{$attr} == 255; #d# compatibility	368	$ob->{$attr} = new Crossfire::MoveType $ob->{$attr};
273
274	next if $ob->{$attr} =~ /^\d+$/;
275
276	my $flags = 0;
277
278	# assume list
279	for my $flag (map lc, split /\s+/, $ob->{$attr}) {
280	$flags \|= MOVE_WALK if $flag eq "walk";
281	$flags \|= MOVE_FLY_LOW if $flag eq "fly_low";
282	$flags \|= MOVE_FLY_HIGH if $flag eq "fly_high";
283	$flags \|= MOVE_FLYING if $flag eq "flying";
284	$flags \|= MOVE_SWIM if $flag eq "swim";
285	$flags \|= MOVE_BOAT if $flag eq "boat";
286	$flags \|= MOVE_ALL if $flag eq "all";
287
288	$flags &= ~MOVE_WALK if $flag eq "-walk";
289	$flags &= ~MOVE_FLY_LOW if $flag eq "-fly_low";
290	$flags &= ~MOVE_FLY_HIGH if $flag eq "-fly_high";
291	$flags &= ~MOVE_FLYING if $flag eq "-flying";
292	$flags &= ~MOVE_SWIM if $flag eq "-swim";
293	$flags &= ~MOVE_BOAT if $flag eq "-boat";
294	$flags &= ~MOVE_ALL if $flag eq "-all";
295	}
296
297	$ob->{$attr} = $flags;
298	}	369	}
299		370
300	# convert outdated movement flags to new movement sets	371	# convert outdated movement flags to new movement sets
301	if (defined (my $v = delete $ob->{no_pass})) {	372	if (defined (my $v = delete $ob->{no_pass})) {
302	$ob->{move_block} = $v ? MOVE_ALL : 0;	373	$ob->{move_block} = new Crossfire::MoveType $v ? "all" : "";
303	}	374	}
304	if (defined (my $v = delete $ob->{slow_move})) {	375	if (defined (my $v = delete $ob->{slow_move})) {
305	$ob->{move_slow} \|= MOVE_WALK;	376	$ob->{move_slow} += "walk";
306	$ob->{move_slow_penalty} = $v;	377	$ob->{move_slow_penalty} = $v;
307	}	378	}
308	if (defined (my $v = delete $ob->{walk_on})) {	379	if (defined (my $v = delete $ob->{walk_on})) {
309	$ob->{move_on} = MOVE_ALL unless exists $ob->{move_on};	380	$ob->{move_on} \|\|= new Crossfire::MoveType; if ($v) { $ob->{move_on} += "walk" } else { $ob->{move_on} -= "walk" }
310	$ob->{move_on} = $v ? $ob->{move_on} \| MOVE_WALK
311	: $ob->{move_on} & ~MOVE_WALK;
312	}	381	}
313	if (defined (my $v = delete $ob->{walk_off})) {	382	if (defined (my $v = delete $ob->{walk_off})) {
314	$ob->{move_off} = MOVE_ALL unless exists $ob->{move_off};	383	$ob->{move_off} \|\|= new Crossfire::MoveType; if ($v) { $ob->{move_off} += "walk" } else { $ob->{move_off} -= "walk" }
315	$ob->{move_off} = $v ? $ob->{move_off} \| MOVE_WALK
316	: $ob->{move_off} & ~MOVE_WALK;
317	}	384	}
318	if (defined (my $v = delete $ob->{fly_on})) {	385	if (defined (my $v = delete $ob->{fly_on})) {
319	$ob->{move_on} = MOVE_ALL unless exists $ob->{move_on};	386	$ob->{move_on} \|\|= new Crossfire::MoveType; if ($v) { $ob->{move_on} += "fly_low" } else { $ob->{move_on} -= "fly_low" }
320	$ob->{move_on} = $v ? $ob->{move_on} \| MOVE_FLY_LOW
321	: $ob->{move_on} & ~MOVE_FLY_LOW;
322	}	387	}
323	if (defined (my $v = delete $ob->{fly_off})) {	388	if (defined (my $v = delete $ob->{fly_off})) {
324	$ob->{move_off} = MOVE_ALL unless exists $ob->{move_off};	389	$ob->{move_off} \|\|= new Crossfire::MoveType; if ($v) { $ob->{move_off} += "fly_low" } else { $ob->{move_off} -= "fly_low" }
325	$ob->{move_off} = $v ? $ob->{move_off} \| MOVE_FLY_LOW
326	: $ob->{move_off} & ~MOVE_FLY_LOW;
327	}	390	}
328	if (defined (my $v = delete $ob->{flying})) {	391	if (defined (my $v = delete $ob->{flying})) {
329	$ob->{move_type} = MOVE_ALL unless exists $ob->{move_type};	392	$ob->{move_type} \|\|= new Crossfire::MoveType; if ($v) { $ob->{move_type} += "fly_low" } else { $ob->{move_type} -= "fly_low" }
330	$ob->{move_type} = $v ? $ob->{move_type} \| MOVE_FLY_LOW
331	: $ob->{move_type} & ~MOVE_FLY_LOW;
332	}	393	}
333		394
334	# convert idiotic event_xxx things into objects	395	# convert idiotic event_xxx things into objects
335	while (my ($event, $subtype) = each %EVENT_TYPE) {	396	while (my ($event, $subtype) = each %EVENT_TYPE) {
336	if (exists $ob->{"event_${event}_plugin"}) {	397	if (exists $ob->{"event_${event}_plugin"}) {
…		…
567		628
568	my $inv = delete $a{inventory};	629	my $inv = delete $a{inventory};
569	my $more = delete $a{more}; # arches do not support 'more', but old maps can contain some	630	my $more = delete $a{more}; # arches do not support 'more', but old maps can contain some
570	my $anim = delete $a{anim};	631	my $anim = delete $a{anim};
571		632
		633	if ($a{_atype} eq 'object') {
		634	$str .= join "\n", "anim", @$anim, "mina\n"
		635	if $anim;
		636	}
		637
572	my @kv;	638	my @kv;
573		639
574	for ($a{_name} eq "map"	640	for ($a{_name} eq "map"
575	? @Crossfire::FIELD_ORDER_MAP	641	? @Crossfire::FIELD_ORDER_MAP
576	: @Crossfire::FIELD_ORDER) {	642	: @Crossfire::FIELD_ORDER) {
…		…
587	my ($k, $v) = @$_;	653	my ($k, $v) = @$_;
588		654
589	if (my $end = $Crossfire::FIELD_MULTILINE{$k}) {	655	if (my $end = $Crossfire::FIELD_MULTILINE{$k}) {
590	$v =~ s/\n$//;	656	$v =~ s/\n$//;
591	$str .= "$k\n$v\n$end\n";	657	$str .= "$k\n$v\n$end\n";
592	} elsif (exists $Crossfire::FIELD_MOVEMENT{$k}) {
593	if ($v & ~Crossfire::MOVE_ALL or !$v) {
594	$str .= "$k $v\n";
595
596	} elsif ($v & Crossfire::MOVE_ALLBIT) {
597	$str .= "$k all";
598
599	$str .= " -walk" unless $v & Crossfire::MOVE_WALK;
600	$str .= " -fly_low" unless $v & Crossfire::MOVE_FLY_LOW;
601	$str .= " -fly_high" unless $v & Crossfire::MOVE_FLY_HIGH;
602	$str .= " -swim" unless $v & Crossfire::MOVE_SWIM;
603	$str .= " -boat" unless $v & Crossfire::MOVE_BOAT;
604
605	$str .= "\n";
606
607	} else {
608	$str .= $k;
609
610	$str .= " walk" if $v & Crossfire::MOVE_WALK;
611	$str .= " fly_low" if $v & Crossfire::MOVE_FLY_LOW;
612	$str .= " fly_high" if $v & Crossfire::MOVE_FLY_HIGH;
613	$str .= " swim" if $v & Crossfire::MOVE_SWIM;
614	$str .= " boat" if $v & Crossfire::MOVE_BOAT;
615
616	$str .= "\n";
617	}
618	} else {	658	} else {
619	$str .= "$k $v\n";	659	$str .= "$k $v\n";
620	}	660	}
621	}	661	}
622		662
623	if ($inv) {	663	if ($inv) {
624	$append->($_) for @$inv;	664	$append->($_) for @$inv;
625	}
626
627	if ($a{_atype} eq 'object') {
628	$str .= join "\n", "anim", @$anim, "mina\n"
629	if $anim;
630	}	665	}
631		666
632	$str .= "end\n";	667	$str .= "end\n";
633		668
634	if ($a{_atype} eq 'object') {	669	if ($a{_atype} eq 'object') {
…		…
795	];	830	];
796		831
797	$attr	832	$attr
798	}	833	}
799		834
800	sub arch_edit_sections {
801	# if (edit_type == IGUIConstants.TILE_EDIT_NONE)
802	# edit_type = 0;
803	# else if (edit_type != 0) {
804	# // all flags from 'check_type' must be unset in this arch because they get recalculated now
805	# edit_type &= ~check_type;
806	# }
807	#
808	# }
809	# if ((check_type & IGUIConstants.TILE_EDIT_MONSTER) != 0 &&
810	# getAttributeValue("alive", defarch) == 1 &&
811	# (getAttributeValue("monster", defarch) == 1 \|\|
812	# getAttributeValue("generator", defarch) == 1)) {
813	# // Monster: monsters/npcs/generators
814	# edit_type \|= IGUIConstants.TILE_EDIT_MONSTER;
815	# }
816	# if ((check_type & IGUIConstants.TILE_EDIT_WALL) != 0 &&
817	# arch_type == 0 && getAttributeValue("no_pass", defarch) == 1) {
818	# // Walls
819	# edit_type \|= IGUIConstants.TILE_EDIT_WALL;
820	# }
821	# if ((check_type & IGUIConstants.TILE_EDIT_CONNECTED) != 0 &&
822	# getAttributeValue("connected", defarch) != 0) {
823	# // Connected Objects
824	# edit_type \|= IGUIConstants.TILE_EDIT_CONNECTED;
825	# }
826	# if ((check_type & IGUIConstants.TILE_EDIT_EXIT) != 0 &&
827	# arch_type == 66 \|\| arch_type == 41 \|\| arch_type == 95) {
828	# // Exit: teleporter/exit/trapdoors
829	# edit_type \|= IGUIConstants.TILE_EDIT_EXIT;
830	# }
831	# if ((check_type & IGUIConstants.TILE_EDIT_TREASURE) != 0 &&
832	# getAttributeValue("no_pick", defarch) == 0 && (arch_type == 4 \|\|
833	# arch_type == 5 \|\| arch_type == 36 \|\| arch_type == 60 \|\|
834	# arch_type == 85 \|\| arch_type == 111 \|\| arch_type == 123 \|\|
835	# arch_type == 124 \|\| arch_type == 130)) {
836	# // Treasure: randomtreasure/money/gems/potions/spellbooks/scrolls
837	# edit_type \|= IGUIConstants.TILE_EDIT_TREASURE;
838	# }
839	# if ((check_type & IGUIConstants.TILE_EDIT_DOOR) != 0 &&
840	# arch_type == 20 \|\| arch_type == 23 \|\| arch_type == 26 \|\|
841	# arch_type == 91 \|\| arch_type == 21 \|\| arch_type == 24) {
842	# // Door: door/special door/gates + keys
843	# edit_type \|= IGUIConstants.TILE_EDIT_DOOR;
844	# }
845	# if ((check_type & IGUIConstants.TILE_EDIT_EQUIP) != 0 &&
846	# getAttributeValue("no_pick", defarch) == 0 && ((arch_type >= 13 &&
847	# arch_type <= 16) \|\| arch_type == 33 \|\| arch_type == 34 \|\|
848	# arch_type == 35 \|\| arch_type == 39 \|\| arch_type == 70 \|\|
849	# arch_type == 87 \|\| arch_type == 99 \|\| arch_type == 100 \|\|
850	# arch_type == 104 \|\| arch_type == 109 \|\| arch_type == 113 \|\|
851	# arch_type == 122 \|\| arch_type == 3)) {
852	# // Equipment: weapons/armour/wands/rods
853	# edit_type \|= IGUIConstants.TILE_EDIT_EQUIP;
854	# }
855	#
856	# return(edit_type);
857	#
858	#
859	}
860
861	sub cache_file($$&&) {	835	sub cache_file($$&&) {
862	my ($src, $cache, $load, $create) = @_;	836	my ($src, $cache, $load, $create) = @_;
863		837
864	my ($size, $mtime) = (stat $src)[7,9]	838	my ($size, $mtime) = (stat $src)[7,9]
865	or Carp::croak "$src: $!";	839	or Carp::croak "$src: $!";
…		…
913	}, sub {	887	}, sub {
914	read_arch "$LIB/archetypes"	888	read_arch "$LIB/archetypes"
915	};	889	};
916	}	890	}
917		891
		892	sub construct_tilecache_pb {
		893	my ($idx, $cache) = @_;
		894
		895	my $pb = new Gtk2::Gdk::Pixbuf "rgb", 1, 8, 64 * TILESIZE, TILESIZE * int +($idx + 63) / 64;
		896
		897	while (my ($name, $tile) = each %$cache) {
		898	my $tpb = delete $tile->{pb};
		899	my $ofs = $tile->{idx};
		900
		901	for my $x (0 .. $tile->{w} - 1) {
		902	for my $y (0 .. $tile->{h} - 1) {
		903	my $idx = $ofs + $x + $y * $tile->{w};
		904	$tpb->copy_area ($x * TILESIZE, $y * TILESIZE, TILESIZE, TILESIZE,
		905	$pb, ($idx % 64) * TILESIZE, TILESIZE * int $idx / 64);
		906	}
		907	}
		908	}
		909
		910	$pb->save ("$VARDIR/tilecache.png", "png", compression => 1);
		911
		912	$cache
		913	}
		914
		915	sub use_tilecache {
		916	my ($face) = @_;
		917	$TILE = new_from_file Gtk2::Gdk::Pixbuf "$VARDIR/tilecache.png"
		918	or die "$VARDIR/tilecache.png: $!";
		919	*FACE = $_[0];
		920	}
		921
918	=item load_tilecache	922	=item load_tilecache
919		923
920	(Re-)Load %TILE and %FACE.	924	(Re-)Load %TILE and %FACE.
921		925
922	=cut	926	=cut
923		927
924	sub load_tilecache() {	928	sub load_tilecache() {
925	require Gtk2;	929	require Gtk2;
926		930
		931	if (-e "$LIB/crossfire.0") { # Crossfire1 version
927	cache_file "$LIB/crossfire.0", "$VARDIR/tilecache.pst", sub {	932	cache_file "$LIB/crossfire.0", "$VARDIR/tilecache.pst", \&use_tilecache,
928	$TILE = new_from_file Gtk2::Gdk::Pixbuf "$VARDIR/tilecache.png"	933	sub {
929	or die "$VARDIR/tilecache.png: $!";
930	*FACE = $_[0];
931	}, sub {
932	my $tile = read_pak "$LIB/crossfire.0";	934	my $tile = read_pak "$LIB/crossfire.0";
933		935
934	my %cache;	936	my %cache;
935		937
936	my $idx = 0;	938	my $idx = 0;
937		939
938	for my $name (sort keys %$tile) {	940	for my $name (sort keys %$tile) {
939	my $pb = new Gtk2::Gdk::PixbufLoader;	941	my $pb = new Gtk2::Gdk::PixbufLoader;
940	$pb->write ($tile->{$name});	942	$pb->write ($tile->{$name});
941	$pb->close;	943	$pb->close;
942	my $pb = $pb->get_pixbuf;	944	my $pb = $pb->get_pixbuf;
943		945
944	my $tile = $cache{$name} = {	946	my $tile = $cache{$name} = {
945	pb => $pb,	947	pb => $pb,
946	idx => $idx,	948	idx => $idx,
947	w => int $pb->get_width / TILESIZE,	949	w => int $pb->get_width / TILESIZE,
948	h => int $pb->get_height / TILESIZE,	950	h => int $pb->get_height / TILESIZE,
		951	};
		952
		953	$idx += $tile->{w} * $tile->{h};
		954	}
		955
		956	construct_tilecache_pb $idx, \%cache;
		957
		958	\%cache
949	};	959	};
		960
		961	} else { # Crossfire+ version
		962	cache_file "$LIB/facedata", "$VARDIR/tilecache.pst", \&use_tilecache,
		963	sub {
		964	my %cache;
		965	my $facedata = Storable::retrieve "$LIB/facedata";
		966
		967	$facedata->{version} == 2
		968	or die "$LIB/facedata: version mismatch, cannot proceed.";
		969
		970	my $faces = $facedata->{faceinfo};
		971	my $idx = 0;
		972
		973	for (sort keys %$faces) {
		974	my ($face, $info) = ($_, $faces->{$_});
		975
		976	my $pb = new Gtk2::Gdk::PixbufLoader;
		977	$pb->write ($info->{data32});
		978	$pb->close;
		979	my $pb = $pb->get_pixbuf;
		980
		981	my $tile = $cache{$face} = {
		982	pb => $pb,
		983	idx => $idx,
		984	w => int $pb->get_width / TILESIZE,
		985	h => int $pb->get_height / TILESIZE,
950		986	};
951		987
952	$idx += $tile->{w} * $tile->{h};	988	$idx += $tile->{w} * $tile->{h};
953	}
954
955	my $pb = new Gtk2::Gdk::Pixbuf "rgb", 1, 8, 64 * TILESIZE, TILESIZE * int +($idx + 63) / 64;
956
957	while (my ($name, $tile) = each %cache) {
958	my $tpb = delete $tile->{pb};
959	my $ofs = $tile->{idx};
960
961	for my $x (0 .. $tile->{w} - 1) {
962	for my $y (0 .. $tile->{h} - 1) {
963	my $idx = $ofs + $x + $y * $tile->{w};
964	$tpb->copy_area ($x * TILESIZE, $y * TILESIZE, TILESIZE, TILESIZE,
965	$pb, ($idx % 64) * TILESIZE, TILESIZE * int $idx / 64);
966	}	989	}
		990
		991	construct_tilecache_pb $idx, \%cache;
		992
		993	\%cache
967	}	994	};
968	}
969
970	$pb->save ("$VARDIR/tilecache.png", "png", compression => 1);
971
972	\%cache
973	};	995	}
974	}	996	}
975		997
976	=head1 AUTHOR	998	=head1 AUTHOR
977		999
978	Marc Lehmann <schmorp@schmorp.de>	1000	Marc Lehmann <schmorp@schmorp.de>

Diff Legend

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

Comparing deliantra/Deliantra/Deliantra.pm (file contents): Revision 1.85 by root, Wed Feb 7 00:44:18 2007 UTC vs. Revision 1.106 by root, Mon Apr 23 19:09:48 2007 UTC

Diff Legend

Comparing deliantra/Deliantra/Deliantra.pm (file contents):
Revision 1.85 by root, Wed Feb 7 00:44:18 2007 UTC vs.
Revision 1.106 by root, Mon Apr 23 19:09:48 2007 UTC