Source

x-symbol / fonts / makesub

Full commit
#!/usr/bin/perl -w
### makesub --- create super- and subscripts for a bdf base font

## Copyright (C) 1995 Julian Bradfield, 1996-1999 Free Software Foundation, Inc.

## Author: Christoph Wedler <wedler@users.sourceforge.net>
## Version: 3.4
## Keywords: fonts, WYSIWYG, LaTeX, HTML, wp, math
## X-URL: http://x-symbol.sourceforge.net/

## 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, 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., 675 Mass Ave, Cambridge, MA 02139, USA.

### Commentary:

## Usage: makesub SOURCE TARGET.

## TODO: better (more PERLish?) error handling

## CREDITS: This script is a merge and change of the scripts makesupers and
## makesub in package "math-mode" by Julian Bradfield <jcb@dcs.ed.ac.uk>.

### Code:

%supoffs = ( '08' , 3, 10 , 4, 12 , 4, 14 , 5, 16 , 5, 18 , 6, 24, 7 );
##%supoffs = ( '08' , 3, 10 , 3, 12 , 3, 14 , 3, 16 , 3, 18 , 3, 24, 3 );
%suboffs = ( '08' ,-2, 10 ,-2, 12 ,-3, 14 ,-3, 16 ,-3, 18 ,-4, 24,-5 );

unless ($#ARGV == 1) {
    die "Usage: makesub SOURCE TARGET";
}
$source = $ARGV[0] ;
$target = $ARGV[1] ;

$error = 0;

$offset = 0;
$_ = $target;
if (( -r $source ) and (/([0-9][0-9]).*su([bp])\.bdf$/)) {
  if ($2 eq "b") { $offset = $suboffs{$1}; }
  else { $offset = $supoffs{$1}; }
  makesub ($offset, "_su$2", $source, $target);
}
exit $error;

sub makesub {
    my ($shift,$suffix,$SOURCE,$TARGET) = @_;
    unless (open SOURCE, $SOURCE) {
	warn "Cannot read $SOURCE: $!\n";
	$error = 1;
	return;
    }
    unless (open TARGET, ">$TARGET") {
	warn "Cannot write $TARGET: $!\n";
	$error = 1;
	return;
    }
    while (<SOURCE>) {
	if ( m/^FONT / ) {
	    s/^(FONT -)([^-]*)-([^-]*)-([^-]*)-([^-]*)-([^-]*)-([^-]*)-([^-]*)-/"$1$2-$3$suffix-$4-$5-$6-$7-$8-"/e;
	} elsif ( m/^FAMILY_NAME / ) {
	    s/^(FAMILY_NAME \"[^\"]*)(\")/"$1$suffix$2"/e;
	} elsif ( m/^(FONTBOUNDINGBOX|BBX) / ) {
	    ## if we're shifting everything up (sup), the bounding box moves up
	    ## relative to the origin, so subtract $shift from y
	    s/ ([-0-9]+)$/' ' .($1 + $shift)/e ;
	} elsif ( m/^(CAP_HEIGHT|X_HEIGHT|FONT_ASCENT) / ) {
	    ## probably ought to add $shift off these, but they'd better not go
	    ## negative
	    s/ ([-0-9]+)$/' ' . &max($1 + $shift,0)/e ;
	} elsif ( m/^FONT_DESCENT / ) {
	    ## and subtract shift to these, and not negative
	    s/ ([-0-9]+)$/' ' . &max($1 - $shift,0)/e ;
	}
	print TARGET $_;
    }
    close TARGET;
    close SOURCE;
}

sub max { ($_[0] > $_[1]) ? $_[0] : $_[1] ; }

### makesub ends here