[ViewVC] Diff of: cvs/deliantra/Deliantra/Deliantra.pm

Comparing deliantra/Deliantra/Deliantra.pm (file contents):
Revision 1.58 by root, Thu Mar 23 20:15:08 2006 UTC vs.
Revision 1.62 by root, Tue Mar 28 14:44:52 2006 UTC

    name name_pl custom_name title race
    slaying skill msg lore other_arch face
    #todo-events
    animation is_animated
-   Str Dex Con Wis Pow Cha Int
+   str dex con wis pow cha int
    hp maxhp sp maxsp grace maxgrace
    exp perm_exp expmul
    food dam luck wc ac x y speed speed_left move_state attack_movement
-   nrof level direction type subtype
+   nrof level direction type subtype attacktype
    resist_physical resist_magic resist_fire resist_electricity
    resist_cold resist_confusion resist_acid resist_drain
    resist_weaponmagic resist_ghosthit resist_poison resist_slow
    resist_paralyze resist_turn_undead resist_fear resist_cancellation
    body_range body_arm body_torso body_head body_neck body_skill
    body_finger body_shoulder body_foot body_hand body_wrist body_waist
 ));
+our %EVENT_TYPE = (
+   apply   =>  1,
+   attack  =>  2,
+   death   =>  3,
+   drop    =>  4,
+   pickup  =>  5,
+   say     =>  6,
+   stop    =>  7,
+   time    =>  8,
+   throw   =>  9,
+   trigger => 10,
+   close   => 11,
+   timer   => 12,
+);
 sub MOVE_WALK      (){ 0x01 }
 sub MOVE_FLY_LOW   (){ 0x02 }
 sub MOVE_FLY_HIGH  (){ 0x04 }
 sub MOVE_FLYING    (){ 0x06 }
 sub MOVE_SWIM      (){ 0x08 }
    close $fh;
    rename "$path~", $path
       or die "$path: $!";
 }
+# object as in "Object xxx", i.e. archetypes
 sub normalize_object($) {
    my ($ob) = @_;
+   # nuke outdated or never supported fields
    delete $ob->{$_} for qw(
       can_knockback can_parry can_impale can_cut can_dam_armour
       can_apply pass_thru can_pass_thru
    );
+   # convert movement strings to bitsets
    for my $attr (keys %FIELD_MOVEMENT) {
       next unless exists $ob->{$attr};
       $ob->{$attr} = MOVE_ALL if $ob->{$attr} == 255; #d# compatibility
       }
       $ob->{$attr} = $flags;
    }
+   # convert outdated movement flags to new movement sets
    if (defined (my $v = delete $ob->{no_pass})) {
       $ob->{move_block} = $v ? MOVE_ALL : 0;
    }
    if (defined (my $v = delete $ob->{slow_move})) {
       $ob->{move_slow} |= MOVE_WALK;
    if (defined (my $v = delete $ob->{flying})) {
       $ob->{move_type} = $v ? $ob->{move_type} | MOVE_FLY_LOW
                             : $ob->{move_type} & ~MOVE_FLY_LOW;
    }
+   # convert idiotic event_xxx things into objects
+   while (my ($event, $subtype) = each %EVENT_TYPE) {
+      if (exists $ob->{"event_${event}_plugin"}) {
+         push @{$ob->{inventory}}, {
+            _name   => "event_$event",
+            title   => delete $ob->{"event_${event}_plugin"},
+            slaying => delete $ob->{"event_${event}"},
+            name    => delete $ob->{"event_${event}_options"},
+         };
+      }
+   }
    $ob
 }
+# arch as in "arch xxx", ie.. objects
 sub normalize_arch($) {
    my ($ob) = @_;
    normalize_object $ob;
 sub editor_archs {
    my %paths;
    for (keys %ARCH) {
       my $arch = $ARCH{$_};
-      push @{$paths{$arch->{editor_folder}}}, \$arch;
+      push @{$paths{$arch->{editor_folder}}}, $arch;
    }
    \%paths
 }
    my $type = $obj->{type} || $arch->{type};
    if ($type > 0) {
       $root = $Crossfire::Data::ATTR{$type};
    } else {
+      my %a = (%$arch, %$obj);
+      if ($a{is_floor} && !$a{alive}) {
+         $root = $Crossfire::Data::TYPE{Floor};
+      } elsif (!$a{is_floor} && $a{alive} && !$a{tear_down}) {
+         $root = $Crossfire::Data::TYPE{"Monster & NPC"};
+      } elsif (!$a{is_floor} && !$a{alive} && $a{move_block}) {
+         $root = $Crossfire::Data::TYPE{Wall};
+      } elsif (!$a{is_floor} && $a{alive} && $a{tear_down}) {
+         $root = $Crossfire::Data::TYPE{"Weak Wall"};
+      } else {
-      $root = $Crossfire::Data::TYPE{Misc};
+         $root = $Crossfire::Data::TYPE{Misc};
-      type:
-      for (@Crossfire::Data::ATTR0) {
-         my $req = $_->{required}
-            or die "internal error: ATTR0 without 'required'";
-         keys %$req;
-         while (my ($k, $v) = each %$req) {
-            next type
-               unless $obj->{$k} == $v || $arch->{$k} == $v;
-         }
-         $root = $_;
       }
    }
    my @import = ($root);
    cache_file "$LIB/crossfire.0", "$VARDIR/tilecache.pst", sub {
       $TILE = new_from_file Gtk2::Gdk::Pixbuf "$VARDIR/tilecache.png"
          or die "$VARDIR/tilecache.png: $!";
       *FACE = $_[0];
    }, sub {
-      require File::Temp;
       my $tile = read_pak "$LIB/crossfire.0";
       my %cache;
       my $idx = 0;
       for my $name (sort keys %$tile) {
-         my ($fh, $filename) = File::Temp::tempfile ();
+         my $pb = new Gtk2::Gdk::PixbufLoader;
-         print $fh $tile->{$name};
+         $pb->write ($tile->{$name});
-         close $fh;
+         $pb->close;
-         my $pb = new_from_file Gtk2::Gdk::Pixbuf $filename;
+         my $pb = $pb->get_pixbuf;
-         unlink $filename;
          my $tile = $cache{$name} = {
             pb  => $pb,
             idx => $idx,
             w   => int $pb->get_width  / TILESIZE,
                                 $pb, ($idx % 64) * TILESIZE, TILESIZE * int $idx / 64);
             }
          }
       }
-      $pb->save ("$VARDIR/tilecache.png", "png");
+      $pb->save ("$VARDIR/tilecache.png", "png", compression => 1);
       \%cache
    };
 }

Diff Legend

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

Comparing deliantra/Deliantra/Deliantra.pm (file contents): Revision 1.58 by root, Thu Mar 23 20:15:08 2006 UTC vs. Revision 1.62 by root, Tue Mar 28 14:44:52 2006 UTC

Diff Legend

Comparing deliantra/Deliantra/Deliantra.pm (file contents):
Revision 1.58 by root, Thu Mar 23 20:15:08 2006 UTC vs.
Revision 1.62 by root, Tue Mar 28 14:44:52 2006 UTC