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

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

Diff Legend

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

Comparing deliantra/Deliantra/Deliantra.pm (file contents): Revision 1.87 by root, Fri Feb 9 01:49:35 2007 UTC vs. Revision 1.104 by root, Mon Apr 16 12:32:30 2007 UTC

Diff Legend

Comparing deliantra/Deliantra/Deliantra.pm (file contents):
Revision 1.87 by root, Fri Feb 9 01:49:35 2007 UTC vs.
Revision 1.104 by root, Mon Apr 16 12:32:30 2007 UTC