Patch title: Release 90 bulk changes
Abstract:
File: /graphic/vector/cff.pli
Key:
    Removed line
    Added line
module "/pliant/language/stream.pli"
module "/pliant/language/unsafe.pli"


method s readn n -> v
  arg_rw Stream s ; arg Int n ; arg uInt v
  if n=1
    s raw_read addressof:(var uInt8 u8) uInt8:size ; v := u8
  eif n=2
    s raw_read addressof:(var uInt16_hi u16) uInt16_hi:size ; v := u16
  eif n=4
    s raw_read addressof:(var uInt32_hi u32) uInt32_hi:size ; v := u32


function decode_int s -> i
  arg Str s ; arg Int i
  var uInt8 b0 := s:0 number
  if b0>=32 and b0<=246
    i := (cast b0 Int)-139
  eif b0>=247 and b0<=250 and s:len>=2
    var uInt8 b1 := s:1 number
    i := (b0-247)*256+b1+108
  eif b0>=251 and b0<=254 and s:len>=2
    var uInt8 b1 := s:1 number
    i := -(b0-251)*256-b1-108
  eif b0=28 and s:len>=3
    i := s:1:number*2^8+s:2:number
    if s:1:number>=128
      i := i .or. -(2^16)
  eif b0=29 and s:len>=5
    i := s:1:number*2^24+s:2:number*2^16+s:3:number*2^8+s:4:number
    if Int:size>4 and s:1:number>=128
      i := i .or. -(2^32)
  else
    i := undefined
  
function decode_float s -> f
  arg Str s ; arg Float f
  var uInt8 b0 := s:0 number
  if b0<>30
    f := undefined
  var Str t
  var Int i := 1
  part scan
    if i>=s:len
      return undefined
    var Int d := s:i:number\16
    if d=15
      leave scan
    else
      t += "0123456789.EE?-?":d
      if d=12
        t += "-"
    var Int d := s:i:number%16
    if d=15
      leave scan
    else
      t += "0123456789.EE?-?":d
      if d=12
        t += "-"
    i += 1
    restart scan
  if not (t parse f)
    f := undefined
      
 
method s atend -> c
  arg_rw Str s ; arg CBool c
  c := s:len=0

method s getc -> v
  arg_rw Str s ; arg uInt v
  v := s:0:number
  s := s 1 s:len

method s decode_top glyphs_offset -> output
  arg_rw Str s ; arg_rw Intn glyphs_offset ; arg Str output
  output := ""
  while not s:atend
    var Int b := s getc
    if b>=32
      var Int val
      if b<=246
        val := b - 139
      eif b<=250
        val := (b - 247)*256 + 108 + s:getc
      eif b<=254
        val := -(b - 251)*256 - 108 - s:getc
      else
        val := 0
        for (var Int i) 0 3
          addressof:val map uInt8 3-i := s getc
      output += " "+string:val
    eif b<>12
      output += " cmd"+string:(cast b Int)
      if b=17
        glyphs_offset := val
    else
      b := s getc
      output += " alt"+string:(cast b Int)
      

method s decode_glyph -> output
  arg_rw Str s ; arg Str output
  output := ""
  while not s:atend
    var Int b := s getc
    if b>=32
      var Int val
      if b<=246
        val := b - 139
      eif b<=250
        val := (b - 247)*256 + 108 + s:getc
      eif b<=254
        val := -(b - 251)*256 - 108 - s:getc
      else
        val := 0
        for (var Int i) 0 3
          addressof:val map uInt8 3-i := s getc
      output += " "+string:val
    else
      if b=1
        output += " hstem"
      eif b=3
        output += " vstem"
      eif b=4
        output += " vmoveto"
      eif b=5
        output += " rlineto"
      eif b=6
        output += " hlineto"
      eif b=7
        output += " vlineto"
      eif b=8
        output += " rrcurveto"
      eif b=9
        output += " closepath"
      eif b=10
        output += " callsubr"
      eif b=11
        output += " return"
      eif b=13
        output += " hsbw"
      eif b=14
        output += " endchar"
      eif b=21
        output += " rmoveto"
      eif b=22
        output += " hmoveto"
      eif b=30
        output += " vhcurveto"
      eif b=31
        output += " hvcurveto"
      eif b=12
        b := s getc
        if b=0
          output += " dotsection"
        eif b=1
          output += " vstem3"
        eif b=2
          output += " hstem3"
        eif b=6
          output += " seac"
        eif b=7
          output += " sbw"
        eif b=12
          output += " div"
        eif b=16
          output += " callothersubr"
        eif b=17
          output += " pop"
        eif b=33
          output += " setcurrentpoint"
        else
          output += " [lb]"+string:(cast b Int)+"[rb]"
      else
        output += " <"+string:(cast b Int)+">"

function cff_decode src dest -> status
  arg_rw Stream src dest ; arg ExtendedStatus status
  # read header
  src raw_read addressof:(var uInt8 major) uInt8:size
  src raw_read addressof:(var uInt8 minor) uInt8:size
  if major<>1 or minor<>0
    return failure:"Unsupported format version"
  src raw_read addressof:(var uInt8 hdrsize) uInt8:size
  src raw_read addressof:(var uInt8 offsize) uInt8:size
  for (var Int i) 5 hdrsize
    src raw_read addressof:(var Byte drop) 1
  var Str top ; var Intn glyphs_offset
  for (var Int ind) 0 4
    if ind=4
      src configure "seek "+string:glyphs_offset
    src raw_read addressof:(var uInt16_hi count) uInt16_hi:size
    console (shunt ind=0 "name" ind=1 "top dict" ind=2 "string" ind=3 "global subr" ind=4 "charStrings" ind=5 "Font DICT" ind=6 "Private DICT" ind=7 "Local Subr" "unknown") " INDEX is " (cast count Int)
    (var Array:Int offsets) size := count+1
    if count>0
      src raw_read addressof:(var uInt8 offsize) uInt8:size
      console "*" (cast offsize Int)
      for (var Int i) 0 count
        offsets i := src readn offsize
    else
      offsets 0 := 1      
    for (var Int i) 0 count
      console " " offsets:i
    console eol
    (src query "seek") parse (var Intn base) ; base -= 1
    if ind=1
      top := repeat offsets:1-offsets:0 " "
      src raw_read top:characters top:len
      console (top decode_top glyphs_offset) eol
    eif ind=4
      var Int head := 0
      for (var Int i) 0 count-1
        src configure "seek "+(string base+offsets:i+head)
        var Str glyph := repeat (offsets i+1)-(offsets i)-head " "
        src raw_read glyph:characters glyph:len
        console "character " i ":" (glyph decode_glyph) eol
    src configure "seek "+(string base+offsets:count)
  status := success
  

function test
  (var Stream src) open "file:/tmp/font.cff" in+safe
  (var Stream dest) open "file:/tmp/font.txt" out+safe
  var ExtendedStatus status := cff_decode src dest
  console (shunt status=success "ok" "FAILED") " " status:message eol

test