#!/opt/bin/perl

# cfarch2png - convert crossfire maps to png+metadata
# Copyright (C) 2005,2007 Marc Lehmann <cfmaps@schmorp.de>
#
# CFARCH2PNG is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with gvpe; if not, write to the Free Software
# Foundation, Inc. 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA

# Quoth The master himself:
#
# Object ordering is basically like this:
# top face: players or monsters.  If none on the space, object with highest
# visibility value - if equal, then top object in terms of object stacking on the map.
# middle face: Object with highest visibility (of monster/player on a space).  If
# no monster/player, then object with second highest visibility, or if all equal,
# second top object relative to map stacking.
# Bottom object: the highest object that is a floor type object. 
#
# ... I believe that anytime, but it still doesn't mention the smoothlevel
# interaction :(

our $VERSION = '2.001';

use strict;

use Crossfire 1.0;
use List::Util qw(max);

use Gtk2;

sub T (){ 32 }

Crossfire::load_archetypes;
Crossfire::load_tilecache;

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

   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 $level = $layer * 256;

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

               $FACE{$face}
                  or (warn "$mapname: face '$face' not found for arch '$a->{_name}' at ($x|$y)\n"), last;

               my $idx = $FACE{$face}{idx};

               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;

               $draw_info{$level}{$idx}{$mx, $my} |= 0x2000;

               if (0) { # disable smoothing for the time being
               if (my $sface = $FACEDATA{faceinfo}{$face}{smooth}) {
                  $FACE{$sface}
                     or (warn "$mapname: smoothface '$sface' not found for arch '$a->{_name}' at ($x|$y)\n"), last;
                  my $idx = $FACE{$sface}{idx};
                  my $level = $layer * 256 + $FACEDATA{faceinfo}{$face}{smoothlevel};

                  # full tile
                  $draw_info{$level}{$idx}{$mx    , $my    } |= 0x1000;

                  # borders
                  $draw_info{$level}{$idx}{$mx + 1, $my    } |= 0x0091;
                  $draw_info{$level}{$idx}{$mx    , $my + 1} |= 0x0032;
                  $draw_info{$level}{$idx}{$mx - 1, $my    } |= 0x0064;
                  $draw_info{$level}{$idx}{$mx    , $my - 1} |= 0x00c8;

                  # corners
                  $draw_info{$level}{$idx}{$mx + 1, $my + 1} |= 0x0100;
                  $draw_info{$level}{$idx}{$mx - 1, $my + 1} |= 0x0200;
                  $draw_info{$level}{$idx}{$mx - 1, $my - 1} |= 0x0400;
                  $draw_info{$level}{$idx}{$mx + 1, $my - 1} |= 0x0800;
               }
               }

               $o = $o->{more};
            }
         }
      }
   }

   my $map_pb = new Gtk2::Gdk::Pixbuf "rgb", 1, 8, $mapx * T, $mapy * T
      or die;
   $map_pb->fill (0xffffff00);

   # second pass, render the map
   for my $level (sort { $a <=> $b } keys %draw_info) {
      my $v = $draw_info{$level};
      while (my ($face, $info) = each %$v) {
         while (my ($xy, $bits) = each %$info) {
            my ($x, $y) = split $;, $xy;

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

            # bits is __fn cccc CCCC bbbb
            # f  full tile draw with x|y bigface displacement
            # n  do not draw borders&corners
            # c  draw these corners, but...
            # C  ... not these
            # b  draw these borders

            if ($bits & 0x2000) {
               my $ix =     $face % CACHESTRIDE;
               my $iy = int $face / CACHESTRIDE;

               $TILE->composite ($map_pb,
                  $x * T, $y * T,
                  T, T,
                  ($x - $ix) * T, ($y - $iy) * T, 1, 1,
                  "nearest",
                  255
               );
            }

            unless ($bits & 0x1000) {
               my $border = $face + ($bits & 0xf);
               my $bx =     $border % CACHESTRIDE;
               my $by = int $border / CACHESTRIDE;
               $TILE->composite ($map_pb,
                  $x * T, $y * T,
                  T, T,
                  ($x - $bx) * T, ($y - $by) * T, 1, 1,
                  "nearest",
                  255
               ) if $border;

               my $corner = $face + (($bits >> 8) & ~($bits >> 4) & 0xf);
               my $cx =     $corner % CACHESTRIDE;
               my $cy = int $corner / CACHESTRIDE;
               $TILE->composite ($map_pb,
                  $x * T, $y * T,
                  T, T,
                  ($x - $cx) * T, ($y - $cy) * T, 1, 1,
                  "nearest",
                  255
               ) if $corner;
            }
         }
      }
   }

   # 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;
         }
   }

   ($map_pb, \%meta)
}

for my $file (@ARGV) {
   my $mapa = read_arch $file;
   $file =~ s/\.map$//;
   my ($pb, $meta) = cfmap_render $mapa, $file;
   $pb->save ("$file.png~~", "png");
   system "gm", "convert", "$file.png~~", "-filter" => "lanczos", "-geometry" => "3.125%", "-quality" => 85, "$file.jpg";
   #system "mogrify", "-colors" => 65536, "$file.png~"; # destroys transparency
   system "optipng", "-q", "-out", "$file.png~", "$file.png~~";
#   system "pngnq <\Q$file.png~\E >\Q$file.png\E";
   unlink "$file.png~~";
   utime +(stat $file)[8,9], "$file.jpg";
   utime +(stat $file)[8,9], "$file.png~";
   rename "$file.png~", "$file.png";
}