FreewarWiki:Bot/Skripts/makemap.pl

Dieses Script ist hier lediglich archiviert und nicht direkt lauffähig. Wenn Du es benutzen möchtest, musst Du es lokal abspeichern und mit einem geeigneten Interpreter ausführen lassen. Zum Übernehmen solltest Du nicht den unten angezeigten Text verwenden, sondern den Quelltext des Wiki-Artikels: Dazu wählst Du Bearbeiten und kopierst den (meist zwischen PRE-Tags eingefassten) Scripttext.

Sofern Du die Scripte dauerhaft lokal abgespeichert hältst, solltest Du sie vor der nächsten Ausführung darauf prüfen, ob sie noch aktuell sind.

Letzter Bearbeiter: Bwoebi — Zuletzt bearbeitet: 30.06.2017

 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 = 170; # oestlicher Rand, 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;
 }