home *** CD-ROM | disk | FTP | other *** search
/ Mega Top 1 / os2_top1.zip / os2_top1 / APPS / TEKST / GROFFEXE / BIN / AFMTODIT.PL < prev    next >
Text File  |  1994-01-02  |  9KB  |  328 lines
  1. extproc perl -Sx
  2.  
  3. #! /usr/bin/perl
  4. #Copyright (C) 1989, 1990, 1991, 1992 Free Software Foundation, Inc.
  5. #     Written by James Clark (jjc@jclark.com)
  6. #
  7. #This file is part of groff.
  8. #
  9. #groff is free software; you can redistribute it and/or modify it under
  10. #the terms of the GNU General Public License as published by the Free
  11. #Software Foundation; either version 2, or (at your option) any later
  12. #version.
  13. #
  14. #groff is distributed in the hope that it will be useful, but WITHOUT ANY
  15. #WARRANTY; without even the implied warranty of MERCHANTABILITY or
  16. #FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  17. #for more details.
  18. #
  19. #You should have received a copy of the GNU General Public License along
  20. #with groff; see the file COPYING.  If not, write to the Free Software
  21. #Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  22.  
  23. $prog = $0;
  24. $prog =~ s@.*/@@;
  25.  
  26. do 'getopts.pl';
  27. do Getopts('e:sd:i:a:n');
  28.  
  29. if ($#ARGV != 2) {
  30.     die "Usage: $prog [-ns] [-d DESC] [-e encoding] [-i n] [-a angle] afmfile mapfile font\n";
  31. }
  32.  
  33. $afm = $ARGV[0];
  34. $map = $ARGV[1];
  35. $font = $ARGV[2];
  36. $desc = $opt_d || "DESC";
  37.  
  38. # read the afm file
  39.  
  40. open(AFM, $afm) || die "$prog: can't open \`$ARGV[0]': $!\n";
  41.  
  42. while (<AFM>) {
  43.     chop;
  44.     @field = split(' ');
  45.     if ($field[0] eq "FontName") {
  46.     $psname = $field[1];
  47.     }
  48.     elsif($field[0] eq "ItalicAngle") {
  49.     $italic_angle = -$field[1];
  50.     }
  51.     elsif ($field[0] eq "KPX") {
  52.     if ($#field == 3) {
  53.         push(kern1, $field[1]);
  54.         push(kern2, $field[2]);
  55.         push(kernx, $field[3]);
  56.     }
  57.     }
  58.     elsif ($field[0] eq "italicCorrection") {
  59.     $italic_correction{$field[1]} = $field[2];
  60.     }
  61.     elsif ($field[0] eq "leftItalicCorrection") {
  62.     $left_italic_correction{$field[1]} = $field[2];
  63.     }
  64.     elsif ($field[0] eq "subscriptCorrection") {
  65.     $subscript_correction{$field[1]} = $field[2];
  66.     }
  67.     elsif ($field[0] eq "StartCharMetrics") {
  68.     while (<AFM>) {
  69.         @field = split(' ');
  70.         last if ($field[0] eq "EndCharMetrics");
  71.         if ($field[0] eq "C") {
  72.         $c = -1;
  73.         $wx = 0;
  74.         $n = "";
  75.         $lly = 0;
  76.         $ury = 0;
  77.         $llx = 0;
  78.         $urx = 0;
  79.         $c = $field[1];
  80.         $i = 2;
  81.         while ($i <= $#field) {
  82.             if ($field[$i] eq "WX") {
  83.             $w = $field[$i + 1];
  84.             $i += 2;
  85.             }
  86.             elsif ($field[$i] eq "N") {
  87.             $n = $field[$i + 1];
  88.             $i += 2;
  89.             }
  90.             elsif ($field[$i] eq "B") {
  91.             $llx = $field[$i + 1];
  92.             $lly = $field[$i + 2];
  93.             $urx = $field[$i + 3];
  94.             $ury = $field[$i + 4];
  95.             $i += 5;
  96.             }
  97.             elsif ($field[$i] eq "L") {
  98.             push(ligatures, $field[$i + 2]);
  99.             $i += 3;
  100.             }
  101.             else {
  102.             while ($i <= $#field && $field[$i] ne ";") {
  103.                 $i++;
  104.             }
  105.             $i++;
  106.             }
  107.         }
  108.         if (!$opt_e && $c != -1) {
  109.             $encoding[$c] = $n;
  110.             $in_encoding{$n} = 1;
  111.         }
  112.         $width{$n} = $w;
  113.         $height{$n} = $ury;
  114.         $depth{$n} = -$lly;
  115.         $left_side_bearing{$n} = -$llx;
  116.         $right_side_bearing{$n} = $urx - $w;
  117.         }
  118.     }
  119.     }
  120. }
  121. close(AFM);
  122.  
  123. # read the DESC file
  124.  
  125. $sizescale = 1;
  126.  
  127. open(DESC, $desc) || die "$prog: can't open \`$desc': $!\n";
  128. while (<DESC>) {
  129.     next if /^#/;
  130.     chop;
  131.     @field = split(' ');
  132.     last if $field[0] eq "charset";
  133.     if ($field[0] eq "res") { $resolution = $field[1]; }
  134.     if ($field[0] eq "unitwidth") { $unitwidth = $field[1]; }
  135.     if ($field[0] eq "sizescale") { $sizescale = $field[1]; }
  136. }
  137. close(DESC);
  138.  
  139. if ($opt_e) {
  140.     # read the encoding file
  141.     
  142.     open(ENCODING, $opt_e) || die "$prog: can't open \`$opt_e': $!\n";
  143.     while (<ENCODING>) {
  144.     chop;
  145.     @field = split(' ');
  146.     if ($#field == 1) {
  147.         if ($field[1] >= 0 && defined $width{$field[0]}) {
  148.         $encoding[$field[1]] = $field[0];
  149.         $in_encoding{$field[0]} = 1;
  150.         }
  151.     }
  152.     }
  153.     close(ENCODING);
  154. }
  155.  
  156. # read the map file
  157.  
  158. open(MAP, $map) || die "$prog: can't open \`$map': $!\n";
  159. while (<MAP>) {
  160.     next if /^#/;
  161.     chop;
  162.     @field = split(' ');
  163.     if ($#field == 1 && $in_encoding{$field[0]}) {
  164.     if (defined $mapped{$field[1]}) {
  165.         warn "Both $mapped{$field[1]} and $field[0] map to $field[1]";
  166.     }
  167.     elsif ($field[1] eq "space") {
  168.         # the PostScript character `space' is automatically mapped
  169.         # to the groff character `space'; this is for grops
  170.         warn "you are not allowed to map to the groff character `space'";
  171.     }
  172.     elsif ($field[0] eq "space") {
  173.         warn "you are not allowed to map the PostScript character `space'";
  174.     }
  175.     else {
  176.         $nmap{$field[0]} += 0;
  177.         $map{$field[0],$nmap{$field[0]}} = $field[1];
  178.         $nmap{$field[0]} += 1;
  179.         $mapped{$field[1]} = $field[0];
  180.     }
  181.     }
  182. }
  183. close(MAP);
  184.  
  185. $italic_angle = $opt_a if $opt_a;
  186.  
  187. # print it all out
  188.  
  189. open(FONT, ">$font") || die "$prog: can't open \`$font' for output: $!\n";
  190. select(FONT);
  191.  
  192. print("name $font\n");
  193. print("internalname $psname\n") if $psname;
  194. print("special\n") if $opt_s;
  195. printf("slant %g\n", $italic_angle) if $italic_angle != 0;
  196. printf("spacewidth %d\n", do conv($width{"space"})) if defined $width{"space"};
  197.  
  198. if ($opt_e) {
  199.     $e = $opt_e;
  200.     $e =~ s@.*/@@;
  201.     print("encoding $e\n");
  202. }
  203.  
  204. if (!$opt_n && $#ligatures >= 0) {
  205.     print("ligatures");
  206.     foreach $lig (@ligatures) {
  207.     print(" $lig");
  208.     }
  209.     print(" 0\n");
  210. }
  211.  
  212. if ($#kern1 >= 0) {
  213.     print("kernpairs\n");
  214.     
  215.     for ($i = 0; $i <= $#kern1; $i++) {
  216.     $c1 = $kern1[$i];
  217.     $c2 = $kern2[$i];
  218.     if ($in_encoding{$c1} == 1 && $nmap{$c1} != 0
  219.         && $in_encoding{$c2} == 1 && $nmap{$c2} != 0) {
  220.         for ($j = 0; $j < $nmap{$c1}; $j++) {
  221.         for ($k = 0; $k < $nmap{$c2}; $k++) {
  222.             if ($kernx[$i] != 0) {
  223.             printf("%s %s %d\n",
  224.                    $map{$c1,$j},
  225.                    $map{$c2,$k},
  226.                    do conv($kernx[$i]));
  227.             }
  228.         }
  229.         }
  230.     }
  231.     }
  232. }
  233.  
  234. # characters not shorter than asc_boundary are considered to have ascenders
  235. $asc_boundary = $height{"t"} - 1;
  236.  
  237. # likewise for descenders
  238. $desc_boundary = $depth{"g"};
  239. $desc_boundary = $depth{"j"} if $depth{"j"} < $desc_boundary;
  240. $desc_boundary = $depth{"p"} if $depth{"p"} < $desc_boundary;
  241. $desc_boundary = $depth{"q"} if $depth{"q"} < $desc_boundary;
  242. $desc_boundary = $depth{"y"} if $depth{"y"} < $desc_boundary;
  243. $desc_boundary -= 1;
  244.  
  245. if (defined $height{"x"}) {
  246.     $xheight = $height{"x"};
  247. }
  248. elsif (defined $height{"alpha"}) {
  249.     $xheight = $height{"alpha"};
  250. }
  251. else {
  252.     $xheight = 450;
  253. }
  254.  
  255. $italic_angle = $italic_angle*3.14159265358979323846/180.0;
  256. $slant = sin($italic_angle)/cos($italic_angle);
  257. $slant = 0 if $slant < 0;
  258.  
  259. print("charset\n");
  260. for ($i = 0; $i < 256; $i++) {
  261.     $ch = $encoding[$i];
  262.     if ($ch ne "" && $ch ne "space") {
  263.     $map{$ch,"0"} = "---" if $nmap{$ch} == 0;
  264.     $type = 0;
  265.     $h = $height{$ch};
  266.     $h = 0 if $h < 0;
  267.     $d = $depth{$ch};
  268.     $d = 0 if $d < 0;
  269.     $type = 1 if $d >= $desc_boundary;
  270.     $type += 2 if $h >= $asc_boundary;
  271.     printf("%s\t%d", $map{$ch,"0"}, do conv($width{$ch}));
  272.     $italic_correction = 0;
  273.     $left_math_fit = 0;
  274.     $subscript_correction = 0;
  275.     if (defined $opt_i) {
  276.         $italic_correction = $right_side_bearing{$ch} + $opt_i;
  277.         $italic_correction = 0 if $italic_correction < 0;
  278.         $subscript_correction = $slant * $xheight * .8;
  279.         $subscript_correction = $italic_correction if
  280.         $subscript_correction > $italic_correction;
  281.         $left_math_fit = $left_side_bearing{$ch} + $opt_i;
  282.     }
  283.     if (defined $italic_correction{$ch}) {
  284.         $italic_correction = $italic_correction{$ch};
  285.     }
  286.     if (defined $left_italic_correction{$ch}) {
  287.         $left_math_fit = $left_italic_correction{$ch};
  288.     }
  289.     if (defined $subscript_correction{$ch}) {
  290.         $subscript_correction = $subscript_correction{$ch};
  291.     }
  292.     if ($subscript_correction != 0) {
  293.         printf(",%d,%d", do conv($h), do conv($d));
  294.         printf(",%d,%d,%d", do conv($italic_correction),
  295.            do conv($left_math_fit),
  296.            do conv($subscript_correction));
  297.     }
  298.     elsif ($left_math_fit != 0) {
  299.         printf(",%d,%d", do conv($h), do conv($d));
  300.         printf(",%d,%d", do conv($italic_correction),
  301.            do conv($left_math_fit));
  302.     }
  303.     elsif ($italic_correction != 0) {
  304.         printf(",%d,%d", do conv($h), do conv($d));
  305.         printf(",%d", do conv($italic_correction));
  306.     }
  307.     elsif ($d != 0) {
  308.         printf(",%d,%d", do conv($h), do conv($d));
  309.     }
  310.     else {
  311.         # always put the height in to stop groff guessing
  312.         printf(",%d", do conv($h));
  313.     }
  314.     printf("\t%d", $type);
  315.     printf("\t0%03o\t%s\n", $i, $ch);
  316.     for ($j = 1; $j < $nmap{$ch}; $j++) {
  317.         printf("%s\t\"\n", $map{$ch,$j});
  318.     }
  319.     }
  320.     if ($ch eq "space" && defined $width{"space"}) {
  321.     printf("space\t%d\t0\t0%03o\n", do conv($width{"space"}), $i);
  322.     }
  323. }
  324.  
  325. sub conv {
  326.     $_[0]*$unitwidth*$resolution/(72*1000*$sizescale) + ($_[0] < 0 ? -.5 : .5);
  327. }
  328.