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.142 by root, Sat May 15 00:30:53 2010 UTC

1=head1 NAME 1=head1 NAME
2 2
3Crossfire - Crossfire maphandling 3Deliantra - Deliantra suppport module to read/write archetypes, maps etc.
4
5=over 4
4 6
5=cut 7=cut
6 8
7package Crossfire; 9package Deliantra;
8 10
9our $VERSION = '0.98'; 11our $VERSION = '1.30';
10 12
11use strict; 13use common::sense;
12 14
13use base 'Exporter'; 15use base 'Exporter';
14 16
15use Carp (); 17use Carp ();
16use File::Spec; 18use File::Spec;
17use List::Util qw(min max); 19use List::Util qw(min max);
18use Storable qw(freeze thaw); 20use Storable qw(freeze thaw);
19 21
20our @EXPORT = qw( 22our @EXPORT = qw(
21 read_pak read_arch *ARCH TILESIZE $TILE *FACE editor_archs arch_extents 23 read_pak read_arch
24 *ARCH $TILE *FACE *FACEDATA
25 TILESIZE CACHESTRIDE
26 editor_archs arch_extents
22); 27);
23 28
24use JSON::XS qw(from_json to_json); 29use JSON::XS qw(decode_json encode_json);
25 30
26our $LIB = $ENV{CROSSFIRE_LIBDIR}; 31our $LIB = $ENV{DELIANTRA_LIBDIR};
27 32
28our $VARDIR = $ENV{HOME} ? "$ENV{HOME}/.crossfire" 33our $VARDIR = $ENV{HOME} ? "$ENV{HOME}/.deliantra"
29 : $ENV{AppData} ? "$ENV{APPDATA}/crossfire" 34 : $ENV{AppData} ? "$ENV{APPDATA}/deliantra"
30 : File::Spec->tmpdir . "/crossfire"; 35 : File::Spec->tmpdir . "/deliantra";
31 36
32mkdir $VARDIR, 0777; 37mkdir $VARDIR, 0777;
33 38
34sub TILESIZE (){ 32 } 39sub TILESIZE (){ 32 }
40sub CACHESTRIDE (){ 64 }
35 41
36our %ARCH; 42our %ARCH;
43our %FACE; # face32
37our %FACE; 44our %FACEDATA;
38our $TILE; 45our $TILE;
39 46
40our %FIELD_MULTILINE = ( 47our %FIELD_MULTILINE = (
41 msg => "endmsg", 48 msg => "endmsg",
42 lore => "endlore", 49 lore => "endlore",
… …
49 56
50# same as in server save routine, to (hopefully) be compatible 57# same as in server save routine, to (hopefully) be compatible
51# to the other editors. 58# to the other editors.
52our @FIELD_ORDER_MAP = (qw( 59our @FIELD_ORDER_MAP = (qw(
53 file_format_version 60 file_format_version
54 name attach swap_time reset_timeout fixed_resettime difficulty region 61 name attach swap_time reset_timeout fixed_resettime difficulty
62 region music
55 shopitems shopgreed shopmin shopmax shoprace 63 shopitems shopgreed shopmin shopmax shoprace
56 darkness width height enter_x enter_y msg maplore 64 darkness width height enter_x enter_y msg maplore
57 unique template 65 unique template
58 outdoor temp pressure humid windspeed winddir sky nosmooth 66 outdoor temp pressure humid windspeed winddir sky nosmooth
59 tile_path_1 tile_path_2 tile_path_3 tile_path_4 67 tile_path_1 tile_path_2 tile_path_3 tile_path_4
… …
64 72
65 elevation 73 elevation
66 74
67 name name_pl custom_name attach title race 75 name name_pl custom_name attach title race
68 slaying skill msg lore other_arch 76 slaying skill msg lore other_arch
69 face animation is_animated 77 sound sound_destroy face animation is_animated
70 magicmap smoothlevel smoothface 78 magicmap smoothlevel smoothface
71 str dex con wis pow cha int 79 str dex con wis pow cha int
72 hp maxhp sp maxsp grace maxgrace 80 hp maxhp sp maxsp grace maxgrace
73 exp perm_exp expmul 81 exp perm_exp expmul
74 food dam luck wc ac x y speed speed_left move_state attack_movement 82 food dam luck wc ac x y speed speed_left move_state attack_movement
… …
83 resist_life_stealing resist_disease 91 resist_life_stealing resist_disease
84 92
85 path_attuned path_repelled path_denied material materialname 93 path_attuned path_repelled path_denied material materialname
86 value carrying weight invisible state magic 94 value carrying weight invisible state magic
87 last_heal last_sp last_grace last_eat 95 last_heal last_sp last_grace last_eat
88 connected glow_radius randomitems npx_status npc_program 96 connected glow_radius randomitems tresure_env npx_status npc_program
89 run_away pick_up container will_apply smoothlevel 97 run_away pick_up container will_apply smoothlevel
90 current_weapon_script weapontype tooltype elevation client_type 98 current_weapon_script weapontype tooltype elevation client_type
91 item_power duration range 99 item_power duration range
92 range_modifier duration_modifier dam_modifier gen_sp_armour 100 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 101 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 112 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 113 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 114 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 115 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 116 activate_on_push activate_on_release is_water use_content_on_gen is_buildable
117 precious
109 118
110 body_range body_arm body_torso body_head body_neck body_skill 119 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 120 body_finger body_shoulder body_foot body_hand body_wrist body_waist
112)); 121));
113 122
… …
130sub MOVE_FLY_LOW (){ 0x02 } 139sub MOVE_FLY_LOW (){ 0x02 }
131sub MOVE_FLY_HIGH (){ 0x04 } 140sub MOVE_FLY_HIGH (){ 0x04 }
132sub MOVE_FLYING (){ 0x06 } 141sub MOVE_FLYING (){ 0x06 }
133sub MOVE_SWIM (){ 0x08 } 142sub MOVE_SWIM (){ 0x08 }
134sub MOVE_BOAT (){ 0x10 } 143sub MOVE_BOAT (){ 0x10 }
144sub MOVE_SHIP (){ 0x20 }
135sub MOVE_KNOWN (){ 0x1f } # all of above 145sub MOVE_KNOWN (){ 0x3f } # all of above
136sub MOVE_ALL (){ 0x10000 } # very special value 146sub MOVE_ALL (){ 0x10000 } # very special value
137 147
138our %MOVE_TYPE = ( 148our %MOVE_TYPE = (
139 walk => MOVE_WALK, 149 walk => MOVE_WALK,
140 fly_low => MOVE_FLY_LOW, 150 fly_low => MOVE_FLY_LOW,
141 fly_high => MOVE_FLY_HIGH, 151 fly_high => MOVE_FLY_HIGH,
142 flying => MOVE_FLYING, 152 flying => MOVE_FLYING,
143 swim => MOVE_SWIM, 153 swim => MOVE_SWIM,
144 boat => MOVE_BOAT, 154 boat => MOVE_BOAT,
155 ship => MOVE_SHIP,
145 all => MOVE_ALL, 156 all => MOVE_ALL,
146); 157);
147 158
148our @MOVE_TYPE = qw(all walk flying fly_low fly_high swim boat); 159our @MOVE_TYPE = qw(all walk flying fly_low fly_high swim boat ship);
149 160
150{ 161{
151 package Crossfire::MoveType; 162 package Deliantra::MoveType;
152 163
153 use overload 164 use overload
154 '=' => sub { bless [@{$_[0]}], ref $_[0] }, 165 '=' => sub { bless [@{$_[0]}], ref $_[0] },
155 '""' => \&as_string, 166 '""' => \&as_string,
156 '>=' => sub { $_[0][0] & $MOVE_TYPE{$_[1]} ? $_[0][1] & $MOVE_TYPE{$_[1]} : undef }, 167 '>=' => sub { $_[0][0] & $MOVE_TYPE{$_[1]} ? $_[0][1] & $MOVE_TYPE{$_[1]} : undef },
168 '<=' => sub {
169 ($_[0][0] & $MOVE_TYPE{$_[1]}) == $MOVE_TYPE{$_[1]}
170 ? $_[0][1] & $MOVE_TYPE{$_[1]}
171 : undef
172 },
157 '+=' => sub { $_[0][0] |= $MOVE_TYPE{$_[1]}; $_[0][1] |= $MOVE_TYPE{$_[1]}; &normalise }, 173 '+=' => sub { $_[0][0] |= $MOVE_TYPE{$_[1]}; $_[0][1] |= $MOVE_TYPE{$_[1]}; &normalise },
158 '-=' => sub { $_[0][0] |= $MOVE_TYPE{$_[1]}; $_[0][1] &= ~$MOVE_TYPE{$_[1]}; &normalise }, 174 '-=' => sub { $_[0][0] |= $MOVE_TYPE{$_[1]}; $_[0][1] &= ~$MOVE_TYPE{$_[1]}; &normalise },
159 '/=' => sub { $_[0][0] &= ~$MOVE_TYPE{$_[1]}; &normalise }, 175 '/=' => sub { $_[0][0] &= ~$MOVE_TYPE{$_[1]}; &normalise },
160 'x=' => sub { 176 'x=' => sub { # toggle between off, + and -
161 my $cur = $_[0] >= $_[1]; 177 my $cur = $_[0] >= $_[1];
162 if (!defined $cur) { 178 if (!defined $cur) {
163 if ($_[0] >= "all") { 179 if ($_[0] >= "all") {
164 $_[0] -= $_[1]; 180 $_[0] -= $_[1];
165 } else { 181 } else {
… …
174 $_[0] 190 $_[0]
175 }, 191 },
176 'eq' => sub { "$_[0]" eq "$_[1]" }, 192 'eq' => sub { "$_[0]" eq "$_[1]" },
177 'ne' => sub { "$_[0]" ne "$_[1]" }, 193 'ne' => sub { "$_[0]" ne "$_[1]" },
178 ; 194 ;
179}
180 195
181sub Crossfire::MoveType::new { 196 sub TO_JSON {
197 $_[0][0]
198 }
199}
200
201sub Deliantra::MoveType::new {
182 my ($class, $string) = @_; 202 my ($class, $string) = @_;
183 203
184 my $mask; 204 my $mask;
185 my $value; 205 my $value;
186 206
… …
200 } 220 }
201 221
202 (bless [$mask, $value], $class)->normalise 222 (bless [$mask, $value], $class)->normalise
203} 223}
204 224
205sub Crossfire::MoveType::normalise { 225sub Deliantra::MoveType::normalise {
206 my ($self) = @_; 226 my ($self) = @_;
207 227
208 if ($self->[0] & MOVE_ALL) { 228 if ($self->[0] & MOVE_ALL) {
209 my $mask = ~(($self->[1] & MOVE_ALL ? $self->[1] : ~$self->[1]) & $self->[0] & ~MOVE_ALL); 229 my $mask = ~(($self->[1] & MOVE_ALL ? $self->[1] : ~$self->[1]) & $self->[0] & ~MOVE_ALL);
210 $self->[0] &= $mask; 230 $self->[0] &= $mask;
… …
214 $self->[1] &= $self->[0]; 234 $self->[1] &= $self->[0];
215 235
216 $self 236 $self
217} 237}
218 238
219sub Crossfire::MoveType::as_string { 239sub Deliantra::MoveType::as_string {
220 my ($self) = @_; 240 my ($self) = @_;
221 241
222 my @res; 242 my @res;
223 243
224 my ($mask, $value) = @$self; 244 my ($mask, $value) = @$self;
225 245
226 for (@Crossfire::MOVE_TYPE) { 246 for (@Deliantra::MOVE_TYPE) {
227 my $bit = $Crossfire::MOVE_TYPE{$_}; 247 my $bit = $Deliantra::MOVE_TYPE{$_};
228 if (($mask & $bit) == $bit && (($value & $bit) == $bit || ($value & $bit) == 0)) { 248 if (($mask & $bit) == $bit && (($value & $bit) == $bit || ($value & $bit) == 0)) {
229 $mask &= ~$bit; 249 $mask &= ~$bit;
230 push @res, $value & $bit ? $_ : "-$_"; 250 push @res, $value & $bit ? $_ : "-$_";
231 } 251 }
232 } 252 }
… …
325 345
326# object as in "Object xxx", i.e. archetypes 346# object as in "Object xxx", i.e. archetypes
327sub normalize_object($) { 347sub normalize_object($) {
328 my ($ob) = @_; 348 my ($ob) = @_;
329 349
350 delete $ob->{editable}; # deprecated
351
330 # convert material bitset to materialname, if possible 352 # convert material bitset to materialname, if possible
331 if (exists $ob->{material}) { 353 if (exists $ob->{material}) {
332 if (!$ob->{material}) { 354 if (!$ob->{material}) {
333 delete $ob->{material}; 355 delete $ob->{material};
334 } elsif (exists $ob->{materialname}) { 356 } elsif (exists $ob->{materialname}) {
… …
344 } else { 366 } else {
345 warn "object $ob->{_name} has unknown material ($ob->{material}) set.\n"; 367 warn "object $ob->{_name} has unknown material ($ob->{material}) set.\n";
346 } 368 }
347 } 369 }
348 370
371 # check whether attachment is the same as in the archetype
372 if (exists $ob->{attach}) {
373 my $arch = $ARCH{$ob->{_name}};
374 my $js = JSON::XS->new->utf8->canonical (1);
375
376 if (defined $arch->{attach}
377 && $js->encode ($js->decode ($ob->{attach})) eq $js->encode ($arch->{attach})) {
378 delete $ob->{attach}
379 }
380 }
381
349 # color_fg is used as default for magicmap if magicmap does not exist 382 # 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}; 383 $ob->{magicmap} ||= delete $ob->{color_fg} if exists $ob->{color_fg};
351 384
352 # nuke outdated or never supported fields 385 # nuke outdated or never supported fields
353 delete @$ob{qw( 386 delete @$ob{qw(
… …
361 394
362 # convert movement strings to bitsets 395 # convert movement strings to bitsets
363 for my $attr (keys %FIELD_MOVEMENT) { 396 for my $attr (keys %FIELD_MOVEMENT) {
364 next unless exists $ob->{$attr}; 397 next unless exists $ob->{$attr};
365 398
366 $ob->{$attr} = new Crossfire::MoveType $ob->{$attr}; 399 $ob->{$attr} = new Deliantra::MoveType $ob->{$attr};
367 } 400 }
368 401
369 # convert outdated movement flags to new movement sets 402 # convert outdated movement flags to new movement sets
370 if (defined (my $v = delete $ob->{no_pass})) { 403 if (defined (my $v = delete $ob->{no_pass})) {
371 $ob->{move_block} = new Crossfire::MoveType $v ? "all" : ""; 404 $ob->{move_block} = new Deliantra::MoveType $v ? "all" : "0";
372 } 405 }
373 if (defined (my $v = delete $ob->{slow_move})) { 406 if (defined (my $v = delete $ob->{slow_move})) {
374 $ob->{move_slow} += "walk"; 407 $ob->{move_slow} += "walk";
375 $ob->{move_slow_penalty} = $v; 408 $ob->{move_slow_penalty} = $v;
376 } 409 }
377 if (defined (my $v = delete $ob->{walk_on})) { 410 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" } 411 $ob->{move_on} ||= new Deliantra::MoveType; if ($v) { $ob->{move_on} += "walk" } else { $ob->{move_on} -= "walk" }
379 } 412 }
380 if (defined (my $v = delete $ob->{walk_off})) { 413 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" } 414 $ob->{move_off} ||= new Deliantra::MoveType; if ($v) { $ob->{move_off} += "walk" } else { $ob->{move_off} -= "walk" }
382 } 415 }
383 if (defined (my $v = delete $ob->{fly_on})) { 416 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" } 417 $ob->{move_on} ||= new Deliantra::MoveType; if ($v) { $ob->{move_on} += "fly_low" } else { $ob->{move_on} -= "fly_low" }
385 } 418 }
386 if (defined (my $v = delete $ob->{fly_off})) { 419 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" } 420 $ob->{move_off} ||= new Deliantra::MoveType; if ($v) { $ob->{move_off} += "fly_low" } else { $ob->{move_off} -= "fly_low" }
388 } 421 }
389 if (defined (my $v = delete $ob->{flying})) { 422 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" } 423 $ob->{move_type} ||= new Deliantra::MoveType; if ($v) { $ob->{move_type} += "fly_low" } else { $ob->{move_type} -= "fly_low" }
391 } 424 }
392 425
393 # convert idiotic event_xxx things into objects 426 # convert idiotic event_xxx things into objects
394 while (my ($event, $subtype) = each %EVENT_TYPE) { 427 while (my ($event, $subtype) = each %EVENT_TYPE) {
395 if (exists $ob->{"event_${event}_plugin"}) { 428 if (exists $ob->{"event_${event}_plugin"}) {
… …
411# arch as in "arch xxx", ie.. objects 444# arch as in "arch xxx", ie.. objects
412sub normalize_arch($) { 445sub normalize_arch($) {
413 my ($ob) = @_; 446 my ($ob) = @_;
414 447
415 normalize_object $ob; 448 normalize_object $ob;
449
450 return if $ob->{_atype} eq "object";
416 451
417 my $arch = $ARCH{$ob->{_name}} 452 my $arch = $ARCH{$ob->{_name}}
418 or (warn "$ob->{_name}: no such archetype", return $ob); 453 or (warn "$ob->{_name}: no such archetype", return $ob);
419 454
420 if ($arch->{type} == 22) { # map 455 if ($arch->{type} == 22) { # map
… …
456} 491}
457 492
458sub attr_thaw($) { 493sub attr_thaw($) {
459 my ($ob) = @_; 494 my ($ob) = @_;
460 495
461 $ob->{attach} = from_json $ob->{attach} 496 $ob->{attach} = decode_json $ob->{attach}
462 if exists $ob->{attach}; 497 if exists $ob->{attach};
463 498
464 $ob 499 $ob
465} 500}
466 501
467sub attr_freeze($) { 502sub attr_freeze($) {
468 my ($ob) = @_; 503 my ($ob) = @_;
469 504
470 $ob->{attach} = Crossfire::to_json $ob->{attach} 505 $ob->{attach} = JSON::XS->new->utf8->canonical->encode ($ob->{attach})
471 if exists $ob->{attach}; 506 if exists $ob->{attach};
472 507
473 $ob 508 $ob
474} 509}
475 510
… …
495 530
496 my %arc; 531 my %arc;
497 my ($more, $prev); 532 my ($more, $prev);
498 my $comment; 533 my $comment;
499 534
500 open my $fh, "<:raw:perlio:utf8", $path 535 open my $fh, "<:utf8", $path
501 or Carp::croak "$path: $!"; 536 or Carp::croak "$path: $!";
502 537
503# binmode $fh; 538# binmode $fh;
504 539
505 my $parse_block; $parse_block = sub { 540 my $parse_block; $parse_block = sub {
… …
605 my $str; 640 my $str;
606 641
607 my $append; $append = sub { 642 my $append; $append = sub {
608 my %a = %{$_[0]}; 643 my %a = %{$_[0]};
609 644
610 Crossfire::attr_freeze \%a; 645 Deliantra::attr_freeze \%a;
611 Crossfire::normalize_arch \%a; 646 Deliantra::normalize_arch \%a;
612 647
613 # undo the bit-split we did before 648 # undo the bit-split we did before
614 if (exists $a{attack_movement_bits_0_3} or exists $a{attack_movement_bits_4_7}) { 649 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}) 650 $a{attack_movement} = (delete $a{attack_movement_bits_0_3})
616 | (delete $a{attack_movement_bits_4_7}); 651 | (delete $a{attack_movement_bits_4_7});
… …
634 } 669 }
635 670
636 my @kv; 671 my @kv;
637 672
638 for ($a{_name} eq "map" 673 for ($a{_name} eq "map"
639 ? @Crossfire::FIELD_ORDER_MAP 674 ? @Deliantra::FIELD_ORDER_MAP
640 : @Crossfire::FIELD_ORDER) { 675 : @Deliantra::FIELD_ORDER) {
641 push @kv, [$_, delete $a{$_}] 676 push @kv, [$_, delete $a{$_}]
642 if exists $a{$_}; 677 if exists $a{$_};
643 } 678 }
644 679
645 for (sort keys %a) { 680 for (sort keys %a) {
… …
648 } 683 }
649 684
650 for (@kv) { 685 for (@kv) {
651 my ($k, $v) = @$_; 686 my ($k, $v) = @$_;
652 687
653 if (my $end = $Crossfire::FIELD_MULTILINE{$k}) { 688 if (my $end = $Deliantra::FIELD_MULTILINE{$k}) {
654 $v =~ s/\n$//; 689 $v =~ s/\n$//;
655 $str .= "$k\n$v\n$end\n"; 690 $str .= "$k\n$v\n$end\n";
656 } else { 691 } else {
657 $str .= "$k $v\n"; 692 $str .= "$k $v\n";
658 } 693 }
… …
754=cut 789=cut
755 790
756sub arch_attr($) { 791sub arch_attr($) {
757 my ($obj) = @_; 792 my ($obj) = @_;
758 793
759 require Crossfire::Data; 794 require Deliantra::Data;
760 795
761 my $root; 796 my $root;
762 my $attr = { }; 797 my $attr = { };
763 798
764 my $arch = $ARCH{ $obj->{_name} }; 799 my $arch = $ARCH{ $obj->{_name} };
765 my $type = $obj->{type} || $arch->{type}; 800 my $type = $obj->{type} || $arch->{type};
766 801
767 if ($type > 0) { 802 if ($type > 0) {
768 $root = $Crossfire::Data::ATTR{$type}; 803 $root = $Deliantra::Data::ATTR{$type};
769 } else { 804 } else {
770 my %a = (%$arch, %$obj); 805 my %a = (%$arch, %$obj);
771 806
772 if ($a{is_floor} && !$a{alive}) { 807 if ($a{is_floor} && !$a{alive}) {
773 $root = $Crossfire::Data::TYPE{Floor}; 808 $root = $Deliantra::Data::TYPE{Floor};
774 } elsif (!$a{is_floor} && $a{alive} && !$a{tear_down}) { 809 } elsif (!$a{is_floor} && $a{alive} && !$a{tear_down}) {
775 $root = $Crossfire::Data::TYPE{"Monster & NPC"}; 810 $root = $Deliantra::Data::TYPE{"Monster & NPC"};
776 } elsif (!$a{is_floor} && !$a{alive} && $a{move_block}) { 811 } elsif (!$a{is_floor} && !$a{alive} && $a{move_block}) {
777 $root = $Crossfire::Data::TYPE{Wall}; 812 $root = $Deliantra::Data::TYPE{Wall};
778 } elsif (!$a{is_floor} && $a{alive} && $a{tear_down}) { 813 } elsif (!$a{is_floor} && $a{alive} && $a{tear_down}) {
779 $root = $Crossfire::Data::TYPE{"Weak Wall"}; 814 $root = $Deliantra::Data::TYPE{"Weak Wall"};
780 } else { 815 } else {
781 $root = $Crossfire::Data::TYPE{Misc}; 816 $root = $Deliantra::Data::TYPE{Misc};
782 } 817 }
783 } 818 }
784 819
820 my (%ignore);
785 my @import = ($root); 821 my @import = ($root);
822
823 my @new_import;
824 while (my $type = shift @import) {
825 # first import everything we will need:
826 push @import,
827 grep $_,
828 map $Deliantra::Data::TYPE{$_},
829 @{$type->{import} || []};
830
831 # and compute the ignored attributes
832 for (@{$type->{ignore} || []}) {
833 $ignore{$_}++ for ref $_ ? @$_ : $_;
834 }
835
836 push @new_import, $type;
786 837 }
838 (@import) = @new_import;
839
840 # then add defaults to the back of the list, so they are added
841 # as last resort.
787 unshift @import, \%Crossfire::Data::DEFAULT_ATTR 842 push @import, \%Deliantra::Data::DEFAULT_ATTR
788 unless $type == 116; 843 unless $type == 116;
789 844
790 my (%ignore);
791 my (@section_order, %section, @attr_order); 845 my (@section_order, %section, @attr_order);
792 846
847 # @import = root, imported, default
793 while (my $type = shift @import) { 848 while (my $type = pop @import) {
794 push @import, @{$type->{import} || []};
795
796 $attr->{$_} ||= $type->{$_} 849 $attr->{$_} ||= $type->{$_}
797 for qw(name desc use); 850 for qw(name desc use);
798
799 for (@{$type->{ignore} || []}) {
800 $ignore{$_}++ for ref $_ ? @$_ : $_;
801 }
802 851
803 for ([general => ($type->{attr} || [])], @{$type->{section} || []}) { 852 for ([general => ($type->{attr} || [])], @{$type->{section} || []}) {
804 my ($name, $attr) = @$_; 853 my ($name, $attr) = @$_;
805 push @section_order, $name; 854 push @section_order, $name;
806 for (@$attr) { 855 for (@$attr) {
807 my ($k, $v) = @$_; 856 my ($k, $v) = @$_;
808 push @attr_order, $k; 857 push @attr_order, $k;
809 $section{$name}{$k} ||= $v; 858 $section{$name}{$k} = $v; # overwrite, so that the root decides
810 }
811 } 859 }
860 }
861 }
862
863 # remove ignores for "root" type
864 for (
865 map @{$_->[1]}, # section attributes
866 [general => ($root->{attr} || [])],
867 @{$root->{section} || []}
868 ) {
869 my ($k, $v) = @$_;
870 # skip fixed attributes, if they are ignored thats fine
871 next if $v->{type} eq 'fixed';
872
873 delete $ignore{$k}; # if the attributes are defined explicitly they
874 # should NOT be ignored. ignore should mainly
875 # hit imported/inherited attributes.
812 } 876 }
813 877
814 $attr->{section} = [ 878 $attr->{section} = [
815 map !exists $section{$_} ? () : do { 879 map !exists $section{$_} ? () : do {
816 my $attr = delete $section{$_}; 880 my $attr = delete $section{$_};
… …
820 map exists $attr->{$_} && !$ignore{$_} 884 map exists $attr->{$_} && !$ignore{$_}
821 ? [$_ => delete $attr->{$_}] : (), 885 ? [$_ => delete $attr->{$_}] : (),
822 @attr_order 886 @attr_order
823 ] 887 ]
824 }, 888 },
825
826 exists $section{$_} ? [$_ => delete $section{$_}] : (), 889 exists $section{$_} ? [$_ => delete $section{$_}] : (),
827 @section_order 890 @section_order
828 ]; 891 ];
829 892
830 $attr 893 $attr
831} 894}
… …
888} 951}
889 952
890sub construct_tilecache_pb { 953sub construct_tilecache_pb {
891 my ($idx, $cache) = @_; 954 my ($idx, $cache) = @_;
892 955
893 my $pb = new Gtk2::Gdk::Pixbuf "rgb", 1, 8, 64 * TILESIZE, TILESIZE * int +($idx + 63) / 64; 956 my $pb = new Gtk2::Gdk::Pixbuf "rgb", 1, 8, CACHESTRIDE * TILESIZE, TILESIZE * int +($idx + CACHESTRIDE - 1) / CACHESTRIDE;
894 957
895 while (my ($name, $tile) = each %$cache) { 958 while (my ($name, $tile) = each %$cache) {
896 my $tpb = delete $tile->{pb}; 959 my $tpb = delete $tile->{pb};
897 my $ofs = $tile->{idx}; 960 my $ofs = $tile->{idx};
898 961
899 for my $x (0 .. $tile->{w} - 1) { 962 for my $x (0 .. $tile->{w} - 1) {
900 for my $y (0 .. $tile->{h} - 1) { 963 for my $y (0 .. $tile->{h} - 1) {
901 my $idx = $ofs + $x + $y * $tile->{w}; 964 my $idx = $ofs + $x + $y * $tile->{w};
902 $tpb->copy_area ($x * TILESIZE, $y * TILESIZE, TILESIZE, TILESIZE, 965 $tpb->copy_area ($x * TILESIZE, $y * TILESIZE, TILESIZE, TILESIZE,
903 $pb, ($idx % 64) * TILESIZE, TILESIZE * int $idx / 64); 966 $pb, ($idx % CACHESTRIDE) * TILESIZE, TILESIZE * int $idx / CACHESTRIDE);
904 } 967 }
905 } 968 }
906 } 969 }
907 970
908 $pb->save ("$VARDIR/tilecache.png", "png", compression => 1); 971 $pb->save ("$VARDIR/tilecache.png", "png", compression => 1);
… …
924=cut 987=cut
925 988
926sub load_tilecache() { 989sub load_tilecache() {
927 require Gtk2; 990 require Gtk2;
928 991
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, 992 cache_file "$LIB/facedata", "$VARDIR/tilecache.pst", \&use_tilecache,
961 sub { 993 sub {
962 my %cache; 994 my %cache;
963 my $facedata = Storable::retrieve "$LIB/facedata"; 995 my $facedata = Storable::retrieve "$LIB/facedata";
964 996
965 $facedata->{version} == 2 997 $facedata->{version} == 2
966 or die "$LIB/facedata: version mismatch, cannot proceed."; 998 or die "$LIB/facedata: version mismatch, cannot proceed.";
967 999
968 my $faces = $facedata->{faceinfo}; 1000 my $faces = $facedata->{faceinfo};
969 my $idx = 0; 1001 my $idx = 0;
970 1002
971 for (sort keys %$faces) { 1003 for (sort keys %$faces) {
972 my ($face, $info) = ($_, $faces->{$_}); 1004 my ($face, $info) = ($_, $faces->{$_});
973 1005
974 my $pb = new Gtk2::Gdk::PixbufLoader; 1006 my $pb = new Gtk2::Gdk::PixbufLoader;
975 $pb->write ($info->{data32}); 1007 $pb->write ($info->{data32});
976 $pb->close; 1008 $pb->close;
977 my $pb = $pb->get_pixbuf; 1009 my $pb = $pb->get_pixbuf;
978 1010
979 my $tile = $cache{$face} = { 1011 my $tile = $cache{$face} = {
980 pb => $pb, 1012 pb => $pb,
981 idx => $idx, 1013 idx => $idx,
982 w => int $pb->get_width / TILESIZE, 1014 w => int $pb->get_width / TILESIZE,
983 h => int $pb->get_height / TILESIZE, 1015 h => int $pb->get_height / TILESIZE,
984 }; 1016 };
985 1017
986 $idx += $tile->{w} * $tile->{h}; 1018 $idx += $tile->{w} * $tile->{h};
987 } 1019 }
988 1020
989 construct_tilecache_pb $idx, \%cache; 1021 construct_tilecache_pb $idx, \%cache;
990 1022
991 \%cache 1023 \%cache
992 }; 1024 };
993 }
994} 1025}
1026
1027=back
995 1028
996=head1 AUTHOR 1029=head1 AUTHOR
997 1030
998 Marc Lehmann <schmorp@schmorp.de> 1031 Marc Lehmann <schmorp@schmorp.de>
999 http://home.schmorp.de/ 1032 http://home.schmorp.de/
… …
1002 http://www.ta-sa.org/ 1035 http://www.ta-sa.org/
1003 1036
1004=cut 1037=cut
1005 1038
10061 10391
1040

Diff Legend

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