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 = 147; # oestlicher Rand Felseninsel+3, damit Itolos und Belpharia-Inseln draussen bleiben
 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;
 }