--- deliantra/Deliantra/Deliantra.pm	2006/02/05 21:18:07	1.9
+++ deliantra/Deliantra/Deliantra.pm	2006/02/06 23:01:31	1.10
@@ -14,7 +14,7 @@
 
 use Storable;
 
-our @EXPORT = qw(read_pak read_arch arch2map $ARCH TILESIZE);
+our @EXPORT = qw(read_pak read_arch arch2map $ARCH TILESIZE editor_archs arch2pickmap arch_extends);
 
 our $LIB = $ENV{CROSSFIRE_LIBDIR}
    or die "\$CROSSFIRE_LIBDIR must be set\n";
@@ -126,6 +126,142 @@
    }
 }
 
+# put all archs into a hash with editor_face as it's key
+# NOTE: the arrays in the hash values are references to 
+# the archs from $ARCH
+sub editor_archs {
+   my %paths;
+
+   for (keys %$ARCH) {
+      my $arch = $ARCH->{$_};
+      push @{$paths{$arch->{editor_folder}}}, \$arch;
+   }
+
+   return \%paths;
+}
+
+# arch_extends determines how the arch looks like on the map,
+# bigfaces, linked faces and single faces are handled here
+# it returns (<xoffset>, <yoffset>, <width>, <height>)
+# NOTE: non rectangular linked faces are not considered
+sub arch_extends {
+   my ($a) = @_;
+
+   my $TC = \%Crossfire::Tilecache::TILECACHE;
+
+   my $facename =
+      $a->{face} || $ARCH->{$a->{_name}}->{face}
+         or return ();
+
+   my $tile = $TC->{$facename}
+      or (warn "no gfx found for arch '$facename' in arch_size ()"), return;
+
+   if ($tile->{w} > 1 || $tile->{h} > 1) { 
+      # bigfaces
+      return (0, 0, $tile->{w}, $tile->{h});
+
+   } elsif ($a->{more}) {
+      # linked faces
+      my ($miw, $mih, $maw, $mah) = (0, 0, 0, 0);
+      do {
+         $miw > (0 + $a->{x}) and $miw = $a->{x};
+         $mih > (0 + $a->{y}) and $mih = $a->{y};
+         $maw < (0 + $a->{x}) and $maw = $a->{x};
+         $mah < (0 + $a->{y}) and $mah = $a->{y};
+      } while $a = $a->{more};
+
+      return ($miw, $mih, ($maw - $miw) + 1, ($mah - $mih) + 1)
+
+   } else {
+      # single face
+      return (0, 0, 1, 1);
+   }
+}
+
+# arch2pickmap forms a list of archs to a pickmap
+sub arch2pickmap {
+   my ($archs, $w) = @_;
+
+   # sort archs alphabetiacally
+   my $archs = [ sort { ${$a}->{_name} cmp ${$b}->{_name} } @$archs ];
+
+   $w ||= 10; # default width
+   my $num = @$archs;
+   my $map = { };
+   # overall placement coords
+   my $x = 0; 
+   my $y = 0;
+
+   my ($maxh, $maxw) = (0, 0); # maximum sizes, to set map width/height later
+   my $drawn_archs = 1;                  # line-break counter
+   my $max_line_height = 1;
+
+   for (my $i = 0; $i < $num; $i++) {
+
+      defined  ${$archs->[$i]}->{face} or next;
+
+      # check whether this tile was already written (see below at (b))
+      unless (defined $map->{map}[$x][$y]) {
+
+         my ($xoffs, $yoffs, $arch_w, $arch_h) = arch_extends (${$archs->[$i]});
+
+         # these are special placement coords, for chained faces which
+         # have a special placement offset
+         my ($place_x, $place_y) = ($x, $y);
+         $xoffs < 0 and
+            $place_x += -$xoffs;
+         $yoffs < 0 and
+            $place_y += -$yoffs;
+
+         # iterate over the tiles this arch takes
+         # NOTE: Chained archs are maybe not a rectangle, but i don't care
+         # much for that on pickmaps
+
+         for (my $xi = 0; $xi < $arch_w; $xi++) {
+            for (my $yi = 0; $yi < $arch_h; $yi++) {
+
+               my ($lx, $ly) = ($x + $xi, $y + $yi);
+
+               if ($lx == $place_x and $ly == $place_y) {
+                  push @{$map->{map}[$place_x][$place_y]}, my $a = ${$archs->[$i]};
+
+               } else {
+
+                  # (b): here we set occupied tiles, but without the arch
+                  $map->{map}[$lx][$ly] = [];
+               }
+            }
+         }
+         $drawn_archs++;
+
+         $x += $arch_w - 1;
+         $max_line_height < $arch_h
+            and $max_line_height = $arch_h;
+
+      } else {
+         $i--;
+      }
+
+
+      $x++;
+
+      if ($x > $w) {
+
+         $y += $max_line_height;
+         $max_line_height = 1;
+         $x = 0;
+      }
+
+      $maxw < ($x + 1) and $maxw = $x + 1;
+      $maxh < ($y + 1) and $maxh = $y + 1;
+   }
+
+   $map->{height} = $maxh;
+   $map->{width} = $maxw;
+
+   return $map;
+}
+
 sub arch2map($;$) {
    my ($mapa) = @_;