User:3247's Image Wizard/Scripts/dvk2svg.pl
Jump to navigation
Jump to search
Dieses perl-Programm konvertiert Verkehrszeichen aus dem DVKAZ-Format, das die Bundesanstalt für Straßenwesen (BASt) für den offiziellen Verkehrszeichenkatalog (VzKat) benutzt, ins SVG-Format.
Voraussetzungen[edit]
Es werden die Zeichensätze "DIN 1451 Mittelschrift" und "DIN 1451 Engschrift" benötigt. Diese müssen mit Batik ins SVG-Format konvertiert werden und im aktuellen Verzeichnis unter den Namen din1451m.svgfont und din1451e.svgfont abgelegt werden.
Dieses Programm besitzt keine vollständige Unterstützung von SVG-Fonts; es ist möglich, dass SVG-Fonts, die mit anderen Konvertern oder mit neueren Versionen von Batik konvertiert wurden, nicht kompatibel sind.
Quelltext[edit]
#!/usr/bin/perl
#
# dvk2svg.pl - Convert DVKAZ (German Road Sign Catalogue) data to SVG
# Copyright (C) 2005 Claus Faerber <claus@faerber.name>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or (at
# your option) any later version.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
# 02110-1301, USA.
#
# As a special exception, permission is granted to include the source
# code of this program into a document and copy, distribute and/or
# modify that document under the terms of the GNU Free Documentation
# License, Version 1.2 or any later version published by the Free
# Software Foundation; with no Invariant Sections, no Front-Cover Texts,
# and no Back-Cover Texts.
#
# If you write modifications of your own for this software, it is your
# choice whether to permit this exception to apply to your
# modifications. If you do not wish that, delete this exception notice.
use utf8;
use Data::Dumper;
use Encode;
use Getopt::Std;
use Math::Trig;
our @colors = ('none', 'white', '#CC0000', '#009933', '#003399', '#993300',
'', '#ffcc33', '#ff6600', '', 'black', '#999999');
print "<?xml version=\"1.0\" standalone=\"no\"?>\n";
print "<!DOCTYPE svg PUBLIC \"-//W3C//DTD SVG 1.1//EN\" \"http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd\">\n";
our ($x_offset,$y_offset);
our ($in_path,$in_svg) = undef;
our @comments = ();
our $path_pos = 0;
sub end_comments { if(@comments && !$head_printed++) { print "<!--\n"; foreach(@comments){s/--/- -/g;
s/Ä/Ae/g; s/Ae/ae/g; s/Ö/Oe/g; s/ö/oe/g; s/Ü/Ue/g; s/ü/ue/g; s/ß/ss/g; s/[\x80-\xFF]/_/g;
print " $_\n";}; print "-->\n"; } @comments=(); }
sub end_path { print "Z" if $in_path && $path_pos; print "\" />\n" if $in_path; $in_path = undef;
print "" if $in_text; $in_text = undef; end_comments(); };
sub end_svg { end_path(); print "</svg>\n" if $in_svg; $in_svg = undef; };
sub start_path {
return if $in_path;
print "<path";
printf " fill=\"%s\"", $colors[$path_fill] if $colors[$path_fill];
print " fill-rule=\"evenodd\"" if $colors[$path_fill];
printf " stroke=\"%s\"", $colors[$path_stroke] if $colors[$path_stroke];
print " stroke-width=\"0.25\"" if int($path_stroke) && $colors[$path_stroke];
print " d=\"";
$in_path = 1; $path_pos = 0;
spos(undef,undef);
};
our $scale = 10;
our($x_offset,$y_offset) = (0,0);
sub dd { return (shift() * $scale) };
sub xx { return dd(shift() + $x_offset) };
sub yy { return dd(shift()*(-1) + $y_offset) };
our($x_pos,$y_pos)=(undef,undef);
sub spos { ($x_pos,$y_pos) = @_; };
sub move { my($pen,$nx,$ny) = @_;
start_path();
if($path_pos++ && $pen == 3) { print "Z\n "; $path_pos = 0; }
printf "%s%f %f",
($pen == 3 ? 'M' : 'L'),
xx($nx),
yy($ny)
unless $nx==$x_pos && $ny==$y_pos
&& (defined $x_pos)
&& (defined $y_pos);
spos($nx,$ny);
};
while(<>)
{
s/[\r\n]*$//;
$_ = Encode::decode('CP850',$_);
if(m/^99(.*)/) {
push @comments,$1;
}
elsif(m/^11(....(..........)(..........)(..........)(..........))/) {
push @comments, $1;
end_svg();
my @data = split /\s+/, $data;
printf "<svg width=\"%f\" height=\"%f\" version=\"1.1\" xmlns=\"http://www.w3.org/2000/svg\">\n", dd($3-$2+10), dd($5-$4+10);
($x_offset,$y_offset) = (-$2+5,$5+5);
$in_path = 0; $in_svg = 1;
}
elsif(m/^43........(...).............(..)/) {
end_path();
$path_fill = $1;
$path_stroke = $2;
}
elsif(m/^37....(..........)(..........)(..........)(..........)(..........)(.)/) {
my($cx,$cy,$as0,$ae0,$r,$pen) = ($1,$2,$3,$4,$5,$6);
my $sgn = $ae0 > $as0 ? 1 : -1;
my $x1 = $cx + $r * cos(deg2rad($as0));
my $y1 = $cy + $r * sin(deg2rad($as0));
move($pen,$x1,$y1);
for( my $as = $as0; $as * $sgn < $ae0 * $sgn ; $as += 120 * $sgn ) {
my $ae = $as + 120 * $sgn; $ae = $ae0 if $ae * $sgn > $ae0 * $sgn;
my $x2 = $cx + $r * cos(deg2rad($ae));
my $y2 = $cy + $r * sin(deg2rad($ae));
printf "A%f %f 0 0 %d %f %f", dd($r), dd($r),
$sgn > 0 ? 0 : 1, xx($x2), yy($y2);
spos($x2,$y2);
}
}
elsif(m/^38....(..........)(..........)(..........)(..........)(..........)(..........)(..........)(.)/) {
my($cx,$cy,$as0,$ae0,$rx,$ry,$tlt,$pen) = ($1,$2,$3,$4,$5,$6,$7,$8);
my $sgn = $ae0 > $as0 ? 1 : -1;
my $x1 = cos(deg2rad($tlt)) * $rx*cos(deg2rad($as0))
- sin(deg2rad($tlt)) * $ry*sin(deg2rad($as0)) + $cx;
my $y1 = sin(deg2rad($tlt)) * $rx*cos(deg2rad($as0))
+ cos(deg2rad($tlt)) * $ry*sin(deg2rad($as0)) + $cy;
move($pen,$x1,$y1);
for( my $as = $as0; $as * $sgn < $ae0 * $sgn ; $as += 120 * $sgn ) {
my $ae = $as + 120 * $sgn; $ae = $ae0 if $ae * $sgn > $ae0 * $sgn;
my $x2 = cos(deg2rad($tlt)) * $rx*cos(deg2rad($ae))
- sin(deg2rad($tlt)) * $ry*sin(deg2rad($ae)) + $cx;
my $y2 = sin(deg2rad($tlt)) * $rx*cos(deg2rad($ae))
+ cos(deg2rad($tlt)) * $ry*sin(deg2rad($ae)) + $cy;
printf "A%f %f %f 0 %d %f %f", dd($rx), dd($ry), -$tlt,
$sgn > 0 ? 0 : 1, xx($x2), yy($y2);
spos($x2,$y2);
}
}
elsif(m/^39....(..........)(..........)(..........)(..........)(......)/ && !@bezier) {
@bezier = ($1,$2,$3,$4,$5);
}
elsif(m/^39....(..........)(..........)(..........)(..........)/ && @bezier) {
my($x1,$y1,$x2,$y2,$pen,$x3,$y3,$x4,$y4) = (@bezier,$1,$2,$3,$4);
move($pen,$x1,$y1);
printf "C%f %f %f %f %f %f",
xx($x2),yy($y2),
xx($x3),yy($y3),
xx($x4),yy($y4);
spos($x4,$y4);
@bezier = ();
}
elsif(m/^42....(..........)(..........)(......)/) {
my($x,$y,$pen) = ($1,$2,$3);
move($3,$x,$y);
}
elsif(m/^47....(..........)(..........)(..........)(..........)...(.)/ && !$in_text) {
$text_font = $5 eq 'M' ? 'DIN 1451 Mittelschrift' : 'DIN 1451 Engschrift';
($text_x,$text_y,$text_size,$text_rot) = ($1,$2,$3,$4);
end_path();
$in_text = 1;
open_font(lc "din1451$5.svgfont");
start_path();
}
elsif(m/^47....(.*)/ && $in_text) {
write_text($1);
} else {
print STDERR "!!!!! $_";
}
}
end_svg();
our($font_info)=undef;
our($font_data)=undef;
sub open_font {
use XML::Parser;
new XML::Parser( Handlers => { Start => sub {
my($expat,$name,%attr) = @_;
if($name eq 'missing-glyph') {
$font_data{'default'} = \%attr;
}
elsif($name eq 'glyph') {
$font_data{$attr{'unicode'}} = \%attr;
}
elsif($name eq 'font-face') {
$font_info = \%attr;
}
}} )->parsefile(shift);
}
our $font_scale;
sub fs_i { return (shift()*1.0) * $font_scale; }
sub fs { return dd(fs_i(shift)).' '; }
sub fx { return xx(fs_i(shift) + $text_x).' '; }
sub fy { return yy(fs_i(shift) + $text_y).' '; }
sub write_text {
my @chars = split //, shift;
my $last = undef;
$font_scale = $text_size / ($font_info->{'ascent'} + $font_info->{'descent'});
foreach my $char (@chars) {
my $char_data = exists $font_data{$char} ? $font_data{$char} : $font_data{'default'};
my $d = $char_data->{'d'};
Dumper($d);
$d =~ s/([LMT])\s*([0-9\.-]+)\s*([0-9\.-]+)/ $1.fx($2).fy($3)/ge;
$d =~ s/([lmt])\s*([0-9\.-]+)\s*([0-9\.-]+)/ $1.fs($2).fs($3)/ge;
$d =~ s/(H)\s*([0-9\.-]+)/ $1.fx($2)/ge;
$d =~ s/(V)\s*([0-9\.-]+)/ $1.fy($2)/ge;
$d =~ s/(h)\s*([0-9\.-]+)/ $1.fs($2)/ge;
$d =~ s/(v)\s*([0-9\.-]+)/ $1.fs($2)/ge;
$d =~ s/([C])\s*([0-9\.-]+)\s*([0-9\.-]+)\s*([0-9\.-]+)\s*([0-9\.-]+)\s*([0-9\.-]+)\s*([0-9\.-]+)/ $1.fx($2).fy($3).fx($4).fy($5).fx($6).fy($6)/ge;
$d =~ s/([c])\s*([0-9\.-]+)\s*([0-9\.-]+)\s*([0-9\.-]+)\s*([0-9\.-]+)\s*([0-9\.-]+)\s*([0-9\.-]+)/ $1.fs($2).fs($3).fs($4).fs($5).fs($6).fs($6)/ge;
$d =~ s/([SQ])\s*([0-9\.-]+)\s*([0-9\.-]+)\s*([0-9\.-]+)\s*([0-9\.-]+)/ $1.fx($2).fy($3).fx($4).fy($5)/ge;
$d =~ s/([sq])\s*([0-9\.-]+)\s*([0-9\.-]+)\s*([0-9\.-]+)\s*([0-9\.-]+)/ $1.fs($2).fs($3).fs($4).fs($5)/ge;
$d =~ s/([A])\s*([0-9\.-]+)\s*([0-9\.-]+)\s*([0-9\.-]+)\s*([0-9\.-]+)\s*([0-9\.-]+)\s*([0-9\.-]+)\s*([0-9\.-]+)/ $1.fs($2).fs($3)."$4 $5 $6".fx($7).fy($8)/ge;
$d =~ s/([a])\s*([0-9\.-]+)\s*([0-9\.-]+)\s*([0-9\.-]+)\s*([0-9\.-]+)\s*([0-9\.-]+)\s*([0-9\.-]+)\s*([0-9\.-]+)/ $1.fs($2).fs($3)."$4 $5 $6".fs($7).fs($8)/ge;
print " $d\n";
$path_pos = $d =~ m/zZ\s*$/ ? 0 : 1;
$text_x += $char_data->{'horiz-adv-x'} * $font_scale;
$last = $_;
}
}