ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra/Deliantra.pm
(Generate patch)

Comparing deliantra/Deliantra/Deliantra.pm (file contents):
Revision 1.106 by root, Mon Apr 23 19:09:48 2007 UTC vs.
Revision 1.112 by root, Thu Jun 21 00:07:54 2007 UTC

… …
4 4
5=cut 5=cut
6 6
7package Crossfire; 7package Crossfire;
8 8
9our $VERSION = '0.98'; 9our $VERSION = '1.0';
10 10
11use strict; 11use strict;
12 12
13use base 'Exporter'; 13use base 'Exporter';
14 14
… …
16use File::Spec; 16use File::Spec;
17use List::Util qw(min max); 17use List::Util qw(min max);
18use Storable qw(freeze thaw); 18use Storable qw(freeze thaw);
19 19
20our @EXPORT = qw( 20our @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
24use JSON::XS qw(from_json to_json); 27use JSON::XS qw(from_json to_json);
25 28
26our $LIB = $ENV{CROSSFIRE_LIBDIR}; 29our $LIB = $ENV{CROSSFIRE_LIBDIR};
… …
29 : $ENV{AppData} ? "$ENV{APPDATA}/crossfire" 32 : $ENV{AppData} ? "$ENV{APPDATA}/crossfire"
30 : File::Spec->tmpdir . "/crossfire"; 33 : File::Spec->tmpdir . "/crossfire";
31 34
32mkdir $VARDIR, 0777; 35mkdir $VARDIR, 0777;
33 36
34sub TILESIZE (){ 32 } 37sub TILESIZE (){ 32 }
38sub CACHESTRIDE (){ 64 }
35 39
36our %ARCH; 40our %ARCH;
41our %FACE; # face32
37our %FACE; 42our %FACEDATA;
38our $TILE; 43our $TILE;
39 44
40our %FIELD_MULTILINE = ( 45our %FIELD_MULTILINE = (
41 msg => "endmsg", 46 msg => "endmsg",
42 lore => "endlore", 47 lore => "endlore",
… …
83 resist_life_stealing resist_disease 88 resist_life_stealing resist_disease
84 89
85 path_attuned path_repelled path_denied material materialname 90 path_attuned path_repelled path_denied material materialname
86 value carrying weight invisible state magic 91 value carrying weight invisible state magic
87 last_heal last_sp last_grace last_eat 92 last_heal last_sp last_grace last_eat
88 connected glow_radius randomitems npx_status npc_program 93 connected glow_radius randomitems tresure_env npx_status npc_program
89 run_away pick_up container will_apply smoothlevel 94 run_away pick_up container will_apply smoothlevel
90 current_weapon_script weapontype tooltype elevation client_type 95 current_weapon_script weapontype tooltype elevation client_type
91 item_power duration range 96 item_power duration range
92 range_modifier duration_modifier dam_modifier gen_sp_armour 97 range_modifier duration_modifier dam_modifier gen_sp_armour
93 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
… …
104 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
105 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
106 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
107 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
108 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
109 115
110 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
111 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
112)); 118));
113 119
… …
346 } else { 352 } else {
347 warn "object $ob->{_name} has unknown material ($ob->{material}) set.\n"; 353 warn "object $ob->{_name} has unknown material ($ob->{material}) set.\n";
348 } 354 }
349 } 355 }
350 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
351 # color_fg is used as default for magicmap if magicmap does not exist 368 # 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}; 369 $ob->{magicmap} ||= delete $ob->{color_fg} if exists $ob->{color_fg};
353 370
354 # nuke outdated or never supported fields 371 # nuke outdated or never supported fields
355 delete @$ob{qw( 372 delete @$ob{qw(
… …
890} 907}
891 908
892sub construct_tilecache_pb { 909sub construct_tilecache_pb {
893 my ($idx, $cache) = @_; 910 my ($idx, $cache) = @_;
894 911
895 my $pb = new Gtk2::Gdk::Pixbuf "rgb", 1, 8, 64 * TILESIZE, TILESIZE * int +($idx + 63) / 64; 912 my $pb = new Gtk2::Gdk::Pixbuf "rgb", 1, 8, CACHESTRIDE * TILESIZE, TILESIZE * int +($idx + CACHESTRIDE - 1) / CACHESTRIDE;
896 913
897 while (my ($name, $tile) = each %$cache) { 914 while (my ($name, $tile) = each %$cache) {
898 my $tpb = delete $tile->{pb}; 915 my $tpb = delete $tile->{pb};
899 my $ofs = $tile->{idx}; 916 my $ofs = $tile->{idx};
900 917
901 for my $x (0 .. $tile->{w} - 1) { 918 for my $x (0 .. $tile->{w} - 1) {
902 for my $y (0 .. $tile->{h} - 1) { 919 for my $y (0 .. $tile->{h} - 1) {
903 my $idx = $ofs + $x + $y * $tile->{w}; 920 my $idx = $ofs + $x + $y * $tile->{w};
904 $tpb->copy_area ($x * TILESIZE, $y * TILESIZE, TILESIZE, TILESIZE, 921 $tpb->copy_area ($x * TILESIZE, $y * TILESIZE, TILESIZE, TILESIZE,
905 $pb, ($idx % 64) * TILESIZE, TILESIZE * int $idx / 64); 922 $pb, ($idx % CACHESTRIDE) * TILESIZE, TILESIZE * int $idx / CACHESTRIDE);
906 } 923 }
907 } 924 }
908 } 925 }
909 926
910 $pb->save ("$VARDIR/tilecache.png", "png", compression => 1); 927 $pb->save ("$VARDIR/tilecache.png", "png", compression => 1);
… …
926=cut 943=cut
927 944
928sub load_tilecache() { 945sub load_tilecache() {
929 require Gtk2; 946 require Gtk2;
930 947
948 if (-e "$LIB/facedata") { # Crossfire TRT faces
949 cache_file "$LIB/facedata", "$VARDIR/tilecache.pst", \&use_tilecache,
950 sub {
951 my %cache;
952 my $facedata = Storable::retrieve "$LIB/facedata";
953
954 $facedata->{version} == 2
955 or die "$LIB/facedata: version mismatch, cannot proceed.";
956
957 my $faces = $facedata->{faceinfo};
958 my $idx = 0;
959
960 for (sort keys %$faces) {
961 my ($face, $info) = ($_, $faces->{$_});
962
963 my $pb = new Gtk2::Gdk::PixbufLoader;
964 $pb->write ($info->{data32});
965 $pb->close;
966 my $pb = $pb->get_pixbuf;
967
968 my $tile = $cache{$face} = {
969 pb => $pb,
970 idx => $idx,
971 w => int $pb->get_width / 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
981 };
982
983 *FACEDATA = Storable::retrieve "$LIB/facedata";
984
931 if (-e "$LIB/crossfire.0") { # Crossfire1 version 985 } elsif (-e "$LIB/crossfire.0") { # Crossfire1 version
932 cache_file "$LIB/crossfire.0", "$VARDIR/tilecache.pst", \&use_tilecache, 986 cache_file "$LIB/crossfire.0", "$VARDIR/tilecache.pst", \&use_tilecache,
933 sub { 987 sub {
934 my $tile = read_pak "$LIB/crossfire.0"; 988 my $tile = read_pak "$LIB/crossfire.0";
935 989
936 my %cache; 990 my %cache;
… …
956 construct_tilecache_pb $idx, \%cache; 1010 construct_tilecache_pb $idx, \%cache;
957 1011
958 \%cache 1012 \%cache
959 }; 1013 };
960 1014
961 } else { # Crossfire+ version 1015 *FACEDATA = { };
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,
986 };
987
988 $idx += $tile->{w} * $tile->{h};
989 }
990
991 construct_tilecache_pb $idx, \%cache;
992
993 \%cache
994 };
995 } 1016 }
996} 1017}
997 1018
998=head1 AUTHOR 1019=head1 AUTHOR
999 1020
… …
1004 http://www.ta-sa.org/ 1025 http://www.ta-sa.org/
1005 1026
1006=cut 1027=cut
1007 1028
10081 10291
1030

Diff Legend

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