package Crossfire;
=head1 NAME

Crossfire - Crossfire maphandling

=cut

our $VERSION = '1.21';

use strict;

use Storable;
use List::Util qw(max);

#use Gtk2;

#init Gtk2::Gdk;

my $LIB = $ENV{CROSSFIRE_LIBDIR}
   or die "\$CROSSFIRE_LIBDIR must be set\n";

my $VARDIR = "$ENV{HOME}/.gcfedit";
mkdir $VARDIR;

sub T (){ 32 }

sub read_pak($) {
   my ($path) = @_;

   eval {
      -M "$VARDIR/crossfire.pak.pst" < -M $path
      && Storable::retrieve "$VARDIR/crossfire.pak.pst"
   } or do {
      my %pak;

      open my $fh, "<:raw", $path
         or die "$_[0]: $!";
      while (<$fh>) {
         my ($type, $id, $len, $path) = split;
         $path =~ s/.*\///;
         read $fh, $pak{$path}, $len;
      }

      Storable::nstore \%pak, "$VARDIR/crossfire.pak.pst";

      \%pak
   }
}

sub read_arch($;$) {
   my ($path) = @_;

   my %arc;
   my ($more, $prev);

   open my $fh, "<:raw", $path
      or die "$path: $!";

   my $parse_block; $parse_block = sub {
      my %arc = @_;

      while (<$fh>) {
         s/\s+$//;
         if (/^end$/i) {
            last;
         } elsif (/^arch (\S+)$/) {
            push @{ $arc{inventory} }, $parse_block->(_name => $1);
         } elsif (/^lore$/) {
            while (<$fh>) {
               last if /^endlore\s*$/i;
               $arc{lore} .= $_;
            }
         } elsif (/^msg$/) {
            while (<$fh>) {
               last if /^endmsg\s*$/i;
               $arc{msg} .= $_;
            }
         } elsif (/^(\S+)\s*(.*)$/) {
            $arc{lc $1} = $2;
         } elsif (/^\s*($|#)/) {
            #
         } else {
            warn "$path: unparsable line '$_' in arch $arc{_name}";
         }
      }

      \%arc
   };

   while (<$fh>) {
      s/\s+$//;
      if (/^more$/i) {
         $more = $prev;
      } elsif (/^object (\S+)$/i) {
         my $name = $1;
         my $arc = $parse_block->(_name => $name);

         if ($more) {
            $more->{more} = $arc;
         } else {
            $arc{$name} = $arc;
         }
         $prev = $arc;
         $more = undef;
      } elsif (/^arch (\S+)$/i) {
         push @{ $arc{arch} }, $parse_block->(_name => $1);
      } elsif (/^\s*($|#)/) {
         #
      } else {
         warn "$path: unparseable top-level line '$_'";
      }
   }

   undef $parse_block; # work around bug in perl not freeing $fh etc.

   \%arc
}

sub cfmap_meta($;$) {
   my ($self, $mapa, $mapname) = @_;

   my $arch = $self->{arch};

   my %meta;

   my ($mapx, $mapy);

   my $map;

   for (@{ $mapa->{arch} }) {
      my ($x, $y) = ($_->{x}, $_->{y});

      if ($_->{_name} eq "map") {
         $meta{info} = $_;

         $mapx = $_->{width}  || $x;
         $mapy = $_->{height} || $y;
      } else {
         push @{ $map->[$x][$y] }, $_;

         # arch map is unreliable w.r.t. width and height
         $mapx = $x + 1 if $mapx <= $x;
         $mapy = $y + 1 if $mapy <= $y;
         #$mapx = $a->{x} + 1, warn "$mapname: arch '$a->{_name}' outside map width at ($a->{x}|$a->{y})\n" if $mapx <= $a->{x};
         #$mapy = $a->{y} + 1, warn "$mapname: arch '$a->{_name}' outside map height at ($a->{x}|$a->{y})\n" if $mapy <= $a->{y};
      }
   }

   $meta{width}  = $mapx;
   $meta{height} = $mapy;

   my %draw_info;
   my %map_info;

   # first pass, gather face stacking order, border and corner info
   for my $x (0 .. $mapx - 1) {
      my $col = $map->[$x];
      for my $y (0 .. $mapy - 1) {
         my $as = $col->[$y] || [];

         for my $layer (0 .. $#$as) {
            my $a = $as->[$layer];

            my $o = $arch->{$a->{_name}}
               or (warn "$mapname: arch '$a->{_name}' not found at ($x|$y)\n"), next;

            #my $is_floor = exists $a->{is_floor}    ? $a->{is_floor}    : $o->{is_floor};
            my $level = $layer * 256;

            $level -= 100 * 256 if $o->{_name} eq "blocked";

            while ($o) {
               my $face = $a->{face} || $o->{face};

               my $mx = $x + $o->{x};
               my $my = $y + $o->{y};

               last if 0 > $mx || $mx >= $mapx
                    || 0 > $my || $my >= $mapy;

               push @{ $map_info{$level}{$mx, $my} }, $a;

               $o = $o->{more};
               $level = ($layer + 1000) * 2; # put "big things" on top, no matter what
            }
         }
      }
   }

   # third pass, gather meta info
   for my $level (sort { $a <=> $b } keys %map_info) {
      my $info = $map_info{$level};

         while (my ($xy, $as) = each %$info) {
            my ($x, $y) = split $;, $xy;

            next if $x < 0 || $x >= $mapx
                 || $y < 0 || $y >= $mapy;

            push @{ $meta{map}[$x][$y] }, $_ for @$as;
         }
   }

   \%meta
}

sub new {
   my $class = shift;
   my $self = bless { }, $class;
   $self->{arch} = read_arch "$LIB/archetypes";
   $self->{tile} = read_pak  "$LIB/crossfire.0";
   $self
}

sub read {
   my ($self, $file) = @_;
   my $mapa = read_arch $file;
   my $map = $self->cfmap_meta ($mapa, $file);
   print "READ: ".join(',', %{$map->{info}})."\n";
   return $map;
}

=head1 AUTHOR

 Marc Lehmann <schmorp@schmorp.de>
 http://home.schmorp.de/

 Robin Redeker <elmex@ta-sa.org>
 http://www.ta-sa.org/

=cut
1;