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.121 by root, Mon Apr 14 00:35:17 2008 UTC

1=head1 NAME 1=head1 NAME
2 2
3Crossfire - Crossfire maphandling 3Deliantra - Deliantra suppport module to read/write archetypes, maps etc.
4 4
5=cut 5=cut
6 6
7package Crossfire; 7package Deliantra;
8 8
9our $VERSION = '0.98'; 9our $VERSION = '1.14';
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{DELIANTRA_LIBDIR} || $ENV{CROSSFIRE_LIBDIR};
27 30
28our $VARDIR = $ENV{HOME} ? "$ENV{HOME}/.crossfire" 31our $OLDDIR = $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
35our $VARDIR = $ENV{HOME} ? "$ENV{HOME}/.deliantra"
36 : $ENV{AppData} ? "$ENV{APPDATA}/deliantra"
37 : File::Spec->tmpdir . "/deliantra";
38
32mkdir $VARDIR, 0777; 39mkdir $VARDIR, 0777;
33 40
34sub TILESIZE (){ 32 } 41sub TILESIZE (){ 32 }
42sub CACHESTRIDE (){ 64 }
35 43
36our %ARCH; 44our %ARCH;
45our %FACE; # face32
37our %FACE; 46our %FACEDATA;
38our $TILE; 47our $TILE;
39 48
40our %FIELD_MULTILINE = ( 49our %FIELD_MULTILINE = (
41 msg => "endmsg", 50 msg => "endmsg",
42 lore => "endlore", 51 lore => "endlore",
… …
58 outdoor temp pressure humid windspeed winddir sky nosmooth 67 outdoor temp pressure humid windspeed winddir sky nosmooth
59 tile_path_1 tile_path_2 tile_path_3 tile_path_4 68 tile_path_1 tile_path_2 tile_path_3 tile_path_4
60)); 69));
61 70
62our @FIELD_ORDER = (qw( 71our @FIELD_ORDER = (qw(
72 inherit
73
63 elevation 74 elevation
64 75
65 name name_pl custom_name attach title race 76 name name_pl custom_name attach title race
66 slaying skill msg lore other_arch 77 slaying skill msg lore other_arch
67 face animation is_animated 78 face animation is_animated
… …
81 resist_life_stealing resist_disease 92 resist_life_stealing resist_disease
82 93
83 path_attuned path_repelled path_denied material materialname 94 path_attuned path_repelled path_denied material materialname
84 value carrying weight invisible state magic 95 value carrying weight invisible state magic
85 last_heal last_sp last_grace last_eat 96 last_heal last_sp last_grace last_eat
86 connected glow_radius randomitems npx_status npc_program 97 connected glow_radius randomitems tresure_env npx_status npc_program
87 run_away pick_up container will_apply smoothlevel 98 run_away pick_up container will_apply smoothlevel
88 current_weapon_script weapontype tooltype elevation client_type 99 current_weapon_script weapontype tooltype elevation client_type
89 item_power duration range 100 item_power duration range
90 range_modifier duration_modifier dam_modifier gen_sp_armour 101 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 102 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 113 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 114 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 115 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 116 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 117 activate_on_push activate_on_release is_water use_content_on_gen is_buildable
118 precious
107 119
108 body_range body_arm body_torso body_head body_neck body_skill 120 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 121 body_finger body_shoulder body_foot body_hand body_wrist body_waist
110)); 122));
111 123
… …
128sub MOVE_FLY_LOW (){ 0x02 } 140sub MOVE_FLY_LOW (){ 0x02 }
129sub MOVE_FLY_HIGH (){ 0x04 } 141sub MOVE_FLY_HIGH (){ 0x04 }
130sub MOVE_FLYING (){ 0x06 } 142sub MOVE_FLYING (){ 0x06 }
131sub MOVE_SWIM (){ 0x08 } 143sub MOVE_SWIM (){ 0x08 }
132sub MOVE_BOAT (){ 0x10 } 144sub MOVE_BOAT (){ 0x10 }
145sub MOVE_SHIP (){ 0x20 }
133sub MOVE_KNOWN (){ 0x1f } # all of above 146sub MOVE_KNOWN (){ 0x3f } # all of above
134sub MOVE_ALL (){ 0x10000 } # very special value 147sub MOVE_ALL (){ 0x10000 } # very special value
135 148
136our %MOVE_TYPE = ( 149our %MOVE_TYPE = (
137 walk => MOVE_WALK, 150 walk => MOVE_WALK,
138 fly_low => MOVE_FLY_LOW, 151 fly_low => MOVE_FLY_LOW,
139 fly_high => MOVE_FLY_HIGH, 152 fly_high => MOVE_FLY_HIGH,
140 flying => MOVE_FLYING, 153 flying => MOVE_FLYING,
141 swim => MOVE_SWIM, 154 swim => MOVE_SWIM,
142 boat => MOVE_BOAT, 155 boat => MOVE_BOAT,
156 ship => MOVE_SHIP,
143 all => MOVE_ALL, 157 all => MOVE_ALL,
144); 158);
145 159
146our @MOVE_TYPE = qw(all walk flying fly_low fly_high swim boat); 160our @MOVE_TYPE = keys %MOVE_TYPE;
147 161
148{ 162{
149 package Crossfire::MoveType; 163 package Deliantra::MoveType;
150 164
151 use overload 165 use overload
152 '=' => sub { bless [@{$_[0]}], ref $_[0] }, 166 '=' => sub { bless [@{$_[0]}], ref $_[0] },
153 '""' => \&as_string, 167 '""' => \&as_string,
154 '>=' => sub { $_[0][0] & $MOVE_TYPE{$_[1]} ? $_[0][1] & $MOVE_TYPE{$_[1]} : undef }, 168 '>=' => sub { $_[0][0] & $MOVE_TYPE{$_[1]} ? $_[0][1] & $MOVE_TYPE{$_[1]} : undef },
… …
174 'eq' => sub { "$_[0]" eq "$_[1]" }, 188 'eq' => sub { "$_[0]" eq "$_[1]" },
175 'ne' => sub { "$_[0]" ne "$_[1]" }, 189 'ne' => sub { "$_[0]" ne "$_[1]" },
176 ; 190 ;
177} 191}
178 192
179sub Crossfire::MoveType::new { 193sub Deliantra::MoveType::new {
180 my ($class, $string) = @_; 194 my ($class, $string) = @_;
181 195
182 my $mask; 196 my $mask;
183 my $value; 197 my $value;
184 198
… …
198 } 212 }
199 213
200 (bless [$mask, $value], $class)->normalise 214 (bless [$mask, $value], $class)->normalise
201} 215}
202 216
203sub Crossfire::MoveType::normalise { 217sub Deliantra::MoveType::normalise {
204 my ($self) = @_; 218 my ($self) = @_;
205 219
206 if ($self->[0] & MOVE_ALL) { 220 if ($self->[0] & MOVE_ALL) {
207 my $mask = ~(($self->[1] & MOVE_ALL ? $self->[1] : ~$self->[1]) & $self->[0] & ~MOVE_ALL); 221 my $mask = ~(($self->[1] & MOVE_ALL ? $self->[1] : ~$self->[1]) & $self->[0] & ~MOVE_ALL);
208 $self->[0] &= $mask; 222 $self->[0] &= $mask;
… …
212 $self->[1] &= $self->[0]; 226 $self->[1] &= $self->[0];
213 227
214 $self 228 $self
215} 229}
216 230
217sub Crossfire::MoveType::as_string { 231sub Deliantra::MoveType::as_string {
218 my ($self) = @_; 232 my ($self) = @_;
219 233
220 my @res; 234 my @res;
221 235
222 my ($mask, $value) = @$self; 236 my ($mask, $value) = @$self;
223 237
224 for (@Crossfire::MOVE_TYPE) { 238 for (@Deliantra::MOVE_TYPE) {
225 my $bit = $Crossfire::MOVE_TYPE{$_}; 239 my $bit = $Deliantra::MOVE_TYPE{$_};
226 if (($mask & $bit) == $bit && (($value & $bit) == $bit || ($value & $bit) == 0)) { 240 if (($mask & $bit) == $bit && (($value & $bit) == $bit || ($value & $bit) == 0)) {
227 $mask &= ~$bit; 241 $mask &= ~$bit;
228 push @res, $value & $bit ? $_ : "-$_"; 242 push @res, $value & $bit ? $_ : "-$_";
229 } 243 }
230 } 244 }
… …
342 } else { 356 } else {
343 warn "object $ob->{_name} has unknown material ($ob->{material}) set.\n"; 357 warn "object $ob->{_name} has unknown material ($ob->{material}) set.\n";
344 } 358 }
345 } 359 }
346 360
361 # check whether attachment is the same as in the archetype
362 if (exists $ob->{attach}) {
363 my $arch = $ARCH{$ob->{_name}};
364 my $js = JSON::XS->new->utf8->canonical (1);
365
366 if (defined $arch->{attach}
367 && $js->encode ($js->decode ($ob->{attach})) eq $js->encode ($arch->{attach})) {
368 delete $ob->{attach}
369 }
370 }
371
347 # color_fg is used as default for magicmap if magicmap does not exist 372 # 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}; 373 $ob->{magicmap} ||= delete $ob->{color_fg} if exists $ob->{color_fg};
349 374
350 # nuke outdated or never supported fields 375 # nuke outdated or never supported fields
351 delete @$ob{qw( 376 delete @$ob{qw(
… …
359 384
360 # convert movement strings to bitsets 385 # convert movement strings to bitsets
361 for my $attr (keys %FIELD_MOVEMENT) { 386 for my $attr (keys %FIELD_MOVEMENT) {
362 next unless exists $ob->{$attr}; 387 next unless exists $ob->{$attr};
363 388
364 $ob->{$attr} = new Crossfire::MoveType $ob->{$attr}; 389 $ob->{$attr} = new Deliantra::MoveType $ob->{$attr};
365 } 390 }
366 391
367 # convert outdated movement flags to new movement sets 392 # convert outdated movement flags to new movement sets
368 if (defined (my $v = delete $ob->{no_pass})) { 393 if (defined (my $v = delete $ob->{no_pass})) {
369 $ob->{move_block} = new Crossfire::MoveType $v ? "all" : ""; 394 $ob->{move_block} = new Deliantra::MoveType $v ? "all" : "";
370 } 395 }
371 if (defined (my $v = delete $ob->{slow_move})) { 396 if (defined (my $v = delete $ob->{slow_move})) {
372 $ob->{move_slow} += "walk"; 397 $ob->{move_slow} += "walk";
373 $ob->{move_slow_penalty} = $v; 398 $ob->{move_slow_penalty} = $v;
374 } 399 }
375 if (defined (my $v = delete $ob->{walk_on})) { 400 if (defined (my $v = delete $ob->{walk_on})) {
376 $ob->{move_on} ||= new Crossfire::MoveType; if ($v) { $ob->{move_on} += "walk" } else { $ob->{move_on} -= "walk" } 401 $ob->{move_on} ||= new Deliantra::MoveType; if ($v) { $ob->{move_on} += "walk" } else { $ob->{move_on} -= "walk" }
377 } 402 }
378 if (defined (my $v = delete $ob->{walk_off})) { 403 if (defined (my $v = delete $ob->{walk_off})) {
379 $ob->{move_off} ||= new Crossfire::MoveType; if ($v) { $ob->{move_off} += "walk" } else { $ob->{move_off} -= "walk" } 404 $ob->{move_off} ||= new Deliantra::MoveType; if ($v) { $ob->{move_off} += "walk" } else { $ob->{move_off} -= "walk" }
380 } 405 }
381 if (defined (my $v = delete $ob->{fly_on})) { 406 if (defined (my $v = delete $ob->{fly_on})) {
382 $ob->{move_on} ||= new Crossfire::MoveType; if ($v) { $ob->{move_on} += "fly_low" } else { $ob->{move_on} -= "fly_low" } 407 $ob->{move_on} ||= new Deliantra::MoveType; if ($v) { $ob->{move_on} += "fly_low" } else { $ob->{move_on} -= "fly_low" }
383 } 408 }
384 if (defined (my $v = delete $ob->{fly_off})) { 409 if (defined (my $v = delete $ob->{fly_off})) {
385 $ob->{move_off} ||= new Crossfire::MoveType; if ($v) { $ob->{move_off} += "fly_low" } else { $ob->{move_off} -= "fly_low" } 410 $ob->{move_off} ||= new Deliantra::MoveType; if ($v) { $ob->{move_off} += "fly_low" } else { $ob->{move_off} -= "fly_low" }
386 } 411 }
387 if (defined (my $v = delete $ob->{flying})) { 412 if (defined (my $v = delete $ob->{flying})) {
388 $ob->{move_type} ||= new Crossfire::MoveType; if ($v) { $ob->{move_type} += "fly_low" } else { $ob->{move_type} -= "fly_low" } 413 $ob->{move_type} ||= new Deliantra::MoveType; if ($v) { $ob->{move_type} += "fly_low" } else { $ob->{move_type} -= "fly_low" }
389 } 414 }
390 415
391 # convert idiotic event_xxx things into objects 416 # convert idiotic event_xxx things into objects
392 while (my ($event, $subtype) = each %EVENT_TYPE) { 417 while (my ($event, $subtype) = each %EVENT_TYPE) {
393 if (exists $ob->{"event_${event}_plugin"}) { 418 if (exists $ob->{"event_${event}_plugin"}) {
… …
454} 479}
455 480
456sub attr_thaw($) { 481sub attr_thaw($) {
457 my ($ob) = @_; 482 my ($ob) = @_;
458 483
459 $ob->{attach} = from_json $ob->{attach} 484 $ob->{attach} = decode_json $ob->{attach}
460 if exists $ob->{attach}; 485 if exists $ob->{attach};
461 486
462 $ob 487 $ob
463} 488}
464 489
465sub attr_freeze($) { 490sub attr_freeze($) {
466 my ($ob) = @_; 491 my ($ob) = @_;
467 492
468 $ob->{attach} = Crossfire::to_json $ob->{attach} 493 $ob->{attach} = JSON::XS->new->utf8->canonical->encode ($ob->{attach})
469 if exists $ob->{attach}; 494 if exists $ob->{attach};
470 495
471 $ob 496 $ob
472} 497}
473 498
… …
603 my $str; 628 my $str;
604 629
605 my $append; $append = sub { 630 my $append; $append = sub {
606 my %a = %{$_[0]}; 631 my %a = %{$_[0]};
607 632
608 Crossfire::attr_freeze \%a; 633 Deliantra::attr_freeze \%a;
609 Crossfire::normalize_arch \%a; 634 Deliantra::normalize_arch \%a;
610 635
611 # undo the bit-split we did before 636 # undo the bit-split we did before
612 if (exists $a{attack_movement_bits_0_3} or exists $a{attack_movement_bits_4_7}) { 637 if (exists $a{attack_movement_bits_0_3} or exists $a{attack_movement_bits_4_7}) {
613 $a{attack_movement} = (delete $a{attack_movement_bits_0_3}) 638 $a{attack_movement} = (delete $a{attack_movement_bits_0_3})
614 | (delete $a{attack_movement_bits_4_7}); 639 | (delete $a{attack_movement_bits_4_7});
… …
632 } 657 }
633 658
634 my @kv; 659 my @kv;
635 660
636 for ($a{_name} eq "map" 661 for ($a{_name} eq "map"
637 ? @Crossfire::FIELD_ORDER_MAP 662 ? @Deliantra::FIELD_ORDER_MAP
638 : @Crossfire::FIELD_ORDER) { 663 : @Deliantra::FIELD_ORDER) {
639 push @kv, [$_, delete $a{$_}] 664 push @kv, [$_, delete $a{$_}]
640 if exists $a{$_}; 665 if exists $a{$_};
641 } 666 }
642 667
643 for (sort keys %a) { 668 for (sort keys %a) {
… …
646 } 671 }
647 672
648 for (@kv) { 673 for (@kv) {
649 my ($k, $v) = @$_; 674 my ($k, $v) = @$_;
650 675
651 if (my $end = $Crossfire::FIELD_MULTILINE{$k}) { 676 if (my $end = $Deliantra::FIELD_MULTILINE{$k}) {
652 $v =~ s/\n$//; 677 $v =~ s/\n$//;
653 $str .= "$k\n$v\n$end\n"; 678 $str .= "$k\n$v\n$end\n";
654 } else { 679 } else {
655 $str .= "$k $v\n"; 680 $str .= "$k $v\n";
656 } 681 }
… …
752=cut 777=cut
753 778
754sub arch_attr($) { 779sub arch_attr($) {
755 my ($obj) = @_; 780 my ($obj) = @_;
756 781
757 require Crossfire::Data; 782 require Deliantra::Data;
758 783
759 my $root; 784 my $root;
760 my $attr = { }; 785 my $attr = { };
761 786
762 my $arch = $ARCH{ $obj->{_name} }; 787 my $arch = $ARCH{ $obj->{_name} };
763 my $type = $obj->{type} || $arch->{type}; 788 my $type = $obj->{type} || $arch->{type};
764 789
765 if ($type > 0) { 790 if ($type > 0) {
766 $root = $Crossfire::Data::ATTR{$type}; 791 $root = $Deliantra::Data::ATTR{$type};
767 } else { 792 } else {
768 my %a = (%$arch, %$obj); 793 my %a = (%$arch, %$obj);
769 794
770 if ($a{is_floor} && !$a{alive}) { 795 if ($a{is_floor} && !$a{alive}) {
771 $root = $Crossfire::Data::TYPE{Floor}; 796 $root = $Deliantra::Data::TYPE{Floor};
772 } elsif (!$a{is_floor} && $a{alive} && !$a{tear_down}) { 797 } elsif (!$a{is_floor} && $a{alive} && !$a{tear_down}) {
773 $root = $Crossfire::Data::TYPE{"Monster & NPC"}; 798 $root = $Deliantra::Data::TYPE{"Monster & NPC"};
774 } elsif (!$a{is_floor} && !$a{alive} && $a{move_block}) { 799 } elsif (!$a{is_floor} && !$a{alive} && $a{move_block}) {
775 $root = $Crossfire::Data::TYPE{Wall}; 800 $root = $Deliantra::Data::TYPE{Wall};
776 } elsif (!$a{is_floor} && $a{alive} && $a{tear_down}) { 801 } elsif (!$a{is_floor} && $a{alive} && $a{tear_down}) {
777 $root = $Crossfire::Data::TYPE{"Weak Wall"}; 802 $root = $Deliantra::Data::TYPE{"Weak Wall"};
778 } else { 803 } else {
779 $root = $Crossfire::Data::TYPE{Misc}; 804 $root = $Deliantra::Data::TYPE{Misc};
780 } 805 }
781 } 806 }
782 807
783 my @import = ($root); 808 my @import = ($root);
784 809
785 unshift @import, \%Crossfire::Data::DEFAULT_ATTR 810 unshift @import, \%Deliantra::Data::DEFAULT_ATTR
786 unless $type == 116; 811 unless $type == 116;
787 812
788 my (%ignore); 813 my (%ignore);
789 my (@section_order, %section, @attr_order); 814 my (@section_order, %section, @attr_order);
790 815
791 while (my $type = shift @import) { 816 while (my $type = shift @import) {
817 push @import,
818 grep $_,
819 map $Deliantra::Data::TYPE{$_},
792 push @import, @{$type->{import} || []}; 820 @{$type->{import} || []};
793 821
794 $attr->{$_} ||= $type->{$_} 822 $attr->{$_} ||= $type->{$_}
795 for qw(name desc use); 823 for qw(name desc use);
796 824
797 for (@{$type->{ignore} || []}) { 825 for (@{$type->{ignore} || []}) {
… …
886} 914}
887 915
888sub construct_tilecache_pb { 916sub construct_tilecache_pb {
889 my ($idx, $cache) = @_; 917 my ($idx, $cache) = @_;
890 918
891 my $pb = new Gtk2::Gdk::Pixbuf "rgb", 1, 8, 64 * TILESIZE, TILESIZE * int +($idx + 63) / 64; 919 my $pb = new Gtk2::Gdk::Pixbuf "rgb", 1, 8, CACHESTRIDE * TILESIZE, TILESIZE * int +($idx + CACHESTRIDE - 1) / CACHESTRIDE;
892 920
893 while (my ($name, $tile) = each %$cache) { 921 while (my ($name, $tile) = each %$cache) {
894 my $tpb = delete $tile->{pb}; 922 my $tpb = delete $tile->{pb};
895 my $ofs = $tile->{idx}; 923 my $ofs = $tile->{idx};
896 924
897 for my $x (0 .. $tile->{w} - 1) { 925 for my $x (0 .. $tile->{w} - 1) {
898 for my $y (0 .. $tile->{h} - 1) { 926 for my $y (0 .. $tile->{h} - 1) {
899 my $idx = $ofs + $x + $y * $tile->{w}; 927 my $idx = $ofs + $x + $y * $tile->{w};
900 $tpb->copy_area ($x * TILESIZE, $y * TILESIZE, TILESIZE, TILESIZE, 928 $tpb->copy_area ($x * TILESIZE, $y * TILESIZE, TILESIZE, TILESIZE,
901 $pb, ($idx % 64) * TILESIZE, TILESIZE * int $idx / 64); 929 $pb, ($idx % CACHESTRIDE) * TILESIZE, TILESIZE * int $idx / CACHESTRIDE);
902 } 930 }
903 } 931 }
904 } 932 }
905 933
906 $pb->save ("$VARDIR/tilecache.png", "png", compression => 1); 934 $pb->save ("$VARDIR/tilecache.png", "png", compression => 1);
… …
922=cut 950=cut
923 951
924sub load_tilecache() { 952sub load_tilecache() {
925 require Gtk2; 953 require Gtk2;
926 954
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, 955 cache_file "$LIB/facedata", "$VARDIR/tilecache.pst", \&use_tilecache,
959 sub { 956 sub {
960 my %cache; 957 my %cache;
961 my $facedata = Storable::retrieve "$LIB/facedata"; 958 my $facedata = Storable::retrieve "$LIB/facedata";
962 959
963 $facedata->{version} == 2 960 $facedata->{version} == 2
964 or die "$LIB/facedata: version mismatch, cannot proceed."; 961 or die "$LIB/facedata: version mismatch, cannot proceed.";
965 962
966 my $faces = $facedata->{faceinfo}; 963 my $faces = $facedata->{faceinfo};
967 my $idx = 0; 964 my $idx = 0;
968 965
969 for (sort keys %$faces) { 966 for (sort keys %$faces) {
970 my ($face, $info) = ($_, $faces->{$_}); 967 my ($face, $info) = ($_, $faces->{$_});
971 968
972 my $pb = new Gtk2::Gdk::PixbufLoader; 969 my $pb = new Gtk2::Gdk::PixbufLoader;
973 $pb->write ($info->{data32}); 970 $pb->write ($info->{data32});
974 $pb->close; 971 $pb->close;
975 my $pb = $pb->get_pixbuf; 972 my $pb = $pb->get_pixbuf;
976 973
977 my $tile = $cache{$face} = { 974 my $tile = $cache{$face} = {
978 pb => $pb, 975 pb => $pb,
979 idx => $idx, 976 idx => $idx,
980 w => int $pb->get_width / TILESIZE, 977 w => int $pb->get_width / TILESIZE,
981 h => int $pb->get_height / TILESIZE, 978 h => int $pb->get_height / TILESIZE,
982 }; 979 };
983 980
984 $idx += $tile->{w} * $tile->{h}; 981 $idx += $tile->{w} * $tile->{h};
985 } 982 }
986 983
987 construct_tilecache_pb $idx, \%cache; 984 construct_tilecache_pb $idx, \%cache;
988 985
989 \%cache 986 \%cache
990 }; 987 };
991 }
992} 988}
993 989
994=head1 AUTHOR 990=head1 AUTHOR
995 991
996 Marc Lehmann <schmorp@schmorp.de> 992 Marc Lehmann <schmorp@schmorp.de>
… …
1000 http://www.ta-sa.org/ 996 http://www.ta-sa.org/
1001 997
1002=cut 998=cut
1003 999
10041 10001
1001

Diff Legend

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