FreewarWiki:Bot/Skripts/makemap.pl

use strict;
use GD;
use Digest::MD5 qw(md5_hex);
use LWP::UserAgent;

# makemap.pl
#
# Erzeugt eine Gesamtkarte aus einer Kartenfeld-Liste. Die Kartenfeld-
# Liste muss die Struktur
#
# Gebietname;X;Y;NPC-Name(wird ignoriert);Kartenfeld-URL
#
# haben. 
# 
# Die Kartenfeld-Bilder werden vom Server geholt, wenn sie nicht bereits
# im Cache-Verzeichnis liegen:
my $cache_dir = "./map_cache/";
die ("cannot open directory $cache_dir") unless (-d $cache_dir);

# auf z.b. 5 setzen, wenn felder mit luecken gewuenscht
my $cellspacing = 0;

# auf 1 setzen, wenn alle 5 zeilen/spalten linie gewuenscht
my $draw_grid = 0;

# auf 1 setzen, wenn auch unzugaengliche Felder (Berge, Meer) erscheinen sollen
my $draw_inaccessible = 1;

# Bereich angeben. Alles ausserhalb wird ignoriert. Die Karte wird aber
# immer nur so gross, wie tatsaechlich Felder da sind, nicht so gross,
# wie man hier angibt.
# (nicht mit 1,1 starten, sonst kriegt man den Dummyplace mit)
my $min_x = 2;
my $min_y = 2;
my $max_x = 400;
my $max_y = 400;

# Hintergrundfarbe fuer Karte
my $bgcolor = 0xffffff;

die ("usage: $0 maplistfilename") unless (scalar(@ARGV)==1);
open(MAP, $ARGV[0]) or die "cannot open $ARGV[0]";
my $mapfile;

my $min_x_found = $max_x;
my $min_y_found = $max_y;
my $max_x_found = $min_x;
my $max_y_found = $min_y;

my $mapfields;

my $useragent = LWP::UserAgent->new(); 

while(<MAP>)
{
    # Zeile zerlegen
    my ($gebiet, $betretbar, $x, $y, $npc, $url) = split(/;/);

    # Koordinaten-Check
    next if ($x < $min_x) or ($x > $max_x);
    next if ($y < $min_y) or ($y > $max_y);
    next if ((!$betretbar || $gebiet eq "") && (!$draw_inaccessible));
    $min_x_found = $x if ($x < $min_x_found);
    $min_y_found = $y if ($y < $min_y_found);
    $max_x_found = $x if ($x > $max_x_found);
    $max_y_found = $y if ($y > $max_y_found);

    # Ist Feld schon bekannt?
    my $field = $mapfields->{$x}->{$y};
    if (defined($field))
    {
        # TODO evtl. pruefen ob zusaetzl. Info vorhanden
        next;
    }

    $field->{"url"} = $url;
    $mapfields->{$x}->{$y} = $field;
}
close(MAP);

die ("no map data found in given range") unless scalar(keys(%{$mapfields}));

print STDERR "x range: $min_x_found to $max_x_found\n";
print STDERR "y range: $min_y_found to $max_y_found\n";

# Alle Bilder downloaden, falls noch nicht passiert
my $cachefile;
foreach my $i(values(%{$mapfields})) 
{
    foreach my $field(values(%{$i}))
    {
        my $url = $field->{"url"};
        $cachefile = $cache_dir."/".md5_hex($url).".jpg";
        unless (-f $cachefile)
        {
            $useragent->get($url, ":content_file" => $cachefile);
            die ("cannot download $url to $cachefile") unless (-f $cachefile);
        }
        $field->{"imagefile"} = $cachefile;
    }
}

# Groesse eines Kartenfelds feststellen
my $sampleimage = GD::Image->new($cachefile) 
    or die("cannot create image from $cachefile");
my ($tilewidth, $tileheight) = $sampleimage->getBounds();
print STDERR "tile size: $tilewidth x $tileheight\n";

# Leeres Kartenbild erstellen
my $mapwidth = ($max_x_found-$min_x_found+1)*$tilewidth + 
    ($max_x_found-$min_x_found+2)*$cellspacing;
my $mapheight = ($max_y_found-$min_y_found+1)*$tileheight + 
    ($max_y_found-$min_y_found+2)*$cellspacing;
my $mapimage = GD::Image->new($mapwidth, $mapheight, 1);
print STDERR "map size: $mapwidth x $mapheight\n";

$mapimage->filledRectangle(0, 0, $mapwidth, $mapheight, $bgcolor);

# Gitternetz einzeichnen
if ($draw_grid)
{
    for (my $x = $min_x_found; $x <= $max_x_found; $x++)
    {
        if ($x%5 == 0)
        {
            my $mpx = mapx($x) + ($tilewidth/2);
            $mapimage->line($mpx, 0, $mpx, $mapheight, 0);
        }
    }
    for (my $y = $min_y_found; $y <= $max_y_found; $y++)
    {
        if ($y%5 == 0)
        {
            my $mpy = mapy($y) + ($tileheight/2);
            $mapimage->line(0, $mpy, $mapwidth, $mpy, 0);
        }
    }
}

# Bilder einzeichnen
foreach my $x(keys(%{$mapfields}))
{
    foreach my $y(keys(%{$mapfields->{$x}}))
    {
        my $imgfile = $mapfields->{$x}->{$y}->{"imagefile"};
        my $img = GD::Image->new($imgfile);
        die ("cannot load $imgfile") unless defined($img);

        $mapimage->copy($img, mapx($x), mapy($y), 
            0, 0, $tilewidth, $tileheight);
    }
}

# Ausgabe. Man kann stattdessen auch "->jpg" schreiben o.ae.
print $mapimage->png;

sub mapx
{
    my $x = shift;
    return ($x - $min_x_found) * ($tilewidth + $cellspacing) + $cellspacing;
}

sub mapy
{
    my $y = shift;
    return ($y - $min_y_found) * ($tileheight + $cellspacing) + $cellspacing;
}