Patch title: Release 96 bulk changes
Abstract:
File: /pliant/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/storage/database.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/color/database.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"


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/storage/database.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/color/database.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 use_tiff_lib (file_query "file:/lib/libtiff.so.4" s
if use_tiff_lib
constant use_libtiff (file_query "file:/lib/libtiff.so.4" standard)=defined or (file_query "file:/usr/lib/libtiff.so.4" standard)=defined
if use_libtiff
  module "/pliant/graphic/filter/tiff.pli"



method pdf filter base a p decoder decoder_options -> s
  arg_rw PDFReader pdf ; arg_rw Link:Stream base ; arg Addre
  implicit pdf
    if (a is Array)
      s :> base
      var Link:Array array :> a as Array
      for (var Int i) 0 array:size-1
        s :> pdf filter s array:i p decoder decoder_options
    eif (a as Ident)="FlateDecode"
      s :> new Stream
      s open "zlib:" "" in+safe pliant_default_file_system b
    eif (a as Ident)="ASCII85Decode"
      s :> new Stream
      s open "ascii85:" "" in+safe pliant_default_file_syste
  module "/pliant/graphic/filter/tiff.pli"



method pdf filter base a p decoder decoder_options -> s
  arg_rw PDFReader pdf ; arg_rw Link:Stream base ; arg Addre
  implicit pdf
    if (a is Array)
      s :> base
      var Link:Array array :> a as Array
      for (var Int i) 0 array:size-1
        s :> pdf filter s array:i p decoder decoder_options
    eif (a as Ident)="FlateDecode"
      s :> new Stream
      s open "zlib:" "" in+safe pliant_default_file_system b
    eif (a as Ident)="ASCII85Decode"
      s :> new Stream
      s open "ascii85:" "" in+safe pliant_default_file_syste
    eif use_tiff_lib and (a as Ident)="CCITTFaxDecode"
    eif use_libtiff and (a as Ident)="CCITTFaxDecode"
      s :> base
      s :> base
      decoder :> image_read_filter ".tiff"
      decoder :> image_read_filter ".libtiff"
      var Int k := (p first "K") as Int
      decoder_options += " write_tiff_header compression "+s
    eif (a as Ident)="DCTDecode"
      s :> base
      decoder :> image_read_filter ".jpeg"
    eif (a is Ident)
      s :> null map Stream
      warning "unsupported '"+(a as Ident)+"' encoding used"
      if debug_image
        console "unsupported '"+(a as Ident)+"' encoding use
    else
      s :> base


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
  if debug_do
    console "PDF Do " ; display solve:(xobject_dict first (p
  var Arrow a := solve (xobject_dict first (pop as Ident))
  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 gamut0 :> colorspace solve:(d fi
        var Link:ColorGamut gamut :> gamut0
        var CBool mask := false
        if not exists:gamut and ((d first "ImageMask") is Bo
          mask := (d first "ImageMask") as Bool
          if mask
            gamut0 :> pdf gamut
            gamut :> pdf gamut
            var ColorBuffer c0 ; memory_clear addressof:c0 g
            if gamut:model=color_gamut_additive
              bytes_fill addressof:c0 1 gamut:dimension
            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_image
          image_counter += 1
          console "draw image " image_counter ": " size_x " 
          if exists:gamut
            console " " gamut:name
          console (shunt mask " MASK" "") " transparency " c
        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")
        var CBool reverse := false
        if gamut:model=color_gamut_substractive and gamut:di
          if pdf:gamut:name="grey"
            gamut0 :> pdf gamut
            gamut :> pdf gamut
            reverse := true
          eif (solve:(d first "ColorSpace") as Ident)="Devic
            reverse := true
        if mask
          reverse := ((solve:(d first "Decode") as Array):0 
        if debug_image and reverse
          console "image will be reversed" eol
        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
        var Int line_size := shunt mask (img:size_x+7)\8 add
        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
        part read_lines
          (raw_stream query "seek") parse (var Intn current_
          raw_stream configure "seek "+(string img_object:se
          var Link:Stream pixels :> filter d (var Link:Image
          if not exists:pixels
            warning "unsupported image encoding" ; leave rea
          if exists:decoder
            if (decoder open pixels decoder_options+" size_x
              warning "failed to setup image decoder" ; deco
          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 false # image_counter=1
              for (var Int i) 0 line_size-1
                final map uInt8 i := shunt (i\16)%2=0 255 0
            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
            eif addressof:gamut<>addressof:gamut0
              var Address src := final ; var Address stop :=
              var Address dest := final2
              while src<>stop
                memory_copy src dest gamut0:pixel_size
                for (var Int i) 0 gamut:transparency-1
                  dest map uInt8 gamut:dimension+i := shunt 
                src := src translate Byte gamut0:pixel_size
                dest := dest translate Byte gamut:pixel_size
              img write 0 size_y-1-y size_x final2
            else
              img write 0 size_y-1-y size_x final
          ok := true
        if exists:decoder
          if decoder:close=failure
            warning "failed to read image" ; ok := false
        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 exists:pixels and pixels=failure
          warning "failed to read image" ; ok := false
        (addressof:ca omap PDFImageCache) image :> img
        if debug_image and ok
          img options += " image_counter "+string:image_coun
          var Link:ImageConvert conv :> new ImageConvert
          conv bind img color_gamut:"rgb" "fast"
          conv save "file:/tmp/image/"+(right string:image_c
      if ok
        cache_ready ca
      else
        cache_cancel ca
        warning "failed to load image"
        return
    else
      if debug_do
        console "-"
    if draw_image # and image_counter<>230
      var Int k := (p first "K") as Int
      decoder_options += " write_tiff_header compression "+s
    eif (a as Ident)="DCTDecode"
      s :> base
      decoder :> image_read_filter ".jpeg"
    eif (a is Ident)
      s :> null map Stream
      warning "unsupported '"+(a as Ident)+"' encoding used"
      if debug_image
        console "unsupported '"+(a as Ident)+"' encoding use
    else
      s :> base


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
  if debug_do
    console "PDF Do " ; display solve:(xobject_dict first (p
  var Arrow a := solve (xobject_dict first (pop as Ident))
  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 gamut0 :> colorspace solve:(d fi
        var Link:ColorGamut gamut :> gamut0
        var CBool mask := false
        if not exists:gamut and ((d first "ImageMask") is Bo
          mask := (d first "ImageMask") as Bool
          if mask
            gamut0 :> pdf gamut
            gamut :> pdf gamut
            var ColorBuffer c0 ; memory_clear addressof:c0 g
            if gamut:model=color_gamut_additive
              bytes_fill addressof:c0 1 gamut:dimension
            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_image
          image_counter += 1
          console "draw image " image_counter ": " size_x " 
          if exists:gamut
            console " " gamut:name
          console (shunt mask " MASK" "") " transparency " c
        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")
        var CBool reverse := false
        if gamut:model=color_gamut_substractive and gamut:di
          if pdf:gamut:name="grey"
            gamut0 :> pdf gamut
            gamut :> pdf gamut
            reverse := true
          eif (solve:(d first "ColorSpace") as Ident)="Devic
            reverse := true
        if mask
          reverse := ((solve:(d first "Decode") as Array):0 
        if debug_image and reverse
          console "image will be reversed" eol
        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
        var Int line_size := shunt mask (img:size_x+7)\8 add
        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
        part read_lines
          (raw_stream query "seek") parse (var Intn current_
          raw_stream configure "seek "+(string img_object:se
          var Link:Stream pixels :> filter d (var Link:Image
          if not exists:pixels
            warning "unsupported image encoding" ; leave rea
          if exists:decoder
            if (decoder open pixels decoder_options+" size_x
              warning "failed to setup image decoder" ; deco
          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 false # image_counter=1
              for (var Int i) 0 line_size-1
                final map uInt8 i := shunt (i\16)%2=0 255 0
            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
            eif addressof:gamut<>addressof:gamut0
              var Address src := final ; var Address stop :=
              var Address dest := final2
              while src<>stop
                memory_copy src dest gamut0:pixel_size
                for (var Int i) 0 gamut:transparency-1
                  dest map uInt8 gamut:dimension+i := shunt 
                src := src translate Byte gamut0:pixel_size
                dest := dest translate Byte gamut:pixel_size
              img write 0 size_y-1-y size_x final2
            else
              img write 0 size_y-1-y size_x final
          ok := true
        if exists:decoder
          if decoder:close=failure
            warning "failed to read image" ; ok := false
        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 exists:pixels and pixels=failure
          warning "failed to read image" ; ok := false
        (addressof:ca omap PDFImageCache) image :> img
        if debug_image and ok
          img options += " image_counter "+string:image_coun
          var Link:ImageConvert conv :> new ImageConvert
          conv bind img color_gamut:"rgb" "fast"
          conv save "file:/tmp/image/"+(right string:image_c
      if ok
        cache_ready ca
      else
        cache_cancel ca
        warning "failed to load image"
        return
    else
      if debug_do
        console "-"
    if draw_image # and image_counter<>230
      draw image (addressof:ca omap PDFImageCache):image con
      var Link:ImagePrototype img :> (addressof:ca omap PDFImageCache) image
      if context:transparency=0 and img:gamut:name<>pdf:gamut:name and img:gamut:name+"+transparencies"<>pdf:gamut:name and not pdf:separated
        var Curve rect
        rect angle img:x0 img:y0
        rect angle img:x1 img:y0
        rect angle img:x1 img:y1
        rect angle img:x0 img:y1
        rect compute outline
        (var Array:Curve curves) size := 1 ; curves 0 := rect
        var ColorBuffer blank
        for (var Int i) 0 pdf:gamut:pixel_size-1
          addressof:blank map uInt8 i := shunt i<pdf:gamut:dimension 0 255
        draw fill curves fill_evenodd context:t addressof:blank
      draw image img context:t
  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
  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
    var Int context_level := context level
    context_save
    context fill_opacity := 1
    context stroke_opacity := 1
    context mixture := ""
    if debug_form
      console "# form begin " ; display a true ; console eol
    process_instructions
    if debug_form
      console "# form end (group model is " (shunt context:g
    context_restore context_level
    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
      var Str transparency := (shunt context:gs_count>0 " fl
  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
  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
    var Int context_level := context level
    context_save
    context fill_opacity := 1
    context stroke_opacity := 1
    context mixture := ""
    if debug_form
      console "# form begin " ; display a true ; console eol
    process_instructions
    if debug_form
      console "# form end (group model is " (shunt context:g
    context_restore context_level
    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
      var Str transparency := (shunt context:gs_count>0 " fl
      if context:mixture<>"" and context:mixture<>"Normal" and context:mixture<>"Multiply" and context:mixture<>"Screen" and context:mixture<>"Darken" and context:mixture<>"Lighten"
        warning "unsupported color mixture "+context:mixture
      memo_draw include sub DrawTransform "xx "+(string ct:x
      do_object attached := addressof sub
    if debug_do
      console "Do first" eol
  else
    if debug
      console "unexpected Do usage (Subtype = "+subtype+")" 
    warning "unexpected Do usage (Subtype = "+subtype+")"


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
    color_device := options option "color_device" Str "panto
    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 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
    if false
      console "metadata " ; display solve:(root first "Metad
      stream configure "seek "+(string cobject:seek)
      stream :> filter (solve:(root first "Metadata") as Dic
      while not stream:atend
        console "  " stream:readline eol
      stream :> raw_stream
      console "default gray " ; display solve:(root first "D
      console "default rgb " ; display solve:(root first "De
    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_mode := 1
        context fill_gamut :> color_gamut pdf:color_device+"
        context:fill_color:bytes 0 := 255
        context:fill_color:bytes 1 := 255
        context stroke_mode := 1
        context stroke_gamut :> color_gamut pdf:color_device
        context:stroke_color:bytes 0 := 255
        context:stroke_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
      base_t := context t
      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
      if debug_header
        console "ressources " ; display addressof:res ; cons
      pdf xobject_dict :> solve:(res first "XObject") as Dic
      pdf colorspace_dict :> solve:(res first "ColorSpace") 
      if debug_header
        console "colorspaces are " ; display addressof:color
      if first_page
        var Str gamutname := options option "gamut" Str
        if gamutname=""
      memo_draw include sub DrawTransform "xx "+(string ct:x
      do_object attached := addressof sub
    if debug_do
      console "Do first" eol
  else
    if debug
      console "unexpected Do usage (Subtype = "+subtype+")" 
    warning "unexpected Do usage (Subtype = "+subtype+")"


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
    color_device := options option "color_device" Str "panto
    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 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
    if false
      console "metadata " ; display solve:(root first "Metad
      stream configure "seek "+(string cobject:seek)
      stream :> filter (solve:(root first "Metadata") as Dic
      while not stream:atend
        console "  " stream:readline eol
      stream :> raw_stream
      console "default gray " ; display solve:(root first "D
      console "default rgb " ; display solve:(root first "De
    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_mode := 1
        context fill_gamut :> color_gamut pdf:color_device+"
        context:fill_color:bytes 0 := 255
        context:fill_color:bytes 1 := 255
        context stroke_mode := 1
        context stroke_gamut :> color_gamut pdf:color_device
        context:stroke_color:bytes 0 := 255
        context:stroke_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
      base_t := context t
      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
      if debug_header
        console "ressources " ; display addressof:res ; cons
      pdf xobject_dict :> solve:(res first "XObject") as Dic
      pdf colorspace_dict :> solve:(res first "ColorSpace") 
      if debug_header
        console "colorspaces are " ; display addressof:color
      if first_page
        var Str gamutname := options option "gamut" Str
        if gamutname=""
          var Pointer:Dictionary aws :> solve:(page first "AWSInfo") as Dictionary
          var Pointer:Array seps :> solve:(aws first "Separations") as Array
          if seps:size>0
            part scan_separations
              gamutname := color_device+":"
              for (var Int i) 0 seps:size-1
                var Pointer:Dictionary sep :> seps:i as Dictionary
                var Pointer:Str sepname :> solve:(sep first "Name") as Ident
                if sepname<>""
                  gamutname += (pdf real_color_name sepname)+"+"
                else
                  gamutname := "" ; leave scan_separations
              gamutname += "transparencies"
        if gamutname=""
          var (Dictionary Str Str) already := var (Dictionar
          part gamut_lap
            var (Dictionary Str Str) possible := var (Dictio
            var (Dictionary Str Str) rejected := var (Dictio
            var Str suggest := "" ; var CBool suggested := f
            each colorspace colorspace_dict getkey key
              (var Array:Str inks) size := 0
              var Link:Array a :> solve:colorspace as Array
              if a:size>=2 and (a:0 as Ident)="Separation" a
                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
                  inks += "process_"+(shunt i=0 "cyan" i=1 "
              if not (key parse "DN_" any:(var Str csname))
                csname := ""
              var Int i := 0
              while i<inks:size and exists:(already first in
                i += 1
                if (csname parse any "_" any:(var Str remain
                  csname := remain
                else
                  csname := ""
              if i<inks:size and not exists:(possible first 
                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
              if i<inks:size and csname:len>0 and (csname pa
                if not suggested
                  suggest := inks i ; suggested := true
                eif suggest<>inks:i
                  suggest := ""
                if debug_gamut
                  console "suggest " key " " already:size " 
            var Str selected := suggest
            each k possible
              if not exists:(rejected first k)
                if selected=""
                  selected := k
                eif suggest=""
                  if debug_gamut
                    each colorspace colorspace_dict getkey k
                      console "colorspace " key " is " ; dis
                  return (failure "Ambigious inks order betw
            if selected<>""
              gamutname += selected+"+"
              already insert selected selected
              restart gamut_lap
          if gamutname<>""
            gamutname := pdf:color_device+":"+gamutname+"tra
          else
            gamutname := "rgba"
        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 false
        console "contents are " ; display c false ; console 
      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 false
          console "content " i " is " ; display addressof:co
        if not (addressof:content is Dictionary)
          return failure:"no page content"
        stream configure "seek "+(string cobject:seek)
        stream :> filter content (var Link:ImageReadFilter d
        # console "stream is " entry_type:(addressof stream:
        process_instructions
        stream :> raw_stream
        if pdf:status=failure
          return pdf:status
      if context:level>0
        warning "unmatched context save"
        context_restore 0
      if context:clip_count+context:gs_count>0
        warning "unclosed clipping"
        for (var Int i) 1 context:clip_count
          draw clip_close
        for (var Int i) 1 context:gs_count
          draw clip_close
      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
          var (Dictionary Str Str) already := var (Dictionar
          part gamut_lap
            var (Dictionary Str Str) possible := var (Dictio
            var (Dictionary Str Str) rejected := var (Dictio
            var Str suggest := "" ; var CBool suggested := f
            each colorspace colorspace_dict getkey key
              (var Array:Str inks) size := 0
              var Link:Array a :> solve:colorspace as Array
              if a:size>=2 and (a:0 as Ident)="Separation" a
                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
                  inks += "process_"+(shunt i=0 "cyan" i=1 "
              if not (key parse "DN_" any:(var Str csname))
                csname := ""
              var Int i := 0
              while i<inks:size and exists:(already first in
                i += 1
                if (csname parse any "_" any:(var Str remain
                  csname := remain
                else
                  csname := ""
              if i<inks:size and not exists:(possible first 
                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
              if i<inks:size and csname:len>0 and (csname pa
                if not suggested
                  suggest := inks i ; suggested := true
                eif suggest<>inks:i
                  suggest := ""
                if debug_gamut
                  console "suggest " key " " already:size " 
            var Str selected := suggest
            each k possible
              if not exists:(rejected first k)
                if selected=""
                  selected := k
                eif suggest=""
                  if debug_gamut
                    each colorspace colorspace_dict getkey k
                      console "colorspace " key " is " ; dis
                  return (failure "Ambigious inks order betw
            if selected<>""
              gamutname += selected+"+"
              already insert selected selected
              restart gamut_lap
          if gamutname<>""
            gamutname := pdf:color_device+":"+gamutname+"tra
          else
            gamutname := "rgba"
        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 false
        console "contents are " ; display c false ; console 
      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 false
          console "content " i " is " ; display addressof:co
        if not (addressof:content is Dictionary)
          return failure:"no page content"
        stream configure "seek "+(string cobject:seek)
        stream :> filter content (var Link:ImageReadFilter d
        # console "stream is " entry_type:(addressof stream:
        process_instructions
        stream :> raw_stream
        if pdf:status=failure
          return pdf:status
      if context:level>0
        warning "unmatched context save"
        context_restore 0
      if context:clip_count+context:gs_count>0
        warning "unclosed clipping"
        for (var Int i) 1 context:clip_count
          draw clip_close
        for (var Int i) 1 context:gs_count
          draw clip_close
      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