#!/usr/bin/perl
#
# create_mvg.pl - Create line numbers of Munich U-Bahn, bus and tram
# Copyright (C) 2006 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 Math::Trig;
our @data = (
[ 'U1', 'München_U1', '#270' ],
[ 'U2', 'München_U2', '#b00' ],
[ 'U3', 'München_U3', '#e80' ],
[ 'U4', 'München_U4', '#0ca' ],
[ 'U5', 'München_U5', '#b70' ],
[ 'U6', 'München_U6', '#00c' ],
[ 'U7', 'München_U7', '#b70', '#b00' ],
[ 'U8', 'München_U8', '#b00', '#270' ],
[ 'U8', 'München_U8_MO', '#270', '#b00' ],
);
our($font_info)=undef;
our($font_attr)=undef;
our($font_data)=undef;
our ($x_offset,$y_offset);
our $path_pos = 0;
sub end_path { if($in_path) { $data .= "Z" if $path_pos; $data .= "\""; $data .= " />\n"; $in_path = undef; }
$data .= "" if $in_text; $in_text = undef; };
sub start_path {
return if $in_path;
$data .= "<path";
$data .= sprintf " fill=\"%s\"", $path_fill if $path_fill;
$data .= " fill-rule=\"evenodd\"" if $path_fill;
$data .= sprintf " stroke=\"%s\"", $path_stroke if $path_stroke;
$data .= " stroke-width=\"0.25\"" if $path_stroke;
$data .= " d=\"";
$in_path = 1; $path_pos = 0;
spos(undef,undef);
};
our $scale = 1;
our($x_offset,$y_offset) = (0,0);
sub dd { return (shift() * $scale) };
sub xx { return dd(shift() + $x_offset) };
sub yy { return dd(shift() + $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) { $data .= "Z\n "; $path_pos = 0; }
$data .= sprintf "\n %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);
};
open FILES, ">files.txt";
foreach (@data)
{
my($text,$fn,$col_1,$col_2,$col_t,$col_s) = @{$_};
local ($x_offset,$y_offset) = undef;
print STDERR "$fn.svg\n";
open STDOUT, ">$fn.svg";
print '<svg width="1400" height="900" version="1.1" xmlns="http://www.w3.org/2000/svg">',"\n";
print '<rect width="1400" height="900" fill="'.$col_1.'" />', "\n" unless $col_2;
print '<path fill="'.$col_1.'" d="M350 300L1400 0 1400 900 0 900Z" />', "\n",
'<path fill="'.$col_2.'" d="M0 0L1400 0 0 900Z" />', "\n" if $col_2;
my $font_size = 720;
open_font('VeraMoBd.svgfont');
my $pathd = write_text(
1400/2,
900 - (900-$font_size),
$font_size,
$text);
print '<path fill="'.($col_t||'white').'"';
print ' fill-rule="evenodd"' if $pathd =~ m/[Zz].*[Zz]/;
print ' stroke-width="15" stroke="'.$col_s.'"' if $col_s;
print ' d="'.path_clean($pathd).'" />',"\n";
print '</svg>';
print FILES ">$fn.svg\n";
print FILES "{{Information\n";
print FILES "|Description = {{de|Liniennummer der Linie $text der [[:de:U-Bahn München|]].}}".
"{{en|line number sign of line $text of [[:en:Munich U-Bahn|]].}}\n";
print FILES "|Date = {{subst:CURRENTYEAR}}-{{subst:CURRENTMONTH}}-{{subst:CURRENTDAY2}}\n";
print FILES "|Source = created with [[:User:3247's Image Wizard/Scripts/create_mvg.pl|create_mvg.pl]]\n";
print FILES "|Permission = see below\n";
print FILES "|Author = Claus Färber ([[User:3247|]])\n";
print FILES "}}\n";
print FILES "==License==\n";
print FILES "{{PD-self}}\n";
print FILES "[[Category:line numbers of Munich U-Bahn]]\n", $type;
}
exit(0);
sub open_font {
use XML::Parser;
new XML::Parser( Handlers => { Start => sub {
my($expat,$name,%attr) = @_;
if($name eq 'font') {
$font_attr = \%attr;
}
elsif($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)*(-1) + $text_y).' '; }
sub path_clean
{
my $data = shift;
$data =~ s/,/ /g;
$data =~ s/\s*([LMTHVCSQAZ])\s*/$1/gei;
return $data;
}
sub write_text {
my ($text_x_x,$text_y_y,$text_size,$string) = @_;
my $path_data = '';
($text_x,$text_y) = ($text_x_x,$text_y_y);
my @chars = split //, $string;
my $last = undef;
$font_scale = $text_size / ($font_info->{'ascent'} + $font__info->{'descent'});
my $width = 0;
foreach my $char (@chars) {
my $char_data = exists $font_data{$char} ? $font_data{$char} : $font_data{'default'};
$width += ($char_data->{'horiz-adv-x'} || $font_info->{'horiz-adv-x'} || $font_attr->{'horiz-adv-x'}) * $font_scale;
}
$text_x -= $width / 2.0;
foreach my $char (@chars) {
my $char_data = exists $font_data{$char} ? $font_data{$char} : $font_data{'default'};
my $d = $char_data->{'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;
$path_data .= $d;
$text_x += ($char_data->{'horiz-adv-x'} || $font_info->{'horiz-adv-x'} || $font_attr->{'horiz-adv-x'}) * $font_scale;
$last = $_;
}
return $path_data;
}
