Patch title: Release 91 bulk changes
Abstract:
File: /graphic/vector/font.pli
Key:
    Removed line
    Added line
   
abstract
  [Loading and rendering a PostScript Type 1 font]


method f load_postscript filename options -> status
  arg_rw Font f ; arg Str filename options ; arg Status stat
  if false
    (var Stream s) open "pfb:"+filename in+safe
    (var Stream clear) open "file:/tmp/font.txt" out+safe
    while not s:atend
      clear writeline s:readline
    clear close
  (var Stream s) open "pfb:"+filename in+safe
  if s=failure or not (s:readline parse "%!" any)
abstract
  [Loading and rendering a PostScript Type 1 font]


method f load_postscript filename options -> status
  arg_rw Font f ; arg Str filename options ; arg Status stat
  if false
    (var Stream s) open "pfb:"+filename in+safe
    (var Stream clear) open "file:/tmp/font.txt" out+safe
    while not s:atend
      clear writeline s:readline
    clear close
  (var Stream s) open "pfb:"+filename in+safe
  if s=failure or not (s:readline parse "%!" any)
    return failure
    (var Stream s) open filename in+safe
    if s=failure or not (s:readline parse "%!" any)
      return failure
  f file := filename
  var FontContext ctx ; ctx filename := filename
  while not s:atend
    var Str l := s readline
    if (l parse word:"/FontName" "/" any:(var Str n) word:"d
      f psname := n
    eif (l parse word:"/FullName" "(" any:(var Str n) ")" wo
      f fullname := n
    eif (l parse word:"/FamilyName" "(" any:(var Str n) ")" 
      f family := n
    eif type1details and (l parse word:"/Weight" "(" any:(va
      f weight := n
    eif type1details and (l parse word:"/ItalicAngle" (var F
      f italic := ff
    eif type1details and (l parse word:"/isFixedPitch" any:(
      f fixed := n="true"
    eif (l parse word:"/FontBBox" "{" (var Int ix0) (var Int
      f x0 := ix0/1000
      f y0 := -iy1/1000
      f x1 := ix1/1000
      f y1 := -iy0/1000
    eif (l parse word:"dup" (var Int i) "{" any:(var Str d) 
      if i>=0 and i<2^16
        if i>=ctx:subrs:size
          ctx:subrs size := i+1
        ctx:subrs i := d
    eif (l parse "/" any:(var Str n) "{" any:(var Str d) "}"
      ctx:defs insert n d
    eif (l parse word:"dup" (var Int i) "/" any:(var Str n) 
      var Pointer:Int num :> postscript_glyphs first n
      if i>=0 and i<256 and exists:num
        if f:encoding:size=0
          f:encoding size := 256
          for (var Int j) 0 255
            f:encoding j := undefined
        f:encoding i := num
    else
      void
      # console "font line " l eol
  each def ctx:defs
    var Str n := ctx:defs key def
    var Pointer:Int num :> postscript_glyphs first n
    if exists:num
      var FontChar new_ch := var FontChar empty_char
      ctx open_char_def new_ch n
      ctx interprete def
      ctx close_char_def
      if not auto_accent or not exists:(accents first num) o
        f:chars insert num new_ch
    else
      void
      # console "unsupported glyph " def eol
  if f:x0=0 and f:y0=0 and f:x1=0 and f:y1=0
    each ch f:chars
      for (var Int j) 0 ch:curves:size-1
        ch:curves:j bbox (var Float x0) (var Float y0) (var 
        if y0=defined and y1=defined
          f x0 := min f:x0 x0
          f y0 := min f:y0 y0
          f x1 := max f:x1 x1
          f y1 := max f:y1 y1
  f md5 := file_md5_hexa_signature filename
  if verbose
    console "  loaded font " f:fullname eol
  status := success


  f file := filename
  var FontContext ctx ; ctx filename := filename
  while not s:atend
    var Str l := s readline
    if (l parse word:"/FontName" "/" any:(var Str n) word:"d
      f psname := n
    eif (l parse word:"/FullName" "(" any:(var Str n) ")" wo
      f fullname := n
    eif (l parse word:"/FamilyName" "(" any:(var Str n) ")" 
      f family := n
    eif type1details and (l parse word:"/Weight" "(" any:(va
      f weight := n
    eif type1details and (l parse word:"/ItalicAngle" (var F
      f italic := ff
    eif type1details and (l parse word:"/isFixedPitch" any:(
      f fixed := n="true"
    eif (l parse word:"/FontBBox" "{" (var Int ix0) (var Int
      f x0 := ix0/1000
      f y0 := -iy1/1000
      f x1 := ix1/1000
      f y1 := -iy0/1000
    eif (l parse word:"dup" (var Int i) "{" any:(var Str d) 
      if i>=0 and i<2^16
        if i>=ctx:subrs:size
          ctx:subrs size := i+1
        ctx:subrs i := d
    eif (l parse "/" any:(var Str n) "{" any:(var Str d) "}"
      ctx:defs insert n d
    eif (l parse word:"dup" (var Int i) "/" any:(var Str n) 
      var Pointer:Int num :> postscript_glyphs first n
      if i>=0 and i<256 and exists:num
        if f:encoding:size=0
          f:encoding size := 256
          for (var Int j) 0 255
            f:encoding j := undefined
        f:encoding i := num
    else
      void
      # console "font line " l eol
  each def ctx:defs
    var Str n := ctx:defs key def
    var Pointer:Int num :> postscript_glyphs first n
    if exists:num
      var FontChar new_ch := var FontChar empty_char
      ctx open_char_def new_ch n
      ctx interprete def
      ctx close_char_def
      if not auto_accent or not exists:(accents first num) o
        f:chars insert num new_ch
    else
      void
      # console "unsupported glyph " def eol
  if f:x0=0 and f:y0=0 and f:x1=0 and f:y1=0
    each ch f:chars
      for (var Int j) 0 ch:curves:size-1
        ch:curves:j bbox (var Float x0) (var Float y0) (var 
        if y0=defined and y1=defined
          f x0 := min f:x0 x0
          f y0 := min f:y0 y0
          f x1 := max f:x1 x1
          f y1 := max f:y1 y1
  f md5 := file_md5_hexa_signature filename
  if verbose
    console "  loaded font " f:fullname eol
  status := success


export postscript_glyphs font_postscript
export postscript_glyphs '. load_postscript' font_postscript