Benutzer:Count Ypsilon/Skript:makemap.pl

Dieses Skript erzeugt eine Gesamtkarte eines beliebigen Kartenausschnittes. Heruntergeladene Kartenfelder werden dabei zwischengespeichert, um bei erneutem Lauf weniger Netzlast zu erzeugen. Als Eingabe ist eine Kartenfeldliste erforderlich, wie sie das Skript maplist.pl erzeugt. Die Ausgabe erfolgt auf stdout (also geeignet umleiten).

 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 = 200;
 my $max_y = 200;
 
 # 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, $begehbar, $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 (($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;
 }