diff options
Diffstat (limited to 'fonts/utilities/vplutils/spacevpl.pl')
| -rw-r--r-- | fonts/utilities/vplutils/spacevpl.pl | 349 |
1 files changed, 349 insertions, 0 deletions
diff --git a/fonts/utilities/vplutils/spacevpl.pl b/fonts/utilities/vplutils/spacevpl.pl new file mode 100644 index 0000000000..f51201630f --- /dev/null +++ b/fonts/utilities/vplutils/spacevpl.pl @@ -0,0 +1,349 @@ +#!@PERL@ +# spacevpl +# (C) A. J. C. Duggan 1993 +# Alter sizes at sidebearings of VPL files +# +# actions are --- +# -ht expr -wd expr -dp expr -ic expr -hs expr -vs expr +# (ic = italic correction, wd = width, ht = height, dp = depth, +# hs = horizontal shift, vs = vertical shift) +# exprs combine these dimensions and constants with *, /, +, - + +# v1.2 23/9/93 AJCD +# Created at vplutils release level 1.2 + +($prog) = ($0 =~ /([^\/]*)$/); + +unshift(@INC, "@PERLLIBDIR@"); # set perl include directory + +require 'paths.pl'; +require 'parseenc.pl'; +require 'parsepl.pl'; + +############################################################################### +# Auxiliary routines +############################################################################### + +# fatal(...) +# causes a fatal error with the arguments given +sub fatal { + print STDERR "$prog: "; + printf STDERR @_; + print STDERR "\n"; + exit 1; +} + +# inrange(num, range) +# tests if number is in the range given +# range = num[,range] | [num]-[num][,range] | [] +sub inrange { + local($number, $range) = @_; + foreach (split(/,/, $range)) { + if (/^(0x?[\da-fA-F]+)/) { + next if $number < oct($1); + } elsif (/^(\d+)/) { + next if $number < $1; + } + if (/(0x?[\da-fA-F]+)$/) { + next if $number > oct($1); + } elsif (/(\d+)$/) { + next if $number > $1; + } + return 1; + } + 0; +} + +############################################################################### +# Property list manipulation routines +############################################################################### + +# PL property functions +# called by parsepl with normal arguments as parameters + +sub printprop { # print a property + &expand(&property(@_)); + undef; +} + +sub printlist { # print a property list + &expand(&list(@_)); + undef; +} + +sub mapfont { # print a property list with one previous param + local($first) = join(' ', shift, shift); + $mapfont = 1; + &expand(&list($first, @_)); + undef; +} + +sub vtitle { + &expand(&property("COMMENT", @_)); + undef; +} + +sub checksum { # save checksum + local($name, $number) = @_; + push(@fontprops, "(FONTCHECKSUM $number)"); + &expand(&property($name, $number)); + undef; +} + +sub designunits { # save designunits + local($name, $number) = @_; + $designunits = &number($number); + &expand(&property($name, $number)); + undef; +} + +sub designsize { # save designsize + local($name, $number) = @_; + push(@fontprops, "(FONTDSIZE $number)"); + $designsize = &number($number); + &expand(&property($name, $number)); + undef; +} + +# character properties +%charprop = @thismap = (); + +sub charprop { + local($name, $number) = @_; + $charprop{$name} = &number($number)*$designsize/$designunits; + undef; +} + +sub moveright { + local($name, $number) = @_; + if ($charprop{CHARHS} || $charprop{MARKED}) { + &property(@_); + } else { + $charprop{CHARHS} = &number($number)*$designsize/$designunits; + undef; + } +} + +sub moveleft { + local($name, $number) = @_; + if ($charprop{CHARHS} || $charprop{MARKED}) { + &property(@_); + } else { + $charprop{CHARHS} = -&number($number)*$designsize/$designunits; + undef; + } +} + +sub moveup { + local($name, $number) = @_; + if ($charprop{CHARVS} || $charprop{MARKED}) { + &property(@_); + } else { + $charprop{CHARVS} = &number($number)*$designsize/$designunits; + undef; + } +} + +sub movedown { + local($name, $number) = @_; + if ($charprop{CHARVS} || $charprop{MARKED}) { + &property(@_); + } else { + $charprop{CHARVS} = -&number($number)*$designsize/$designunits; + undef; + } +} + +sub mark { # MAP property which makes a mark + $charprop{MARKED} = 1; + &property(@_); +} + +sub map { # deal with MAP lists + shift; + @thismap = @_; + undef; +} + +sub character { # add or replace character properties + local($name) = shift; + local($number) = shift; + local($value) = &number($number); + local(%props) = %charprop; + + if (!$mapfont) { + &expand("(MAPFONT D 0", @fontprops, ")"); + $mapfont = 1; + } + + if (&inrange($value, $range)) { # adjust values + print STDERR "Altering properties for character $number\n" if $debug; + foreach (CHARWD, CHARHT, CHARDP, CHARIC, CHARHS, CHARVS) { + $props{$_} = eval $expr{$_} + if defined($expr{$_}); + } + } + foreach (CHARWD, CHARHT, CHARDP, CHARIC) { + if ($props{$_}) { + push(@_, sprintf("($_ R %.5f)", $props{$_}*$designunits/$designsize)); + } + } + push(@thismap, "(SETCHAR $number)") # add default map if necessary + if !@thismap && ($props{CHARHS} || $props{CHARVS}); + if ($props{CHARHS} > 0) { + unshift(@thismap, sprintf("(MOVERIGHT R %.5f)", + $props{CHARHS}*$designunits/$designsize)); + } elsif ($props{CHARVS} < 0) { + unshift(@thismap, sprintf("(MOVELEFT R %.5f)", + -$props{CHARHS}*$designunits/$designsize)); + } + if ($props{CHARVS} > 0) { + unshift(@thismap, sprintf("(MOVEUP R %.5f)", + $props{CHARVS}*$designunits/$designsize)); + } elsif ($props{CHARVS} < 0) { + unshift(@thismap, sprintf("(MOVEDOWN R %.5f)", + -$props{CHARVS}*$designunits/$designsize)); + } + + @thismap = ("(MAP", @thismap, ")") + if @thismap; + + &expand("(CHARACTER $number", @_, @thismap, ")"); + + %charprop = @thismap = (); + undef; +} + +############################################################################### +# Parsing and tokenisation +############################################################################### + +# list of property -> parameters_action +# (N=number, S=string, P=property list, L=label or number) +&plactions(CHECKSUM, checksum, DESIGNSIZE, designsize, + DESIGNUNITS, designunits, CODINGSCHEME, printprop, + FAMILY, printprop, FACE, printprop, SEVENBITSAFEFLAG, ignore, + HEADER, printprop, BOUNDARYCHAR, printprop, + VTITLE, vtitle, COMMENT, printprop, + FONTDIMEN, printlist, # FONTDIMEN properties follow + SLANT, property, SPACE, property, STRETCH, property, + SHRINK, property, XHEIGHT, property, QUAD, property, + EXTRASPACE, property, NUM1, property, NUM2, property, + NUM3, property, DENOM1, property, DENOM2, property, + SUP1, property, SUP2, property, SUP3, property, + SUB1, property, SUB2, property, SUPDROP, property, + SUBDROP, property, DELIM1, property, DELIM2, property, + AXISHEIGHT, property, DEFAULTRULETHICKNESS, property, + BIGOPSPACING1, property, BIGOPSPACING2, property, + BIGOPSPACING3, property, BIGOPSPACING4, property, + BIGOPSPACING5, property, PARAMETER, property, + LIGTABLE, printlist, # LIGTABLE properties follow + LABEL, property, KRN, property, STOP, property, + SKIP, property, LIG, property, '/LIG', property, + '/LIG>', property, 'LIG/', property, 'LIG/>', property, + '/LIG/', property, '/LIG/>', property, + '/LIG/>>', property, + MAPFONT, mapfont, # MAPFONT properties follow + FONTDSIZE, property, FONTNAME, property, FONTAREA, property, + FONTCHECKSUM, property, FONTAT, property, + CHARACTER, character, # CHARACTER properties follow + CHARWD, charprop, CHARHT, charprop, CHARDP, charprop, + CHARIC, charprop, NEXTLARGER, property, + VARCHAR, list, # VARCHAR properties follow + TOP, property, MID, property, BOT, property, REP, property, + MAP, map, # MAP properties follow + SELECTFONT, property, SETCHAR, mark, + SETRULE, mark, PUSH, mark, POP, mark, + MOVERIGHT, moveright, MOVELEFT, moveleft, MOVEUP, moveup, + MOVEDOWN, movedown, SPECIAL, mark, SPECIALHEX, mark + ); + +############################################################################### +# Expression checking +############################################################################### + +# compileexpr(expr) +# sanitise and convert expression to do-form +sub compileexpr { + local($expr) = shift; + local($paren, $operand, $newexpr) = (0, 1); + foreach (split(/([-()\/*+])/, $expr)) { + s/\s*//g; # drop spaces + next if /^$/; # ignore empty lines + if ($operand) { # operand expected + if (/^\d+$/ || /^\d*\.\d+$/) { # constant + $newexpr .= $_; + $operand = 0; + } elsif (/^wd$/ || /^ht$/ || /^dp$/ || /^ic$/ || /^hs$/ || /^vs$/) { + tr/a-z/A-Z/; # uppercase + $newexpr .= "\$charprop{CHAR$_}"; # character property + $operand = 0; + } elsif (/^ds$/) { # designsize + $newexpr .= "\$designsize"; + $operand = 0; + } elsif (/\(/) { # open parenthesis + $newexpr .= $_; + $paren++; + } elsif (/-/) { # unary negation + $newexpr .= $_; + } else { + &fatal("Operand expected, got $_ in $expr\n"); + } + } else { # operator expected + if (/[-+*\/]/) { # operator found + $newexpr .= $_; + $operand = 1; + } elsif (/\)/) { # close parenthesis + $newexpr .= $_; + &fatal("Unmatched ) in $expr\n") if --$paren < 0; + } else { + &fatal("Operator expected, got $_ in $expr\n"); + } + } + } + &fatal("Unmatched ( in $expr\n") if $paren; + print STDERR "Compiled $expr to $newexpr\n" if $debug; + $newexpr; +} + +############################################################################### +# Argument processing +############################################################################### + +$vtitle = join(' ', $prog, @ARGV); # set VTITLE to arguments +%expr = (); # property -> expression +$range = '-'; # character range + +while (@ARGV) { + $_ = shift; + ARGSW: + { + /^-quiet$/ && ($quiet = 1, last ARGSW); + /^-debug$/ && ($debug = 1, last ARGSW); + /^-range$/ && ($range = shift, last ARGSW); + /^-(ic|wd|ht|dp|hs|vs)$/ && + (($prop = "CHAR$1") =~ tr/a-z/A-Z/, + $expr{$prop} = &compileexpr(shift), last ARGSW); + if (/^-/) { + /^-v$/ && print STDERR "$prog release @RELEASE@\n"; + print STDERR join("\n", + "Usage: $prog [-quiet] [-defenc defaultenc] [-wd expr] [-ht expr] [-dp expr]", + " [-hs expr] [-vs expr] filename\n"); + exit 1; + } else { # filename + &fatal('too many property list files specified') if defined($file); + $file = $_; + } + } +} + +&fatal('no property list files specified') if !defined($file); + +print "(VTITLE created by $vtitle)\n", + "(COMMENT $prog is (C) A. J. C. Duggan 1993)\n"; + +@fontprops = ("(FONTNAME ".&fontname($file).")"); + +&parsepl($file); # process PL file + +exit 0; # good termination |