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.105 by root, Tue Apr 17 18:50:41 2007 UTC vs.
Revision 1.127 by root, Mon Sep 15 23:39:13 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.222';
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};
27 30
28our $VARDIR = $ENV{HOME} ? "$ENV{HOME}/.crossfire" 31our $VARDIR = $ENV{HOME} ? "$ENV{HOME}/.deliantra"
29 : $ENV{AppData} ? "$ENV{APPDATA}/crossfire" 32 : $ENV{AppData} ? "$ENV{APPDATA}/deliantra"
30 : File::Spec->tmpdir . "/crossfire"; 33 : File::Spec->tmpdir . "/deliantra";
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
… …
130sub MOVE_FLY_LOW (){ 0x02 } 136sub MOVE_FLY_LOW (){ 0x02 }
131sub MOVE_FLY_HIGH (){ 0x04 } 137sub MOVE_FLY_HIGH (){ 0x04 }
132sub MOVE_FLYING (){ 0x06 } 138sub MOVE_FLYING (){ 0x06 }
133sub MOVE_SWIM (){ 0x08 } 139sub MOVE_SWIM (){ 0x08 }
134sub MOVE_BOAT (){ 0x10 } 140sub MOVE_BOAT (){ 0x10 }
141sub MOVE_SHIP (){ 0x20 }
135sub MOVE_KNOWN (){ 0x1f } # all of above 142sub MOVE_KNOWN (){ 0x3f } # all of above
136sub MOVE_ALL (){ 0x10000 } # very special value 143sub MOVE_ALL (){ 0x10000 } # very special value
137 144
138our %MOVE_TYPE = ( 145our %MOVE_TYPE = (
139 walk => MOVE_WALK, 146 walk => MOVE_WALK,
140 fly_low => MOVE_FLY_LOW, 147 fly_low => MOVE_FLY_LOW,
141 fly_high => MOVE_FLY_HIGH, 148 fly_high => MOVE_FLY_HIGH,
142 flying => MOVE_FLYING, 149 flying => MOVE_FLYING,
143 swim => MOVE_SWIM, 150 swim => MOVE_SWIM,
144 boat => MOVE_BOAT, 151 boat => MOVE_BOAT,
152 ship => MOVE_SHIP,
145 all => MOVE_ALL, 153 all => MOVE_ALL,
146); 154);
147 155
148our @MOVE_TYPE = qw(all walk flying fly_low fly_high swim boat); 156our @MOVE_TYPE = keys %MOVE_TYPE;
149 157
150{ 158{
151 package Crossfire::MoveType; 159 package Deliantra::MoveType;
152 160
153 use overload 161 use overload
154 '=' => sub { bless [@{$_[0]}], ref $_[0] }, 162 '=' => sub { bless [@{$_[0]}], ref $_[0] },
155 '""' => \&as_string, 163 '""' => \&as_string,
156 '>=' => sub { $_[0][0] & $MOVE_TYPE{$_[1]} ? $_[0][1] & $MOVE_TYPE{$_[1]} : undef }, 164 '>=' => sub { $_[0][0] & $MOVE_TYPE{$_[1]} ? $_[0][1] & $MOVE_TYPE{$_[1]} : undef },
… …
176 'eq' => sub { "$_[0]" eq "$_[1]" }, 184 'eq' => sub { "$_[0]" eq "$_[1]" },
177 'ne' => sub { "$_[0]" ne "$_[1]" }, 185 'ne' => sub { "$_[0]" ne "$_[1]" },
178 ; 186 ;
179} 187}
180 188
181sub Crossfire::MoveType::new { 189sub Deliantra::MoveType::new {
182 my ($class, $string) = @_; 190 my ($class, $string) = @_;
183 191
184 my $mask; 192 my $mask;
185 my $value; 193 my $value;
186 194
… …
200 } 208 }
201 209
202 (bless [$mask, $value], $class)->normalise 210 (bless [$mask, $value], $class)->normalise
203} 211}
204 212
205sub Crossfire::MoveType::normalise { 213sub Deliantra::MoveType::normalise {
206 my ($self) = @_; 214 my ($self) = @_;
207 215
208 if ($self->[0] & MOVE_ALL) { 216 if ($self->[0] & MOVE_ALL) {
209 my $mask = ~(($self->[1] & MOVE_ALL ? $self->[1] : ~$self->[1]) & $self->[0] & ~MOVE_ALL); 217 my $mask = ~(($self->[1] & MOVE_ALL ? $self->[1] : ~$self->[1]) & $self->[0] & ~MOVE_ALL);
210 $self->[0] &= $mask; 218 $self->[0] &= $mask;
… …
214 $self->[1] &= $self->[0]; 222 $self->[1] &= $self->[0];
215 223
216 $self 224 $self
217} 225}
218 226
219sub Crossfire::MoveType::as_string { 227sub Deliantra::MoveType::as_string {
220 my ($self) = @_; 228 my ($self) = @_;
221 229
222 my @res; 230 my @res;
223 231
224 my ($mask, $value) = @$self; 232 my ($mask, $value) = @$self;
225 233
226 for (@Crossfire::MOVE_TYPE) { 234 for (@Deliantra::MOVE_TYPE) {
227 my $bit = $Crossfire::MOVE_TYPE{$_}; 235 my $bit = $Deliantra::MOVE_TYPE{$_};
228 if (($mask & $bit) == $bit && (($value & $bit) == $bit || ($value & $bit) == 0)) { 236 if (($mask & $bit) == $bit && (($value & $bit) == $bit || ($value & $bit) == 0)) {
229 $mask &= ~$bit; 237 $mask &= ~$bit;
230 push @res, $value & $bit ? $_ : "-$_"; 238 push @res, $value & $bit ? $_ : "-$_";
231 } 239 }
232 } 240 }
… …
344 } else { 352 } else {
345 warn "object $ob->{_name} has unknown material ($ob->{material}) set.\n"; 353 warn "object $ob->{_name} has unknown material ($ob->{material}) set.\n";
346 } 354 }
347 } 355 }
348 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
349 # 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
350 $ob->{magicmap} ||= delete $ob->{color_fg} if exists $ob->{color_fg}; 369 $ob->{magicmap} ||= delete $ob->{color_fg} if exists $ob->{color_fg};
351 370
352 # nuke outdated or never supported fields 371 # nuke outdated or never supported fields
353 delete @$ob{qw( 372 delete @$ob{qw(
… …
361 380
362 # convert movement strings to bitsets 381 # convert movement strings to bitsets
363 for my $attr (keys %FIELD_MOVEMENT) { 382 for my $attr (keys %FIELD_MOVEMENT) {
364 next unless exists $ob->{$attr}; 383 next unless exists $ob->{$attr};
365 384
366 $ob->{$attr} = new Crossfire::MoveType $ob->{$attr}; 385 $ob->{$attr} = new Deliantra::MoveType $ob->{$attr};
367 } 386 }
368 387
369 # convert outdated movement flags to new movement sets 388 # convert outdated movement flags to new movement sets
370 if (defined (my $v = delete $ob->{no_pass})) { 389 if (defined (my $v = delete $ob->{no_pass})) {
371 $ob->{move_block} = new Crossfire::MoveType $v ? "all" : ""; 390 $ob->{move_block} = new Deliantra::MoveType $v ? "all" : "";
372 } 391 }
373 if (defined (my $v = delete $ob->{slow_move})) { 392 if (defined (my $v = delete $ob->{slow_move})) {
374 $ob->{move_slow} += "walk"; 393 $ob->{move_slow} += "walk";
375 $ob->{move_slow_penalty} = $v; 394 $ob->{move_slow_penalty} = $v;
376 } 395 }
377 if (defined (my $v = delete $ob->{walk_on})) { 396 if (defined (my $v = delete $ob->{walk_on})) {
378 $ob->{move_on} ||= new Crossfire::MoveType; if ($v) { $ob->{move_on} += "walk" } else { $ob->{move_on} -= "walk" } 397 $ob->{move_on} ||= new Deliantra::MoveType; if ($v) { $ob->{move_on} += "walk" } else { $ob->{move_on} -= "walk" }
379 } 398 }
380 if (defined (my $v = delete $ob->{walk_off})) { 399 if (defined (my $v = delete $ob->{walk_off})) {
381 $ob->{move_off} ||= new Crossfire::MoveType; if ($v) { $ob->{move_off} += "walk" } else { $ob->{move_off} -= "walk" } 400 $ob->{move_off} ||= new Deliantra::MoveType; if ($v) { $ob->{move_off} += "walk" } else { $ob->{move_off} -= "walk" }
382 } 401 }
383 if (defined (my $v = delete $ob->{fly_on})) { 402 if (defined (my $v = delete $ob->{fly_on})) {
384 $ob->{move_on} ||= new Crossfire::MoveType; if ($v) { $ob->{move_on} += "fly_low" } else { $ob->{move_on} -= "fly_low" } 403 $ob->{move_on} ||= new Deliantra::MoveType; if ($v) { $ob->{move_on} += "fly_low" } else { $ob->{move_on} -= "fly_low" }
385 } 404 }
386 if (defined (my $v = delete $ob->{fly_off})) { 405 if (defined (my $v = delete $ob->{fly_off})) {
387 $ob->{move_off} ||= new Crossfire::MoveType; if ($v) { $ob->{move_off} += "fly_low" } else { $ob->{move_off} -= "fly_low" } 406 $ob->{move_off} ||= new Deliantra::MoveType; if ($v) { $ob->{move_off} += "fly_low" } else { $ob->{move_off} -= "fly_low" }
388 } 407 }
389 if (defined (my $v = delete $ob->{flying})) { 408 if (defined (my $v = delete $ob->{flying})) {
390 $ob->{move_type} ||= new Crossfire::MoveType; if ($v) { $ob->{move_type} += "fly_low" } else { $ob->{move_type} -= "fly_low" } 409 $ob->{move_type} ||= new Deliantra::MoveType; if ($v) { $ob->{move_type} += "fly_low" } else { $ob->{move_type} -= "fly_low" }
391 } 410 }
392 411
393 # convert idiotic event_xxx things into objects 412 # convert idiotic event_xxx things into objects
394 while (my ($event, $subtype) = each %EVENT_TYPE) { 413 while (my ($event, $subtype) = each %EVENT_TYPE) {
395 if (exists $ob->{"event_${event}_plugin"}) { 414 if (exists $ob->{"event_${event}_plugin"}) {
… …
456} 475}
457 476
458sub attr_thaw($) { 477sub attr_thaw($) {
459 my ($ob) = @_; 478 my ($ob) = @_;
460 479
461 $ob->{attach} = from_json $ob->{attach} 480 $ob->{attach} = decode_json $ob->{attach}
462 if exists $ob->{attach}; 481 if exists $ob->{attach};
463 482
464 $ob 483 $ob
465} 484}
466 485
467sub attr_freeze($) { 486sub attr_freeze($) {
468 my ($ob) = @_; 487 my ($ob) = @_;
469 488
470 $ob->{attach} = Crossfire::to_json $ob->{attach} 489 $ob->{attach} = JSON::XS->new->utf8->canonical->encode ($ob->{attach})
471 if exists $ob->{attach}; 490 if exists $ob->{attach};
472 491
473 $ob 492 $ob
474} 493}
475 494
… …
605 my $str; 624 my $str;
606 625
607 my $append; $append = sub { 626 my $append; $append = sub {
608 my %a = %{$_[0]}; 627 my %a = %{$_[0]};
609 628
610 Crossfire::attr_freeze \%a; 629 Deliantra::attr_freeze \%a;
611 Crossfire::normalize_arch \%a; 630 Deliantra::normalize_arch \%a;
612 631
613 # undo the bit-split we did before 632 # undo the bit-split we did before
614 if (exists $a{attack_movement_bits_0_3} or exists $a{attack_movement_bits_4_7}) { 633 if (exists $a{attack_movement_bits_0_3} or exists $a{attack_movement_bits_4_7}) {
615 $a{attack_movement} = (delete $a{attack_movement_bits_0_3}) 634 $a{attack_movement} = (delete $a{attack_movement_bits_0_3})
616 | (delete $a{attack_movement_bits_4_7}); 635 | (delete $a{attack_movement_bits_4_7});
… …
634 } 653 }
635 654
636 my @kv; 655 my @kv;
637 656
638 for ($a{_name} eq "map" 657 for ($a{_name} eq "map"
639 ? @Crossfire::FIELD_ORDER_MAP 658 ? @Deliantra::FIELD_ORDER_MAP
640 : @Crossfire::FIELD_ORDER) { 659 : @Deliantra::FIELD_ORDER) {
641 push @kv, [$_, delete $a{$_}] 660 push @kv, [$_, delete $a{$_}]
642 if exists $a{$_}; 661 if exists $a{$_};
643 } 662 }
644 663
645 for (sort keys %a) { 664 for (sort keys %a) {
… …
648 } 667 }
649 668
650 for (@kv) { 669 for (@kv) {
651 my ($k, $v) = @$_; 670 my ($k, $v) = @$_;
652 671
653 if (my $end = $Crossfire::FIELD_MULTILINE{$k}) { 672 if (my $end = $Deliantra::FIELD_MULTILINE{$k}) {
654 $v =~ s/\n$//; 673 $v =~ s/\n$//;
655 $str .= "$k\n$v\n$end\n"; 674 $str .= "$k\n$v\n$end\n";
656 } else { 675 } else {
657 $str .= "$k $v\n"; 676 $str .= "$k $v\n";
658 } 677 }
… …
754=cut 773=cut
755 774
756sub arch_attr($) { 775sub arch_attr($) {
757 my ($obj) = @_; 776 my ($obj) = @_;
758 777
759 require Crossfire::Data; 778 require Deliantra::Data;
760 779
761 my $root; 780 my $root;
762 my $attr = { }; 781 my $attr = { };
763 782
764 my $arch = $ARCH{ $obj->{_name} }; 783 my $arch = $ARCH{ $obj->{_name} };
765 my $type = $obj->{type} || $arch->{type}; 784 my $type = $obj->{type} || $arch->{type};
766 785
767 if ($type > 0) { 786 if ($type > 0) {
768 $root = $Crossfire::Data::ATTR{$type}; 787 $root = $Deliantra::Data::ATTR{$type};
769 } else { 788 } else {
770 my %a = (%$arch, %$obj); 789 my %a = (%$arch, %$obj);
771 790
772 if ($a{is_floor} && !$a{alive}) { 791 if ($a{is_floor} && !$a{alive}) {
773 $root = $Crossfire::Data::TYPE{Floor}; 792 $root = $Deliantra::Data::TYPE{Floor};
774 } elsif (!$a{is_floor} && $a{alive} && !$a{tear_down}) { 793 } elsif (!$a{is_floor} && $a{alive} && !$a{tear_down}) {
775 $root = $Crossfire::Data::TYPE{"Monster & NPC"}; 794 $root = $Deliantra::Data::TYPE{"Monster & NPC"};
776 } elsif (!$a{is_floor} && !$a{alive} && $a{move_block}) { 795 } elsif (!$a{is_floor} && !$a{alive} && $a{move_block}) {
777 $root = $Crossfire::Data::TYPE{Wall}; 796 $root = $Deliantra::Data::TYPE{Wall};
778 } elsif (!$a{is_floor} && $a{alive} && $a{tear_down}) { 797 } elsif (!$a{is_floor} && $a{alive} && $a{tear_down}) {
779 $root = $Crossfire::Data::TYPE{"Weak Wall"}; 798 $root = $Deliantra::Data::TYPE{"Weak Wall"};
780 } else { 799 } else {
781 $root = $Crossfire::Data::TYPE{Misc}; 800 $root = $Deliantra::Data::TYPE{Misc};
782 } 801 }
783 } 802 }
784 803
785 my @import = ($root); 804 my @import = ($root);
786 805
787 unshift @import, \%Crossfire::Data::DEFAULT_ATTR 806 unshift @import, \%Deliantra::Data::DEFAULT_ATTR
788 unless $type == 116; 807 unless $type == 116;
789 808
790 my (%ignore); 809 my (%ignore);
791 my (@section_order, %section, @attr_order); 810 my (@section_order, %section, @attr_order);
792 811
793 while (my $type = shift @import) { 812 while (my $type = shift @import) {
813 push @import,
814 grep $_,
815 map $Deliantra::Data::TYPE{$_},
794 push @import, @{$type->{import} || []}; 816 @{$type->{import} || []};
795 817
796 $attr->{$_} ||= $type->{$_} 818 $attr->{$_} ||= $type->{$_}
797 for qw(name desc use); 819 for qw(name desc use);
798 820
799 for (@{$type->{ignore} || []}) { 821 for (@{$type->{ignore} || []}) {
… …
888} 910}
889 911
890sub construct_tilecache_pb { 912sub construct_tilecache_pb {
891 my ($idx, $cache) = @_; 913 my ($idx, $cache) = @_;
892 914
893 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;
894 916
895 while (my ($name, $tile) = each %$cache) { 917 while (my ($name, $tile) = each %$cache) {
896 my $tpb = delete $tile->{pb}; 918 my $tpb = delete $tile->{pb};
897 my $ofs = $tile->{idx}; 919 my $ofs = $tile->{idx};
898 920
899 for my $x (0 .. $tile->{w} - 1) { 921 for my $x (0 .. $tile->{w} - 1) {
900 for my $y (0 .. $tile->{h} - 1) { 922 for my $y (0 .. $tile->{h} - 1) {
901 my $idx = $ofs + $x + $y * $tile->{w}; 923 my $idx = $ofs + $x + $y * $tile->{w};
902 $tpb->copy_area ($x * TILESIZE, $y * TILESIZE, TILESIZE, TILESIZE, 924 $tpb->copy_area ($x * TILESIZE, $y * TILESIZE, TILESIZE, TILESIZE,
903 $pb, ($idx % 64) * TILESIZE, TILESIZE * int $idx / 64); 925 $pb, ($idx % CACHESTRIDE) * TILESIZE, TILESIZE * int $idx / CACHESTRIDE);
904 } 926 }
905 } 927 }
906 } 928 }
907 929
908 $pb->save ("$VARDIR/tilecache.png", "png", compression => 1); 930 $pb->save ("$VARDIR/tilecache.png", "png", compression => 1);
… …
924=cut 946=cut
925 947
926sub load_tilecache() { 948sub load_tilecache() {
927 require Gtk2; 949 require Gtk2;
928 950
929 if (-e "$LIB/crossfire.0") { # Crossfire1 version
930 cache_file "$LIB/crossfire.0", "$VARDIR/tilecache.pst", \&use_tilecache,
931 sub {
932 my $tile = read_pak "$LIB/crossfire.0";
933
934 my %cache;
935
936 my $idx = 0;
937
938 for my $name (sort keys %$tile) {
939 my $pb = new Gtk2::Gdk::PixbufLoader;
940 $pb->write ($tile->{$name});
941 $pb->close;
942 my $pb = $pb->get_pixbuf;
943
944 my $tile = $cache{$name} = {
945 pb => $pb,
946 idx => $idx,
947 w => int $pb->get_width / TILESIZE,
948 h => int $pb->get_height / TILESIZE,
949 };
950
951 $idx += $tile->{w} * $tile->{h};
952 }
953
954 construct_tilecache_pb $idx, \%cache;
955
956 \%cache
957 };
958
959 } else { # Crossfire+ version
960 cache_file "$LIB/facedata", "$VARDIR/tilecache.pst", \&use_tilecache, 951 cache_file "$LIB/facedata", "$VARDIR/tilecache.pst", \&use_tilecache,
961 sub { 952 sub {
962 my %cache; 953 my %cache;
963 my $facedata = Storable::retrieve "$LIB/facedata"; 954 my $facedata = Storable::retrieve "$LIB/facedata";
964 955
965 $facedata->{version} == 2 956 $facedata->{version} == 2
966 or die "$LIB/facedata: version mismatch, cannot proceed."; 957 or die "$LIB/facedata: version mismatch, cannot proceed.";
967 958
968 my $faces = $facedata->{faceinfo}; 959 my $faces = $facedata->{faceinfo};
969 my $idx = 0; 960 my $idx = 0;
970 961
971 for (sort keys %$faces) { 962 for (sort keys %$faces) {
972 my ($face, $info) = ($_, $faces->{$_}); 963 my ($face, $info) = ($_, $faces->{$_});
973 964
974 my $pb = new Gtk2::Gdk::PixbufLoader; 965 my $pb = new Gtk2::Gdk::PixbufLoader;
975 $pb->write ($info->{data32}); 966 $pb->write ($info->{data32});
976 $pb->close; 967 $pb->close;
977 my $pb = $pb->get_pixbuf; 968 my $pb = $pb->get_pixbuf;
978 969
979 my $tile = $cache{$face} = { 970 my $tile = $cache{$face} = {
980 pb => $pb, 971 pb => $pb,
981 idx => $idx, 972 idx => $idx,
982 w => int $pb->get_width / TILESIZE, 973 w => int $pb->get_width / TILESIZE,
983 h => int $pb->get_height / TILESIZE, 974 h => int $pb->get_height / TILESIZE,
984 }; 975 };
985 976
986 $idx += $tile->{w} * $tile->{h}; 977 $idx += $tile->{w} * $tile->{h};
987 } 978 }
988 979
989 construct_tilecache_pb $idx, \%cache; 980 construct_tilecache_pb $idx, \%cache;
990 981
991 \%cache 982 \%cache
992 }; 983 };
993 }
994} 984}
995 985
996=head1 AUTHOR 986=head1 AUTHOR
997 987
998 Marc Lehmann <schmorp@schmorp.de> 988 Marc Lehmann <schmorp@schmorp.de>
… …
1002 http://www.ta-sa.org/ 992 http://www.ta-sa.org/
1003 993
1004=cut 994=cut
1005 995
10061 9961
997

Diff Legend

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