Kategorien
FreewarWiki:Bot/Skripts/makemap.pl
< FreewarWiki:Bot | Skripts
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; }