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 <[email protected]> # # 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 = $_; } }