Kategorien
Benutzer:Count Ypsilon/Skript:maplist.pl: Unterschied zwischen den Versionen
Zur Navigation springen
Zur Suche springen
K (Felder ohne NPC-Nennung auch parsen) |
K (Bot: Automatisierte Textersetzung (-85.10.193.197 +welt1.freewar.de)) |
||
(11 dazwischenliegende Versionen von 4 Benutzern werden nicht angezeigt) | |||
Zeile 1: | Zeile 1: | ||
Skript zur Erzeugung einer einfachen, | Skript zur Erzeugung einer einfachen, semikolon-separierten Liste aller Felder. | ||
Spalte 1=Gebietsname, Spalten | Spalte 1=Gebietsname (leer, falls es sich um ein nicht begehbares Grenzfeld handelt) | ||
Spalte 2=0, wenn das Feld unbegehbar ist, 1, wenn es begehbar ist | |||
Spalten 3/4=x und y | |||
Spalte 5=NPC-Name (Feld ist mehrfach in Liste, wenn mehrere NPCs, und einfach mit "none" in Spalte 4, wenn kein NPC) | |||
Spalte 6=URL des Kartenfeld-Bildes | |||
Achtung - Grenzfelder zwischen zwei Gebieten können mehrfach in der Liste auftauchen, einmal mit gesetzten Gebietsnamen beim Gebiet, zu dem sie gehören, und vorher/nachher noch einmal mit leeren Gebietsnamen im Kontext des Gebiets, bei dem sie als Grenzfeld gelistet sind. | |||
<pre> | |||
#!/usr/bin/perl | |||
use strict; | |||
use LWP::UserAgent; | |||
use URI::Escape; | |||
use HTTP::Request; | |||
my $ua = LWP::UserAgent->new(); | |||
my $host = "http://www.fwwiki.de"; | |||
my $url = $host . "/index.php/Kategorie:Karten"; | |||
my $unbegehbar = { | |||
"119;105" => 1, "120;105" => 1, "121;105" => 1, "119;106" => 1, | |||
"120;106" => 1, "119;107" => 1, "120;107" => 1, "119;108" => 1, | |||
"120;108" => 1, "115;109" => 1, "116;109" => 1, "117;109" => 1, | |||
"118;109" => 1, "119;109" => 1, "120;109" => 1, "113;110" => 1, | |||
"114;110" => 1, "115;110" => 1, "116;110" => 1, "117;110" => 1, | |||
"118;110" => 1, "119;110" => 1, "113;111" => 1, "114;111" => 1, | |||
"115;111" => 1, "116;111" => 1, "117;111" => 1, "115;112" => 1, | |||
"116;112" => 1, "116;113" => 1, "123;112" => 1, | |||
"123;113" => 1, "123;115" => 1, "123;116" => 1, "123;117" => 1, | |||
"72;81" => 1, "73;81" => 1, "74;81" => 1, "75;81" => 1, | |||
"70;82" => 1, "71;82" => 1, "72;82" => 1, "73;82" => 1, | |||
"74;82" => 1, "75;82" => 1, "70;83" => 1, "71;83" => 1, | |||
"72;83" => 1, "73;83" => 1, "-308;-194" => 1, | |||
"98;99" => 1, "57;98" => 1, "59;98" => 1, | |||
"81;86" => 1, "81;85" => 1, "82;85" => 1, "83;85" => 1, "80;86" => 1, | |||
"-314;-195" => 1, "-313;-195" => 1, "-314;-194" => 1, "-313;-194" => 1, | |||
"-828;-809" => 1, "-827;-809" => 1, "-828;-808" => 1, "-827;-808" => 1, | |||
}; | |||
while($url ne "") | |||
{ | |||
#print "GET $url\n"; | |||
my $request = HTTP::Request->new("GET", $url); | |||
my $response = $ua->simple_request($request); | |||
my $c = $response->content(); | |||
$url = ""; | |||
while($c =~ /<a([^>]*)>([^<]*)<\/a>/gm) | |||
{ | |||
my ($anchor, $text) = ($1, $2); | |||
my $href; | |||
$href = $1 if ($anchor =~ /href\s*=\s*"([^"]*)"/); | |||
$href =~ s/&/&/g; | |||
my $title; | |||
$title = $1 if ($anchor =~ /title\s*=\s*"([^"]*)"/); | |||
$url = $host.$href if ($text =~ /n.*chste \d+/); | |||
fetchMap($1, $host.$href) if ($text =~ /Karte:\s*(.*)/); | |||
} | |||
} | |||
sub fetchMap | |||
{ | |||
my ($text, $href) = @_; | |||
my $request = HTTP::Request->new("GET", $href."?action=edit"); | |||
my $response = $ua->simple_request($request); | |||
my $c = $response->content(); | |||
my @lines = split(/\n/, $c); | |||
my $firstx; | |||
my $curx; | |||
my $cury; | |||
my $opened; | |||
my $firstline = 1; | |||
foreach my $line(@lines) | |||
{ | |||
next unless ($line =~ /\{\{Karte\/([^|{}\/]+)(\/([^|{}]+))?(\|([^{}]*))?\}\}(\{\{.*\}\})?/); | |||
my ($vorlage, $sub, $argl, $more) = ($1, $3, $5, $6); | |||
my @args = split(/\|/, $argl); | |||
if (!$opened) | |||
{ | |||
$opened = 1 if ($vorlage eq "Beginn"); | |||
next; | |||
} | |||
if ($vorlage eq "Ort" || $vorlage eq "Passage") | |||
# falls zusaetzliche Vorlagen in einer neuen Zeile notiert sind, naechste Zeile einlesen | |||
{ | |||
next; | |||
} | |||
if ($vorlage eq "Ende") | |||
{ | |||
last; | |||
} | |||
elsif ($vorlage eq "NeueZeile") | |||
{ | |||
$firstline = 0; | |||
$curx = $firstx; | |||
} | |||
elsif ($vorlage eq "Koord") | |||
{ | |||
if (($firstline) && (!defined($firstx))) | |||
{ | |||
$firstx = $args[0]; | |||
} | |||
else | |||
{ | |||
$cury = $args[0]; | |||
} | |||
} | |||
elsif ($vorlage =~ /^Feld\d*$/) | |||
{ | |||
my $img = shift(@args); | |||
if ($img eq "http://welt1.freewar.de/freewar/images/map/black.jpg") | |||
{ | |||
print "$text;0;$curx;$cury;;$img\n"; | |||
} | |||
else | |||
{ | |||
push(@args, "none") if (scalar(@args) == 0); | |||
my $begehbar = ($unbegehbar->{"$curx;$cury"}) ? 0 : 1; | |||
foreach my $npc(@args) | |||
{ | |||
if (lc($npc) eq "none") { $npc = "" }; | |||
print "$text;$begehbar;$curx;$cury;$npc;$img\n" unless ($npc =~ /^Alt=/); | |||
} | |||
} | |||
$curx++; | |||
} | |||
else | |||
{ | |||
if ($vorlage eq "Berg") | |||
{ | |||
my $img = "http://welt1.freewar.de/freewar/images/map/std.jpg"; | |||
print "$text;0;$curx;$cury;;$img\n"; | |||
} | |||
elsif ($vorlage eq "Grenzfeld") | |||
{ | |||
my $img = shift(@args); | |||
print "$text;0;$curx;$cury;;$img\n"; | |||
} | |||
elsif ($vorlage ne "Leer") | |||
{ | |||
print STDERR "unbekannt: Vorlage '$vorlage' in '$text'\n"; | |||
next; | |||
} | |||
$curx++; | |||
} | |||
} | |||
} | |||
</pre> |
Aktuelle Version vom 30. Januar 2010, 12:27 Uhr
Skript zur Erzeugung einer einfachen, semikolon-separierten Liste aller Felder.
Spalte 1=Gebietsname (leer, falls es sich um ein nicht begehbares Grenzfeld handelt) Spalte 2=0, wenn das Feld unbegehbar ist, 1, wenn es begehbar ist Spalten 3/4=x und y Spalte 5=NPC-Name (Feld ist mehrfach in Liste, wenn mehrere NPCs, und einfach mit "none" in Spalte 4, wenn kein NPC) Spalte 6=URL des Kartenfeld-Bildes
Achtung - Grenzfelder zwischen zwei Gebieten können mehrfach in der Liste auftauchen, einmal mit gesetzten Gebietsnamen beim Gebiet, zu dem sie gehören, und vorher/nachher noch einmal mit leeren Gebietsnamen im Kontext des Gebiets, bei dem sie als Grenzfeld gelistet sind.
#!/usr/bin/perl use strict; use LWP::UserAgent; use URI::Escape; use HTTP::Request; my $ua = LWP::UserAgent->new(); my $host = "http://www.fwwiki.de"; my $url = $host . "/index.php/Kategorie:Karten"; my $unbegehbar = { "119;105" => 1, "120;105" => 1, "121;105" => 1, "119;106" => 1, "120;106" => 1, "119;107" => 1, "120;107" => 1, "119;108" => 1, "120;108" => 1, "115;109" => 1, "116;109" => 1, "117;109" => 1, "118;109" => 1, "119;109" => 1, "120;109" => 1, "113;110" => 1, "114;110" => 1, "115;110" => 1, "116;110" => 1, "117;110" => 1, "118;110" => 1, "119;110" => 1, "113;111" => 1, "114;111" => 1, "115;111" => 1, "116;111" => 1, "117;111" => 1, "115;112" => 1, "116;112" => 1, "116;113" => 1, "123;112" => 1, "123;113" => 1, "123;115" => 1, "123;116" => 1, "123;117" => 1, "72;81" => 1, "73;81" => 1, "74;81" => 1, "75;81" => 1, "70;82" => 1, "71;82" => 1, "72;82" => 1, "73;82" => 1, "74;82" => 1, "75;82" => 1, "70;83" => 1, "71;83" => 1, "72;83" => 1, "73;83" => 1, "-308;-194" => 1, "98;99" => 1, "57;98" => 1, "59;98" => 1, "81;86" => 1, "81;85" => 1, "82;85" => 1, "83;85" => 1, "80;86" => 1, "-314;-195" => 1, "-313;-195" => 1, "-314;-194" => 1, "-313;-194" => 1, "-828;-809" => 1, "-827;-809" => 1, "-828;-808" => 1, "-827;-808" => 1, }; while($url ne "") { #print "GET $url\n"; my $request = HTTP::Request->new("GET", $url); my $response = $ua->simple_request($request); my $c = $response->content(); $url = ""; while($c =~ /<a([^>]*)>([^<]*)<\/a>/gm) { my ($anchor, $text) = ($1, $2); my $href; $href = $1 if ($anchor =~ /href\s*=\s*"([^"]*)"/); $href =~ s/&/&/g; my $title; $title = $1 if ($anchor =~ /title\s*=\s*"([^"]*)"/); $url = $host.$href if ($text =~ /n.*chste \d+/); fetchMap($1, $host.$href) if ($text =~ /Karte:\s*(.*)/); } } sub fetchMap { my ($text, $href) = @_; my $request = HTTP::Request->new("GET", $href."?action=edit"); my $response = $ua->simple_request($request); my $c = $response->content(); my @lines = split(/\n/, $c); my $firstx; my $curx; my $cury; my $opened; my $firstline = 1; foreach my $line(@lines) { next unless ($line =~ /\{\{Karte\/([^|{}\/]+)(\/([^|{}]+))?(\|([^{}]*))?\}\}(\{\{.*\}\})?/); my ($vorlage, $sub, $argl, $more) = ($1, $3, $5, $6); my @args = split(/\|/, $argl); if (!$opened) { $opened = 1 if ($vorlage eq "Beginn"); next; } if ($vorlage eq "Ort" || $vorlage eq "Passage") # falls zusaetzliche Vorlagen in einer neuen Zeile notiert sind, naechste Zeile einlesen { next; } if ($vorlage eq "Ende") { last; } elsif ($vorlage eq "NeueZeile") { $firstline = 0; $curx = $firstx; } elsif ($vorlage eq "Koord") { if (($firstline) && (!defined($firstx))) { $firstx = $args[0]; } else { $cury = $args[0]; } } elsif ($vorlage =~ /^Feld\d*$/) { my $img = shift(@args); if ($img eq "http://welt1.freewar.de/freewar/images/map/black.jpg") { print "$text;0;$curx;$cury;;$img\n"; } else { push(@args, "none") if (scalar(@args) == 0); my $begehbar = ($unbegehbar->{"$curx;$cury"}) ? 0 : 1; foreach my $npc(@args) { if (lc($npc) eq "none") { $npc = "" }; print "$text;$begehbar;$curx;$cury;$npc;$img\n" unless ($npc =~ /^Alt=/); } } $curx++; } else { if ($vorlage eq "Berg") { my $img = "http://welt1.freewar.de/freewar/images/map/std.jpg"; print "$text;0;$curx;$cury;;$img\n"; } elsif ($vorlage eq "Grenzfeld") { my $img = shift(@args); print "$text;0;$curx;$cury;;$img\n"; } elsif ($vorlage ne "Leer") { print STDERR "unbekannt: Vorlage '$vorlage' in '$text'\n"; next; } $curx++; } } }