Patch title: Release 93 bulk changes
Abstract:
File: /graphic/vfilter/pdf.pli
Key:
    Removed line
    Added line
   
module "/pliant/language/compiler.pli"
module "/pliant/language/stream.pli"
module "/pliant/language/stream/filesystembase.pli"
module "/pliant/language/stream/count.pli"
module "/pliant/admin/file.pli"
module "/pliant/math/transform.pli"
module "/pliant/math/curve.pli"
module "/pliant/math/matrix.pli"
module "/pliant/graphic/draw/prototype.pli"
module "/pliant/graphic/draw/displaylist.pli"
module "/pliant/graphic/draw/transform.pli"
module "/pliant/graphic/vector/font.pli"
module "/pliant/graphic/vector/freetype.pli"
module "/pliant/graphic/vector/stroke.pli"
module "/pliant/graphic/color/gamut.pli"
module "/pliant/language/compiler.pli"
module "/pliant/language/stream.pli"
module "/pliant/language/stream/filesystembase.pli"
module "/pliant/language/stream/count.pli"
module "/pliant/admin/file.pli"
module "/pliant/math/transform.pli"
module "/pliant/math/curve.pli"
module "/pliant/math/matrix.pli"
module "/pliant/graphic/draw/prototype.pli"
module "/pliant/graphic/draw/displaylist.pli"
module "/pliant/graphic/draw/transform.pli"
module "/pliant/graphic/vector/font.pli"
module "/pliant/graphic/vector/freetype.pli"
module "/pliant/graphic/vector/stroke.pli"
module "/pliant/graphic/color/gamut.pli"
module "/pliant/graphic/color/ink.pli"
module "/pliant/graphic/image/pixmap.pli"
module "/pliant/graphic/image/packed.pli"
module "/pliant/graphic/misc/bytes.pli"
module "/pliant/graphic/misc/float.pli"
module "/pliant/language/data/cache.pli"
module "/pliant/language/compiler/type/inherit.pli"
module "/pliant/language/data/id.pli"
module "/pliant/graphic/filter/prototype.pli"
module "/pliant/graphic/filter/jpeg.pli"
module "prototype.pli"


constant debug false
constant debug_header false
constant debug_image false
constant debug_do false
module "/pliant/graphic/image/pixmap.pli"
module "/pliant/graphic/image/packed.pli"
module "/pliant/graphic/misc/bytes.pli"
module "/pliant/graphic/misc/float.pli"
module "/pliant/language/data/cache.pli"
module "/pliant/language/compiler/type/inherit.pli"
module "/pliant/language/data/id.pli"
module "/pliant/graphic/filter/prototype.pli"
module "/pliant/graphic/filter/jpeg.pli"
module "prototype.pli"


constant debug false
constant debug_header false
constant debug_image false
constant debug_do false
constant debug_font false
constant debug_gamut false
constant message_debug false
constant draw_image true
constant draw_fill true
constant draw_stroke true
constant draw_shading true
constant draw_text true
constant message_debug false
constant draw_image true
constant draw_fill true
constant draw_stroke true
constant draw_shading true
constant draw_text true
constant token_overflow 2^16



type PDFContext
  field Transform2 t <- constant:(transform 0 0 25.4/72 25.4
  field Int clip_count <- 0
  field Float clip_x0 clip_y0 Float clip_x1 clip_y1 <- undef
  field Link:ColorGamut fill_gamut ; field ColorBuffer fill_
  field Link:ColorGamut stroke_gamut ; field ColorBuffer str
  field Int transparency # 2 means OP is set, 1 means OPM is
  field Link:(Array uInt8 256) gradation
  field Float line_width



type PDFContext
  field Transform2 t <- constant:(transform 0 0 25.4/72 25.4
  field Int clip_count <- 0
  field Float clip_x0 clip_y0 Float clip_x1 clip_y1 <- undef
  field Link:ColorGamut fill_gamut ; field ColorBuffer fill_
  field Link:ColorGamut stroke_gamut ; field ColorBuffer str
  field Int transparency # 2 means OP is set, 1 means OPM is
  field Link:(Array uInt8 256) gradation
  field Float line_width
  field Int line_cap <- 0
  field Int line_join <- 0
  field Float line_miter <- 10
  field CBool unsupported_fill <- false
  field CBool unsupported_stroke <- false
  field CBool unsupported_text <- false


type PDFReader
  field Link:Stream raw_stream stream
  field Str options
  field Link:ColorGamut gamut
  field CBool separated ; field Int page_num
  field Intn packed
  field Array stack ; field Int count <- 0
  field PDFContext context ; field List:PDFContext context_s
  field PDFText text
  field (Dictionary Str PDFObject) objects
  field Link:Dictionary xobject_dict colorspace_dict gs_dict
  field CBool unsupported_fill <- false
  field CBool unsupported_stroke <- false
  field CBool unsupported_text <- false


type PDFReader
  field Link:Stream raw_stream stream
  field Str options
  field Link:ColorGamut gamut
  field CBool separated ; field Int page_num
  field Intn packed
  field Array stack ; field Int count <- 0
  field PDFContext context ; field List:PDFContext context_s
  field PDFText text
  field (Dictionary Str PDFObject) objects
  field Link:Dictionary xobject_dict colorspace_dict gs_dict
  field (Dictionary Str Str) known_colors
  field Pointer:PDFObject cobject
  field Array:Curve curves ; field Curve curve
  field Link:DrawPrototype draw
  field Str instruction
  field ExtendedStatus status <- success
  field Dictionary warnings


method pdf token -> t
  arg_rw PDFReader pdf ; arg Str t
  part scan
    var Int u := pdf read_byte
    if pdf:stream:atend
      return ""
    eif separator:u
      restart scan
    eif u="%":number
      while { u := pdf read_byte ; u<>"[cr]":number and u<>"
        void
      restart scan
    eif u="(":number
      t := "(" ; var Int count := 1
      while count>0 and not pdf:stream:atend
        var Int u := pdf read_byte ; t += character u
        if u="(":number
          count += 1
        eif u=")":number
          count -= 1
        eif u="\":number
          u := pdf read_byte
          if u>="0":number and u<="7":number
            t := (t 0 t:len-1)+(character (u-"0":number)*64+
          else
            t := (t 0 t:len-1)+character:u
  field Pointer:PDFObject cobject
  field Array:Curve curves ; field Curve curve
  field Link:DrawPrototype draw
  field Str instruction
  field ExtendedStatus status <- success
  field Dictionary warnings


method pdf token -> t
  arg_rw PDFReader pdf ; arg Str t
  part scan
    var Int u := pdf read_byte
    if pdf:stream:atend
      return ""
    eif separator:u
      restart scan
    eif u="%":number
      while { u := pdf read_byte ; u<>"[cr]":number and u<>"
        void
      restart scan
    eif u="(":number
      t := "(" ; var Int count := 1
      while count>0 and not pdf:stream:atend
        var Int u := pdf read_byte ; t += character u
        if u="(":number
          count += 1
        eif u=")":number
          count -= 1
        eif u="\":number
          u := pdf read_byte
          if u>="0":number and u<="7":number
            t := (t 0 t:len-1)+(character (u-"0":number)*64+
          else
            t := (t 0 t:len-1)+character:u
        if t:len>=token_overflow
          pdf severe "token overflow"
          return ""
    eif (u="<":number or u=">":number) and pdf:pick_byte=u
      t := character:u+(character pdf:read_byte)
    eif u="<":number
      t := "<"
      while { u := pdf read_byte ; u<>">":number and not pdf
        t += character u
      t += ">"
    eif stopper:u and u<>"/":number
      t := character u
    else
      if true
        var Pointer:Stream s :> pdf stream
        var Address a := s stream_read_cur
        while a<>s:stream_read_stop and not stopper:(a map u
          a := a translate uInt8 1
        var Int len := (cast a Int) .-. (cast s:stream_read_
        var Address buf := memory_allocate len addressof:t
        buf map uInt8 := u
        memory_copy s:stream_read_cur (buf translate uInt8 1
        t set buf len true
        s stream_read_cur := a
        if a=s:stream_read_stop
          while not (stopper pdf:pick_byte)
            t += character pdf:read_byte
    eif (u="<":number or u=">":number) and pdf:pick_byte=u
      t := character:u+(character pdf:read_byte)
    eif u="<":number
      t := "<"
      while { u := pdf read_byte ; u<>">":number and not pdf
        t += character u
      t += ">"
    eif stopper:u and u<>"/":number
      t := character u
    else
      if true
        var Pointer:Stream s :> pdf stream
        var Address a := s stream_read_cur
        while a<>s:stream_read_stop and not stopper:(a map u
          a := a translate uInt8 1
        var Int len := (cast a Int) .-. (cast s:stream_read_
        var Address buf := memory_allocate len addressof:t
        buf map uInt8 := u
        memory_copy s:stream_read_cur (buf translate uInt8 1
        t set buf len true
        s stream_read_cur := a
        if a=s:stream_read_stop
          while not (stopper pdf:pick_byte)
            t += character pdf:read_byte
            if t:len>=token_overflow
              pdf severe "token overflow"
              return ""
      else
        t := character u
        while not (stopper pdf:pick_byte)
          t += character pdf:read_byte
    var Int u := pdf pick_byte
    if u="[cr]":number or u="[lf]":number
      if pdf:pick_byte="[cr]":number
        pdf read_byte
      if pdf:pick_byte="[lf]":number
        pdf read_byte
    eif separator:u
      pdf read_byte


method pdf parse -> t
  arg_rw PDFReader pdf ; arg Str t
  implicit pdf
    while true
      t := pdf token
      else
        t := character u
        while not (stopper pdf:pick_byte)
          t += character pdf:read_byte
    var Int u := pdf pick_byte
    if u="[cr]":number or u="[lf]":number
      if pdf:pick_byte="[cr]":number
        pdf read_byte
      if pdf:pick_byte="[lf]":number
        pdf read_byte
    eif separator:u
      pdf read_byte


method pdf parse -> t
  arg_rw PDFReader pdf ; arg Str t
  implicit pdf
    while true
      t := pdf token
      # console t eol
      if t=""
        return t
      eif t="<<" or t="[lb]"
        push addressof:(new PDFMark pdf_mark:t)
      eif t=">>"
        var Int n := 0
        while n<count and not (pick:n is PDFMark)
          n += 1
        if n%2<>0
          severe "wrong number of arguments in dictionary"
        for (var Int i) 0 n-1 step 2
          if not ((pick n-1-i) is Ident)
            severe "wrong key type in dictionary"
        var Link:Dictionary dict :> new Dictionary
        for (var Int i) 0 n-2 step 2 # VERIFY
          dict insert ((pick n-1-i) as Ident) true (pick n-2
        pop n+1
        push addressof:dict
      eif t="[rb]"
        var Int n := 0
        while n<count and (entry_type pick:n)<>PDFMark
          n += 1
        var Link:Array array :> new Array
        array size := n
        for (var Int i) 0 n-1
          array i := pick n-1-i
        pop n+1
        push addressof:array
      eif t="R"
        if not (pick:1 is Int) or not (pick:0 is Int)
          severe "wrong arguments for 'R' instruction" ; ret
        var Link:PDFReference ref :> new PDFReference
        ref id := string:(pick:1 as Int)+" "+string:(pick:0 
        pop 2
        push addressof:ref
      eif (t 0 1)="/"
        var Str ident := t 1 t:len
        var Int i := 0
        while i+2<ident:len
          if ident:i="#" and unhexa:(ident i+1)<>undefined a
            ident := (ident 0 i)+(character unhexa:(ident i+
          i += 1
        push addressof:(new Ident (cast ident Ident))
      eif (t 0 1)="(" and t:len>=2 and (t t:len-1)=")"
        push addressof:(new Str (t 1 t:len-2))
      eif (t 0 1)="<" and t:len>=2 and (t t:len-1)=">"
        var Str s := "" ; var Int j := undefined
        for (var Int i) 1 t:len-2
          var Int k := unhexa t:i
          if k<>undefined
            if j=undefined
              j := k
            else
              s += character 16*j+k ; j := undefined
        if j<>undefined
          s += character 16*j
        push addressof:(new Str s)
      eif (t parse (var Int i))
        push addressof:(new Int i)
      eif (t parse (var Float f))
        push addressof:(new Float f)
      eif t="true"
        push addressof:(new Bool true)
      eif t="false"
        push addressof:(new Bool false)
      else
        return t


method pdf real_color_name name -> real
      if t=""
        return t
      eif t="<<" or t="[lb]"
        push addressof:(new PDFMark pdf_mark:t)
      eif t=">>"
        var Int n := 0
        while n<count and not (pick:n is PDFMark)
          n += 1
        if n%2<>0
          severe "wrong number of arguments in dictionary"
        for (var Int i) 0 n-1 step 2
          if not ((pick n-1-i) is Ident)
            severe "wrong key type in dictionary"
        var Link:Dictionary dict :> new Dictionary
        for (var Int i) 0 n-2 step 2 # VERIFY
          dict insert ((pick n-1-i) as Ident) true (pick n-2
        pop n+1
        push addressof:dict
      eif t="[rb]"
        var Int n := 0
        while n<count and (entry_type pick:n)<>PDFMark
          n += 1
        var Link:Array array :> new Array
        array size := n
        for (var Int i) 0 n-1
          array i := pick n-1-i
        pop n+1
        push addressof:array
      eif t="R"
        if not (pick:1 is Int) or not (pick:0 is Int)
          severe "wrong arguments for 'R' instruction" ; ret
        var Link:PDFReference ref :> new PDFReference
        ref id := string:(pick:1 as Int)+" "+string:(pick:0 
        pop 2
        push addressof:ref
      eif (t 0 1)="/"
        var Str ident := t 1 t:len
        var Int i := 0
        while i+2<ident:len
          if ident:i="#" and unhexa:(ident i+1)<>undefined a
            ident := (ident 0 i)+(character unhexa:(ident i+
          i += 1
        push addressof:(new Ident (cast ident Ident))
      eif (t 0 1)="(" and t:len>=2 and (t t:len-1)=")"
        push addressof:(new Str (t 1 t:len-2))
      eif (t 0 1)="<" and t:len>=2 and (t t:len-1)=">"
        var Str s := "" ; var Int j := undefined
        for (var Int i) 1 t:len-2
          var Int k := unhexa t:i
          if k<>undefined
            if j=undefined
              j := k
            else
              s += character 16*j+k ; j := undefined
        if j<>undefined
          s += character 16*j
        push addressof:(new Str s)
      eif (t parse (var Int i))
        push addressof:(new Int i)
      eif (t parse (var Float f))
        push addressof:(new Float f)
      eif t="true"
        push addressof:(new Bool true)
      eif t="false"
        push addressof:(new Bool false)
      else
        return t


method pdf real_color_name name -> real
  arg PDFReader pdf ; arg Str name real
  arg_rw PDFReader pdf ; arg Str name real
  real := lower name
  if (real eparse "pantone " any:(var Str pantone) " c" any)
    real := pantone
  if (real parse "pantone_" any:(var Str pantone) "_c" any)
    real := pantone
  if real="cyan" or real="magenta" or real="yellow" or real=
    real := "process_"+real
  real := replace real " " "_"
  var Int i := 0
  while { var Int p := pdf:options option_position "alias" i
    if ((pdf:options p pdf:options:len) parse word:"alias" (
      if real=name1
        real := name2
    i += 1
  real := lower name
  if (real eparse "pantone " any:(var Str pantone) " c" any)
    real := pantone
  if (real parse "pantone_" any:(var Str pantone) "_c" any)
    real := pantone
  if real="cyan" or real="magenta" or real="yellow" or real=
    real := "process_"+real
  real := replace real " " "_"
  var Int i := 0
  while { var Int p := pdf:options option_position "alias" i
    if ((pdf:options p pdf:options:len) parse word:"alias" (
      if real=name1
        real := name2
    i += 1
  var Pointer:Str final :> pdf:known_colors first real
  if exists:final
    real := final
  else
    if (color_ink (shunt (real search ":" -1)=(-1) "pantone:" "")+(real 0 (real search "#" real:len)))=success
      pdf:known_colors insert real real
    else
      var Str drop := "drop#"+(string 2^30+pdf:known_colors:size)
      pdf:known_colors insert real drop
      real := drop



method pdf colorspace cs extra -> gamut
  arg_rw PDFReader pdf ; arg Address cs ; arg Str extra ; ar
  gamut :> null map ColorGamut
  if (cs is Ident)
    var Str id := cs as Ident
    if pdf:separated and (id="G" or id="DeviceGray")
      gamut :> color_gamut "pantone:"+(pdf:gamut query "comp
    eif id="G" or id="DeviceGray"
      gamut :> color_gamut "pantone:process_black"+extra
    eif id="RGB" or id="DeviceRGB"
      gamut :> color_gamut "rgb"
    eif id="DeviceCMYK"
      gamut :> color_gamut "pantone:process_cyan+process_mag
    eif (lower:id parse word:"pantone" any:(var Str pantone)
      gamut :> color_gamut "pantone:"+(pdf real_color_name i
  eif (cs is Array)
    var Pointer:Array a :> cs as Array
    if a:size>=2 and (a:0 as Ident)="DeviceN" and (a:1 is Ar
      var Pointer:Array inks :> a:1 as Array
      var Str name := ""
      for (var Int i) 0 inks:size-1
        if (entry_type inks:i)=Ident
          var Str ink := cast (inks:i map Ident) Str
          name += "+"+(pdf real_color_name ink)
      gamut :> color_gamut "pantone:"+(name 1 name:len)+extr
    eif a:size>=2 and (a:0 as Ident)="Separation"
      gamut :> color_gamut "pantone:"+(pdf real_color_name (
    eif a:size>0 and (a:0 as Ident)="CalRGB"
      gamut :> color_gamut "rgb"
  if exists:gamut and gamut=failure
    gamut :> null map ColorGamut



method pdf colorspace cs extra -> gamut
  arg_rw PDFReader pdf ; arg Address cs ; arg Str extra ; ar
  gamut :> null map ColorGamut
  if (cs is Ident)
    var Str id := cs as Ident
    if pdf:separated and (id="G" or id="DeviceGray")
      gamut :> color_gamut "pantone:"+(pdf:gamut query "comp
    eif id="G" or id="DeviceGray"
      gamut :> color_gamut "pantone:process_black"+extra
    eif id="RGB" or id="DeviceRGB"
      gamut :> color_gamut "rgb"
    eif id="DeviceCMYK"
      gamut :> color_gamut "pantone:process_cyan+process_mag
    eif (lower:id parse word:"pantone" any:(var Str pantone)
      gamut :> color_gamut "pantone:"+(pdf real_color_name i
  eif (cs is Array)
    var Pointer:Array a :> cs as Array
    if a:size>=2 and (a:0 as Ident)="DeviceN" and (a:1 is Ar
      var Pointer:Array inks :> a:1 as Array
      var Str name := ""
      for (var Int i) 0 inks:size-1
        if (entry_type inks:i)=Ident
          var Str ink := cast (inks:i map Ident) Str
          name += "+"+(pdf real_color_name ink)
      gamut :> color_gamut "pantone:"+(name 1 name:len)+extr
    eif a:size>=2 and (a:0 as Ident)="Separation"
      gamut :> color_gamut "pantone:"+(pdf real_color_name (
    eif a:size>0 and (a:0 as Ident)="CalRGB"
      gamut :> color_gamut "rgb"
  if exists:gamut and gamut=failure
    gamut :> null map ColorGamut



pdf_instruction M
  warning "set miter limit is not supported"
  context unsupported_stroke := true
pdf_instruction J
  context line_cap := pick:0 as Int
  if context:line_cap<>0
    warning "set line cap to "+(string context:line_cap)+" is not supported"
    context unsupported_stroke := true
  pop

pdf_instruction j
  pop

pdf_instruction j
  warning "set line join is not supported"
  context unsupported_stroke := true
  context line_join := pick:0 as Int
  if context:line_join<>0
    warning "set line join to "+(string context:line_join)+" is not supported"
    context unsupported_stroke := true
  pop

  pop

pdf_instruction J
  warning "set line cap is not supported"
  context unsupported_stroke := true
pdf_instruction M
  context line_miter := pick:0 as Float
  # warning "set miter limit to "+(string context:line_miter)+" is not supported"
  # context unsupported_stroke := true
  pop


pdf_instruction S
  new_curve false
  if draw_stroke and context:stroke_mode<>0
  pop


pdf_instruction S
  new_curve false
  if draw_stroke and context:stroke_mode<>0
    draw stroke curves context:line_width "" transform addre
    draw stroke curves context:line_width "cap "+(string context:line_cap)+" join "+(string context:line_join)+" miter "+(string context:line_miter) transform addressof:(real_color context:stroke_gamut context:stroke_color)
  curves size := 0


pdf_instruction B
  new_curve false
  if draw_fill and context:fill_mode<>0
    draw fill curves fill_nonzero transform addressof:(real_
  if draw_stroke and context:stroke_mode<>0
  curves size := 0


pdf_instruction B
  new_curve false
  if draw_fill and context:fill_mode<>0
    draw fill curves fill_nonzero transform addressof:(real_
  if draw_stroke and context:stroke_mode<>0
    draw stroke curves context:line_width "" transform addre
    draw stroke curves context:line_width "cap "+(string context:line_cap)+" join "+(string context:line_join)+" miter "+(string context:line_miter) transform addressof:(real_color context:stroke_gamut context:stroke_color)
  curves size := 0

pdf_instruction 'B*'
  new_curve false
  if draw_fill and context:fill_mode<>0
    draw fill curves fill_evenodd transform addressof:(real_
  if draw_stroke and context:stroke_mode<>0
  curves size := 0

pdf_instruction 'B*'
  new_curve false
  if draw_fill and context:fill_mode<>0
    draw fill curves fill_evenodd transform addressof:(real_
  if draw_stroke and context:stroke_mode<>0
    draw stroke curves context:line_width "" transform addre
    draw stroke curves context:line_width "cap "+(string context:line_cap)+" join "+(string context:line_join)+" miter "+(string context:line_miter) transform addressof:(real_color context:stroke_gamut context:stroke_color)
  curves size := 0


pdf_instruction Do
  function predictor a b c -> r
    arg Int a b c r
    var Int p := a+b-c
    var Int pa := abs p-a
    var Int pb := abs p-b
    var Int pc := abs p-c
    r := shunt pa<=pb and pa<=pc a pb<=pc b c
  var Str id := pick:0 as Ident
  var Arrow a := solve (xobject_dict first (pop as Ident))
  curves size := 0


pdf_instruction Do
  function predictor a b c -> r
    arg Int a b c r
    var Int p := a+b-c
    var Int pa := abs p-a
    var Int pb := abs p-b
    var Int pc := abs p-c
    r := shunt pa<=pb and pa<=pc a pb<=pc b c
  var Str id := pick:0 as Ident
  var Arrow a := solve (xobject_dict first (pop as Ident))
  if (a is Dictionary) and { var Link:Dictionary d :> a as D
  var Link:Dictionary d :> a as Dictionary
  var Str subtype := (d first "Subtype") as Ident
  if subtype="Image"
    var Pointer:PDFObject img_object :> cobject
    if (cache_open "/pliant/pdf/image/"+img_object:cache_id 
      var CBool ok := false
      part load "loading image"
        var Int size_x := solve:(d first "Width") as Int
        var Int size_y := solve:(d first "Height") as Int
        var Int bpc := solve:(d first "BitsPerComponent") as
        var Link:ColorGamut gamut :> colorspace solve:(d fir
        var CBool mask := false
        if not exists:gamut and ((d first "ImageMask") is Bo
          mask := (d first "ImageMask") as Bool
          if mask
            gamut :> pdf gamut
            var ColorBuffer c0 ; memory_clear addressof:c0 g
            var ColorBuffer c1 := real_color context:fill_ga
        eif bpc=1
          mask := true
          var ColorBuffer c0 ; memory_clear addressof:c0 gam
          var ColorBuffer c1 ; bytes_fill addressof:c1 1 gam
        if debug or debug_image
          console "Do " size_x " x " size_y " " 
          if exists:gamut
            console gamut:name " "
          console (shunt mask "MASK" "") eol
          display a true ; console eol
        if not exists:gamut
          # console "unsupported colorspace " ; display a tr
          var Str name := (solve (solve:(d first "ColorSpace
          if name=""
            name := solve:(d first "ColorSpace") as Ident
          warning "unsupported image colorspace "+name ; lea
        var CBool reverse := (solve:(d first "ColorSpace") a
        if mask
          reverse := ((solve:(d first "Decode") as Array):0 
        var Link:Dictionary parameters :> solve:(d first "De
        var Int predictor := solve:(parameters first "Predic
        if predictor=undefined
          predictor := 1
        var Int pred_columns := solve:(parameters first "Col
        var Int pred_bits := solve:(parameters first "BitsPe
        var Int pred_colors := solve:(parameters first "Colo
        var Int pred_step := undefined
        var Int pred_left := undefined
        if pred_columns<>undefined and pred_bits<>undefined 
          pred_step := max (pred_columns*pred_bits*pred_colo
          pred_left := max (pred_bits*pred_colors+7)\8 1
        if size_x<=0 or size_y<=0
          severe "incorrect image size" ; leave load
        var Link:ImagePrototype img
        if 1n*size_x*size_y*gamut:pixel_size>=packed or mask
          if debug_do
            console "*"
          img :> new ImagePacked
        else
          if debug_do
            console "+"
          img :> new ImagePixmap
        img setup (image_prototype 0 0 1 1 size_x size_y gam
        (raw_stream query "seek") parse (var Intn current_se
        raw_stream configure "seek "+(string img_object:seek
        var Link:Stream pixels :> filter d (var Link:ImageRe
        if not exists:pixels
          warning "unsupported image encoding" ; leave load
        if exists:decoder
          if (decoder open pixels "" (var ImagePrototype h))
            warning "failed to setup image decoder" ; leave 
        var Int line_size := shunt mask (img:size_x+7)\8 img
        var Address buffer := (memory_zallocate line_size+im
        var Address previous := (memory_zallocate line_size+
        var Address final := memory_zallocate line_size null
        var Address final2 := memory_zallocate img:line_size
        var CBool passed := false
        part read_lines
          for (var Int y) 0 size_y-1
            var Int offset := 0
            while offset<line_size
              var Int algo := 0 ; var Int step := line_size-
              if predictor=1
                void
              eif predictor=15
                pixels raw_read addressof:(var uInt8 algo8) 
                if pred_step=defined
                  step := min step pred_step
              else
                algo := predictor-10
              if exists:decoder
                if (decoder readline buffer)=failure
                  warning "failed to read image line "+(stri
              else
                pixels raw_read buffer step
              var Address cur := buffer
              var Address stop := buffer translate Byte step
              var Int left := shunt pred_left<>undefined and
              var Int top := (cast previous Int).-.(cast buf
              var Int topleft := left+top
              if algo=0
                void
              eif algo=1
                cur := cur translate Byte -left
                while cur<>stop
                  cur map uInt8 := (cur map uInt8)+(cur map 
                  cur := cur translate uInt8 1
              eif algo=2
                while cur<>stop
                  cur map uInt8 := (cur map uInt8)+(cur map 
                  cur := cur translate uInt8 1
              eif algo=3
                while cur<>stop
                  cur map uInt8 := (cur map uInt8)+((cur map
                  cur := cur translate uInt8 1
              eif algo=4
                while cur<>stop
                  cur map uInt8 := (cur map uInt8)+(predicto
                  cur := cur translate uInt8 1
              else
                # warning "Unsupported image predictor "+str
                warning "Unsupported image predictor "+strin
              memory_copy buffer (final translate Byte offse
              memory_copy buffer previous step
              offset += step
            if (exists context:gradation)
              var Pointer:(Array uInt8 256) gradation :> con
              var Address cur := final ; var Address stop :=
              while cur<>stop
                cur map uInt8 := gradation (cur map uInt8)
                cur := cur translate uInt8 1
            if reverse
              bytes_copy_255minus final 1 final 1 line_size
            if mask
              var Address cur := final2
              for (var Int i) 0 size_x-1
                memory_copy (shunt ((final map uInt8 i\8) .a
                cur := cur translate Byte img:pixel_size    
              img write 0 size_y-1-y size_x final2
            else
              img write 0 size_y-1-y size_x final
          passed := true
        if exists:decoder
          if decoder:close=failure
            warning "failed to read image" ; leave load
        memory_free (buffer translate Byte -(img:pixel_size)
        memory_free (previous translate Byte -(img:pixel_siz
        memory_free final
        memory_free final2
        img configure "shrink"
        raw_stream configure "seek "+string:current_seek
        if pixels=failure
          warning "failed to read image" ; leave load
        (addressof:ca omap PDFImageCache) image :> img
        ok := passed
      if ok
        cache_ready ca
      else
        cache_cancel ca
        warning "failed to load image"
        return
    else
      if debug_do
        console "-"
    if draw_image
      draw image (addressof:ca omap PDFImageCache):image con
    var Pointer:PDFObject img_object :> cobject
    if (cache_open "/pliant/pdf/image/"+img_object:cache_id 
      var CBool ok := false
      part load "loading image"
        var Int size_x := solve:(d first "Width") as Int
        var Int size_y := solve:(d first "Height") as Int
        var Int bpc := solve:(d first "BitsPerComponent") as
        var Link:ColorGamut gamut :> colorspace solve:(d fir
        var CBool mask := false
        if not exists:gamut and ((d first "ImageMask") is Bo
          mask := (d first "ImageMask") as Bool
          if mask
            gamut :> pdf gamut
            var ColorBuffer c0 ; memory_clear addressof:c0 g
            var ColorBuffer c1 := real_color context:fill_ga
        eif bpc=1
          mask := true
          var ColorBuffer c0 ; memory_clear addressof:c0 gam
          var ColorBuffer c1 ; bytes_fill addressof:c1 1 gam
        if debug or debug_image
          console "Do " size_x " x " size_y " " 
          if exists:gamut
            console gamut:name " "
          console (shunt mask "MASK" "") eol
          display a true ; console eol
        if not exists:gamut
          # console "unsupported colorspace " ; display a tr
          var Str name := (solve (solve:(d first "ColorSpace
          if name=""
            name := solve:(d first "ColorSpace") as Ident
          warning "unsupported image colorspace "+name ; lea
        var CBool reverse := (solve:(d first "ColorSpace") a
        if mask
          reverse := ((solve:(d first "Decode") as Array):0 
        var Link:Dictionary parameters :> solve:(d first "De
        var Int predictor := solve:(parameters first "Predic
        if predictor=undefined
          predictor := 1
        var Int pred_columns := solve:(parameters first "Col
        var Int pred_bits := solve:(parameters first "BitsPe
        var Int pred_colors := solve:(parameters first "Colo
        var Int pred_step := undefined
        var Int pred_left := undefined
        if pred_columns<>undefined and pred_bits<>undefined 
          pred_step := max (pred_columns*pred_bits*pred_colo
          pred_left := max (pred_bits*pred_colors+7)\8 1
        if size_x<=0 or size_y<=0
          severe "incorrect image size" ; leave load
        var Link:ImagePrototype img
        if 1n*size_x*size_y*gamut:pixel_size>=packed or mask
          if debug_do
            console "*"
          img :> new ImagePacked
        else
          if debug_do
            console "+"
          img :> new ImagePixmap
        img setup (image_prototype 0 0 1 1 size_x size_y gam
        (raw_stream query "seek") parse (var Intn current_se
        raw_stream configure "seek "+(string img_object:seek
        var Link:Stream pixels :> filter d (var Link:ImageRe
        if not exists:pixels
          warning "unsupported image encoding" ; leave load
        if exists:decoder
          if (decoder open pixels "" (var ImagePrototype h))
            warning "failed to setup image decoder" ; leave 
        var Int line_size := shunt mask (img:size_x+7)\8 img
        var Address buffer := (memory_zallocate line_size+im
        var Address previous := (memory_zallocate line_size+
        var Address final := memory_zallocate line_size null
        var Address final2 := memory_zallocate img:line_size
        var CBool passed := false
        part read_lines
          for (var Int y) 0 size_y-1
            var Int offset := 0
            while offset<line_size
              var Int algo := 0 ; var Int step := line_size-
              if predictor=1
                void
              eif predictor=15
                pixels raw_read addressof:(var uInt8 algo8) 
                if pred_step=defined
                  step := min step pred_step
              else
                algo := predictor-10
              if exists:decoder
                if (decoder readline buffer)=failure
                  warning "failed to read image line "+(stri
              else
                pixels raw_read buffer step
              var Address cur := buffer
              var Address stop := buffer translate Byte step
              var Int left := shunt pred_left<>undefined and
              var Int top := (cast previous Int).-.(cast buf
              var Int topleft := left+top
              if algo=0
                void
              eif algo=1
                cur := cur translate Byte -left
                while cur<>stop
                  cur map uInt8 := (cur map uInt8)+(cur map 
                  cur := cur translate uInt8 1
              eif algo=2
                while cur<>stop
                  cur map uInt8 := (cur map uInt8)+(cur map 
                  cur := cur translate uInt8 1
              eif algo=3
                while cur<>stop
                  cur map uInt8 := (cur map uInt8)+((cur map
                  cur := cur translate uInt8 1
              eif algo=4
                while cur<>stop
                  cur map uInt8 := (cur map uInt8)+(predicto
                  cur := cur translate uInt8 1
              else
                # warning "Unsupported image predictor "+str
                warning "Unsupported image predictor "+strin
              memory_copy buffer (final translate Byte offse
              memory_copy buffer previous step
              offset += step
            if (exists context:gradation)
              var Pointer:(Array uInt8 256) gradation :> con
              var Address cur := final ; var Address stop :=
              while cur<>stop
                cur map uInt8 := gradation (cur map uInt8)
                cur := cur translate uInt8 1
            if reverse
              bytes_copy_255minus final 1 final 1 line_size
            if mask
              var Address cur := final2
              for (var Int i) 0 size_x-1
                memory_copy (shunt ((final map uInt8 i\8) .a
                cur := cur translate Byte img:pixel_size    
              img write 0 size_y-1-y size_x final2
            else
              img write 0 size_y-1-y size_x final
          passed := true
        if exists:decoder
          if decoder:close=failure
            warning "failed to read image" ; leave load
        memory_free (buffer translate Byte -(img:pixel_size)
        memory_free (previous translate Byte -(img:pixel_siz
        memory_free final
        memory_free final2
        img configure "shrink"
        raw_stream configure "seek "+string:current_seek
        if pixels=failure
          warning "failed to read image" ; leave load
        (addressof:ca omap PDFImageCache) image :> img
        ok := passed
      if ok
        cache_ready ca
      else
        cache_cancel ca
        warning "failed to load image"
        return
    else
      if debug_do
        console "-"
    if draw_image
      draw image (addressof:ca omap PDFImageCache):image con
  eif (a is Dictionary) and cobject:attached<>null
  eif subtype="Form" and cobject:attached<>null
    check (entry_type cobject:attached)=DrawDisplayList
    var Transform2 ct := context t
    (addressof:draw omap DrawDisplayList) include (cobject:a
    if debug_do
      console "Do again" eol
    check (entry_type cobject:attached)=DrawDisplayList
    var Transform2 ct := context t
    (addressof:draw omap DrawDisplayList) include (cobject:a
    if debug_do
      console "Do again" eol
  eif (a is Dictionary)
  eif subtype="Form"
    if (entry_type addressof:draw)=DrawDisplayList
      var Pointer:PDFObject do_object :> cobject
      var Link:DrawDisplayList memo_draw :> addressof:draw m
      var Link:DrawDisplayList sub :> new DrawDisplayList
      sub setup (draw image_prototype "") (draw image_protot
      draw :> sub
      var Transform2 memo_t := context t
      context t := transform
    var Link:Stream current_stream :> stream
    (raw_stream query "seek") parse (var Intn current_seek)
    raw_stream configure "seek "+(string cobject:seek)
    stream :> filter (a map Dictionary) (var Link:ImageReadF
    var Link:Dictionary colorspace_memo :> colorspace_dict
    var Link:Dictionary xobject_memo :> xobject_dict
    var Link:Dictionary gs_memo :> gs_dict
    var Link:Dictionary font_memo :> font_dict
    var Link:Dictionary shading_memo :> shading_dict
    var Link:Dictionary res :> solve:((a as Dictionary) firs
    if exists:res and exists:(res first "XObject")
      xobject_dict :> solve:(res first "XObject") as Diction
    if exists:res and exists:(res first "ColorSpace")
      colorspace_dict :> solve:(res first "ColorSpace") as D
    if exists:res and exists:(res first "ExtGState")
      gs_dict :> solve:(res first "ExtGState") as Dictionary
    if exists:res and exists:(res first "Font")
      font_dict :> solve:(res first "Font") as Dictionary
    if exists:res and exists:(res first "Shading")
      shading_dict :> solve:(res first "Shading") as Diction
    process_instructions
    colorspace_dict :> colorspace_memo
    xobject_dict :> xobject_memo
    gs_dict :> gs_memo
    font_dict :> gs_memo
    shading_dict :> gs_memo
    raw_stream configure "seek "+string:current_seek
    stream :> current_stream
    if (entry_type addressof:draw)=DrawDisplayList
      context t := memo_t
      draw :> memo_draw
      var Transform2 ct := context t
      memo_draw include sub DrawTransform "xx "+(string ct:x
      do_object attached := addressof sub
    if debug_do
      console "Do first" eol
  else
    if (entry_type addressof:draw)=DrawDisplayList
      var Pointer:PDFObject do_object :> cobject
      var Link:DrawDisplayList memo_draw :> addressof:draw m
      var Link:DrawDisplayList sub :> new DrawDisplayList
      sub setup (draw image_prototype "") (draw image_protot
      draw :> sub
      var Transform2 memo_t := context t
      context t := transform
    var Link:Stream current_stream :> stream
    (raw_stream query "seek") parse (var Intn current_seek)
    raw_stream configure "seek "+(string cobject:seek)
    stream :> filter (a map Dictionary) (var Link:ImageReadF
    var Link:Dictionary colorspace_memo :> colorspace_dict
    var Link:Dictionary xobject_memo :> xobject_dict
    var Link:Dictionary gs_memo :> gs_dict
    var Link:Dictionary font_memo :> font_dict
    var Link:Dictionary shading_memo :> shading_dict
    var Link:Dictionary res :> solve:((a as Dictionary) firs
    if exists:res and exists:(res first "XObject")
      xobject_dict :> solve:(res first "XObject") as Diction
    if exists:res and exists:(res first "ColorSpace")
      colorspace_dict :> solve:(res first "ColorSpace") as D
    if exists:res and exists:(res first "ExtGState")
      gs_dict :> solve:(res first "ExtGState") as Dictionary
    if exists:res and exists:(res first "Font")
      font_dict :> solve:(res first "Font") as Dictionary
    if exists:res and exists:(res first "Shading")
      shading_dict :> solve:(res first "Shading") as Diction
    process_instructions
    colorspace_dict :> colorspace_memo
    xobject_dict :> xobject_memo
    gs_dict :> gs_memo
    font_dict :> gs_memo
    shading_dict :> gs_memo
    raw_stream configure "seek "+string:current_seek
    stream :> current_stream
    if (entry_type addressof:draw)=DrawDisplayList
      context t := memo_t
      draw :> memo_draw
      var Transform2 ct := context t
      memo_draw include sub DrawTransform "xx "+(string ct:x
      do_object attached := addressof sub
    if debug_do
      console "Do first" eol
  else
    warning "unexpected Do usage"
    warning "unexpected Do usage (Subtype = "+subtype+")"


pdf_instruction Tf
  text fontdef :> solve:(font_dict first (pick:1 as Ident)) 
  var Pointer:PDFObject img_object :> cobject


pdf_instruction Tf
  text fontdef :> solve:(font_dict first (pick:1 as Ident)) 
  var Pointer:PDFObject img_object :> cobject
  if (cache_open "/pliant/graphic/pdf/font/"+img_object:cach
    var Str name := solve:(text:fontdef first "BaseFont") as
    if debug
      console "font name '" name "' " (shunt (exists text:fo
  var Str name := solve:(text:fontdef first "BaseFont") as Ident
  var Str id := shunt (options option "share_fonts_with_same_name") and name<>"" name img_object:cache_id 
  if (cache_open "/pliant/graphic/pdf/font/"+id Font ((addressof Link:Font text:font) map Link:CachePrototype))
    if debug_font
      console "font name '" name "' " (shunt (exists text:font) "yes" "no") " " img_object:cache_id eol
      console "font def " ; display (addressof text:fontdef)
    part compute_the_encoding
      text:encoding size := 256
      for (var Int i) 0 255
        text:encoding i := i
      var Str charset := (text:fontdef first "Encoding") as 
      if exists:(charsets first charset)
        text encoding := charsets first charset
      var Link:Dictionary enc :> solve:(text:fontdef first "
      var Str charset := (enc first "BaseEncoding") as Ident
      if exists:(charsets first charset)
        text encoding := charsets first charset
      var Link:Array diff :> solve:(enc first "Differences")
      var Int num := undefined
      for (var Int i) 0 diff:size-1
        if (diff:i is Int)
          num := diff:i as Int
        if (diff:i as Ident)<>"" and num>=0 and num<256
          var Pointer:Int unicode :> postscript_glyphs first
          if exists:unicode
            text:encoding num := unicode
          num += 1
      if solve:(text:fontdef first "ToUnicode")<>null
        var Link:Dictionary mapping :> solve:(text:fontdef f
        (raw_stream query "seek") parse (var Intn current_se
        raw_stream configure "seek "+(string cobject:seek)
        var Link:Stream s :> filter mapping (var Link:ImageR
        while not s:atend
          var Str l := s readline
          if (l parse (var Int drop) word:"beginbfchar")
            while (s:readline parse "<" any:(var Str code8) 
              var Int char := unhexa code8
              if char>=0 and char<256
                text:encoding char := unhexa code16
        raw_stream configure "seek "+string:current_seek
    text:font encoding := text encoding
    part load_the_font
      var CBool loaded := false
      var Arrow def := addressof text:fontdef
      if (text:fontdef first "DescendantFonts")<>null
        def := solve (text:fontdef first "DescendantFonts")
        if (def is Array)
          def := solve (def as Array):0
      if ((def as Dictionary) first "FontDescriptor")<>null
        def := solve ((def as Dictionary) first "FontDescrip
      for (var Int i) 0 3
        if ((def as Dictionary) first "FontFile"+(shunt i>0 
          var Link:Dictionary ff :> solve:((def as Dictionar
          if cobject:seek<>0
            (raw_stream query "seek") parse (var Intn curren
            raw_stream configure "seek "+(string cobject:see
            var Str temp := file_temporary
            var Link:Stream src :> filter ff (var Link:Image
            var Int length
            if addressof:src=(addressof pdf:raw_stream)
              length := (ff first "Length") as Int
            else
              length := 2^30
            (var Stream dest) open temp out+safe
            raw_copy src dest length length
            dest close
            # file_copy temp "file:/tmp/font.bin" standard
            raw_stream configure "seek "+(string current_see
      console "font def " ; display (addressof text:fontdef)
    part compute_the_encoding
      text:encoding size := 256
      for (var Int i) 0 255
        text:encoding i := i
      var Str charset := (text:fontdef first "Encoding") as 
      if exists:(charsets first charset)
        text encoding := charsets first charset
      var Link:Dictionary enc :> solve:(text:fontdef first "
      var Str charset := (enc first "BaseEncoding") as Ident
      if exists:(charsets first charset)
        text encoding := charsets first charset
      var Link:Array diff :> solve:(enc first "Differences")
      var Int num := undefined
      for (var Int i) 0 diff:size-1
        if (diff:i is Int)
          num := diff:i as Int
        if (diff:i as Ident)<>"" and num>=0 and num<256
          var Pointer:Int unicode :> postscript_glyphs first
          if exists:unicode
            text:encoding num := unicode
          num += 1
      if solve:(text:fontdef first "ToUnicode")<>null
        var Link:Dictionary mapping :> solve:(text:fontdef f
        (raw_stream query "seek") parse (var Intn current_se
        raw_stream configure "seek "+(string cobject:seek)
        var Link:Stream s :> filter mapping (var Link:ImageR
        while not s:atend
          var Str l := s readline
          if (l parse (var Int drop) word:"beginbfchar")
            while (s:readline parse "<" any:(var Str code8) 
              var Int char := unhexa code8
              if char>=0 and char<256
                text:encoding char := unhexa code16
        raw_stream configure "seek "+string:current_seek
    text:font encoding := text encoding
    part load_the_font
      var CBool loaded := false
      var Arrow def := addressof text:fontdef
      if (text:fontdef first "DescendantFonts")<>null
        def := solve (text:fontdef first "DescendantFonts")
        if (def is Array)
          def := solve (def as Array):0
      if ((def as Dictionary) first "FontDescriptor")<>null
        def := solve ((def as Dictionary) first "FontDescrip
      for (var Int i) 0 3
        if ((def as Dictionary) first "FontFile"+(shunt i>0 
          var Link:Dictionary ff :> solve:((def as Dictionar
          if cobject:seek<>0
            (raw_stream query "seek") parse (var Intn curren
            raw_stream configure "seek "+(string cobject:see
            var Str temp := file_temporary
            var Link:Stream src :> filter ff (var Link:Image
            var Int length
            if addressof:src=(addressof pdf:raw_stream)
              length := (ff first "Length") as Int
            else
              length := 2^30
            (var Stream dest) open temp out+safe
            raw_copy src dest length length
            dest close
            # file_copy temp "file:/tmp/font.bin" standard
            raw_stream configure "seek "+(string current_see
            part load "loading freetype font"
            part load "loading font"
              if not (options option "nopliantfont") and (te
                loaded := true
                if debug
                  console "loaded Type1 font at " cobject:se
              eif not (options option "nofreetypefont") and 
                loaded := true
                if debug
                  console "loaded FreeType font at " cobject
              else
                if debug
                  console "failed to load FreeType font at "
                warning "Failed to load embedded font at "+(
            file_delete temp
      if false # not loaded and ((def as Dictionary) first "
        var Link:Dictionary procs :> solve:((def as Dictiona
        var Int num := undefined
        for (var Int i) 0 diff:size-1
          if (diff:i is Int)
            num := diff:i as Int
          if (diff:i as Ident)<>""
            var Link:Dictionary proc :>solve:(procs first (d
            if cobject:seek<>0
              (raw_stream query "seek") parse (var Intn curr
              raw_stream configure "seek "+(string cobject:s
              var Link:Stream src :> filter proc (var Link:I
              console "glyph " (diff:i as Ident) eol
              while not src:atend
                console "  " src:readline eol
              raw_stream configure "seek "+string:current_se
      if loaded
        cache_ready ((addressof Link:Font text:font) map Lin
      else
        if debug
          console "Font '"+name+"' is missing" eol
        cache_cancel ((addressof Link:Font text:font) map Li
        text font :> null map Font
  if (exists text:font)
    text encoding := text:font encoding
  text scale := pick:0 as Float
  pop 2


method pdf load base_stream options draw -> status
  oarg_rw PDFReader pdf ; arg_rw Stream base_stream ; arg St
  implicit pdf
    separated := options option "separated"
    packed := options option "packed" Intn 16*2^20
    stream :> base_stream
    raw_stream :> base_stream
    pdf options := options
    var Intn fsize := (file_query stream:name standard) size
    if fsize<64
      return failure:"File is too short"
    stream safe_configure "seek "+(string fsize-64)
    stream readline
    var Str l := stream readline
    while not stream :atend and { var Str next := stream  re
      l := next
    if not (l parse (var Intn offset))
      return failure:"Failed to find reference table"
    var Link:Dictionary root :> null map Dictionary
    part scan_reference
      stream configure "seek "+string:offset
      if pdf:token<>"xref"
        return failure:"Corrupted reference table (1)"
      while { var Str l := stream readline ; l<>"trailer" }
        if (l parse (var Int first) (var Int nb))
              if not (options option "nopliantfont") and (te
                loaded := true
                if debug
                  console "loaded Type1 font at " cobject:se
              eif not (options option "nofreetypefont") and 
                loaded := true
                if debug
                  console "loaded FreeType font at " cobject
              else
                if debug
                  console "failed to load FreeType font at "
                warning "Failed to load embedded font at "+(
            file_delete temp
      if false # not loaded and ((def as Dictionary) first "
        var Link:Dictionary procs :> solve:((def as Dictiona
        var Int num := undefined
        for (var Int i) 0 diff:size-1
          if (diff:i is Int)
            num := diff:i as Int
          if (diff:i as Ident)<>""
            var Link:Dictionary proc :>solve:(procs first (d
            if cobject:seek<>0
              (raw_stream query "seek") parse (var Intn curr
              raw_stream configure "seek "+(string cobject:s
              var Link:Stream src :> filter proc (var Link:I
              console "glyph " (diff:i as Ident) eol
              while not src:atend
                console "  " src:readline eol
              raw_stream configure "seek "+string:current_se
      if loaded
        cache_ready ((addressof Link:Font text:font) map Lin
      else
        if debug
          console "Font '"+name+"' is missing" eol
        cache_cancel ((addressof Link:Font text:font) map Li
        text font :> null map Font
  if (exists text:font)
    text encoding := text:font encoding
  text scale := pick:0 as Float
  pop 2


method pdf load base_stream options draw -> status
  oarg_rw PDFReader pdf ; arg_rw Stream base_stream ; arg St
  implicit pdf
    separated := options option "separated"
    packed := options option "packed" Intn 16*2^20
    stream :> base_stream
    raw_stream :> base_stream
    pdf options := options
    var Intn fsize := (file_query stream:name standard) size
    if fsize<64
      return failure:"File is too short"
    stream safe_configure "seek "+(string fsize-64)
    stream readline
    var Str l := stream readline
    while not stream :atend and { var Str next := stream  re
      l := next
    if not (l parse (var Intn offset))
      return failure:"Failed to find reference table"
    var Link:Dictionary root :> null map Dictionary
    part scan_reference
      stream configure "seek "+string:offset
      if pdf:token<>"xref"
        return failure:"Corrupted reference table (1)"
      while { var Str l := stream readline ; l<>"trailer" }
        if (l parse (var Int first) (var Int nb))
          if count<0 or nb>65536
          if nb<0 or nb>65536
            return failure:"Incorrect object number in refer
          for (var Int i) 0 nb-1
            var Str l := stream readline
            if (l parse (var Intn offset) (var Int version) 
              var PDFObject obj
              obj offset := offset
              obj cache_id := generate_id
              objects insert (string first+i)+" "+string:ver
            eif (l parse (var Intn offset) (var Int version)
              var PDFObject obj
              obj offset := offset
              obj cache_id := generate_id
              objects insert (string first+i)+" "+string:ver
            else
              return (failure "Unsupported reference: "+l)
        eif (l 0 1)="%"
          void
        else
          return (failure "Unsupported reference instruction
      var Str t := parse
      if t<>"startxref"
        return (failure "Unsupported trailer end: "+t)
      if not (pick:0 is Dictionary)
        return failure:"unsupported trailer content"
      var Link:Dictionary trailer :> pop as Dictionary
      if not exists:root
        root :> solve:(trailer first "Root") map Dictionary
      var Int prev := (trailer first "Prev") as Int
      if prev<>undefined
        offset := prev
        restart scan_reference
    if not (addressof:root is Dictionary)
      return failure:"failed to find root content"
    if debug or debug_header
      console "root " ; display addressof:root ; console eol
    var Link:Dictionary pages :> solve:(root first "Pages") 
    if debug or debug_header
      console "pages " ; display addressof:pages ; console e
    pdf scan_pages_list addressof:pages (var Array pages_arr
    pdf draw :> draw
    var CBool first_page := true
    if separated
      var Str gamutname := options option "gamut" Str
      pdf gamut :> color_gamut gamutname
      if pdf:gamut=failure
        return (failure "Incorrect gamut '"+gamutname+"' ("+
    for (var Int page_num) (shunt separated 0 (options optio
      pdf page_num := page_num
      context fill_mode := 0
      context stroke_mode := 0
      context transparency := 0
      context line_width := 0
      text font :> null map Font
      text fontdef :> new Dictionary
      text scale := 1
      text tlm := transform 0 0 1 1 0 0
      text tm := text tlm
      if separated
        memory_clear (addressof context:fill_color) pdf:gamu
        memory_clear (addressof context:stroke_color) pdf:ga
        if page_num<pdf:gamut:dimension
          context fill_mode := 1
          context:fill_color:bytes page_num := 255
          context:fill_color:bytes pdf:gamut:dimension+page_
          context stroke_mode := 1
          context:stroke_color:bytes page_num := 255
          context:stroke_color:bytes pdf:gamut:dimension+pag
      else
        context fill_gamut :> color_gamut "pantone:process_b
        context:fill_color:bytes 0 := 255
        context:fill_color:bytes 1 := 255
      if page_num<0 or page_num>=pages_array:size
        return (failure "no page "+(string page_num+1))
      var Link:Dictionary page :> (pdf solve pages_array:pag
      if debug or debug_header
        console "page " ; display addressof:page ; console e
      context t := transform 0 0 25.4/72 25.4/72 0 0
      var Link:Array box :> solve:(page first "CropBox") as 
      if box:size<4
        box :> solve:(page first "MediaBox") as Array
      var Float bx0 := box:0 as Float
      var Float by0 := box:1 as Float
      var Float bx1 := box:2 as Float
      var Float by1 := box:3 as Float
      if bx0=undefined or by0=undefined or bx1=undefined or 
        bx0 := 0 ; by0 := 0 ; bx1 := 210*72/25.4 ; by1 := 29
      if bx1<=bx0 or by1<=by0
        return (failure "Incorrect page format "+(string (bx
      context t := compose (transform -bx0 -by1 1 1 0 0) (tr
      pdf xobject_dict :> new Dictionary
      pdf colorspace_dict :> new Dictionary
      pdf gs_dict :> new Dictionary
      pdf shading_dict :> new Dictionary
      var Link:Dictionary res :> solve:(page first "Resource
      if not exists:res
        res :>  solve:(pages first "Resources") as Dictionar
      # console "ressources " ; display addressof:res ; cons
      pdf xobject_dict :> solve:(res first "XObject") as Dic
      pdf colorspace_dict :> solve:(res first "ColorSpace") 
      # console "colorspaces are " ; display addressof:color
      if first_page
        var Str gamutname := options option "gamut" Str
        if gamutname=""
            return failure:"Incorrect object number in refer
          for (var Int i) 0 nb-1
            var Str l := stream readline
            if (l parse (var Intn offset) (var Int version) 
              var PDFObject obj
              obj offset := offset
              obj cache_id := generate_id
              objects insert (string first+i)+" "+string:ver
            eif (l parse (var Intn offset) (var Int version)
              var PDFObject obj
              obj offset := offset
              obj cache_id := generate_id
              objects insert (string first+i)+" "+string:ver
            else
              return (failure "Unsupported reference: "+l)
        eif (l 0 1)="%"
          void
        else
          return (failure "Unsupported reference instruction
      var Str t := parse
      if t<>"startxref"
        return (failure "Unsupported trailer end: "+t)
      if not (pick:0 is Dictionary)
        return failure:"unsupported trailer content"
      var Link:Dictionary trailer :> pop as Dictionary
      if not exists:root
        root :> solve:(trailer first "Root") map Dictionary
      var Int prev := (trailer first "Prev") as Int
      if prev<>undefined
        offset := prev
        restart scan_reference
    if not (addressof:root is Dictionary)
      return failure:"failed to find root content"
    if debug or debug_header
      console "root " ; display addressof:root ; console eol
    var Link:Dictionary pages :> solve:(root first "Pages") 
    if debug or debug_header
      console "pages " ; display addressof:pages ; console e
    pdf scan_pages_list addressof:pages (var Array pages_arr
    pdf draw :> draw
    var CBool first_page := true
    if separated
      var Str gamutname := options option "gamut" Str
      pdf gamut :> color_gamut gamutname
      if pdf:gamut=failure
        return (failure "Incorrect gamut '"+gamutname+"' ("+
    for (var Int page_num) (shunt separated 0 (options optio
      pdf page_num := page_num
      context fill_mode := 0
      context stroke_mode := 0
      context transparency := 0
      context line_width := 0
      text font :> null map Font
      text fontdef :> new Dictionary
      text scale := 1
      text tlm := transform 0 0 1 1 0 0
      text tm := text tlm
      if separated
        memory_clear (addressof context:fill_color) pdf:gamu
        memory_clear (addressof context:stroke_color) pdf:ga
        if page_num<pdf:gamut:dimension
          context fill_mode := 1
          context:fill_color:bytes page_num := 255
          context:fill_color:bytes pdf:gamut:dimension+page_
          context stroke_mode := 1
          context:stroke_color:bytes page_num := 255
          context:stroke_color:bytes pdf:gamut:dimension+pag
      else
        context fill_gamut :> color_gamut "pantone:process_b
        context:fill_color:bytes 0 := 255
        context:fill_color:bytes 1 := 255
      if page_num<0 or page_num>=pages_array:size
        return (failure "no page "+(string page_num+1))
      var Link:Dictionary page :> (pdf solve pages_array:pag
      if debug or debug_header
        console "page " ; display addressof:page ; console e
      context t := transform 0 0 25.4/72 25.4/72 0 0
      var Link:Array box :> solve:(page first "CropBox") as 
      if box:size<4
        box :> solve:(page first "MediaBox") as Array
      var Float bx0 := box:0 as Float
      var Float by0 := box:1 as Float
      var Float bx1 := box:2 as Float
      var Float by1 := box:3 as Float
      if bx0=undefined or by0=undefined or bx1=undefined or 
        bx0 := 0 ; by0 := 0 ; bx1 := 210*72/25.4 ; by1 := 29
      if bx1<=bx0 or by1<=by0
        return (failure "Incorrect page format "+(string (bx
      context t := compose (transform -bx0 -by1 1 1 0 0) (tr
      pdf xobject_dict :> new Dictionary
      pdf colorspace_dict :> new Dictionary
      pdf gs_dict :> new Dictionary
      pdf shading_dict :> new Dictionary
      var Link:Dictionary res :> solve:(page first "Resource
      if not exists:res
        res :>  solve:(pages first "Resources") as Dictionar
      # console "ressources " ; display addressof:res ; cons
      pdf xobject_dict :> solve:(res first "XObject") as Dic
      pdf colorspace_dict :> solve:(res first "ColorSpace") 
      # console "colorspaces are " ; display addressof:color
      if first_page
        var Str gamutname := options option "gamut" Str
        if gamutname=""
          var Int maxi := 4
          each colorspace colorspace_dict
            var Link:Array a :> solve:colorspace as Array
            # console "  " ; display addressof:a ; console e
            if a:size>=2 and (a:0 as Ident)="DeviceN"
              maxi := max maxi (a:1 as Array):size
          var Str gamutname := "+" ; var CBool some := false
          for (var Int count) maxi 1 step -1
          var (Dictionary Str Str) already := var (Dictionary Str Str) no_inks
          part gamut_lap
            var (Dictionary Str Str) possible := var (Dictionary Str Str) no_inks
            var (Dictionary Str Str) rejected := var (Dictionary Str Str) no_inks
            each colorspace colorspace_dict
            each colorspace colorspace_dict
              (var Array:Str inks) size := 0
              var Link:Array a :> solve:colorspace as Array
              var Link:Array a :> solve:colorspace as Array
              if a:size>=2 and (a:0 as Ident)="Separation" a
                var Str ink := real_color_name (a:1 as Ident
                if (gamutname search "+"+ink+"+" -1)=(-1) an
                  gamutname += ink+"+" ; some := true
              eif a:size>=2 and (a:0 as Ident)="DeviceN" and
                var Link:Array inks :> a:1 as Array
                for (var Int i) 0 inks:size-1
                  var Str ink := real_color_name (inks:i as 
                  if (gamutname search "+"+ink+"+" -1)=(-1)
                    gamutname += ink+"+" ; some := true
              eif (solve:colorspace as Ident)="DeviceCMYK" a
              if a:size>=2 and (a:0 as Ident)="Separation"
                inks += real_color_name (a:1 as Ident)
              eif a:size>=2 and (a:0 as Ident)="DeviceN"
                var Link:Array devn :> a:1 as Array
                for (var Int i) 0 devn:size-1
                  inks += real_color_name (devn:i as Ident)
              eif (solve:colorspace as Ident)="DeviceCMYK"
                for (var Int i) 0 3
                for (var Int i) 0 3
                  var Str ink := "process_"+(shunt i=0 "cyan
                  if (gamutname search "+"+ink+"+" -1)=(-1)
                    gamutname += ink+"+" ; some := true
          if some
            gamutname := "pantone:"+(gamutname 1 gamutname:l
                  inks += "process_"+(shunt i=0 "cyan" i=1 "magenta" i=2 "yellow" "black")
              var Int i := 0
              while i<inks:size and exists:(already first inks:i)
                i += 1
              if i<inks:size and not exists:(possible first inks:i)
                possible insert inks:i inks:i
              for (var Int j) i+1 inks:size-1
                if not exists:(rejected first inks:j)
                  rejected insert inks:j inks:j
            var Str selected := ""
            each k possible
              if not exists:(rejected first k)
                if selected=""
                  selected := k
                else
                  if debug_gamut
                    each colorspace colorspace_dict
                      console "colorspace " ; display colorspace true ; console eol
                  return (failure "Ambigious inks order between '"+selected+"' and '"+k+"'")
            if selected<>""
              gamutname += selected+"+"
              already insert selected selected
              restart gamut_lap
          if gamutname<>""
            gamutname := "pantone:"+gamutname+"transparencies"
          else
            gamutname := "rgb"
          else
            gamutname := "rgb"
        if debug_gamut
          console "PDF gamut is " gamutname eol
        pdf gamut :> color_gamut gamutname
        if pdf:gamut=failure
          return (failure "Incorrect gamut '"+gamutname+"' (
        draw setup (image_prototype 0 0 (bx1-bx0)/72*25.4 (b
        if (options option "header")
          return success
        first_page := false
      pdf gs_dict :> solve:(res first "ExtGState") as Dictio
      pdf font_dict :> solve:(res first "Font") as Dictionar
      pdf shading_dict :> solve:(res first "Shading") as Dic
      var Link:Array contents
      var Address c := solve:(page first "Contents")
      if (c is Array)
        contents :> c as Array
      eif (c is Dictionary)
        contents :> new Array
        contents size := 1
        contents 0 := c
      else
        return failure:"no page content"
      for (var Int i) 0 contents:size-1
        var Link:Dictionary content :> (solve contents:i) ma
        if not (addressof:content is Dictionary)
          return failure:"no page content"
        stream configure "seek "+(string cobject:seek)
        stream :> filter content (var Link:ImageReadFilter d
        process_instructions
        stream :> raw_stream
        if pdf:status=failure
          return pdf:status
      if pdf:count>0
        warning (string pdf:count)+" dust objects on the sta
        pop count
    status := success

draw_record_filters ".pdf" PDFReader true Void false
        pdf gamut :> color_gamut gamutname
        if pdf:gamut=failure
          return (failure "Incorrect gamut '"+gamutname+"' (
        draw setup (image_prototype 0 0 (bx1-bx0)/72*25.4 (b
        if (options option "header")
          return success
        first_page := false
      pdf gs_dict :> solve:(res first "ExtGState") as Dictio
      pdf font_dict :> solve:(res first "Font") as Dictionar
      pdf shading_dict :> solve:(res first "Shading") as Dic
      var Link:Array contents
      var Address c := solve:(page first "Contents")
      if (c is Array)
        contents :> c as Array
      eif (c is Dictionary)
        contents :> new Array
        contents size := 1
        contents 0 := c
      else
        return failure:"no page content"
      for (var Int i) 0 contents:size-1
        var Link:Dictionary content :> (solve contents:i) ma
        if not (addressof:content is Dictionary)
          return failure:"no page content"
        stream configure "seek "+(string cobject:seek)
        stream :> filter content (var Link:ImageReadFilter d
        process_instructions
        stream :> raw_stream
        if pdf:status=failure
          return pdf:status
      if pdf:count>0
        warning (string pdf:count)+" dust objects on the sta
        pop count
    status := success

draw_record_filters ".pdf" PDFReader true Void false