Patch title: Release 92 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/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/vector/font.pli"
module "/pliant/graphic/vector/freetype.pli"
module "/pliant/graphic/vector/stroke.pli"
module "/pliant/graphic/color/gamut.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
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 message_debug 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



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



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 CBool unsupported_fill <- false
  field CBool unsupported_stroke <- false
  field CBool unsupported_text <- false


type PDFReader
  field Link:Stream raw_stream stream
  field Float line_width
  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 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 Pointer:PDFObject cobject
  field Array:Curve curves ; field Curve curve
  field Link:DrawPrototype draw
  field Str instruction
  field ExtendedStatus status <- success
  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 Pointer:PDFObject cobject
  field Array:Curve curves ; field Curve curve
  field Link:DrawPrototype draw
  field Str instruction
  field ExtendedStatus status <- success
  field Dictionary unknown
  field Dictionary warnings


method pdf warning msg
  arg_rw PDFReader pdf ; arg Str msg


method pdf warning msg
  arg_rw PDFReader pdf ; arg Str msg
  pdf:draw warning msg+(shunt pdf:instruction<>"" " while pr
  var Str m := msg+(shunt pdf:instruction<>"" " ('"+pdf:instruction+"' instruction)" "") 
  if (pdf:warnings first m)=null
    pdf:draw warning m
    pdf:warnings insert m true addressof:void




function real_color_name name -> real
  arg Str name real
method pdf real_color_name name -> real
  arg 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 " " "_"
  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 undefined ; p<>undefined }
    if ((pdf:options p pdf:options:len) parse word:"alias" (var Str name1) (var Str name2) any)
      if real=name1
        real := name2
    i += 1

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)

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:"+real_color_name:id+ext
      gamut :> color_gamut "pantone:"+(pdf real_color_name id)+extra
  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
  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 += "+"+real_color_name:ink
          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:"+(name 1 name:len)+extr
    eif a:size>=2 and (a:0 as Ident)="Separation"
      gamut :> color_gamut "pantone:"+real_color_name:(a:1 a
      gamut :> color_gamut "pantone:"+(pdf real_color_name (a:1 as Ident))+extra
    eif a:size>0 and (a:0 as Ident)="CalRGB"
      gamut :> color_gamut "rgb"
  if exists:gamut and gamut=failure
    gamut :> null map ColorGamut



function record_pdf_instruction fun name
  arg Function fun ; arg Str 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



function record_pdf_instruction fun name
  arg Function fun ; arg Str name
  pdf_instructions insert name true addressof:fun
  pdf_instructions insert (shunt name="quote" "'" name) true addressof:fun


pdf_instruction gs
  var Arrow a := solve:(gs_dict first (pick:0 as Ident))


pdf_instruction gs
  var Arrow a := solve:(gs_dict first (pick:0 as Ident))
  if debug
    display a true ; console eol
  if (a is Dictionary)
    var Link:Dictionary d :> a as Dictionary
    var Bool op
    if ((d first "OP") is Bool)
      op := (d first "OP") as Bool
    else
      op := (context:transparency .and. 2)<>0
    var Int opm
    if ((d first "OPM") is Int)
      opm := (d first "OPM") as Int
    else
      opm := context:transparency .and. 1
    context transparency := (shunt op 2 0)+opm
  if (a is Dictionary)
    var Link:Dictionary d :> a as Dictionary
    var Bool op
    if ((d first "OP") is Bool)
      op := (d first "OP") as Bool
    else
      op := (context:transparency .and. 2)<>0
    var Int opm
    if ((d first "OPM") is Int)
      opm := (d first "OPM") as Int
    else
      opm := context:transparency .and. 1
    context transparency := (shunt op 2 0)+opm
    if (solve:(d first "TR") is Dictionary)
      var Link:Dictionary tr :> solve:(d first "TR") as Dictionary
      if ((tr first "FunctionType") is Int) and ((tr first "FunctionType") as Int)=0
        (raw_stream query "seek") parse (var Intn current_seek)
        raw_stream configure "seek "+(string cobject:seek)
        var Link:Stream s :> filter tr (var Link:ImageReadFilter decoder)
        if exists:s
          context gradation :> new (Array uInt8 256)
          s raw_read (addressof context:gradation) 256
        raw_stream configure "seek "+string:current_seek
  else
    severe "expected a Dictionary argument"
  pop


pdf_instruction cs
  var Arrow a := solve (colorspace_dict first (pick:0 as Ide
  if (pick:0 as Ident)="Pattern"
    warning "pattern painting"
    context fill_mode := 0
    context unsupported_fill := true
  eif ((a as Array):0 as Ident)="Separation" and ((a as Arra
    context fill_gamut :> pdf gamut
    if pdf:gamut:model=color_gamut_additive
      context fill_gamut :> color_gamut "pantone:process_bla
    bytes_fill (addressof context:fill_color) 1 context:fill
    context fill_mode := 2
  eif { var Link:ColorGamut gamut :> colorspace a "+transpar
    context fill_gamut :> gamut
    bytes_fill (addressof context:fill_color) 1 context:fill
    context fill_mode := 1
  else
    warning "unexpected colorspace"
    context fill_mode := 0
    context unsupported_fill := true
  else
    severe "expected a Dictionary argument"
  pop


pdf_instruction cs
  var Arrow a := solve (colorspace_dict first (pick:0 as Ide
  if (pick:0 as Ident)="Pattern"
    warning "pattern painting"
    context fill_mode := 0
    context unsupported_fill := true
  eif ((a as Array):0 as Ident)="Separation" and ((a as Arra
    context fill_gamut :> pdf gamut
    if pdf:gamut:model=color_gamut_additive
      context fill_gamut :> color_gamut "pantone:process_bla
    bytes_fill (addressof context:fill_color) 1 context:fill
    context fill_mode := 2
  eif { var Link:ColorGamut gamut :> colorspace a "+transpar
    context fill_gamut :> gamut
    bytes_fill (addressof context:fill_color) 1 context:fill
    context fill_mode := 1
  else
    warning "unexpected colorspace"
    context fill_mode := 0
    context unsupported_fill := true
    if debug
      console "cs trouble" eol
      display a true ; console eol
  pop


pdf_instruction g
  if separated
    memory_clear (addressof context:fill_color) pdf:gamut:pi
    if page_num<pdf:gamut:dimension
  pop


pdf_instruction g
  if separated
    memory_clear (addressof context:fill_color) pdf:gamut:pi
    if page_num<pdf:gamut:dimension
      context fill_mode := 1
      context:fill_color:bytes page_num := cast 255*(bound 1
      context:fill_color:bytes pdf:gamut:dimension+page_num 
      context:fill_color:bytes page_num := cast 255*(bound 1
      context:fill_color:bytes pdf:gamut:dimension+page_num 
    else
      context fill_mode := 0
  else
    context fill_mode := 1
    context fill_gamut :> color_gamut "pantone:process_black
    context:fill_color:bytes 0 := cast 255*(bound 1-(pick:0 
    context:fill_color:bytes 1 := 255
  pop

pdf_instruction G
  if separated
    memory_clear (addressof context:stroke_color) pdf:gamut:
    if page_num<pdf:gamut:dimension
  else
    context fill_mode := 1
    context fill_gamut :> color_gamut "pantone:process_black
    context:fill_color:bytes 0 := cast 255*(bound 1-(pick:0 
    context:fill_color:bytes 1 := 255
  pop

pdf_instruction G
  if separated
    memory_clear (addressof context:stroke_color) pdf:gamut:
    if page_num<pdf:gamut:dimension
      context stroke_mode := 1
      context:stroke_color:bytes page_num := cast 255*(bound
      context:stroke_color:bytes pdf:gamut:dimension+page_nu
      context:stroke_color:bytes page_num := cast 255*(bound
      context:stroke_color:bytes pdf:gamut:dimension+page_nu
    else
      context stroke_mode := 0
  else
    context stroke_mode := 1
    context stroke_gamut :> color_gamut "pantone:process_bla
    context:stroke_color:bytes 0 := cast 255*(bound 1-(pick:
    context:stroke_color:bytes 1 := 255
  pop



pdf_instruction f
  new_curve false
  else
    context stroke_mode := 1
    context stroke_gamut :> color_gamut "pantone:process_bla
    context:stroke_color:bytes 0 := cast 255*(bound 1-(pick:
    context:stroke_color:bytes 1 := 255
  pop



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


pdf_instruction 'f*'
  new_curve false
    draw fill curves fill_nonzero transform addressof:(real_
  curves size := 0


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

pdf_instruction S
  new_curve false
    draw fill curves fill_evenodd transform addressof:(real_
  curves size := 0

pdf_instruction S
  new_curve false
  if context:stroke_mode<>0
  if draw_stroke and context:stroke_mode<>0
    draw stroke curves context:line_width "" transform addre
  curves size := 0


pdf_instruction B
  new_curve false
    draw stroke curves context:line_width "" transform addre
  curves size := 0


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

pdf_instruction 'B*'
  new_curve false
    draw stroke curves context:line_width "" transform addre
  curves size := 0

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


module "/pliant/graphic/vector/shading.pli"
pdf_instruction sh
  var Link:Dictionary d :> solve:(shading_dict first (pick:0
  var Int st := (d first "ShadingType") as Int
  if context:clip_x0=defined and (st=2 or st=3)
    draw stroke curves context:line_width "" transform addre
  curves size := 0


module "/pliant/graphic/vector/shading.pli"
pdf_instruction sh
  var Link:Dictionary d :> solve:(shading_dict first (pick:0
  var Int st := (d first "ShadingType") as Int
  if context:clip_x0=defined and (st=2 or st=3)
    warning (shunt st=2 "axial" "radial")+" shading"
    var Link:ColorGamut gamut :> colorspace solve:(d first "
    if exists:gamut
      var Link:Array a :> (d first "Coords") as Array
      if st=2
        var Point2 p0 := context:t (point (a:0 as Float) (a:
        var Point2 p1 := context:t (point (a:2 as Float) (a:
      eif st=3
        var Point2 p0 := context:t (point (a:0 as Float) (a:
        var Float r0 := norme (context:t (vector (a:2 as Flo
        var Point2 p1 := context:t (point (a:3 as Float) (a:
        var Float r1 := norme (context:t (vector (a:5 as Flo
        if (norme p1-p0)>1e-9
          warning "radial shading with different centers"
      var Link:Dictionary f :> solve:(d first "Function") as
      var ColorBuffer c0
      for (var Int i) 0 gamut:dimension-1
        c0:bytes i := cast 255*(((f first "C0") as Array):i 
      bytes_fill (addressof:c0 translate Byte gamut:dimensio
      var ColorBuffer c1
      for (var Int i) 0 gamut:dimension-1
        c1:bytes i := cast 255*(((f first "C1") as Array):i 
      bytes_fill (addressof:c1 translate Byte gamut:dimensio
      var Link:ImagePacked p :> new ImagePacked
      p setup (image_prototype context:clip_x0 context:clip_
      if st=2
        p axial_shading p0 c0 p1 c1 gamut
      eif st=3
        p radial_shading p0 r0 c0 p1 r1 c1 gamut
    var Link:ColorGamut gamut :> colorspace solve:(d first "
    if exists:gamut
      var Link:Array a :> (d first "Coords") as Array
      if st=2
        var Point2 p0 := context:t (point (a:0 as Float) (a:
        var Point2 p1 := context:t (point (a:2 as Float) (a:
      eif st=3
        var Point2 p0 := context:t (point (a:0 as Float) (a:
        var Float r0 := norme (context:t (vector (a:2 as Flo
        var Point2 p1 := context:t (point (a:3 as Float) (a:
        var Float r1 := norme (context:t (vector (a:5 as Flo
        if (norme p1-p0)>1e-9
          warning "radial shading with different centers"
      var Link:Dictionary f :> solve:(d first "Function") as
      var ColorBuffer c0
      for (var Int i) 0 gamut:dimension-1
        c0:bytes i := cast 255*(((f first "C0") as Array):i 
      bytes_fill (addressof:c0 translate Byte gamut:dimensio
      var ColorBuffer c1
      for (var Int i) 0 gamut:dimension-1
        c1:bytes i := cast 255*(((f first "C1") as Array):i 
      bytes_fill (addressof:c1 translate Byte gamut:dimensio
      var Link:ImagePacked p :> new ImagePacked
      p setup (image_prototype context:clip_x0 context:clip_
      if st=2
        p axial_shading p0 c0 p1 c1 gamut
      eif st=3
        p radial_shading p0 r0 c0 p1 r1 c1 gamut
      draw image p transform
      if draw_shading
        draw image p transform
    else
      warning "unsupported shading colorspace"
      var Link:DrawPrototype dt :> draw trouble_open
      dt rectangle context:clip_x0 context:clip_y0 context:c
      draw trouble_close
  else
    warning "unsupported shading "+string:((d first "Shading
    var Link:DrawPrototype dt :> draw trouble_open
    dt rectangle context:clip_x0 context:clip_y0 context:cli
    draw trouble_close
  pop


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 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
    else
      warning "unsupported shading colorspace"
      var Link:DrawPrototype dt :> draw trouble_open
      dt rectangle context:clip_x0 context:clip_y0 context:c
      draw trouble_close
  else
    warning "unsupported shading "+string:((d first "Shading
    var Link:DrawPrototype dt :> draw trouble_open
    dt rectangle context:clip_x0 context:clip_y0 context:cli
    draw trouble_close
  pop


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 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 Int
        var Link:ColorGamut gamut :> colorspace solve:(d fir
        var Link:ColorGamut gamut :> colorspace solve:(d fir
        var CBool mask := false
        if not exists:gamut and ((d first "ImageMask") is Bool)
          mask := (d first "ImageMask") as Bool
          if mask
            gamut :> pdf gamut
            var ColorBuffer c0 ; memory_clear addressof:c0 gamut:pixel_size
            var ColorBuffer c1 := real_color context:fill_gamut context:fill_color
        eif bpc=1
          mask := true
          var ColorBuffer c0 ; memory_clear addressof:c0 gamut:pixel_size
          var ColorBuffer c1 ; bytes_fill addressof:c1 1 gamut:pixel_size
        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
        if not exists:gamut
          warning "unsupported image colorspace" ; leave loa
          # console "unsupported colorspace " ; display a true ; console eol
          var Str name := (solve (solve:(d first "ColorSpace") as Array):0) as Ident
          if name=""
            name := solve:(d first "ColorSpace") as Ident
          warning "unsupported image colorspace "+name ; leave load
        var CBool reverse := (solve:(d first "ColorSpace") a
        var CBool reverse := (solve:(d first "ColorSpace") a
        if mask
          reverse := ((solve:(d first "Decode") as Array):0 as Float)<>1
        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: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:ImagePacked packed :> new ImagePacked
        packed setup (image_prototype 0 0 1 1 size_x size_y 
        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 gamut) ""
        (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 
        (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 Address buffer := (memory_zallocate packed:line_
        var Address previous := (memory_zallocate packed:lin
        var Address final := memory_zallocate packed:line_si
        var Int line_size := shunt mask (img:size_x+7)\8 img:line_size
        var Address buffer := (memory_zallocate line_size+img:pixel_size null) translate Byte gamut:pixel_size
        var Address previous := (memory_zallocate line_size+img:pixel_size null) translate Byte gamut:pixel_size
        var Address final := memory_zallocate line_size null
        var Address final2 := memory_zallocate img:line_size null
        var CBool passed := false
        part read_lines
          for (var Int y) 0 size_y-1
            var Int offset := 0
        var CBool passed := false
        part read_lines
          for (var Int y) 0 size_y-1
            var Int offset := 0
            while offset<packed:line_size
              var Int algo := 0 ; var Int step := packed:lin
            while offset<line_size
              var Int algo := 0 ; var Int step := line_size-offset
              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
              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 left := shunt pred_left<>undefined and pred_left<img:pixel_size -pred_left -(img pixel_size)
              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
              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 "+strin
                # warning "Unsupported image predictor "+string:predictor+" algorithm "+string:algo+" at line "+string:y+"/"+string:size_y+" ("+string:size_x+" "+string:size_y+" "+string:line_size+" , "+string:pred_columns+" "+string:pred_bits+" "+string:pred_colors+" "+string:pred_step+" "+string:pred_left+")" ; leave read_lines
                warning "Unsupported image predictor "+string:predictor+" algorithm "+string:algo ; leave read_lines
              memory_copy buffer (final translate Byte offse
              memory_copy buffer previous step
              offset += step
              memory_copy buffer (final translate Byte offse
              memory_copy buffer previous step
              offset += step
            if (exists context:gradation)
              var Pointer:(Array uInt8 256) gradation :> context gradation
              var Address cur := final ; var Address stop := final translate Byte line_size
              while cur<>stop
                cur map uInt8 := gradation (cur map uInt8)
                cur := cur translate uInt8 1
            if reverse
            if reverse
              bytes_copy_255minus final 1 final 1 packed:lin
            packed write 0 size_y-1-y size_x final
              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) .and. 2^(7-i%8))<>0 addressof:c1 addressof:c0) cur img:pixel_size
                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
          passed := true
        if exists:decoder
          if decoder:close=failure
            warning "failed to read image" ; leave load
        memory_free (buffer translate Byte -(packed:pixel_si
        memory_free (previous translate Byte -(packed:pixel_
        memory_free (buffer translate Byte -(img:pixel_size))
        memory_free (previous translate Byte -(img:pixel_size))
        memory_free final
        memory_free final
        packed shrink
        memory_free final2
        img configure "shrink"
        raw_stream configure "seek "+string:current_seek
        if pixels=failure
          warning "failed to read image" ; leave load
        raw_stream configure "seek "+string:current_seek
        if pixels=failure
          warning "failed to read image" ; leave load
        (addressof:ca omap PDFImageCache) image :> packed
        (addressof:ca omap PDFImageCache) image :> img
        ok := passed
      if ok
        cache_ready ca
      else
        cache_cancel ca
        warning "failed to load image"
        return
        ok := passed
      if ok
        cache_ready ca
      else
        cache_cancel ca
        warning "failed to load image"
        return
    draw image (addressof:ca omap PDFImageCache):image conte
    else
      if debug_do
        console "-"
    if draw_image
      draw image (addressof:ca omap PDFImageCache):image context:t
  eif (a is Dictionary) and cobject:attached<>null
    check (entry_type cobject:attached)=DrawDisplayList
  eif (a is Dictionary) and cobject:attached<>null
    check (entry_type cobject:attached)=DrawDisplayList
    (addressof:draw omap DrawDisplayList) include (cobject:a
    var Transform2 ct := context t
    (addressof:draw omap DrawDisplayList) include (cobject:attached map DrawDisplayList) DrawTransform "xx "+(string ct:xx)+" xy "+(string ct:xy)+" xt "+(string ct:xt)+" yx "+(string ct:yx)+" yy "+(string ct:yy)+" yt "+(string ct:yt)
    if debug_do
      console "Do again" eol
  eif (a is Dictionary)
    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
  eif (a is Dictionary)
    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_prototype ""):options
      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
      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
      memo_draw include sub context:t
      var Transform2 ct := context t
      memo_draw include sub DrawTransform "xx "+(string ct:xx)+" xy "+(string ct:xy)+" xt "+(string ct:xt)+" yx "+(string ct:yx)+" yy "+(string ct:yy)+" yt "+(string ct:yt)
      do_object attached := addressof sub
      do_object attached := addressof sub
    if debug_do
      console "Do first" eol
  else
    warning "unexpected Do usage"


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
      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"
  else
    warning "unexpected Do usage"


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
      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"
              if (text:font load_postscript temp "")=success
              if not (options option "nopliantfont") and (text:font load_postscript temp "")=success
                loaded := true
                if debug
                  console "loaded Type1 font at " cobject:se
                loaded := true
                if debug
                  console "loaded Type1 font at " cobject:se
              eif (text:font load_freetype temp "")=success
              eif not (options option "nofreetypefont") and (text:font load_freetype temp "")=success
                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


pdf_instruction 'T*'
                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


pdf_instruction 'T*'
  text tlm := compose (transform 0 text:leading 1 1 0 0) tex
  text tlm := compose (transform 0 -(text:leading) 1 1 0 0) text:tlm
  text tm := text tlm

method pdf draw_text txt offsets
  arg_rw PDFReader pdf ; arg Str txt ; arg_rw Array:Float of
  implicit pdf
  text tm := text tlm

method pdf draw_text txt offsets
  arg_rw PDFReader pdf ; arg Str txt ; arg_rw Array:Float of
  implicit pdf
    if false
    if debug
      console "text is "
      for (var Int i) 0 txt:len-1
        console (shunt txt:i:number>=32 and txt:i:number<128
      console " ("
      for (var Int i) 0 txt:len-1
        console " " txt:i:number
      console ")" eol
    var Transform2 t := compose (transform 0 0 text:scale -(
    var Float length := 0
    var ColorBuffer color := real_color context:fill_gamut c
    var Int firstchar := (text:fontdef first "FirstChar") as
    if firstchar<0
      firstchar := 0
    var Str32 unicode := text_to_unicode txt text:encoding
    if debug
      console "unicode is"
      for (var Int i) 0 unicode:len-1
        console " " unicode:i:number
      console eol
    var Link:Font font :> text font
    if not exists:font
      font :> font (solve:(text:fontdef first "BaseFont") as
    if not exists:font
      warning "Font '"+(solve:(text:fontdef first "BaseFont"
      console "text is "
      for (var Int i) 0 txt:len-1
        console (shunt txt:i:number>=32 and txt:i:number<128
      console " ("
      for (var Int i) 0 txt:len-1
        console " " txt:i:number
      console ")" eol
    var Transform2 t := compose (transform 0 0 text:scale -(
    var Float length := 0
    var ColorBuffer color := real_color context:fill_gamut c
    var Int firstchar := (text:fontdef first "FirstChar") as
    if firstchar<0
      firstchar := 0
    var Str32 unicode := text_to_unicode txt text:encoding
    if debug
      console "unicode is"
      for (var Int i) 0 unicode:len-1
        console " " unicode:i:number
      console eol
    var Link:Font font :> text font
    if not exists:font
      font :> font (solve:(text:fontdef first "BaseFont") as
    if not exists:font
      warning "Font '"+(solve:(text:fontdef first "BaseFont"
      if false
      if debug
        console "missing font " ; display (addressof text:fo
        warning "Using missing font"
        console "text is "
        for (var Int i) 0 txt:len-1
          console (shunt txt:i:number>=32 and txt:i:number<1
        console " ("
        for (var Int i) 0 txt:len-1
          console " " txt:i:number
        console ")" eol
        console "unicode text is "
        for (var Int i) 0 unicode:len-1
          console character:(shunt unicode:i:number>=32 and 
        console " ("
        for (var Int i) 0 unicode:len-1
          console " " unicode:i:number
        console ")" eol
      font :> font "Helvetica"
    for (var Int i) 0 txt:len-1
      var Int c := txt:i number
      var Int width := (((text:fontdef first "Widths") as Ar
      if width=undefined
        width := cast (font length (unicode i 1) null)*1000 
      offsets i := (width-offsets:i)/1000+(shunt c=32 text:w
      length += offsets i
        console "missing font " ; display (addressof text:fo
        warning "Using missing font"
        console "text is "
        for (var Int i) 0 txt:len-1
          console (shunt txt:i:number>=32 and txt:i:number<1
        console " ("
        for (var Int i) 0 txt:len-1
          console " " txt:i:number
        console ")" eol
        console "unicode text is "
        for (var Int i) 0 unicode:len-1
          console character:(shunt unicode:i:number>=32 and 
        console " ("
        for (var Int i) 0 unicode:len-1
          console " " unicode:i:number
        console ")" eol
      font :> font "Helvetica"
    for (var Int i) 0 txt:len-1
      var Int c := txt:i number
      var Int width := (((text:fontdef first "Widths") as Ar
      if width=undefined
        width := cast (font length (unicode i 1) null)*1000 
      offsets i := (width-offsets:i)/1000+(shunt c=32 text:w
      length += offsets i
    if false
    if debug
      console "length is"
      for (var Int i) 0 unicode:len-1
        console " " offsets:i
      console " -> " length eol
    if true
      var Address kerning := memory_allocate txt:len*Float:s
      for (var Int i) 0 txt:len-1
        var Float length := font length (unicode i 1) null
        if length=0
          length := offsets i
        kerning map Float i := offsets:i/length
      var Address kerning := memory_allocate txt:len*Float:s
      for (var Int i) 0 txt:len-1
        var Float length := font length (unicode i 1) null
        if length=0
          length := offsets i
        kerning map Float i := offsets:i/length
      draw text unicode font kerning undefined t addressof:c
      if draw_text
        draw text unicode font kerning undefined t addressof:color
      memory_free kerning
    else
      for (var Int i) 0 txt:len-1
      memory_free kerning
    else
      for (var Int i) 0 txt:len-1
        draw text (unicode i 1) font null undefined t addres
        if draw_text
          draw text (unicode i 1) font null undefined t addressof:color
        t := compose (transform offsets:i 0 1 1 0 0) t
    text tm := compose (transform length 0 1 1 0 0) text:tm


pdf_instruction Tr
        t := compose (transform offsets:i 0 1 1 0 0) t
    text tm := compose (transform length 0 1 1 0 0) text:tm


pdf_instruction Tr
  if (pick:0 as Float)<>0
    warning "not implemented"
  if (pick:0 as Int)<>0
    warning "text rendering mode "+string:(pick:0 as Int)+" is not supported"
  pop

pdf_instruction Tz
  if (pick:0 as Float)<>100
  pop

pdf_instruction Tz
  if (pick:0 as Float)<>100
    warning "not implemented"
    warning "text horizontal scaling "+string:(pick:0 as Float)+"% is not supported"
  pop

  pop

pdf_instruction Ts
  if (pick:0 as Float)<>0
    warning "text rise "+string:(pick:0 as Float)+" is not supported"
  pop


pdf_instruction quote
  text tlm := compose (transform 0 -(text:leading) 1 1 0 0) text:tlm
  text tm := text tlm
  var Str txt := pick:0 as Str
  (var Array:Float offsets) size := txt len
  for (var Int i) 0 offsets:size-1
    offsets i := 0
  draw_text txt offsets
  pop


# tagging


method pdf process_instructions
  arg_rw PDFReader pdf
  implicit pdf
    while { var Str t := parse ; t<>"" and t<>"endstream" }
      if debug
        console t
        for (var Int i) (min count-1 7) 0 step -1
          console " " ; display pick:i
        console eol
      var Pointer:Arrow p :> pdf_instructions first t
      if p<>null
        instruction := t
        pdf_instruction_prototype pdf (p map Function)
        instruction := ""
        if status=failure
          return
      else
# tagging


method pdf process_instructions
  arg_rw PDFReader pdf
  implicit pdf
    while { var Str t := parse ; t<>"" and t<>"endstream" }
      if debug
        console t
        for (var Int i) (min count-1 7) 0 step -1
          console " " ; display pick:i
        console eol
      var Pointer:Arrow p :> pdf_instructions first t
      if p<>null
        instruction := t
        pdf_instruction_prototype pdf (p map Function)
        instruction := ""
        if status=failure
          return
      else
        if debug
          console "TROUBLE" eol
        warning "unsupported instruction '"+t+"'"
        pop count
    if t="" and addressof:stream<>addressof:raw_stream
      stream :> raw_stream
      t := token
    if t="endstream"
      t := token
    if t<>"endobj" 
      warning "missing page end '"+t+"'"



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"
        warning "unsupported instruction '"+t+"'"
        pop count
    if t="" and addressof:stream<>addressof:raw_stream
      stream :> raw_stream
      t := token
    if t="endstream"
      t := token
    if t<>"endobj" 
      warning "missing page end '"+t+"'"



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
    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
            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"
    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
            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") 
    var Link:Dictionary pages :> solve:(root first "Pages") 
    if debug
    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
      console "pages " ; display addressof:pages ; console e
    pdf scan_pages_list addressof:pages (var Array pages_arr
    pdf draw :> draw
    for (var Int page_num) (options option "page" Int 1)-1 (
    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+"' ("+pdf:gamut:message+")")
    for (var Int page_num) (shunt separated 0 (options option "page" Int 1)-1) (shunt separated pdf:gamut:dimension-1 (options option "page" Int pages_array:size)-1)
      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
      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 false # FIXME separated
        memory_clear (addressof context:fill_color) draw:gam
        if page_num<draw:gamut:dimension
      if separated
        memory_clear (addressof context:fill_color) pdf:gamut:pixel_size
        memory_clear (addressof context:stroke_color) pdf:gamut:pixel_size
        if page_num<pdf:gamut:dimension
          context fill_mode := 1
          context:fill_color:bytes page_num := 255
          context fill_mode := 1
          context:fill_color:bytes page_num := 255
          context:fill_color:bytes draw:gamut:dimension+page
          context:fill_color:bytes pdf:gamut:dimension+page_num := 255
          context stroke_mode := 1
          context:stroke_color:bytes page_num := 255
          context stroke_mode := 1
          context:stroke_color:bytes page_num := 255
          context:stroke_color:bytes draw:gamut:dimension+pa
          context:stroke_color:bytes pdf:gamut:dimension+page_num := 255
      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
      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
      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
        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
      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 eol
          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
      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
          each colorspace colorspace_dict
            var Link:Array a :> solve:colorspace as Array
            if a:size>=2 and (a:0 as Ident)="Separation" and
              var Str ink := real_color_name (a:1 as Ident)
              if (gamutname search "+"+ink+"+" -1)=(-1) and 
                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 Id
                if (gamutname search "+"+ink+"+" -1)=(-1)
            # console "  " ; display addressof:a ; console eol
            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
            each colorspace colorspace_dict
              var Link:Array a :> solve:colorspace as Array
              if a:size>=2 and (a:0 as Ident)="Separation" and count=1
                var Str ink := real_color_name (a:1 as Ident)
                if (gamutname search "+"+ink+"+" -1)=(-1) and ink<>"all"
                  gamutname += ink+"+" ; some := true
                  gamutname += ink+"+" ; some := true
            eif (solve:colorspace as Ident)="DeviceCMYK" and
              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:len
        else
          gamutname := "rgb"
      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 (by1
              eif a:size>=2 and (a:0 as Ident)="DeviceN" and (a:1 as Array):size=count
                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 Ident)
                  if (gamutname search "+"+ink+"+" -1)=(-1)
                    gamutname += ink+"+" ; some := true
              eif (solve:colorspace as Ident)="DeviceCMYK" and count=4
                for (var Int i) 0 3
                  var Str ink := "process_"+(shunt i=0 "cyan" i=1 "magenta" i=2 "yellow" "black")
                  if (gamutname search "+"+ink+"+" -1)=(-1)
                    gamutname += ink+"+" ; some := true
          if some
            gamutname := "pantone:"+(gamutname 1 gamutname:len)+"transparencies"
          else
            gamutname := "rgb"
        pdf gamut :> color_gamut gamutname
        if pdf:gamut=failure
          return (failure "Incorrect gamut '"+gamutname+"' ("+pdf:gamut:message+")")
        draw setup (image_prototype 0 0 (bx1-bx0)/72*25.4 (by1-by0)/72*25.4 undefined undefined pdf:gamut) options+(shunt separated "" " page_count "+(string pages_array:size))
        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

      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 Void
draw_record_filters ".pdf" PDFReader true Void false