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.102 by elmex, Sun Apr 15 11:43:03 2007 UTC vs.
Revision 1.120 by root, Wed Dec 26 18:26:15 2007 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 is_animated animation face 78 face animation is_animated
68 magicmap smoothlevel smoothface 79 magicmap smoothlevel smoothface
69 str dex con wis pow cha int 80 str dex con wis pow cha int
70 hp maxhp sp maxsp grace maxgrace 81 hp maxhp sp maxsp grace maxgrace
71 exp perm_exp expmul 82 exp perm_exp expmul
72 food dam luck wc ac x y speed speed_left move_state attack_movement 83 food dam luck wc ac x y speed speed_left move_state attack_movement
… …
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} = Deliantra::encode_json $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