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.86 by root, Wed Feb 7 00:56:06 2007 UTC vs.
Revision 1.111 by elmex, Thu Jun 7 14:45:22 2007 UTC

… …
4 4
5=cut 5=cut
6 6
7package Crossfire; 7package Crossfire;
8 8
9our $VERSION = '0.96'; 9our $VERSION = '0.99';
10 10
11use strict; 11use strict;
12 12
13use base 'Exporter'; 13use base 'Exporter';
14 14
… …
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 *ARCH TILESIZE $TILE *FACE editor_archs arch_extents
22); 22);
23 23
24use JSON::Syck (); #TODO#d# replace by JSON::PC when it becomes available == working 24use JSON::XS qw(from_json to_json);
25
26sub from_json($) {
27 $JSON::Syck::ImplicitUnicode = 1;
28 JSON::Syck::Load $_[0]
29}
30
31sub to_json($) {
32 $JSON::Syck::ImplicitUnicode = 0;
33 JSON::Syck::Dump $_[0]
34}
35 25
36our $LIB = $ENV{CROSSFIRE_LIBDIR}; 26our $LIB = $ENV{CROSSFIRE_LIBDIR};
37 27
38our $VARDIR = $ENV{HOME} ? "$ENV{HOME}/.crossfire" 28our $VARDIR = $ENV{HOME} ? "$ENV{HOME}/.crossfire"
39 : $ENV{AppData} ? "$ENV{APPDATA}/crossfire" 29 : $ENV{AppData} ? "$ENV{APPDATA}/crossfire"
… …
68 outdoor temp pressure humid windspeed winddir sky nosmooth 58 outdoor temp pressure humid windspeed winddir sky nosmooth
69 tile_path_1 tile_path_2 tile_path_3 tile_path_4 59 tile_path_1 tile_path_2 tile_path_3 tile_path_4
70)); 60));
71 61
72our @FIELD_ORDER = (qw( 62our @FIELD_ORDER = (qw(
63 inherit
64
73 elevation 65 elevation
74 66
75 name name_pl custom_name attach title race 67 name name_pl custom_name attach title race
76 slaying skill msg lore other_arch face 68 slaying skill msg lore other_arch
77 #todo-events
78 animation is_animated 69 face animation is_animated
70 magicmap smoothlevel smoothface
79 str dex con wis pow cha int 71 str dex con wis pow cha int
80 hp maxhp sp maxsp grace maxgrace 72 hp maxhp sp maxsp grace maxgrace
81 exp perm_exp expmul 73 exp perm_exp expmul
82 food dam luck wc ac x y speed speed_left move_state attack_movement 74 food dam luck wc ac x y speed speed_left move_state attack_movement
83 nrof level direction type subtype attacktype 75 nrof level direction type subtype attacktype
… …
91 resist_life_stealing resist_disease 83 resist_life_stealing resist_disease
92 84
93 path_attuned path_repelled path_denied material materialname 85 path_attuned path_repelled path_denied material materialname
94 value carrying weight invisible state magic 86 value carrying weight invisible state magic
95 last_heal last_sp last_grace last_eat 87 last_heal last_sp last_grace last_eat
96 connected glow_radius randomitems npx_status npc_program 88 connected glow_radius randomitems tresure_env npx_status npc_program
97 run_away pick_up container will_apply smoothlevel 89 run_away pick_up container will_apply smoothlevel
98 current_weapon_script weapontype tooltype elevation client_type 90 current_weapon_script weapontype tooltype elevation client_type
99 item_power duration range 91 item_power duration range
100 range_modifier duration_modifier dam_modifier gen_sp_armour 92 range_modifier duration_modifier dam_modifier gen_sp_armour
101 move_type move_block move_allow move_on move_off move_on move_slow move_slow_penalty 93 move_type move_block move_allow move_on move_off move_on move_slow move_slow_penalty
… …
112 known_magical known_cursed can_use_skill been_applied has_ready_scroll 104 known_magical known_cursed can_use_skill been_applied has_ready_scroll
113 can_use_rod can_use_horn make_invisible inv_locked is_wooded is_hilly 105 can_use_rod can_use_horn make_invisible inv_locked is_wooded is_hilly
114 has_ready_skill has_ready_weapon no_skill_ident is_blind can_see_in_dark 106 has_ready_skill has_ready_weapon no_skill_ident is_blind can_see_in_dark
115 is_cauldron is_dust no_steal one_hit berserk neutral no_attack no_damage 107 is_cauldron is_dust no_steal one_hit berserk neutral no_attack no_damage
116 activate_on_push activate_on_release is_water use_content_on_gen is_buildable 108 activate_on_push activate_on_release is_water use_content_on_gen is_buildable
109 precious
117 110
118 body_range body_arm body_torso body_head body_neck body_skill 111 body_range body_arm body_torso body_head body_neck body_skill
119 body_finger body_shoulder body_foot body_hand body_wrist body_waist 112 body_finger body_shoulder body_foot body_hand body_wrist body_waist
120)); 113));
121 114
… …
138sub MOVE_FLY_LOW (){ 0x02 } 131sub MOVE_FLY_LOW (){ 0x02 }
139sub MOVE_FLY_HIGH (){ 0x04 } 132sub MOVE_FLY_HIGH (){ 0x04 }
140sub MOVE_FLYING (){ 0x06 } 133sub MOVE_FLYING (){ 0x06 }
141sub MOVE_SWIM (){ 0x08 } 134sub MOVE_SWIM (){ 0x08 }
142sub MOVE_BOAT (){ 0x10 } 135sub MOVE_BOAT (){ 0x10 }
136sub MOVE_SHIP (){ 0x20 }
143sub MOVE_KNOWN (){ 0x1f } # all of above 137sub MOVE_KNOWN (){ 0x3f } # all of above
144sub MOVE_ALLBIT (){ 0x10000 }
145sub MOVE_ALL (){ 0x1001f } # very special value, more PITA 138sub MOVE_ALL (){ 0x10000 } # very special value
139
140our %MOVE_TYPE = (
141 walk => MOVE_WALK,
142 fly_low => MOVE_FLY_LOW,
143 fly_high => MOVE_FLY_HIGH,
144 flying => MOVE_FLYING,
145 swim => MOVE_SWIM,
146 boat => MOVE_BOAT,
147 ship => MOVE_SHIP,
148 all => MOVE_ALL,
149);
150
151our @MOVE_TYPE = keys %MOVE_TYPE;
152
153{
154 package Crossfire::MoveType;
155
156 use overload
157 '=' => sub { bless [@{$_[0]}], ref $_[0] },
158 '""' => \&as_string,
159 '>=' => sub { $_[0][0] & $MOVE_TYPE{$_[1]} ? $_[0][1] & $MOVE_TYPE{$_[1]} : undef },
160 '+=' => sub { $_[0][0] |= $MOVE_TYPE{$_[1]}; $_[0][1] |= $MOVE_TYPE{$_[1]}; &normalise },
161 '-=' => sub { $_[0][0] |= $MOVE_TYPE{$_[1]}; $_[0][1] &= ~$MOVE_TYPE{$_[1]}; &normalise },
162 '/=' => sub { $_[0][0] &= ~$MOVE_TYPE{$_[1]}; &normalise },
163 'x=' => sub {
164 my $cur = $_[0] >= $_[1];
165 if (!defined $cur) {
166 if ($_[0] >= "all") {
167 $_[0] -= $_[1];
168 } else {
169 $_[0] += $_[1];
170 }
171 } elsif ($cur) {
172 $_[0] -= $_[1];
173 } else {
174 $_[0] /= $_[1];
175 }
176
177 $_[0]
178 },
179 'eq' => sub { "$_[0]" eq "$_[1]" },
180 'ne' => sub { "$_[0]" ne "$_[1]" },
181 ;
182}
183
184sub Crossfire::MoveType::new {
185 my ($class, $string) = @_;
186
187 my $mask;
188 my $value;
189
190 if ($string =~ /^\s*\d+\s*$/) {
191 $mask = MOVE_ALL;
192 $value = $string+0;
193 } else {
194 for (split /\s+/, lc $string) {
195 if (s/^-//) {
196 $mask |= $MOVE_TYPE{$_};
197 $value &= ~$MOVE_TYPE{$_};
198 } else {
199 $mask |= $MOVE_TYPE{$_};
200 $value |= $MOVE_TYPE{$_};
201 }
202 }
203 }
204
205 (bless [$mask, $value], $class)->normalise
206}
207
208sub Crossfire::MoveType::normalise {
209 my ($self) = @_;
210
211 if ($self->[0] & MOVE_ALL) {
212 my $mask = ~(($self->[1] & MOVE_ALL ? $self->[1] : ~$self->[1]) & $self->[0] & ~MOVE_ALL);
213 $self->[0] &= $mask;
214 $self->[1] &= $mask;
215 }
216
217 $self->[1] &= $self->[0];
218
219 $self
220}
221
222sub Crossfire::MoveType::as_string {
223 my ($self) = @_;
224
225 my @res;
226
227 my ($mask, $value) = @$self;
228
229 for (@Crossfire::MOVE_TYPE) {
230 my $bit = $Crossfire::MOVE_TYPE{$_};
231 if (($mask & $bit) == $bit && (($value & $bit) == $bit || ($value & $bit) == 0)) {
232 $mask &= ~$bit;
233 push @res, $value & $bit ? $_ : "-$_";
234 }
235 }
236
237 join " ", @res
238}
146 239
147sub load_ref($) { 240sub load_ref($) {
148 my ($path) = @_; 241 my ($path) = @_;
149 242
150 open my $fh, "<:raw:perlio", $path 243 open my $fh, "<:raw:perlio", $path
… …
254 } else { 347 } else {
255 warn "object $ob->{_name} has unknown material ($ob->{material}) set.\n"; 348 warn "object $ob->{_name} has unknown material ($ob->{material}) set.\n";
256 } 349 }
257 } 350 }
258 351
352 # check whether attachment is the same as in the archetype
353 if (exists $ob->{attach}) {
354 my $arch = $ARCH{$ob->{_name}};
355 my $js = JSON::XS->new->utf8->canonical (1);
356
357 if (defined $arch->{attach}
358 && $js->encode ($js->decode ($ob->{attach})) eq $js->encode ($arch->{attach})) {
359 delete $ob->{attach}
360 }
361 }
362
363 # color_fg is used as default for magicmap if magicmap does not exist
364 $ob->{magicmap} ||= delete $ob->{color_fg} if exists $ob->{color_fg};
365
259 # nuke outdated or never supported fields 366 # nuke outdated or never supported fields
260 delete @$ob{qw( 367 delete @$ob{qw(
261 can_knockback can_parry can_impale can_cut can_dam_armour 368 can_knockback can_parry can_impale can_cut can_dam_armour
262 can_apply pass_thru can_pass_thru 369 can_apply pass_thru can_pass_thru color_bg color_fg
263 )}; 370 )};
264 371
265 if (my $mask = delete $ob->{immune} ) { _add_resist $ob, $mask, 100; } 372 if (my $mask = delete $ob->{immune} ) { _add_resist $ob, $mask, 100; }
266 if (my $mask = delete $ob->{protected} ) { _add_resist $ob, $mask, 30; } 373 if (my $mask = delete $ob->{protected} ) { _add_resist $ob, $mask, 30; }
267 if (my $mask = delete $ob->{vulnerable}) { _add_resist $ob, $mask, -100; } 374 if (my $mask = delete $ob->{vulnerable}) { _add_resist $ob, $mask, -100; }
268 375
269 # convert movement strings to bitsets 376 # convert movement strings to bitsets
270 for my $attr (keys %FIELD_MOVEMENT) { 377 for my $attr (keys %FIELD_MOVEMENT) {
271 next unless exists $ob->{$attr}; 378 next unless exists $ob->{$attr};
272 379
273 $ob->{$attr} = MOVE_ALL if $ob->{$attr} == 255; #d# compatibility 380 $ob->{$attr} = new Crossfire::MoveType $ob->{$attr};
274
275 next if $ob->{$attr} =~ /^\d+$/;
276
277 my $flags = 0;
278
279 # assume list
280 for my $flag (map lc, split /\s+/, $ob->{$attr}) {
281 $flags |= MOVE_WALK if $flag eq "walk";
282 $flags |= MOVE_FLY_LOW if $flag eq "fly_low";
283 $flags |= MOVE_FLY_HIGH if $flag eq "fly_high";
284 $flags |= MOVE_FLYING if $flag eq "flying";
285 $flags |= MOVE_SWIM if $flag eq "swim";
286 $flags |= MOVE_BOAT if $flag eq "boat";
287 $flags |= MOVE_ALL if $flag eq "all";
288
289 $flags &= ~MOVE_WALK if $flag eq "-walk";
290 $flags &= ~MOVE_FLY_LOW if $flag eq "-fly_low";
291 $flags &= ~MOVE_FLY_HIGH if $flag eq "-fly_high";
292 $flags &= ~MOVE_FLYING if $flag eq "-flying";
293 $flags &= ~MOVE_SWIM if $flag eq "-swim";
294 $flags &= ~MOVE_BOAT if $flag eq "-boat";
295 $flags &= ~MOVE_ALL if $flag eq "-all";
296 }
297
298 $ob->{$attr} = $flags;
299 } 381 }
300 382
301 # convert outdated movement flags to new movement sets 383 # convert outdated movement flags to new movement sets
302 if (defined (my $v = delete $ob->{no_pass})) { 384 if (defined (my $v = delete $ob->{no_pass})) {
303 $ob->{move_block} = $v ? MOVE_ALL : 0; 385 $ob->{move_block} = new Crossfire::MoveType $v ? "all" : "";
304 } 386 }
305 if (defined (my $v = delete $ob->{slow_move})) { 387 if (defined (my $v = delete $ob->{slow_move})) {
306 $ob->{move_slow} |= MOVE_WALK; 388 $ob->{move_slow} += "walk";
307 $ob->{move_slow_penalty} = $v; 389 $ob->{move_slow_penalty} = $v;
308 } 390 }
309 if (defined (my $v = delete $ob->{walk_on})) { 391 if (defined (my $v = delete $ob->{walk_on})) {
310 $ob->{move_on} = MOVE_ALL unless exists $ob->{move_on}; 392 $ob->{move_on} ||= new Crossfire::MoveType; if ($v) { $ob->{move_on} += "walk" } else { $ob->{move_on} -= "walk" }
311 $ob->{move_on} = $v ? $ob->{move_on} | MOVE_WALK
312 : $ob->{move_on} & ~MOVE_WALK;
313 } 393 }
314 if (defined (my $v = delete $ob->{walk_off})) { 394 if (defined (my $v = delete $ob->{walk_off})) {
315 $ob->{move_off} = MOVE_ALL unless exists $ob->{move_off}; 395 $ob->{move_off} ||= new Crossfire::MoveType; if ($v) { $ob->{move_off} += "walk" } else { $ob->{move_off} -= "walk" }
316 $ob->{move_off} = $v ? $ob->{move_off} | MOVE_WALK
317 : $ob->{move_off} & ~MOVE_WALK;
318 } 396 }
319 if (defined (my $v = delete $ob->{fly_on})) { 397 if (defined (my $v = delete $ob->{fly_on})) {
320 $ob->{move_on} = MOVE_ALL unless exists $ob->{move_on}; 398 $ob->{move_on} ||= new Crossfire::MoveType; if ($v) { $ob->{move_on} += "fly_low" } else { $ob->{move_on} -= "fly_low" }
321 $ob->{move_on} = $v ? $ob->{move_on} | MOVE_FLY_LOW
322 : $ob->{move_on} & ~MOVE_FLY_LOW;
323 } 399 }
324 if (defined (my $v = delete $ob->{fly_off})) { 400 if (defined (my $v = delete $ob->{fly_off})) {
325 $ob->{move_off} = MOVE_ALL unless exists $ob->{move_off}; 401 $ob->{move_off} ||= new Crossfire::MoveType; if ($v) { $ob->{move_off} += "fly_low" } else { $ob->{move_off} -= "fly_low" }
326 $ob->{move_off} = $v ? $ob->{move_off} | MOVE_FLY_LOW
327 : $ob->{move_off} & ~MOVE_FLY_LOW;
328 } 402 }
329 if (defined (my $v = delete $ob->{flying})) { 403 if (defined (my $v = delete $ob->{flying})) {
330 $ob->{move_type} = MOVE_ALL unless exists $ob->{move_type}; 404 $ob->{move_type} ||= new Crossfire::MoveType; if ($v) { $ob->{move_type} += "fly_low" } else { $ob->{move_type} -= "fly_low" }
331 $ob->{move_type} = $v ? $ob->{move_type} | MOVE_FLY_LOW
332 : $ob->{move_type} & ~MOVE_FLY_LOW;
333 } 405 }
334 406
335 # convert idiotic event_xxx things into objects 407 # convert idiotic event_xxx things into objects
336 while (my ($event, $subtype) = each %EVENT_TYPE) { 408 while (my ($event, $subtype) = each %EVENT_TYPE) {
337 if (exists $ob->{"event_${event}_plugin"}) { 409 if (exists $ob->{"event_${event}_plugin"}) {
… …
568 640
569 my $inv = delete $a{inventory}; 641 my $inv = delete $a{inventory};
570 my $more = delete $a{more}; # arches do not support 'more', but old maps can contain some 642 my $more = delete $a{more}; # arches do not support 'more', but old maps can contain some
571 my $anim = delete $a{anim}; 643 my $anim = delete $a{anim};
572 644
645 if ($a{_atype} eq 'object') {
646 $str .= join "\n", "anim", @$anim, "mina\n"
647 if $anim;
648 }
649
573 my @kv; 650 my @kv;
574 651
575 for ($a{_name} eq "map" 652 for ($a{_name} eq "map"
576 ? @Crossfire::FIELD_ORDER_MAP 653 ? @Crossfire::FIELD_ORDER_MAP
577 : @Crossfire::FIELD_ORDER) { 654 : @Crossfire::FIELD_ORDER) {
… …
588 my ($k, $v) = @$_; 665 my ($k, $v) = @$_;
589 666
590 if (my $end = $Crossfire::FIELD_MULTILINE{$k}) { 667 if (my $end = $Crossfire::FIELD_MULTILINE{$k}) {
591 $v =~ s/\n$//; 668 $v =~ s/\n$//;
592 $str .= "$k\n$v\n$end\n"; 669 $str .= "$k\n$v\n$end\n";
593 } elsif (exists $Crossfire::FIELD_MOVEMENT{$k}) {
594 if ($v & ~Crossfire::MOVE_ALL or !$v) {
595 $str .= "$k $v\n";
596
597 } elsif ($v & Crossfire::MOVE_ALLBIT) {
598 $str .= "$k all";
599
600 $str .= " -walk" unless $v & Crossfire::MOVE_WALK;
601 $str .= " -fly_low" unless $v & Crossfire::MOVE_FLY_LOW;
602 $str .= " -fly_high" unless $v & Crossfire::MOVE_FLY_HIGH;
603 $str .= " -swim" unless $v & Crossfire::MOVE_SWIM;
604 $str .= " -boat" unless $v & Crossfire::MOVE_BOAT;
605
606 $str .= "\n";
607
608 } else {
609 $str .= $k;
610
611 $str .= " walk" if $v & Crossfire::MOVE_WALK;
612 $str .= " fly_low" if $v & Crossfire::MOVE_FLY_LOW;
613 $str .= " fly_high" if $v & Crossfire::MOVE_FLY_HIGH;
614 $str .= " swim" if $v & Crossfire::MOVE_SWIM;
615 $str .= " boat" if $v & Crossfire::MOVE_BOAT;
616
617 $str .= "\n";
618 }
619 } else { 670 } else {
620 $str .= "$k $v\n"; 671 $str .= "$k $v\n";
621 } 672 }
622 } 673 }
623 674
624 if ($inv) { 675 if ($inv) {
625 $append->($_) for @$inv; 676 $append->($_) for @$inv;
626 }
627
628 if ($a{_atype} eq 'object') {
629 $str .= join "\n", "anim", @$anim, "mina\n"
630 if $anim;
631 } 677 }
632 678
633 $str .= "end\n"; 679 $str .= "end\n";
634 680
635 if ($a{_atype} eq 'object') { 681 if ($a{_atype} eq 'object') {
… …
796 ]; 842 ];
797 843
798 $attr 844 $attr
799} 845}
800 846
801sub arch_edit_sections {
802# if (edit_type == IGUIConstants.TILE_EDIT_NONE)
803# edit_type = 0;
804# else if (edit_type != 0) {
805# // all flags from 'check_type' must be unset in this arch because they get recalculated now
806# edit_type &= ~check_type;
807# }
808#
809# }
810# if ((check_type & IGUIConstants.TILE_EDIT_MONSTER) != 0 &&
811# getAttributeValue("alive", defarch) == 1 &&
812# (getAttributeValue("monster", defarch) == 1 ||
813# getAttributeValue("generator", defarch) == 1)) {
814# // Monster: monsters/npcs/generators
815# edit_type |= IGUIConstants.TILE_EDIT_MONSTER;
816# }
817# if ((check_type & IGUIConstants.TILE_EDIT_WALL) != 0 &&
818# arch_type == 0 && getAttributeValue("no_pass", defarch) == 1) {
819# // Walls
820# edit_type |= IGUIConstants.TILE_EDIT_WALL;
821# }
822# if ((check_type & IGUIConstants.TILE_EDIT_CONNECTED) != 0 &&
823# getAttributeValue("connected", defarch) != 0) {
824# // Connected Objects
825# edit_type |= IGUIConstants.TILE_EDIT_CONNECTED;
826# }
827# if ((check_type & IGUIConstants.TILE_EDIT_EXIT) != 0 &&
828# arch_type == 66 || arch_type == 41 || arch_type == 95) {
829# // Exit: teleporter/exit/trapdoors
830# edit_type |= IGUIConstants.TILE_EDIT_EXIT;
831# }
832# if ((check_type & IGUIConstants.TILE_EDIT_TREASURE) != 0 &&
833# getAttributeValue("no_pick", defarch) == 0 && (arch_type == 4 ||
834# arch_type == 5 || arch_type == 36 || arch_type == 60 ||
835# arch_type == 85 || arch_type == 111 || arch_type == 123 ||
836# arch_type == 124 || arch_type == 130)) {
837# // Treasure: randomtreasure/money/gems/potions/spellbooks/scrolls
838# edit_type |= IGUIConstants.TILE_EDIT_TREASURE;
839# }
840# if ((check_type & IGUIConstants.TILE_EDIT_DOOR) != 0 &&
841# arch_type == 20 || arch_type == 23 || arch_type == 26 ||
842# arch_type == 91 || arch_type == 21 || arch_type == 24) {
843# // Door: door/special door/gates + keys
844# edit_type |= IGUIConstants.TILE_EDIT_DOOR;
845# }
846# if ((check_type & IGUIConstants.TILE_EDIT_EQUIP) != 0 &&
847# getAttributeValue("no_pick", defarch) == 0 && ((arch_type >= 13 &&
848# arch_type <= 16) || arch_type == 33 || arch_type == 34 ||
849# arch_type == 35 || arch_type == 39 || arch_type == 70 ||
850# arch_type == 87 || arch_type == 99 || arch_type == 100 ||
851# arch_type == 104 || arch_type == 109 || arch_type == 113 ||
852# arch_type == 122 || arch_type == 3)) {
853# // Equipment: weapons/armour/wands/rods
854# edit_type |= IGUIConstants.TILE_EDIT_EQUIP;
855# }
856#
857# return(edit_type);
858#
859#
860}
861
862sub cache_file($$&&) { 847sub cache_file($$&&) {
863 my ($src, $cache, $load, $create) = @_; 848 my ($src, $cache, $load, $create) = @_;
864 849
865 my ($size, $mtime) = (stat $src)[7,9] 850 my ($size, $mtime) = (stat $src)[7,9]
866 or Carp::croak "$src: $!"; 851 or Carp::croak "$src: $!";
… …
914 }, sub { 899 }, sub {
915 read_arch "$LIB/archetypes" 900 read_arch "$LIB/archetypes"
916 }; 901 };
917} 902}
918 903
904sub construct_tilecache_pb {
905 my ($idx, $cache) = @_;
906
907 my $pb = new Gtk2::Gdk::Pixbuf "rgb", 1, 8, 64 * TILESIZE, TILESIZE * int +($idx + 63) / 64;
908
909 while (my ($name, $tile) = each %$cache) {
910 my $tpb = delete $tile->{pb};
911 my $ofs = $tile->{idx};
912
913 for my $x (0 .. $tile->{w} - 1) {
914 for my $y (0 .. $tile->{h} - 1) {
915 my $idx = $ofs + $x + $y * $tile->{w};
916 $tpb->copy_area ($x * TILESIZE, $y * TILESIZE, TILESIZE, TILESIZE,
917 $pb, ($idx % 64) * TILESIZE, TILESIZE * int $idx / 64);
918 }
919 }
920 }
921
922 $pb->save ("$VARDIR/tilecache.png", "png", compression => 1);
923
924 $cache
925}
926
927sub use_tilecache {
928 my ($face) = @_;
929 $TILE = new_from_file Gtk2::Gdk::Pixbuf "$VARDIR/tilecache.png"
930 or die "$VARDIR/tilecache.png: $!";
931 *FACE = $_[0];
932}
933
919=item load_tilecache 934=item load_tilecache
920 935
921(Re-)Load %TILE and %FACE. 936(Re-)Load %TILE and %FACE.
922 937
923=cut 938=cut
924 939
925sub load_tilecache() { 940sub load_tilecache() {
926 require Gtk2; 941 require Gtk2;
927 942
928 cache_file "$LIB/crossfire.0", "$VARDIR/tilecache.pst", sub { 943 if (-e "$LIB/facedata") { # Crossfire TRT faces
929 $TILE = new_from_file Gtk2::Gdk::Pixbuf "$VARDIR/tilecache.png" 944 cache_file "$LIB/facedata", "$VARDIR/tilecache.pst", \&use_tilecache,
930 or die "$VARDIR/tilecache.png: $!"; 945 sub {
931 *FACE = $_[0];
932 }, sub {
933 my $tile = read_pak "$LIB/crossfire.0";
934
935 my %cache; 946 my %cache;
947 my $facedata = Storable::retrieve "$LIB/facedata";
936 948
949 $facedata->{version} == 2
950 or die "$LIB/facedata: version mismatch, cannot proceed.";
951
952 my $faces = $facedata->{faceinfo};
937 my $idx = 0; 953 my $idx = 0;
938 954
939 for my $name (sort keys %$tile) { 955 for (sort keys %$faces) {
956 my ($face, $info) = ($_, $faces->{$_});
957
940 my $pb = new Gtk2::Gdk::PixbufLoader; 958 my $pb = new Gtk2::Gdk::PixbufLoader;
941 $pb->write ($tile->{$name}); 959 $pb->write ($info->{data32});
942 $pb->close; 960 $pb->close;
943 my $pb = $pb->get_pixbuf; 961 my $pb = $pb->get_pixbuf;
944 962
945 my $tile = $cache{$name} = { 963 my $tile = $cache{$face} = {
946 pb => $pb, 964 pb => $pb,
947 idx => $idx, 965 idx => $idx,
948 w => int $pb->get_width / TILESIZE, 966 w => int $pb->get_width / TILESIZE,
949 h => int $pb->get_height / TILESIZE, 967 h => int $pb->get_height / TILESIZE,
968 };
969
970 $idx += $tile->{w} * $tile->{h};
971 }
972
973 construct_tilecache_pb $idx, \%cache;
974
975 \%cache
950 }; 976 };
977
978 } elsif (-e "$LIB/crossfire.0") { # Crossfire1 version
979 cache_file "$LIB/crossfire.0", "$VARDIR/tilecache.pst", \&use_tilecache,
980 sub {
981 my $tile = read_pak "$LIB/crossfire.0";
982
983 my %cache;
984
985 my $idx = 0;
986
987 for my $name (sort keys %$tile) {
988 my $pb = new Gtk2::Gdk::PixbufLoader;
989 $pb->write ($tile->{$name});
990 $pb->close;
991 my $pb = $pb->get_pixbuf;
992
993 my $tile = $cache{$name} = {
994 pb => $pb,
995 idx => $idx,
996 w => int $pb->get_width / TILESIZE,
997 h => int $pb->get_height / TILESIZE,
951 998 };
952 999
953 $idx += $tile->{w} * $tile->{h}; 1000 $idx += $tile->{w} * $tile->{h};
954 }
955
956 my $pb = new Gtk2::Gdk::Pixbuf "rgb", 1, 8, 64 * TILESIZE, TILESIZE * int +($idx + 63) / 64;
957
958 while (my ($name, $tile) = each %cache) {
959 my $tpb = delete $tile->{pb};
960 my $ofs = $tile->{idx};
961
962 for my $x (0 .. $tile->{w} - 1) {
963 for my $y (0 .. $tile->{h} - 1) {
964 my $idx = $ofs + $x + $y * $tile->{w};
965 $tpb->copy_area ($x * TILESIZE, $y * TILESIZE, TILESIZE, TILESIZE,
966 $pb, ($idx % 64) * TILESIZE, TILESIZE * int $idx / 64);
967 } 1001 }
1002
1003 construct_tilecache_pb $idx, \%cache;
1004
1005 \%cache
968 } 1006 };
969 }
970 1007
971 $pb->save ("$VARDIR/tilecache.png", "png", compression => 1);
972
973 \%cache
974 }; 1008 }
975} 1009}
976 1010
977=head1 AUTHOR 1011=head1 AUTHOR
978 1012
979 Marc Lehmann <schmorp@schmorp.de> 1013 Marc Lehmann <schmorp@schmorp.de>

Diff Legend

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