cgit.sxemacs.org Git - packages/blob - xemacs-packages/x-symbol/fonts/makesub

   1 #!/usr/bin/perl -w
   2 ### makesub --- create super- and subscripts for a bdf base font
   3
   4 ## Copyright (C) 1995 Julian Bradfield, 1996-1999 Free Software Foundation, Inc.
   5
   6 ## Author: Christoph Wedler <wedler@users.sourceforge.net>
   7 ## Version: 3.4
   8 ## Keywords: fonts, WYSIWYG, LaTeX, HTML, wp, math
   9 ## X-URL: http://x-symbol.sourceforge.net/
  10
  11 ## This program is free software; you can redistribute it and/or modify
  12 ## it under the terms of the GNU General Public License as published by
  13 ## the Free Software Foundation; either version 2, or (at your option)
  14 ## any later version.
  15
  16 ## This program is distributed in the hope that it will be useful,
  17 ## but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ## GNU General Public License for more details.
  20
  21 ## You should have received a copy of the GNU General Public License
  22 ## along with this program; if not, write to the Free Software
  23 ## Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  24
  25 ### Commentary:
  26
  27 ## Usage: makesub SOURCE TARGET.
  28
  29 ## TODO: better (more PERLish?) error handling
  30
  31 ## CREDITS: This script is a merge and change of the scripts makesupers and
  32 ## makesub in package "math-mode" by Julian Bradfield <jcb@dcs.ed.ac.uk>.
  33
  34 ### Code:
  35
  36 %supoffs = ( '08' , 3, 10 , 4, 12 , 4, 14 , 5, 16 , 5, 18 , 6, 24, 7 );
  37 ##%supoffs = ( '08' , 3, 10 , 3, 12 , 3, 14 , 3, 16 , 3, 18 , 3, 24, 3 );
  38 %suboffs = ( '08' ,-2, 10 ,-2, 12 ,-3, 14 ,-3, 16 ,-3, 18 ,-4, 24,-5 );
  39
  40 unless ($#ARGV == 1) {
  41     die "Usage: makesub SOURCE TARGET";
  42 }
  43 $source = $ARGV[0] ;
  44 $target = $ARGV[1] ;
  45
  46 $error = 0;
  47
  48 $offset = 0;
  49 $_ = $target;
  50 if (( -r $source ) and (/([0-9][0-9]).*su([bp])\.bdf$/)) {
  51   if ($2 eq "b") { $offset = $suboffs{$1}; }
  52   else { $offset = $supoffs{$1}; }
  53   makesub ($offset, "_su$2", $source, $target);
  54 }
  55 exit $error;
  56
  57 sub makesub {
  58     my ($shift,$suffix,$SOURCE,$TARGET) = @_;
  59     unless (open SOURCE, $SOURCE) {
  60         warn "Cannot read $SOURCE: $!\n";
  61         $error = 1;
  62         return;
  63     }
  64     unless (open TARGET, ">$TARGET") {
  65         warn "Cannot write $TARGET: $!\n";
  66         $error = 1;
  67         return;
  68     }
  69     while (<SOURCE>) {
  70         if ( m/^FONT / ) {
  71             s/^(FONT -)([^-]*)-([^-]*)-([^-]*)-([^-]*)-([^-]*)-([^-]*)-([^-]*)-/"$1$2-$3$suffix-$4-$5-$6-$7-$8-"/e;
  72         } elsif ( m/^FAMILY_NAME / ) {
  73             s/^(FAMILY_NAME \"[^\"]*)(\")/"$1$suffix$2"/e;
  74         } elsif ( m/^(FONTBOUNDINGBOX|BBX) / ) {
  75             ## if we're shifting everything up (sup), the bounding box moves up
  76             ## relative to the origin, so subtract $shift from y
  77             s/ ([-0-9]+)$/' ' .($1 + $shift)/e ;
  78         } elsif ( m/^(CAP_HEIGHT|X_HEIGHT|FONT_ASCENT) / ) {
  79             ## probably ought to add $shift off these, but they'd better not go
  80             ## negative
  81             s/ ([-0-9]+)$/' ' . &max($1 + $shift,0)/e ;
  82         } elsif ( m/^FONT_DESCENT / ) {
  83             ## and subtract shift to these, and not negative
  84             s/ ([-0-9]+)$/' ' . &max($1 - $shift,0)/e ;
  85         }
  86         print TARGET $_;
  87     }
  88     close TARGET;
  89     close SOURCE;
  90 }
  91
  92 sub max { ($_[0] > $_[1]) ? $_[0] : $_[1] ; }
  93
  94 ### makesub ends here