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

Comparing deliantra/Deliantra/Deliantra.pm (file contents):
Revision 1.95 by root, Mon Mar 5 01:10:30 2007 UTC vs.
Revision 1.112 by root, Thu Jun 21 00:07:54 2007 UTC

…		…
4		4
5	=cut	5	=cut
6		6
7	package Crossfire;	7	package Crossfire;
8		8
9	our $VERSION = '0.97';	9	our $VERSION = '1.0';
10		10
11	use strict;	11	use strict;
12		12
13	use base 'Exporter';	13	use base 'Exporter';
14		14
…		…
16	use File::Spec;	16	use File::Spec;
17	use List::Util qw(min max);	17	use List::Util qw(min max);
18	use Storable qw(freeze thaw);	18	use Storable qw(freeze thaw);
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
		22	ARCH $TILE FACE *FACEDATA
		23	TILESIZE CACHESTRIDE
		24	editor_archs arch_extents
22	);	25	);
23		26
24	use JSON::Syck (); #TODO#d# replace by JSON::PC when it becomes available == working	27	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		28
36	our $LIB = $ENV{CROSSFIRE_LIBDIR};	29	our $LIB = $ENV{CROSSFIRE_LIBDIR};
37		30
38	our $VARDIR = $ENV{HOME} ? "$ENV{HOME}/.crossfire"	31	our $VARDIR = $ENV{HOME} ? "$ENV{HOME}/.crossfire"
39	: $ENV{AppData} ? "$ENV{APPDATA}/crossfire"	32	: $ENV{AppData} ? "$ENV{APPDATA}/crossfire"
40	: File::Spec->tmpdir . "/crossfire";	33	: File::Spec->tmpdir . "/crossfire";
41		34
42	mkdir $VARDIR, 0777;	35	mkdir $VARDIR, 0777;
43		36
44	sub TILESIZE (){ 32 }	37	sub TILESIZE (){ 32 }
		38	sub CACHESTRIDE (){ 64 }
45		39
46	our %ARCH;	40	our %ARCH;
		41	our %FACE; # face32
47	our %FACE;	42	our %FACEDATA;
48	our $TILE;	43	our $TILE;
49		44
50	our %FIELD_MULTILINE = (	45	our %FIELD_MULTILINE = (
51	msg => "endmsg",	46	msg => "endmsg",
52	lore => "endlore",	47	lore => "endlore",
…		…
68	outdoor temp pressure humid windspeed winddir sky nosmooth	63	outdoor temp pressure humid windspeed winddir sky nosmooth
69	tile_path_1 tile_path_2 tile_path_3 tile_path_4	64	tile_path_1 tile_path_2 tile_path_3 tile_path_4
70	));	65	));
71		66
72	our @FIELD_ORDER = (qw(	67	our @FIELD_ORDER = (qw(
		68	inherit
		69
73	elevation	70	elevation
74		71
75	name name_pl custom_name attach title race	72	name name_pl custom_name attach title race
76	slaying skill msg lore other_arch face	73	slaying skill msg lore other_arch
77	#todo-events
78	animation is_animated	74	face animation is_animated
		75	magicmap smoothlevel smoothface
79	str dex con wis pow cha int	76	str dex con wis pow cha int
80	hp maxhp sp maxsp grace maxgrace	77	hp maxhp sp maxsp grace maxgrace
81	exp perm_exp expmul	78	exp perm_exp expmul
82	food dam luck wc ac x y speed speed_left move_state attack_movement	79	food dam luck wc ac x y speed speed_left move_state attack_movement
83	nrof level direction type subtype attacktype	80	nrof level direction type subtype attacktype
…		…
91	resist_life_stealing resist_disease	88	resist_life_stealing resist_disease
92		89
93	path_attuned path_repelled path_denied material materialname	90	path_attuned path_repelled path_denied material materialname
94	value carrying weight invisible state magic	91	value carrying weight invisible state magic
95	last_heal last_sp last_grace last_eat	92	last_heal last_sp last_grace last_eat
96	connected glow_radius randomitems npx_status npc_program	93	connected glow_radius randomitems tresure_env npx_status npc_program
97	run_away pick_up container will_apply smoothlevel	94	run_away pick_up container will_apply smoothlevel
98	current_weapon_script weapontype tooltype elevation client_type	95	current_weapon_script weapontype tooltype elevation client_type
99	item_power duration range	96	item_power duration range
100	range_modifier duration_modifier dam_modifier gen_sp_armour	97	range_modifier duration_modifier dam_modifier gen_sp_armour
101	move_type move_block move_allow move_on move_off move_on move_slow move_slow_penalty	98	move_type move_block move_allow move_on move_off move_on move_slow move_slow_penalty
…		…
112	known_magical known_cursed can_use_skill been_applied has_ready_scroll	109	known_magical known_cursed can_use_skill been_applied has_ready_scroll
113	can_use_rod can_use_horn make_invisible inv_locked is_wooded is_hilly	110	can_use_rod can_use_horn make_invisible inv_locked is_wooded is_hilly
114	has_ready_skill has_ready_weapon no_skill_ident is_blind can_see_in_dark	111	has_ready_skill has_ready_weapon no_skill_ident is_blind can_see_in_dark
115	is_cauldron is_dust no_steal one_hit berserk neutral no_attack no_damage	112	is_cauldron is_dust no_steal one_hit berserk neutral no_attack no_damage
116	activate_on_push activate_on_release is_water use_content_on_gen is_buildable	113	activate_on_push activate_on_release is_water use_content_on_gen is_buildable
		114	precious
117		115
118	body_range body_arm body_torso body_head body_neck body_skill	116	body_range body_arm body_torso body_head body_neck body_skill
119	body_finger body_shoulder body_foot body_hand body_wrist body_waist	117	body_finger body_shoulder body_foot body_hand body_wrist body_waist
120	));	118	));
121		119
…		…
138	sub MOVE_FLY_LOW (){ 0x02 }	136	sub MOVE_FLY_LOW (){ 0x02 }
139	sub MOVE_FLY_HIGH (){ 0x04 }	137	sub MOVE_FLY_HIGH (){ 0x04 }
140	sub MOVE_FLYING (){ 0x06 }	138	sub MOVE_FLYING (){ 0x06 }
141	sub MOVE_SWIM (){ 0x08 }	139	sub MOVE_SWIM (){ 0x08 }
142	sub MOVE_BOAT (){ 0x10 }	140	sub MOVE_BOAT (){ 0x10 }
		141	sub MOVE_SHIP (){ 0x20 }
143	sub MOVE_KNOWN (){ 0x1f } # all of above	142	sub MOVE_KNOWN (){ 0x3f } # all of above
144	sub MOVE_ALL (){ 0x10000 } # very special value	143	sub MOVE_ALL (){ 0x10000 } # very special value
145		144
146	our %MOVE_TYPE = (	145	our %MOVE_TYPE = (
147	walk => MOVE_WALK,	146	walk => MOVE_WALK,
148	fly_low => MOVE_FLY_LOW,	147	fly_low => MOVE_FLY_LOW,
149	fly_high => MOVE_FLY_HIGH,	148	fly_high => MOVE_FLY_HIGH,
150	flying => MOVE_FLYING,	149	flying => MOVE_FLYING,
151	swim => MOVE_SWIM,	150	swim => MOVE_SWIM,
152	boat => MOVE_BOAT,	151	boat => MOVE_BOAT,
		152	ship => MOVE_SHIP,
153	all => MOVE_ALL,	153	all => MOVE_ALL,
154	);	154	);
155		155
156	our @MOVE_TYPE = qw(all walk flying fly_low fly_high swim boat);	156	our @MOVE_TYPE = keys %MOVE_TYPE;
157		157
158	{	158	{
159	package Crossfire::MoveType;	159	package Crossfire::MoveType;
160		160
161	use overload	161	use overload
…		…
352	} else {	352	} else {
353	warn "object $ob->{_name} has unknown material ($ob->{material}) set.\n";	353	warn "object $ob->{_name} has unknown material ($ob->{material}) set.\n";
354	}	354	}
355	}	355	}
356		356
		357	# check whether attachment is the same as in the archetype
		358	if (exists $ob->{attach}) {
		359	my $arch = $ARCH{$ob->{_name}};
		360	my $js = JSON::XS->new->utf8->canonical (1);
		361
		362	if (defined $arch->{attach}
		363	&& $js->encode ($js->decode ($ob->{attach})) eq $js->encode ($arch->{attach})) {
		364	delete $ob->{attach}
		365	}
		366	}
		367
		368	# color_fg is used as default for magicmap if magicmap does not exist
		369	$ob->{magicmap} \|\|= delete $ob->{color_fg} if exists $ob->{color_fg};
		370
357	# nuke outdated or never supported fields	371	# nuke outdated or never supported fields
358	delete @$ob{qw(	372	delete @$ob{qw(
359	can_knockback can_parry can_impale can_cut can_dam_armour	373	can_knockback can_parry can_impale can_cut can_dam_armour
360	can_apply pass_thru can_pass_thru	374	can_apply pass_thru can_pass_thru color_bg color_fg
361	)};	375	)};
362		376
363	if (my $mask = delete $ob->{immune} ) { _add_resist $ob, $mask, 100; }	377	if (my $mask = delete $ob->{immune} ) { _add_resist $ob, $mask, 100; }
364	if (my $mask = delete $ob->{protected} ) { _add_resist $ob, $mask, 30; }	378	if (my $mask = delete $ob->{protected} ) { _add_resist $ob, $mask, 30; }
365	if (my $mask = delete $ob->{vulnerable}) { _add_resist $ob, $mask, -100; }	379	if (my $mask = delete $ob->{vulnerable}) { _add_resist $ob, $mask, -100; }
…		…
890	}, sub {	904	}, sub {
891	read_arch "$LIB/archetypes"	905	read_arch "$LIB/archetypes"
892	};	906	};
893	}	907	}
894		908
		909	sub construct_tilecache_pb {
		910	my ($idx, $cache) = @_;
		911
		912	my $pb = new Gtk2::Gdk::Pixbuf "rgb", 1, 8, CACHESTRIDE * TILESIZE, TILESIZE * int +($idx + CACHESTRIDE - 1) / CACHESTRIDE;
		913
		914	while (my ($name, $tile) = each %$cache) {
		915	my $tpb = delete $tile->{pb};
		916	my $ofs = $tile->{idx};
		917
		918	for my $x (0 .. $tile->{w} - 1) {
		919	for my $y (0 .. $tile->{h} - 1) {
		920	my $idx = $ofs + $x + $y * $tile->{w};
		921	$tpb->copy_area ($x * TILESIZE, $y * TILESIZE, TILESIZE, TILESIZE,
		922	$pb, ($idx % CACHESTRIDE) * TILESIZE, TILESIZE * int $idx / CACHESTRIDE);
		923	}
		924	}
		925	}
		926
		927	$pb->save ("$VARDIR/tilecache.png", "png", compression => 1);
		928
		929	$cache
		930	}
		931
		932	sub use_tilecache {
		933	my ($face) = @_;
		934	$TILE = new_from_file Gtk2::Gdk::Pixbuf "$VARDIR/tilecache.png"
		935	or die "$VARDIR/tilecache.png: $!";
		936	*FACE = $_[0];
		937	}
		938
895	=item load_tilecache	939	=item load_tilecache
896		940
897	(Re-)Load %TILE and %FACE.	941	(Re-)Load %TILE and %FACE.
898		942
899	=cut	943	=cut
900		944
901	sub load_tilecache() {	945	sub load_tilecache() {
902	require Gtk2;	946	require Gtk2;
903		947
904	cache_file "$LIB/crossfire.0", "$VARDIR/tilecache.pst", sub {	948	if (-e "$LIB/facedata") { # Crossfire TRT faces
905	$TILE = new_from_file Gtk2::Gdk::Pixbuf "$VARDIR/tilecache.png"	949	cache_file "$LIB/facedata", "$VARDIR/tilecache.pst", \&use_tilecache,
906	or die "$VARDIR/tilecache.png: $!";	950	sub {
907	*FACE = $_[0];
908	}, sub {
909	my $tile = read_pak "$LIB/crossfire.0";
910
911	my %cache;	951	my %cache;
		952	my $facedata = Storable::retrieve "$LIB/facedata";
912		953
		954	$facedata->{version} == 2
		955	or die "$LIB/facedata: version mismatch, cannot proceed.";
		956
		957	my $faces = $facedata->{faceinfo};
913	my $idx = 0;	958	my $idx = 0;
914		959
915	for my $name (sort keys %$tile) {	960	for (sort keys %$faces) {
		961	my ($face, $info) = ($_, $faces->{$_});
		962
916	my $pb = new Gtk2::Gdk::PixbufLoader;	963	my $pb = new Gtk2::Gdk::PixbufLoader;
917	$pb->write ($tile->{$name});	964	$pb->write ($info->{data32});
918	$pb->close;	965	$pb->close;
919	my $pb = $pb->get_pixbuf;	966	my $pb = $pb->get_pixbuf;
920		967
921	my $tile = $cache{$name} = {	968	my $tile = $cache{$face} = {
922	pb => $pb,	969	pb => $pb,
923	idx => $idx,	970	idx => $idx,
924	w => int $pb->get_width / TILESIZE,	971	w => int $pb->get_width / TILESIZE,
925	h => int $pb->get_height / TILESIZE,	972	h => int $pb->get_height / TILESIZE,
		973	};
		974
		975	$idx += $tile->{w} * $tile->{h};
		976	}
		977
		978	construct_tilecache_pb $idx, \%cache;
		979
		980	\%cache
926	};	981	};
		982
		983	*FACEDATA = Storable::retrieve "$LIB/facedata";
		984
		985	} elsif (-e "$LIB/crossfire.0") { # Crossfire1 version
		986	cache_file "$LIB/crossfire.0", "$VARDIR/tilecache.pst", \&use_tilecache,
		987	sub {
		988	my $tile = read_pak "$LIB/crossfire.0";
		989
		990	my %cache;
		991
		992	my $idx = 0;
		993
		994	for my $name (sort keys %$tile) {
		995	my $pb = new Gtk2::Gdk::PixbufLoader;
		996	$pb->write ($tile->{$name});
		997	$pb->close;
		998	my $pb = $pb->get_pixbuf;
		999
		1000	my $tile = $cache{$name} = {
		1001	pb => $pb,
		1002	idx => $idx,
		1003	w => int $pb->get_width / TILESIZE,
		1004	h => int $pb->get_height / TILESIZE,
927		1005	};
928		1006
929	$idx += $tile->{w} * $tile->{h};	1007	$idx += $tile->{w} * $tile->{h};
930	}
931
932	my $pb = new Gtk2::Gdk::Pixbuf "rgb", 1, 8, 64 * TILESIZE, TILESIZE * int +($idx + 63) / 64;
933
934	while (my ($name, $tile) = each %cache) {
935	my $tpb = delete $tile->{pb};
936	my $ofs = $tile->{idx};
937
938	for my $x (0 .. $tile->{w} - 1) {
939	for my $y (0 .. $tile->{h} - 1) {
940	my $idx = $ofs + $x + $y * $tile->{w};
941	$tpb->copy_area ($x * TILESIZE, $y * TILESIZE, TILESIZE, TILESIZE,
942	$pb, ($idx % 64) * TILESIZE, TILESIZE * int $idx / 64);
943	}	1008	}
		1009
		1010	construct_tilecache_pb $idx, \%cache;
		1011
		1012	\%cache
944	}	1013	};
945	}
946		1014
947	$pb->save ("$VARDIR/tilecache.png", "png", compression => 1);	1015	*FACEDATA = { };
948
949	\%cache
950	};	1016	}
951	}	1017	}
952		1018
953	=head1 AUTHOR	1019	=head1 AUTHOR
954		1020
955	Marc Lehmann <schmorp@schmorp.de>	1021	Marc Lehmann <schmorp@schmorp.de>
…		…
959	http://www.ta-sa.org/	1025	http://www.ta-sa.org/
960		1026
961	=cut	1027	=cut
962		1028
963	1	1029	1
		1030

Diff Legend

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

Comparing deliantra/Deliantra/Deliantra.pm (file contents): Revision 1.95 by root, Mon Mar 5 01:10:30 2007 UTC vs. Revision 1.112 by root, Thu Jun 21 00:07:54 2007 UTC

Diff Legend

Comparing deliantra/Deliantra/Deliantra.pm (file contents):
Revision 1.95 by root, Mon Mar 5 01:10:30 2007 UTC vs.
Revision 1.112 by root, Thu Jun 21 00:07:54 2007 UTC