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.104 by root, Mon Apr 16 12:32:30 2007 UTC vs.
Revision 1.118 by root, Wed Dec 5 11:39:26 2007 UTC

… …
4 4
5=cut 5=cut
6 6
7package Crossfire; 7package Crossfire;
8 8
9our $VERSION = '0.98'; 9our $VERSION = '1.13';
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(decode_json encode_json);
25 28
26our $LIB = $ENV{CROSSFIRE_LIBDIR}; 29our $LIB = $ENV{CROSSFIRE_LIBDIR};
27 30
28our $VARDIR = $ENV{HOME} ? "$ENV{HOME}/.crossfire" 31our $VARDIR = $ENV{HOME} ? "$ENV{HOME}/.crossfire"
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",
… …
58 outdoor temp pressure humid windspeed winddir sky nosmooth 63 outdoor temp pressure humid windspeed winddir sky nosmooth
59 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
60)); 65));
61 66
62our @FIELD_ORDER = (qw( 67our @FIELD_ORDER = (qw(
68 inherit
69
63 elevation 70 elevation
64 71
65 name name_pl custom_name attach title race 72 name name_pl custom_name attach title race
66 slaying skill msg lore other_arch 73 slaying skill msg lore other_arch
67 face animation is_animated 74 face animation is_animated
… …
81 resist_life_stealing resist_disease 88 resist_life_stealing resist_disease
82 89
83 path_attuned path_repelled path_denied material materialname 90 path_attuned path_repelled path_denied material materialname
84 value carrying weight invisible state magic 91 value carrying weight invisible state magic
85 last_heal last_sp last_grace last_eat 92 last_heal last_sp last_grace last_eat
86 connected glow_radius randomitems npx_status npc_program 93 connected glow_radius randomitems tresure_env npx_status npc_program
87 run_away pick_up container will_apply smoothlevel 94 run_away pick_up container will_apply smoothlevel
88 current_weapon_script weapontype tooltype elevation client_type 95 current_weapon_script weapontype tooltype elevation client_type
89 item_power duration range 96 item_power duration range
90 range_modifier duration_modifier dam_modifier gen_sp_armour 97 range_modifier duration_modifier dam_modifier gen_sp_armour
91 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
… …
102 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
103 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
104 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
105 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
106 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
107 115
108 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
109 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
110)); 118));
111 119
… …
128sub MOVE_FLY_LOW (){ 0x02 } 136sub MOVE_FLY_LOW (){ 0x02 }
129sub MOVE_FLY_HIGH (){ 0x04 } 137sub MOVE_FLY_HIGH (){ 0x04 }
130sub MOVE_FLYING (){ 0x06 } 138sub MOVE_FLYING (){ 0x06 }
131sub MOVE_SWIM (){ 0x08 } 139sub MOVE_SWIM (){ 0x08 }
132sub MOVE_BOAT (){ 0x10 } 140sub MOVE_BOAT (){ 0x10 }
141sub MOVE_SHIP (){ 0x20 }
133sub MOVE_KNOWN (){ 0x1f } # all of above 142sub MOVE_KNOWN (){ 0x3f } # all of above
134sub MOVE_ALL (){ 0x10000 } # very special value 143sub MOVE_ALL (){ 0x10000 } # very special value
135 144
136our %MOVE_TYPE = ( 145our %MOVE_TYPE = (
137 walk => MOVE_WALK, 146 walk => MOVE_WALK,
138 fly_low => MOVE_FLY_LOW, 147 fly_low => MOVE_FLY_LOW,
139 fly_high => MOVE_FLY_HIGH, 148 fly_high => MOVE_FLY_HIGH,
140 flying => MOVE_FLYING, 149 flying => MOVE_FLYING,
141 swim => MOVE_SWIM, 150 swim => MOVE_SWIM,
142 boat => MOVE_BOAT, 151 boat => MOVE_BOAT,
152 ship => MOVE_SHIP,
143 all => MOVE_ALL, 153 all => MOVE_ALL,
144); 154);
145 155
146our @MOVE_TYPE = qw(all walk flying fly_low fly_high swim boat); 156our @MOVE_TYPE = keys %MOVE_TYPE;
147 157
148{ 158{
149 package Crossfire::MoveType; 159 package Crossfire::MoveType;
150 160
151 use overload 161 use overload
… …
342 } else { 352 } else {
343 warn "object $ob->{_name} has unknown material ($ob->{material}) set.\n"; 353 warn "object $ob->{_name} has unknown material ($ob->{material}) set.\n";
344 } 354 }
345 } 355 }
346 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
347 # 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
348 $ob->{magicmap} ||= delete $ob->{color_fg} if exists $ob->{color_fg}; 369 $ob->{magicmap} ||= delete $ob->{color_fg} if exists $ob->{color_fg};
349 370
350 # nuke outdated or never supported fields 371 # nuke outdated or never supported fields
351 delete @$ob{qw( 372 delete @$ob{qw(
… …
454} 475}
455 476
456sub attr_thaw($) { 477sub attr_thaw($) {
457 my ($ob) = @_; 478 my ($ob) = @_;
458 479
459 $ob->{attach} = from_json $ob->{attach} 480 $ob->{attach} = decode_json $ob->{attach}
460 if exists $ob->{attach}; 481 if exists $ob->{attach};
461 482
462 $ob 483 $ob
463} 484}
464 485
465sub attr_freeze($) { 486sub attr_freeze($) {
466 my ($ob) = @_; 487 my ($ob) = @_;
467 488
468 $ob->{attach} = Crossfire::to_json $ob->{attach} 489 $ob->{attach} = Crossfire::encode_json $ob->{attach}
469 if exists $ob->{attach}; 490 if exists $ob->{attach};
470 491
471 $ob 492 $ob
472} 493}
473 494
… …
787 808
788 my (%ignore); 809 my (%ignore);
789 my (@section_order, %section, @attr_order); 810 my (@section_order, %section, @attr_order);
790 811
791 while (my $type = shift @import) { 812 while (my $type = shift @import) {
813 push @import,
814 grep $_,
815 map $Crossfire::Data::TYPE{$_},
792 push @import, @{$type->{import} || []}; 816 @{$type->{import} || []};
793 817
794 $attr->{$_} ||= $type->{$_} 818 $attr->{$_} ||= $type->{$_}
795 for qw(name desc use); 819 for qw(name desc use);
796 820
797 for (@{$type->{ignore} || []}) { 821 for (@{$type->{ignore} || []}) {
… …
886} 910}
887 911
888sub construct_tilecache_pb { 912sub construct_tilecache_pb {
889 my ($idx, $cache) = @_; 913 my ($idx, $cache) = @_;
890 914
891 my $pb = new Gtk2::Gdk::Pixbuf "rgb", 1, 8, 64 * TILESIZE, TILESIZE * int +($idx + 63) / 64; 915 my $pb = new Gtk2::Gdk::Pixbuf "rgb", 1, 8, CACHESTRIDE * TILESIZE, TILESIZE * int +($idx + CACHESTRIDE - 1) / CACHESTRIDE;
892 916
893 while (my ($name, $tile) = each %$cache) { 917 while (my ($name, $tile) = each %$cache) {
894 my $tpb = delete $tile->{pb}; 918 my $tpb = delete $tile->{pb};
895 my $ofs = $tile->{idx}; 919 my $ofs = $tile->{idx};
896 920
897 for my $x (0 .. $tile->{w} - 1) { 921 for my $x (0 .. $tile->{w} - 1) {
898 for my $y (0 .. $tile->{h} - 1) { 922 for my $y (0 .. $tile->{h} - 1) {
899 my $idx = $ofs + $x + $y * $tile->{w}; 923 my $idx = $ofs + $x + $y * $tile->{w};
900 $tpb->copy_area ($x * TILESIZE, $y * TILESIZE, TILESIZE, TILESIZE, 924 $tpb->copy_area ($x * TILESIZE, $y * TILESIZE, TILESIZE, TILESIZE,
901 $pb, ($idx % 64) * TILESIZE, TILESIZE * int $idx / 64); 925 $pb, ($idx % CACHESTRIDE) * TILESIZE, TILESIZE * int $idx / CACHESTRIDE);
902 } 926 }
903 } 927 }
904 } 928 }
905 929
906 $pb->save ("$VARDIR/tilecache.png", "png", compression => 1); 930 $pb->save ("$VARDIR/tilecache.png", "png", compression => 1);
… …
922=cut 946=cut
923 947
924sub load_tilecache() { 948sub load_tilecache() {
925 require Gtk2; 949 require Gtk2;
926 950
927 if (-e "$LIB/crossfire.0") { # Crossfire1 version
928 cache_file "$LIB/crossfire.0", "$VARDIR/tilecache.pst", \&use_tilecache,
929 sub {
930 my $tile = read_pak "$LIB/crossfire.0";
931
932 my %cache;
933
934 my $idx = 0;
935
936 for my $name (sort keys %$tile) {
937 my $pb = new Gtk2::Gdk::PixbufLoader;
938 $pb->write ($tile->{$name});
939 $pb->close;
940 my $pb = $pb->get_pixbuf;
941
942 my $tile = $cache{$name} = {
943 pb => $pb,
944 idx => $idx,
945 w => int $pb->get_width / 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
955 };
956
957 } else { # Crossfire+ version
958 cache_file "$LIB/facedata", "$VARDIR/tilecache.pst", \&use_tilecache, 951 cache_file "$LIB/facedata", "$VARDIR/tilecache.pst", \&use_tilecache,
959 sub { 952 sub {
960 my %cache; 953 my %cache;
961 my $facedata = Storable::retrieve "$LIB/facedata"; 954 my $facedata = Storable::retrieve "$LIB/facedata";
962 955
963 $facedata->{version} == 2 956 $facedata->{version} == 2
964 or die "$LIB/facedata: version mismatch, cannot proceed."; 957 or die "$LIB/facedata: version mismatch, cannot proceed.";
965 958
966 my $faces = $facedata->{faceinfo}; 959 my $faces = $facedata->{faceinfo};
967 my $idx = 0; 960 my $idx = 0;
968 961
969 for (sort keys %$faces) { 962 for (sort keys %$faces) {
970 my ($face, $info) = ($_, $faces->{$_}); 963 my ($face, $info) = ($_, $faces->{$_});
971 964
972 my $pb = new Gtk2::Gdk::PixbufLoader; 965 my $pb = new Gtk2::Gdk::PixbufLoader;
973 $pb->write ($info->{data32}); 966 $pb->write ($info->{data32});
974 $pb->close; 967 $pb->close;
975 my $pb = $pb->get_pixbuf; 968 my $pb = $pb->get_pixbuf;
976 969
977 my $tile = $cache{$face} = { 970 my $tile = $cache{$face} = {
978 pb => $pb, 971 pb => $pb,
979 idx => $idx, 972 idx => $idx,
980 w => int $pb->get_width / TILESIZE, 973 w => int $pb->get_width / TILESIZE,
981 h => int $pb->get_height / TILESIZE, 974 h => int $pb->get_height / TILESIZE,
982 }; 975 };
983 976
984 $idx += $tile->{w} * $tile->{h}; 977 $idx += $tile->{w} * $tile->{h};
985 } 978 }
986 979
987 construct_tilecache_pb $idx, \%cache; 980 construct_tilecache_pb $idx, \%cache;
988 981
989 \%cache 982 \%cache
990 }; 983 };
991 }
992} 984}
993 985
994=head1 AUTHOR 986=head1 AUTHOR
995 987
996 Marc Lehmann <schmorp@schmorp.de> 988 Marc Lehmann <schmorp@schmorp.de>
… …
1000 http://www.ta-sa.org/ 992 http://www.ta-sa.org/
1001 993
1002=cut 994=cut
1003 995
10041 9961
997

Diff Legend

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