/* REXX conversion of AFMTODIT.CMD (Perl) by James Clark */
/* Converted by Peter Flass <flass@lbdrscs> - July, 1993 */
/* Requires Rexx math function package or equivalent     */
/*          for sin() and cos() functions                */

Call RxFuncAdd "SysSearchPath" , "RexxUtil" , "SysSearchPath"
Call RxFuncAdd "SysFileDelete" , "RexxUtil" , "SysFileDelete"
Call RxFuncAdd "MathLoadFuncs" , "RxMathFn" , "MathLoadFuncs"
rc = MathLoadFuncs()

Parse Arg args
opt_s=''; opt_e=''; opt_i=''; opt_a='';
argc = Words(args)
opt_s = Wordpos("-s",args)
If opt_s>0 Then args=Delword(args,opt_s,1)
i = Wordpos("-e",args)
If i>0 Then Do
  opt_e = Word(args,i+1)
  args  = Delword(args,i,2)
  End
i = Wordpos("-i",args)
If i>0 Then Do
  opt_i = Word(args,i+1)
  args  = Delword(args,i,2)
  End
i = Wordpos("-a",args)
If i>0 Then Do
  opt_a = Word(args,i+1)
  args  = Delword(args,i,2)
  End
If Words(args)<>3 Then Do
   Say "Usage afmtodit [-s] [-e encoding] [-i n]",
       " [-a angle] afmfile mapfile font"
   Exit 
   End
Parse Var args afm map font
/* Initialize stem variables */
nmap.    = 0
psname   = ''
mapped.  = ''
map.     = ''
encoding.= ''
height.  = 0
depth.   = 0
width.   = 0

kerns=0
ligs=0

italic_angle=0
italic_correction.=''
left_italic_correction.=''
char_space = "space"
char_a     = 'a'
char_alpha = "alpha"
char_x     = 'x'
TAB = X2C(09)

afm_file = afm
If afm_file='' Then Do
   Say "Can't open" afm
   Exit
   End
Do While(lines(afm_file)>0)
   inline=Linein(afm_file)
   If Word(inline,1)="FontName" Then Do
      psname=Word(inline,2)
      End /* FontName */
   Else If Word(inline,1)="ItalicAngle" Then Do
      italic_angle=-Word(inline,2)
      End /* ItalicAngle */
   Else If Word(inline,1)="KPX" Then Do
      If Words(inline)=4 Then Do
         kerns=kerns+1
         kern1.kerns=Word(inline,2)
         kern2.kerns=Word(inline,3)
         kernx.kerns=Word(inline,4)
         End /* Words()=4 */
      End /* KPX */
   Else If Word(inline,1)="italicCorrection" Then Do
      i=Word(inline,2)
      italic_correction.i=Word(inline,3)
      End /* italicCorrection */
   Else If Word(inline,1)="leftItalicCorrection" Then Do
      i=Word(inline,2)
      left_italic_correction.i=Word(inline,3)
      End /* left_italic_correction */
   Else If Word(inline,1)="subscriptCorrection" Then Do
      i=Word(inline,2)
      subscript_correction.i=Word(inline,3)
      End /* subscriptCorrection */
   Else If Word(inline,1)="StartCharMetrics" Then Do
      Call parse_char_metrics
      End /* StartCharMetrics */
   End /* Do While */

/**/
/*      Read the DESC file                       */

desc_file = "DESC"
If desc_file='' Then Do
   Say "Can't open DESC"
   Exit
   End
sizescale=1
resolution=''; unitwidth=''; sizescale=''
Do While(lines(desc_file)>0)
   inline=Linein(desc_file)
   If Substr(inline,1,1)='#' Then Iterate
   If Word(inline,1)="charset" Then Leave
   If Word(inline,1)="res" 
   Then resolution=Word(inline,2)
   If Word(inline,1)="unitwidth" 
   Then unitwidth=Word(inline,2)
   If Word(inline,1)="sizescale" 
   Then sizescale=Word(inline,2)
   End /* Do While */

/*      Read the encoding file                */
If opt_e<>'' Then Do
   encoding_file = opt_e
   If encoding_file='' Then Do
      Say "Can't open" opt_e
      Exit
      End
   Do While(Lines(encoding_file)>0)
      inline=Linein(encoding_file)
      If Words(inline)=2 Then Do
         field0=Word(inline,1)
         field1=Word(inline,2)
         If field1>=0 & width.field0<>'' Then Do
            encoding.field1=field0
            in_encoding.field0=1
            End  /* If */
         End /*Words=2 */
      End /* Do While */
   End /* opt_e */

/*      Read the map file                        */
map_file = map
If map_file='' Then Do
   Say "Can't open" map
   Exit
   End
Do While(lines(map_file)>0)
   inline=Linein(map_file)
   If Substr(inline,1,1)='#' Then Iterate
   field0=Word(inline,1)
   field1=Word(inline,2)
   If Words(inline)=2 & in_encoding.field0=1 Then Do
        If mapped.field1<>''
        Then Say "Both" mapped.field1 "and" field0 "map to" field1
        Else If field1 = "space"
        /* The PostScript character 'space' is automatically mapped */
        /* to the groff character 'space'; this is for grops        */
           Then Say "you are not allowed to map" ,
                    "the Postscript character `space'"
           Else Do
              map.field0   = map.field0 field1
              nmap.field0  = nmap.field0+1
              mapped.field1= field0
              End /* Else */
      End /* If Words */
   End /* Do While */

if opt_a<>'' Then italic_angle=opt_a

/**/
/*----------------------------------------------------*/
/*        Print it all out                            */
/*----------------------------------------------------*/

x = SysFileDelete(font)
If x>2 Then Do
   Say "Can't open" font "for output"
   Exit
   End
x = Lineout(font,"name" font)
x = Lineout(font,"internalname" psname)
If opt_s<>0        Then x = Lineout(font,"special")
if italic_angle<>0 Then x = Lineout(font,"slant" italic_angle)
If width.char_space <> ''
Then x = Lineout(font,"spacewidth",
                 Conv(width.char_space))
If opt_e<>'' Then x = Lineout(font,"encoding" opt_e)

If ligs>0 Then Do
   l=''
   x = Lineout(font,"ligatures")
   Do i=1 To ligs
      l = l ligature.i
      End /* Do */
   l = l "0"
   x = Lineout(font,l)
   End /* ligs>0 */

If kerns>0 Then Do
   x = Lineout(font,"kernpairs")
   Do i=1 To kerns
      c1=kern1.i
      c2=kern2.i
      if in_encoding.c1=1 & nmap.c1<>0 & ,
         in_encoding.c2=1 & nmap.c2<>0 Then Do
         Do j=1 To nmap.c1
            Do k=1 to nmap.c2
               x = Lineout(font,Word(map.c1,j) Word(map.c2,k) ,
                                Conv(kernx.i))
               End /* Do k */
            End /* Do j */
         End /* in_encoding */
      End /* Do i */
   End /* kerns */

/* Characters taller than asc_boundary are considered to have ascenders */
asc_boundary = height.char_a + 50
/* likewise for descenders */
desc_boundary = depth.char_a + 50
If height.char_x <> "HEIGHT.x"
Then xheight = height.char_x
Else If height.char_alpha <> "HEIGHT.alpha"
     Then xheight = height.char_alpha
     Else xheight = 450

/* Convert degrees to radians */
italic_angle = italic_angle * 3.14159265358979323846 / 180
slant        = Sin(italic_angle) / Cos(italic_angle)
If slant<0 Then slant=0

x = Lineout(font,"charset")
Do i=1 to 256
   ch=encoding.i
   l=''
   If ch<>'' & ch<>"space" Then Do
      If nmap.ch=0 Then map.ch="---"
      type=0
      h=height.ch
      If h<0 Then h=0
      d=depth.ch
      if d<0 Then d=0
      If d>desc_boundary Then type=1
      If h>asc_boundary  Then type=type+2
      l = Word(map.ch,1)||TAB||Conv(width.ch)
      italic_correction=0
      left_math_fit=0
      subscript_correction=0
      If opt_i<>'' Then Do
         italic_correction = right_side_bearing.ch + opt_i
         If italic_correction<0 Then italic_correction=0
         subscript_correction = slant * xheight * .8
         If subscript_correction>italic_correction 
         Then subscript_correction = italic_correction
         left_math_fit = left_side_bearing.ch + opt_i
         End /* opt_i */
      If italic_correction.ch <> ''
      Then italic_correction = italic_correction.ch
      If left_italic_correction.ch <> ''
      Then left_math_fit = left_italic_correction.ch
      If subscript_correction <> 0 Then Do
         l = l||','||Conv(h)||','||Conv(d)
         l = l||','||Conv(italic_correction),
              ||','||Conv(left_math_fit),
              ||','||Conv(subscript_correction)
         End /* subscript_correction */
      Else If left_math_fit <> 0 Then Do
         l = l||','||Conv(h)||','||Conv(d)
         l = l||','||Conv(italic_correction),
              ||','||Conv(left_math_fit)||TAB
         End /* left_math_fit */
      Else If italic_correction <> 0 Then Do
         l = l||','||Conv(h)||','||Conv(d)
         l = l||','||Conv(italic_correction)||TAB
         End /* italic_correction */
      Else If d <> 0 Then Do
         l = l||','||Conv(h)||','||Conv(d)||TAB||TAB
         End /* d<>0 */
      Else Do
         /* Always put the height in to stop groff guessing */
         l = l||','||Conv(h)||TAB||TAB
         End /* otherwise */
      l = l || TAB || type
      l = l || TAB || '0'Oct(i) || TAB || ch
      x=Lineout(font,l)
      Do j=2 To nmap.ch
         l = Word(map.ch,j) || TAB || '"'
         x = Lineout(font,l)
         End /* Do j */
      If ch="space" & width.char_space <> '' Then Do
         x = Lineout(font,"space"||TAB||conv(width.char_space)||,
                          TAB||'0'||TAB||'0'Oct(i))
         End /* space */
      End /* <> space */
   End /* Do i */

Exit

/* Convert height and width to device units */
Conv:
   Parse Arg num
   If num='' Then num=0
   If num<0 Then adj=-.5; Else adj=.5
   Return Trunc( num * unitwidth * resolution / ,
                (72*1000*sizescale) + adj )
/* End Conv       */

/**/
/*----------------------------------------------------*/
/*      Process Character metrics from AFM file       */
/*----------------------------------------------------*/
parse_char_metrics:
  Do While(lines(afm_file)>0)
     inline=Linein(afm_file)
     If Word(inline,1)="EndCharMetrics" Then Return
     If Word(inline,1)="C" Then Do
        c  = -1
        wx = 0
        n  = ''
        lly=0; ury=0
        llx=0; urx=0
        c  = Word(inline,2)
        i=3
        Do While(i<=Words(inline))
           If Word(inline,i)="WX" Then Do
              w=Word(inline,i+1)
              i=i+2
              End /* WX */
           Else If Word(inline,i)="N" Then Do
              n=Word(inline,i+1)
              i=i+2;
              End /* N */
           Else If Word(inline,i)="B" Then Do
              llx=Word(inline,i+1)
              lly=Word(inline,i+2)
              urx=Word(inline,i+3)
              ury=Word(inline,i+4)
              i=i+5
              End /* B */
           Else If Word(inline,i)="L" Then Do
              ligs=ligs+1
              ligatures.ligs=Word(inline,i+2)
              i=i+3;
              End /* L */
           Else Do 
              Do While(i<=Words(inline) & ,
                       Word(inline,i)<>';')
                 i=i+1;
                 End /* Do While */
              i=i+1
              End /* Else */
           End /* Do While */

        encoding.c=''
        in_encoding.c=0
        If opt_e='' & c<>"-1" Then Do
           encoding.c=n
           in_encoding.n=1
           End /* opt_e */

        width.n  = w
        height.n = ury
        depth.n  = -lly
        left_side_bearing.n  = -llx
        right_side_bearing.n = urx-w
        nmap.n   = 0
        map.n    = ''

        End /* C */

     End /* Do While */
   Return
/* End parse_char_metrics */

/*   Convert arg to 3 octal digits */
Oct: Procedure
   Parse Arg num
   o=''
   Do i=1 To 3
      z   = Trunc(num/8)
      d   = num-z*8
      o   = d||o
      num = z
      End /* Do */
   Return o
/* End Oct        */