Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
tree: 47cfa089b6
Fetching contributors…

Cannot retrieve contributors at this time

executable file 549 lines (480 sloc) 15.418 kB
#!/usr/bin/perl
#
# METAPOST to Type 1 converter
#
# THIS FILE IS PUBLIC DOMAIN NOTWITHSTANDING THE COPYRIGHT ON THE
# OVERALL TSUKURIMASHOU PACKAGE
#
# This file is based on the file "mp2pf.awk" from the METATYPE1 package,
# version 0.55. It is a manual translation by Matthew Skala from the
# original Awk into Perl, with a lot of features irrelevant to the
# Tsukurimashou project (namely hinting, kerning, ligatures, and AFM
# files) removed to improve maintainability.
#
# The mp2pf.awk file contains no copyright-related notices of its own, but
# the README for METATYPE1 version 0.55 contains the following notices (in
# English and Polish; the slashes are verbatim from the original and
# presumably are some convention for expressing non-ASCII Polish letters in
# the ASCII file):
#
# This is METATYPE1 package -- a tool for creating Type 1 fonts using
# METAPOST. The package belongs to public domain (no copyrights,
# copylefts, copyups, copydowns, etc.).
# Version: 0.55 (16.09.2009; a tentative version, released along with
# the sources of the Latin Modern fonts ver. 2.003)
# Author: JNS team <JNSteam@gust.org.pl>
#
# To jest pakiet METATYPE1 -- narz/edzie do tworzenia font/ow Type 1
# za pomoc/a systemu METAPOST. Pakiet stanowi dobro wsp/olne
# (/zadnych copyright/ow, copyleft/ow, copyup/ow, copydown/ow, etc.).
# Wersja: 0.55 (16.09.2009 -- wersja opublikowana wraz z wersj/a
# /xr/od/low/a 2.003 pakietu font/ow Latin Modern)
# Autorstwo: JNS team <JNSteam@gust.org.pl>
#
# Although I assert my general right to claim copyright on work of my own
# that draws from public domain source materials, I nonetheless am releasing
# this file to the public domain in an effort to maintain the spirit of the
# JNS team's release above.
#
# The Adobe copyright notice in the Postscript template code below
# refers only to certain boilerplate required by the file format; it
# applies to no other part of this file and falls under the "scènes
# à faire" doctrine in jurisdictions where that is relevant.
#
# 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.
#
# Matthew Skala
# mskala@ansuz.sooke.bc.ca
#
########################################################################
# header from the Awk version (much of this is now irrelevant due to
# deleted code):
# THIS FILE BELONGS TO THE METATYPE1 PACKAGE
#
# It is an AWK script that does the main job of convertion from
# METAPOST output to (raw) Type 1 format
# History:
# 20.04.2006: 0.40, another bug fixed in set_hint (a[5] and a[6]
# used to be used instead of a[7] and a[8], respectively).
# 24.03.2006: ver. 0.39, a bug fixed in setting vstems using the old scheme
# (hsb was not taken into account); local variable `k'
# introduced in `find_stem3'
# 13-20.11.2005: ver. 0.385 adaptation to the new hinting scheme -- cont.
# global hints are not collected (needed by old interpreters);
# BJ: hit replacement corrected (param. stemx added in
# hint_clash; clear_hint doest not touch triple stem data);
# 26.10.2005: adaptation to the new hinting scheme -- cont. (20.5->-20.5)
# 15.10.2005: beginnig of the adaptation to the new hinting scheme
# 09.07.2005: ver. 0.38, adaptation to the possibility of writing
# implicit encodings (like StandardEncoding) and
# to the handling of (optional) CharSet by afm2pfm
# 15.02.2005: ver. 0.37, doubled kerns and ligatures silently ignored by
# default; they can be reported on demand by setting the
# parameter NQ (Non-Quiet; newly introduced) to a `true' value;
# messages prefixed with `MP2PF:'
# 18.09.2004: ver. 0.36, awk script no longer cares for fontdimen names
# 29.04.2003: ver. 0.35, a bug in gawk circumvented (in clear_hints)
# 18.01.2003: ver. 0.34, normal round function introduced; old one
# renamed to fround (forced round); no more mess due
# ADL comment in PFB and Ascender and Descender ones in AFM;
# again fun. rational: superfluously robust ;-)
# 06.01.2003: ver. 0.33, fun. rational: unlikely case included (as a comment)
# 03.01.2003: ver. 0.32, fontdimens and headerbytes handled
# 31.07.2002: banner added
# 14.07.2002: comment (question) added in `pickup_stem'
# 22.09.2001: ver. 0.31 (remarks moved to an informal readme.his file)
# 26.01.2001: an empty set of KPX pairs admitted
# 14.01.2001: functions rational and approx added
########################################################################
# General utility functions
# Find a string describing a rational approximation of a real number
# Awk version was apparently based on "code kindly sent us by
# Berthold K. P. Horn"
sub rational {
my($x,$nlimit,$dlimit)=@_;
my($p0,$q0,$p1,$q1,$p2,$q2,$s,$ds);
# handle zero, negative, and large
return '0 1' if $x==0;
return '-'.&rational(-$x,$nlimit,$dlimit) if $x<0.0;
return &round($x) if $x>$nlimit;
# loop over guesses until the numerator and denominator are too large
$p0=0; $q0=1; $p1=1; $q1=0; $s=$x;
while (1) {
# check for loop termination with best guess
if ((int($s)!=0) &&
(($p1>($nlimit-$p0)/int($s)) || ($q1>($dlimit-$q0)/int($s)))) {
$p2=$p1;
$q2=$q1;
last;
}
# try a new guess, terminate if we're lucky and it's exact
$p2=$p0+int($s)*$p1;
$q2=$q0+int($s)*$q1;
last if $p2/$q2==$x;
$ds=$s-int($s);
last if $ds==0;
$p0=$p1; $q0=$q1; $p1=$p2; $q1=$q2; $s=1/$ds;
}
return "$p2 $q2";
}
# abs() is built-in in Perl and doesn't need to be defined as a function
sub min { return $_[0]<$_[1]?$_[0]:$_[1]; }
sub max { return $_[0]>$_[1]?$_[0]:$_[1]; }
sub round { return $_[0]>=0?int($_[0]+0.5):-int(-$_[0]+0.5); }
# "forced round" - round to nearest int, but complain about it
sub fround {
my($x)=@_;
if ($x!=int($x)) {
&mess("MP2PF: WRONG ROUNDING IN METAPOST $x IN $name");
return $x>=0?int($x+0.5):-int(-$x+0.5);
} else {
return $x;
}
}
# sort space-separated words; we use Perl's instead of the Awk
# version's homemade bubble sort
sub trivial_sort {
return join(' ',sort { $a <=> $b } split(' ',$_[0]));
}
# write an error message - /dev/tty and log file stuff removed
sub mess {
print STDERR $_[0]."\n";
}
########################################################################
# Functions that generate Postscript code
# Generate Postscript code for a rational approximation
sub approx {
my($x)=@_;
my($r,$a,$b);
# Awk version says:
# "32767 is a limit due to old (DOS?) implementations of t1utils"
$r=&rational($x,32767,32767);
($a,$b)=split(' ',$r);
return $b==1?$a:"$r div";
}
sub make_lineto {
my($dx,$dy)=@_;
if (($dx!=0) || ($dy!=0)) {
if ($dx==0) {&store_pfb("\t".&fround($dy).' vlineto');}
elsif ($dy==0) {&store_pfb("\t".&fround($dx).' hlineto');}
else {&store_pfb("\t".&fround($dx).' '.&fround($dy).' rlineto');}
}
}
sub make_moveto {
my($dx,$dy)=@_;
if (($dx!=0) || ($dy!=0)) {
if ($dx==0) {&store_pfb("\t".&fround($dy).' vmoveto');}
elsif ($dy==0) {&store_pfb("\t".&fround($dx).' hmoveto');}
else {&store_pfb("\t".&fround($dx).' '.&fround($dy).' rmoveto');}
}
}
sub make_curveto {
my($dx1,$dy1,$dx2,$dy2,$dx3,$dy3)=@_;
if (($dx1+$dx2+$dx3!=0) || ($dy1+$dy2+$dy3!=0)) {
if (($dy1==0) && ($dx3==0)) {
&store_pfb("\t".&fround($dx1).' '.&fround($dx2).' '
.&fround($dy2).' '.&fround($dy3).' hvcurveto');
} elsif (($dx1==0) && ($dy3==0)) {
&store_pfb("\t".&fround($dy1).' '.&fround($dx2).' '
.&fround($dy2).' '.&fround($dx3).' vhcurveto');
} else {
&store_pfb("\t".&fround($dx1).' '.&fround($dy1).' '.&fround($dx2).' '
.&fround($dy2).' '.&fround($dx3).' '.&fround($dy3).' rrcurveto');
}
}
}
########################################################################
# Other functions
# extract static data from what was pfcommon.dat
sub get_data_files {
my($s,$key,$a);
@PFB_PRO=split(/\n/,<<EOF);
%!PS-AdobeFont-1.0: ##FONT_NAME## ##VERSION##
%%CreationDate: ##CREATION_DATE##
% Generated by MetaType1 (a MetaPost-based engine)
% ##AUTHOR##
% ADL: ##ADL_ASCENDER## ##ADL_DESCENDER## ##ADL_LINESKIP##
%%EndComments
FontDirectory/##FONT_NAME## known{/##FONT_NAME## findfont dup/UniqueID known{dup
/UniqueID get 0 eq exch/FontType get 1 eq and}{pop false}ifelse
{save true}{false}ifelse}{false}ifelse
17 dict begin
/FontInfo 9 dict dup begin
/version(##VERSION##)readonly def
/Notice(##AUTHOR##)readonly def
/FullName(##FULL_NAME##)readonly def
/FamilyName(##FAMILY_NAME##)readonly def
/Weight(##WEIGHT##)readonly def
/isFixedPitch ##FIXED_PITCH## def
/ItalicAngle ##ITALIC_ANGLE## def
/UnderlinePosition ##UNDERLINE_POSITION## def
/UnderlineThickness ##UNDERLINE_THICKNESS## def
end readonly def
/FontName /##FONT_NAME## def
##ENCODING_DATA##
/PaintType 0 def
/FontType 1 def
/StrokeWidth 0 def
/FontMatrix[0.001 0 0 0.001 0 0]readonly def
%/UniqueID 0 def
/FontBBox{##FONT_BOUNDING_BOX##}readonly def
currentdict end
currentfile eexec
dup/Private 19 dict dup begin
/RD{string currentfile exch readstring pop}executeonly def
/ND{noaccess def}executeonly def
/NP{noaccess put}executeonly def
/BlueValues[##BLUE_VALUES##]def
/OtherBlues[##OTHER_BLUES##]def
/BlueScale ##BLUE_SCALE## def
/BlueShift ##BLUE_SHIFT## def
/BlueFuzz ##BLUE_FUZZ## def
/MinFeature{16 16}ND
%/UniqueID 0 def
/StdHW[##STDHW##]def
/StdVW[##STDVW##]def
/StemSnapH[##STEMSNAPH##]def
/StemSnapV[##STEMSNAPV##]def
/ForceBold ##FORCE_BOLD## def
/password 5839 def
% Copyright (c) 1987-1990 Adobe Systems Incorporated
% All Rights Reserved.
% This code to be used for hint replacement only
/OtherSubrs
[ { } { } { }
{
systemdict /internaldict known not
{ pop 3 }
{ 1183615869 systemdict /internaldict get exec
dup /startlock known
{ /startlock get exec }
{ dup /strtlck known
{ /strtlck get exec }
{ pop 3 }
ifelse }
ifelse }
ifelse
} executeonly
] noaccess def
/Subrs ##NUMBER_OF_SUBRS## array
dup 0 {
3 0 callothersubr
pop
pop
setcurrentpoint
return
} NP
dup 1 {
0 1 callothersubr
return
} NP
dup 2 {
0 2 callothersubr
return
} NP
dup 3 {
return
} NP
dup 4 {
1 3 callothersubr
pop
callsubr
return
} NP
##SUBROUTINES##
ND
2 index
/CharStrings ##NUMBER_OF_CHARSTRINGS## dict dup begin
/.notdef {
0 280 hsbw
endchar
} ND
EOF
@PFB_TRA=split(/\n/,<<EOF);
end end readonly put put
dup/FontName get exch definefont pop
mark currentfile closefile
cleartomark
{restore}if
EOF
open(FD,$FD);
while (<FD>) {
chomp;
s/\s+$//;
if (/^(.*?) +: *(.*?)$/) {
$font_data{$1}=$2;
} else {
&mess('MP2PF: IMPROPER FONT INFO FILE');
}
}
close(FD);
}
sub store_pfb { push @pfb_text,$_[0]; }
sub flush_pfb {
my($s,$i,$n);
open(PFB,">$PFB");
foreach $n (0..$#PFB_PRO) {
$_=$PFB_PRO[$n];
foreach $i (keys %font_data) {
while (/^(.*)##$i##(.*)$/) {
if ($font_data{$i} eq '') {
$_='';
} else {
$_=$1.$font_data{$i}.$2;
}
}
}
$_='' if /##OTHER_BLUES##/;
if (/##ENCODING_DATA##/) {
if ($font_data{'ENCODING_NAME'} ne '') {
$_='/Encoding '.$font_data{'ENCODING_NAME'}.' def';
} else {
$_="/Encoding 256 array\n"
."0 1 255 {1 index exch /.notdef put} for\n";
foreach $i (0..255) {
if (exists $enc_name[$i]) {
$_.="dup $i/$enc_name[$i] put\n";
}
}
$_.='readonly def';
}
}
s/##FONT_BOUNDING_BOX##/$mllx $mlly $murx $mury/;
if (/##STDHW##/) {
if ($stdhw==0) {
$_='';
} else {
s/##STDHW##/$stdhw/;
}
}
if (/##STDVW##/) {
if ($stdvw==0) {
$_='';
} else {
s/##STVHW##/$stdvw/;
}
}
if (/##STEMSNAPH##/) {
if ($stdhw==0) {
$_='';
} else {
s/##STEMSNAPH##/&tab2str($stemsnaph)/e;
}
}
if (/##STEMSNAPV##/) {
if ($stdvw==0) {
$_='';
} else {
s/##STEMSNAPV##/&tab2str($stemsnapv)/e;
}
}
s/##NUMBER_OF_SUBRS##/2+$subrs_base+$#subrs/e;
$_='' if /##SUBROUTINES##/;
s/##NUMBER_OF_CHARSTRINGS##/$num_enc_chars+$num_oth_chars+1/e;
if (/(##[^#]+##)/) {
mess("MP2PF: EXTRA TAG: $1");
}
print PFB "$_\n" if $_ ne '';
}
foreach (@pfb_text) {
print PFB "$_\n" if $_ ne '';
}
foreach (@PFB_TRA) {
print PFB "$_\n" if $_ ne '';
}
close(PFB);
}
########################################################################
# Main program
$tsuversion='UNKNOWN';
open(MAKEFILE,'Makefile');
while (<MAKEFILE>) {
$tsuversion=$1 if /^VERSION\s*=\s*(\S+)/;
}
close(MAKEFILE);
&mess("This is mp2pf from Tsukurimashou $tsuversion "
.'(converts MP EPSes to PS Type 1 fonts)');
$NAME=shift;
if ($NAME eq '') {
&mess('MP2PF: NAME MUST NOT BE EMPTY');
exit(1);
}
$AFM="$NAME.afm";
$PFB="$NAME.p";
$FD="$NAME.pfi";
$KD="$NAME.kpx";
$PL='piclist.tex';
$PL=$1.$PL if $NAME=~m!^(.*/)!;
$max_font_dimen=99; $max_header_byte=99;
$mllx=10000; $mlly=10000; $murx=-10000; $mury=-10000;
&get_data_files;
# dominant stems chosen manually have the highest priority:
$vstem_stat{$font_data{'STDVW'}}=10000 if defined $font_data{'STDVW'};
$hstem_stat{$font_data{'STDHW'}}=10000 if defined $font_data{'STDHW'};
# standard empty subr has number 3==subrs_base-1
$subrs_base=4; $xsubrs{''}=-1;
# the following code must be consistent with tsufb.mp
open(PL,$PL);
while (<PL>) {
chomp;
if (/EPSNAMEandNumber\{.*?\}\{([0-9]+)\}/i) {
push @file,"$NAME.$1";
}
}
close(PL);
foreach $curr_file (@file) {
open(CURR_FILE,$curr_file);
while (<CURR_FILE>) {
@F=split(/\s+/,$_);
if (/%%BoundingBox:/) {
print STDERR "#" if ($n++)%4==0;
$name=''; $code=0; $hsb=0; $width=0; $x0=0; $y0=0; # sentinels
$curr_path=0; $acc_path=0;
$hsb=$F[1]; $llx=$F[1]; $lly=$F[2]; $urx=$F[3]; $ury=$F[4];
$mllx=$llx if $mllx>$llx; $mlly=$lly if $mlly>$lly;
$murx=$urx if $murx<$urx; $mury=$ury if $mury<$ury;
}
if (/^%GLYNFO:/) {
if ($F[1] eq 'NAME') {$name=$F[2]; $code=$F[3];}
if ($F[1] eq 'HSBW') {
$width=$F[3];
$x0=$hsb; $y0=0;
}
if ($F[1] eq 'ACC') {$acc_path=$F[2];}
if ($F[1] eq 'BEGINCHAR') {
&store_pfb("/$name {\n\t".&fround($hsb).' '.&approx($width).' hsbw');
if ($code>=0) {
$num_enc_chars++;
$enc_name[$code]=$name;
} else {
$num_oth_chars++;
}
}
}
if (/lineto/) {
&make_lineto($F[0]-$x0,$F[1]-$y0);
$x0=$F[0]; $y0=$F[1]
} elsif (/curveto/) {
&make_curveto($F[0]-$x0,$F[1]-$y0,$F[2]-$F[0],$F[3]-$F[1],
$F[4]-$F[2],$F[5]-$F[3]);
$x0=$F[4]; $y0=$F[5];
} elsif (/moveto/) {
&make_moveto($F[1]-$x0,$F[2]-$y0);
$x0=$F[1]; $y0=$F[2]; $x_path0=$x0; $y_path0=$y0;
}
if (/closepath/) {
if (($x0!=$x_path0) || ($y0!=$y_path0)) {
# closing with implicit `lineto'
&store_pfb("\tclosepath");
}
}
if (/showpage/) {
&store_pfb("\tendchar\n\t} ND");
}
}
close(CURR_FILE);
}
print STDERR "\n";
&flush_pfb;
Jump to Line
Something went wrong with that request. Please try again.