Patch title: Release 94 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/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/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/graphic/image/pixmap.pli"
module "/pliant/graphic/image/packed.pli"
module "/pliant/graphic/misc/bytes.pli"
module "/pliant/graphic/misc/float.pli"
module "/pliant/language/data/cache.pli"
module "/pliant/language/compiler/type/inherit.pli"
module "/pliant/language/data/id.pli"
module "/pliant/graphic/filter/prototype.pli"
module "/pliant/graphic/filter/jpeg.pli"
module "prototype.pli"


constant debug false
constant debug_header false
constant debug_image false
constant debug_common false

constant debug debug_common
constant debug_xpdf true # XPDF like commands listing
constant debug_header debug_common
constant debug_image debug_common
constant debug_fill debug_common
constant debug_gs debug_common
constant debug_do false
constant debug_do false
constant debug_softmask debug_common
constant debug_form debug_common
constant debug_font false
constant debug_font false
constant debug_font_mapping false
constant debug_text false
constant debug_gamut false
constant debug_gamut false
constant debug_shading false
constant message_debug false
constant draw_image true
constant draw_fill true
constant draw_stroke true
constant draw_shading true
constant draw_text true
constant token_overflow 2^16
constant message_debug false
constant draw_image true
constant draw_fill true
constant draw_stroke true
constant draw_shading true
constant draw_text true
constant token_overflow 2^16
constant prefered_reference (-1)




constant use_tiff_lib (file_query "file:/lib/libtiff.so.4" standard)=defined or (file_query "file:/usr/lib/libtiff.so.4" standard)=defined
if use_tiff_lib
  module "/pliant/graphic/filter/tiff.pli"


gvar Arrow null_arrow


gvar Arrow null_arrow


function text_to_unicode text charset -> unicode
  arg Str text ; arg Array:Int charset ; arg Str32 unicode
  unicode := text
  for (var Int i) 0 text:len-1
    var Int  c := text:i number
    if c<charset:size
      unicode i := character32 charset:c


function char_init
  (var Array:Int ascii) size := 256
  for (var Int i) 0 255
    ascii i := shunt i>=32 and i<127 i undefined
  charsets insert "WinAnsiEncoding" ascii
  charsets insert "MacRomanEncoding" ascii
char_init



type PDFContext
  field Transform2 t <- constant:(transform 0 0 25.4/72 25.4
  field Int clip_count <- 0
function char_init
  (var Array:Int ascii) size := 256
  for (var Int i) 0 255
    ascii i := shunt i>=32 and i<127 i undefined
  charsets insert "WinAnsiEncoding" ascii
  charsets insert "MacRomanEncoding" ascii
char_init



type PDFContext
  field Transform2 t <- constant:(transform 0 0 25.4/72 25.4
  field Int clip_count <- 0
  field Int gs_count <- 0
  field Int level <- 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 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 Str mixture
  field Float fill_opacity <- 1
  field Float stroke_opacity <- 1
  field Link:(Array uInt8 256) gradation
  field Float line_width
  field Int line_cap <- 0
  field Int line_join <- 0
  field Float line_miter <- 10
  field CBool unsupported_fill <- false
  field CBool unsupported_stroke <- false
  field CBool unsupported_text <- false

type PDFText
  field Link:Dictionary fontdef ; field Float scale
  field Link:(Array uInt8 256) gradation
  field Float line_width
  field Int line_cap <- 0
  field Int line_join <- 0
  field Float line_miter <- 10
  field CBool unsupported_fill <- false
  field CBool unsupported_stroke <- false
  field CBool unsupported_text <- false

type PDFText
  field Link:Dictionary fontdef ; field Float scale
  field Link:Font font
  field Link:Font font ; field Str name
  field Transform2 tm tlm
  field Float charspace <- 0
  field Float wordspace <- 0
  field Float leading <- 0
  field Array:Int encoding


type PDFReader
  field Link:Stream raw_stream stream
  field Str options
  field Transform2 tm tlm
  field Float charspace <- 0
  field Float wordspace <- 0
  field Float leading <- 0
  field Array:Int encoding


type PDFReader
  field Link:Stream raw_stream stream
  field Str options
  field Str color_device
  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 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 Transform2 base_t
  field PDFText text
  field (Dictionary Str PDFObject) objects
  field Link:Dictionary xobject_dict colorspace_dict gs_dict
  field (Dictionary Str Str) known_colors
  field Pointer:PDFObject cobject
  field Array:Curve curves ; field Curve curve
  field Link:DrawPrototype draw
  field Str instruction
  field ExtendedStatus status <- success
  field Dictionary warnings


method pdf read_byte -> b
  arg_rw PDFReader pdf ; arg Int b
  var Pointer:Stream s :> pdf stream
  if not s:atend
    b := s:stream_read_cur map uInt8
    s stream_read_cur := s:stream_read_cur translate uInt8 1
  field PDFText text
  field (Dictionary Str PDFObject) objects
  field Link:Dictionary xobject_dict colorspace_dict gs_dict
  field (Dictionary Str Str) known_colors
  field Pointer:PDFObject cobject
  field Array:Curve curves ; field Curve curve
  field Link:DrawPrototype draw
  field Str instruction
  field ExtendedStatus status <- success
  field Dictionary warnings


method pdf read_byte -> b
  arg_rw PDFReader pdf ; arg Int b
  var Pointer:Stream s :> pdf stream
  if not s:atend
    b := s:stream_read_cur map uInt8
    s stream_read_cur := s:stream_read_cur translate uInt8 1
    # if b>=32 and b<128
    #   console "(" character:b ")"
    # else
    #   console "[lb]" b "[rb]"
  else
    b := "[lf]" number


method pdf parse -> t
  arg_rw PDFReader pdf ; arg Str t
  implicit pdf
    while true
      t := pdf token
      if t=""
        return t
      eif t="<<" or t="[lb]"
        push addressof:(new PDFMark pdf_mark:t)
      eif t=">>"
        var Int n := 0
        while n<count and not (pick:n is PDFMark)
          n += 1
        if n%2<>0
          severe "wrong number of arguments in dictionary"
        for (var Int i) 0 n-1 step 2
          if not ((pick n-1-i) is Ident)
            severe "wrong key type in dictionary"
        var Link:Dictionary dict :> new Dictionary
        for (var Int i) 0 n-2 step 2 # VERIFY
          dict insert ((pick n-1-i) as Ident) true (pick n-2
        pop n+1
        push addressof:dict
      eif t="[rb]"
        var Int n := 0
        while n<count and (entry_type pick:n)<>PDFMark
          n += 1
        var Link:Array array :> new Array
        array size := n
        for (var Int i) 0 n-1
          array i := pick n-1-i
        pop n+1
        push addressof:array
      eif t="R"
        if not (pick:1 is Int) or not (pick:0 is Int)
          severe "wrong arguments for 'R' instruction" ; ret
        var Link:PDFReference ref :> new PDFReference
        ref id := string:(pick:1 as Int)+" "+string:(pick:0 
  else
    b := "[lf]" number


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


method pdf display a complete
  arg_rw PDFReader pdf ; arg Address a ; arg CBool complete
  implicit pdf
    var Pointer:Type t :> entry_type a
    if t=PDFReference and complete
      var Arrow b := pdf solve a
      if b<>null and b<>a
        pdf display b complete
        return
        push addressof:(new Float f)
      eif t="true"
        push addressof:(new Bool true)
      eif t="false"
        push addressof:(new Bool false)
      else
        return t


method pdf display a complete
  arg_rw PDFReader pdf ; arg Address a ; arg CBool complete
  implicit pdf
    var Pointer:Type t :> entry_type a
    if t=PDFReference and complete
      var Arrow b := pdf solve a
      if b<>null and b<>a
        pdf display b complete
        return
    console t:name "="
    if not debug_xpdf
      console t:name "="
    if t=Int
      console (a map Int)
    eif t=Float
      console (a map Float)
    eif t=Str
      console string:(a map Str)
    eif t=Bool
      console string:(a map Bool)
    eif t=Ident
    if t=Int
      console (a map Int)
    eif t=Float
      console (a map Float)
    eif t=Str
      console string:(a map Str)
    eif t=Bool
      console string:(a map Bool)
    eif t=Ident
      console string:(cast (a map Ident) Str)
      if debug_xpdf
        console "/" (cast (a map Ident) Str)
      else
        console string:(cast (a map Ident) Str)
    eif t=Dictionary
      console "<<"
      each c (a map Dictionary) getkey k
        console " " k ":"
        pdf display c complete
      console " >>"
    eif t=Array
      console "[lb]"
      for (var Int i) 0 (a map Array):size-1
        console " "
        pdf display (a map Array):i complete
      console " [rb]"
    eif t=PDFReference
      console (cast (a map PDFReference):id Str)
    else
      console "?"


method pdf real_color_name name -> real
  arg_rw PDFReader pdf ; arg Str name real
  real := lower name
  if (real eparse "pantone " any:(var Str pantone) " c" any)
    real := pantone
  if (real parse "pantone_" any:(var Str pantone) "_c" any)
    real := pantone
  if real="cyan" or real="magenta" or real="yellow" or real=
    real := "process_"+real
  real := replace real " " "_"
  var Int i := 0
  while { var Int p := pdf:options option_position "alias" i
    if ((pdf:options p pdf:options:len) parse word:"alias" (
      if real=name1
        real := name2
    i += 1
  var Pointer:Str final :> pdf:known_colors first real
  if exists:final
    real := final
  else
    eif t=Dictionary
      console "<<"
      each c (a map Dictionary) getkey k
        console " " k ":"
        pdf display c complete
      console " >>"
    eif t=Array
      console "[lb]"
      for (var Int i) 0 (a map Array):size-1
        console " "
        pdf display (a map Array):i complete
      console " [rb]"
    eif t=PDFReference
      console (cast (a map PDFReference):id Str)
    else
      console "?"


method pdf real_color_name name -> real
  arg_rw PDFReader pdf ; arg Str name real
  real := lower name
  if (real eparse "pantone " any:(var Str pantone) " c" any)
    real := pantone
  if (real parse "pantone_" any:(var Str pantone) "_c" any)
    real := pantone
  if real="cyan" or real="magenta" or real="yellow" or real=
    real := "process_"+real
  real := replace real " " "_"
  var Int i := 0
  while { var Int p := pdf:options option_position "alias" i
    if ((pdf:options p pdf:options:len) parse word:"alias" (
      if real=name1
        real := name2
    i += 1
  var Pointer:Str final :> pdf:known_colors first real
  if exists:final
    real := final
  else
    if (color_ink (shunt (real search ":" -1)=(-1) "pantone:
    if not (real eparse any:(var Str device) ":" any:(var Str channel))
      device := pdf color_device ; channel := real
    if (channel eparse any:(var Str base) "#" any)
      channel := base
    var Link:ColorInk ink :> color_ink device+":"+channel
    var Int i := 0
    while ink=failure and { var Str device2 := color_database:data:device:device:options option "inherit" i Str ; device2<>"" }
      ink :> color_ink device2+":"+channel
      i += 1
    if ink=success
      pdf:known_colors insert real real
    else
      var Str drop := "drop#"+(string 2^30+pdf:known_colors:
      pdf:known_colors insert real drop
      real := drop


method pdf colorspace cs extra -> gamut
  arg_rw PDFReader pdf ; arg Address cs ; arg Str extra ; ar
  gamut :> null map ColorGamut
  if (cs is Ident)
    var Str id := cs as Ident
    if pdf:separated and (id="G" or id="DeviceGray")
      pdf:known_colors insert real real
    else
      var Str drop := "drop#"+(string 2^30+pdf:known_colors:
      pdf:known_colors insert real drop
      real := drop


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


    eif a:size>0 and (a:0 as Ident)="CalRGB"
      gamut :> color_gamut "rgb"
  if exists:gamut and gamut=failure
    gamut :> null map ColorGamut


method pdf real_color gamut color -> real
  arg_rw PDFReader pdf ; oarg ColorGamut gamut ; arg ColorBu
method pdf real_color gamut color opacity -> real
  arg_rw PDFReader pdf ; oarg ColorGamut gamut ; arg ColorBuffer color ; arg Float opacity ; arg ColorBuffer real
  implicit pdf
    if separated
      memory_copy addressof:color addressof:real pdf:gamut:p
    else
      memory_copy addressof:color addressof:(var ColorBuffer
      if context:transparency<>3
        bytes_fill (addressof:c translate Byte gamut:dimensi
      var Arrow speedup :=  pdf:gamut speedup gamut ""
      pdf:gamut convert gamut addressof:c addressof:real 1 s
      if context:transparency<2
        bytes_fill (addressof:real translate Byte pdf:gamut:
  implicit pdf
    if separated
      memory_copy addressof:color addressof:real pdf:gamut:p
    else
      memory_copy addressof:color addressof:(var ColorBuffer
      if context:transparency<>3
        bytes_fill (addressof:c translate Byte gamut:dimensi
      var Arrow speedup :=  pdf:gamut speedup gamut ""
      pdf:gamut convert gamut addressof:c addressof:real 1 s
      if context:transparency<2
        bytes_fill (addressof:real translate Byte pdf:gamut:
      if opacity<>1
        for (var Int i) 0 pdf:gamut:transparency-1
          var Pointer:uInt8 v :> addressof:real map uInt8 pdf:gamut:dimension+i
          v := cast v*opacity Int
       


       


method pdf filter base a decoder -> s
  arg_rw PDFReader pdf ; arg_rw Link:Stream base ; arg Addre
method pdf filter base a p decoder decoder_options -> s
  arg_rw PDFReader pdf ; arg_rw Link:Stream base ; arg Address a ; arg Dictionary p ; arg_rw Link:ImageReadFilter decoder; arg_rw Str decoder_options ; arg Link:Stream s
  implicit pdf
    if (a is Array)
      s :> base
      var Link:Array array :> a as Array
      for (var Int i) 0 array:size-1
  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 decoder
        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 (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"
      s :> base
      decoder :> image_read_filter ".tiff"
      var Int k := (p first "K") as Int
      decoder_options += " write_tiff_header compression "+string:(shunt k=defined and k<0 4 2)
    eif (a as Ident)="DCTDecode"
      s :> base
      decoder :> image_read_filter ".jpeg"
    eif (a is Ident)
      s :> null map Stream
    eif (a as Ident)="DCTDecode"
      s :> base
      decoder :> image_read_filter ".jpeg"
    eif (a is Ident)
      s :> null map Stream
      console "unsupported '"+(a as Ident)+"' encoding used"
      warning "unsupported '"+(a as Ident)+"' encoding used"
      warning "unsupported '"+(a as Ident)+"' encoding used"
      if debug_image
        console "unsupported '"+(a as Ident)+"' encoding used" eol
    else
      s :> base

    else
      s :> base

method pdf filter d decoder -> s
  arg_rw PDFReader pdf ; arg Dictionary d ; arg_rw Link:Imag
  decoder :> null map ImageReadFilter
  s :> pdf filter pdf:raw_stream (d first "Filter") decoder
method pdf filter d decoder decoder_options -> s
  arg_rw PDFReader pdf ; arg Dictionary d ; arg_w Link:ImageReadFilter decoder ; arg_w Str decoder_options ; arg Link:Stream s
  decoder :> null map ImageReadFilter ; decoder_options := ""
  s :> pdf filter pdf:raw_stream (d first "Filter") ((d first "DecodeParms") as Dictionary) decoder decoder_options
  if addressof:s=(addressof pdf:raw_stream)
  if addressof:s=(addressof pdf:raw_stream)
    var Int length := (d first "Length") as Int
    var Int length := (pdf solve (d first "Length")) as Int
    if length=defined
    if length=defined
      decoder_options += " size "+string:length
      s :> new Stream
      s open "count:" "size "+string:length in+safe pliant_d
      s :> new Stream
      s open "count:" "size "+string:length in+safe pliant_d

  if not exists:s
    decoder :> null map ImageReadFilter
    
method pdf process_instructions
  arg_rw PDFReader pdf
  later



    
method pdf process_instructions
  arg_rw PDFReader pdf
  later



method pdf context_save
  arg_rw PDFReader pdf
  implicit pdf
    context_stack += context
    context clip_count := 0
    context gs_count := 0
    context level += 1

method pdf context_restore level
  arg_rw PDFReader pdf ; arg Int level
  implicit pdf
    while context:level>level
      for (var Int i) 1 context:clip_count
        draw clip_close
      for (var Int i) 1 context:gs_count
        draw clip_close
      context := context_stack last
      context_stack remove context_stack:last

pdf_instruction q
pdf_instruction q
  context_stack += context
  context clip_count := 0
  context_save

pdf_instruction Q

pdf_instruction Q
  if not (exists context_stack:first)
    severe "context stack underflow" ; return
  for (var Int i) 1 context:clip_count
    draw clip_close
  context := context_stack last
  context_stack remove context_stack:last
  if context:level>0
    context_restore context:level-1
  else
    severe "context stack underflow"


if debug_softmask
  module "/pliant/graphic/filter/io.pli"
  module "/pliant/graphic/filter/all.pli"

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 debug_gs
    console "graphic state is " ; display a true ; console eol
    if context:gs_count>0 or context:clip_count>0
      console "stacking gs over " context:gs_count " gs and " context:clip_count " clip" eol
  while context:gs_count>0
    draw clip_close
    context gs_count -= 1
  if (a is Dictionary)
    var Link:Dictionary d :> a as Dictionary
  if (a is Dictionary)
    var Link:Dictionary d :> a as Dictionary
    if (solve:(d first "SMask") is Dictionary)
      var Link:Dictionary smask :> solve:(d first "SMask") as Dictionary
      if (solve:(smask first "G") is Dictionary)
        var Link:Dictionary g :> solve:(smask first "G") as Dictionary
        var Link:Stream current_stream :> stream
        (raw_stream query "seek") parse (var Intn current_seek)
        raw_stream configure "seek "+(string cobject:seek)
        stream :> filter g (var Link:ImageReadFilter decoder) (var Str decoder_options)
        var Link:DrawPrototype draw_memo :> draw
        var Link:ColorGamut gamut_memo :> gamut
        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:(g first "Resources") map Dictionary
        if exists:res and exists:(res first "XObject")
          xobject_dict :> solve:(res first "XObject") as Dictionary
        if exists:res and exists:(res first "ColorSpace")
          colorspace_dict :> solve:(res first "ColorSpace") as Dictionary
        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 Dictionary
        var Array bbox := (g first "BBox") as Array
        if bbox:size=4
          var Float x0 := bbox:0 as Float
          var Float y0 := bbox:1 as Float
          var Float x1 := bbox:2 as Float
          var Float y1 := bbox:3 as Float
          var Point2 p0 := context:t (point x0 y0)
          var Point2 p1 := context:t (point x1 y0)
          var Point2 p2 := context:t (point x1 y1)
          var Point2 p3 := context:t (point x0 y1)
          x0 := min (min p0:x p1:x) (min p2:x p3:x)
          y0 := min (min p0:y p1:y) (min p2:y p3:y)
          x1 := max (max p0:x p1:x) (max p2:x p3:x)
          y1 := max (max p0:y p1:y) (max p2:y p3:y)
          if debug_softmask
            console "softmask bounding box " x0 " " y0 " " x1 " " y1 eol
          draw :> draw clip_open x0 y0 x1 y1
        else
          if debug_softmask
            console "no softmask bounding box" eol
          draw :> draw clip_open undefined undefined undefined undefined
        gamut :> color_gamut "grey"
        if debug_softmask
          (raw_stream query "seek") parse (var Intn current_seek2)
          console "# softmask begin " ; display addressof:smask true ; console eol
          raw_stream configure "seek "+string:current_seek2
        if false
          pdf_instruction_q
          memory_clear (addressof context:fill_color) pdf:gamut:pixel_size
          memory_clear (addressof context:stroke_color) pdf:gamut:pixel_size
        process_instructions
        if false
          pdf_instruction_Q
        if debug_softmask
          console "# softmask end" eol
        context gs_count += 1
        draw :> draw_memo
        gamut :> gamut_memo
        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
    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
    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 ((d first "ca") is Float)
      context fill_opacity := (d first "ca") as Float
    if ((d first "CA") is Float)
      context stroke_opacity := (d first "CA") as Float
    if ((d first "BM") is Ident)
      context mixture := cast ((d first "BM") as Ident) Str
    if (solve:(d first "TR") is Dictionary)
      var Link:Dictionary tr :> solve:(d first "TR") as Dict
      if ((tr first "FunctionType") is Int) and ((tr first "
        (raw_stream query "seek") parse (var Intn current_se
        raw_stream configure "seek "+(string cobject:seek)
    if (solve:(d first "TR") is Dictionary)
      var Link:Dictionary tr :> solve:(d first "TR") as Dict
      if ((tr first "FunctionType") is Int) and ((tr first "
        (raw_stream query "seek") parse (var Intn current_se
        raw_stream configure "seek "+(string cobject:seek)
        var Link:Stream s :> filter tr (var Link:ImageReadFi
        var Link:Stream s :> filter tr (var Link:ImageReadFilter decoder) (var Str decoder_options)
        if exists:s
        if exists:s
          if debug_image
            console "applying gradation" eol
          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 d # dash line pattern
          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 d # dash line pattern
  warning "set dash line pattern is not supported"
  context unsupported_stroke := true
  if not (pick:1 is Array) or not (pick:1 as Array):size=0
    warning "set dash line pattern is not supported"
    context unsupported_stroke := true
  pop 2



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
  pop 2



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
      context fill_gamut :> color_gamut pdf:color_device+":process_black"
    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 CS
  var Arrow a := solve (colorspace_dict first (pick:0 as Ide
  if (pick:0 as Ident)="Pattern"
    warning "pattern painting"
    context stroke_mode := 0
    context unsupported_stroke := true
  eif ((a as Array):0 as Ident)="Separation" and ((a as Arra
    context stroke_gamut :> pdf gamut
    if pdf:gamut:model=color_gamut_additive
    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 CS
  var Arrow a := solve (colorspace_dict first (pick:0 as Ide
  if (pick:0 as Ident)="Pattern"
    warning "pattern painting"
    context stroke_mode := 0
    context unsupported_stroke := true
  eif ((a as Array):0 as Ident)="Separation" and ((a as Arra
    context stroke_gamut :> pdf gamut
    if pdf:gamut:model=color_gamut_additive
      context stroke_gamut :> color_gamut "pantone:process_b
      context stroke_gamut :> color_gamut pdf:color_device+":process_black"
    bytes_fill (addressof context:stroke_color) 1 context:st
    context stroke_mode := 2
  eif { var Link:ColorGamut gamut :> colorspace a "+transpar
    context stroke_gamut :> gamut
    bytes_fill (addressof context:stroke_color) 1 context:st
    context stroke_mode := 1
  else
    warning "unexpected colorspace"
    context stroke_mode := 0
    context unsupported_stroke := true
  pop


pdf_instruction k
  context fill_mode := 1
    bytes_fill (addressof context:stroke_color) 1 context:st
    context stroke_mode := 2
  eif { var Link:ColorGamut gamut :> colorspace a "+transpar
    context stroke_gamut :> gamut
    bytes_fill (addressof context:stroke_color) 1 context:st
    context stroke_mode := 1
  else
    warning "unexpected colorspace"
    context stroke_mode := 0
    context unsupported_stroke := true
  pop


pdf_instruction k
  context fill_mode := 1
  context fill_gamut :> color_gamut "pantone:process_cyan+pr
  context fill_gamut :> color_gamut pdf:color_device+":process_cyan+process_magenta+process_yellow+process_black+transparencies"
  for (var Int i) 0 3
    context:fill_color:bytes i := cast 255*(bound ((pick 3-i
    context:fill_color:bytes 4+i := shunt ((pick 3-i) as Flo
  pop 4

pdf_instruction K
  context stroke_mode := 1
  for (var Int i) 0 3
    context:fill_color:bytes i := cast 255*(bound ((pick 3-i
    context:fill_color:bytes 4+i := shunt ((pick 3-i) as Flo
  pop 4

pdf_instruction K
  context stroke_mode := 1
  context stroke_gamut :> color_gamut "pantone:process_cyan+
  context stroke_gamut :> color_gamut pdf:color_device+":process_cyan+process_magenta+process_yellow+process_black+transparencies"
  for (var Int i) 0 3
    context:stroke_color:bytes i := cast 255*(bound ((pick 3
    context:stroke_color:bytes 4+i := shunt ((pick 3-i) as F
  pop 4


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 
    else
      context fill_mode := 0
  else
    context fill_mode := 1
  for (var Int i) 0 3
    context:stroke_color:bytes i := cast 255*(bound ((pick 3
    context:stroke_color:bytes 4+i := shunt ((pick 3-i) as F
  pop 4


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 
    else
      context fill_mode := 0
  else
    context fill_mode := 1
    context fill_gamut :> color_gamut "pantone:process_black
    context fill_gamut :> color_gamut pdf:color_device+":process_black+transparencies"
    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
    else
      context stroke_mode := 0
  else
    context stroke_mode := 1
    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
    else
      context stroke_mode := 0
  else
    context stroke_mode := 1
    context stroke_gamut :> color_gamut "pantone:process_bla
    context stroke_gamut :> color_gamut pdf:color_device+":process_black+transparencies"
    context:stroke_color:bytes 0 := cast 255*(bound 1-(pick:
    context:stroke_color:bytes 1 := 255
  pop



    context:stroke_color:bytes 0 := cast 255*(bound 1-(pick:
    context:stroke_color:bytes 1 := 255
  pop



if debug_fill
  gvar Int fill_counter := 0

pdf_instruction f
  new_curve false
pdf_instruction f
  new_curve false
  if draw_fill and context:fill_mode<>0
    draw fill curves fill_nonzero transform addressof:(real_
  if debug_fill
    fill_counter += 1
    console "# fill " fill_counter ": " context:fill_mode " " curves:size eol
  if draw_fill and context:fill_mode<>0 # and fill_counter<>798
    draw fill curves fill_nonzero transform addressof:(real_color context:fill_gamut context:fill_color context:fill_opacity)
  curves size := 0


pdf_instruction 'f*'
  new_curve false
  curves size := 0


pdf_instruction 'f*'
  new_curve false
  if debug_fill
    fill_counter += 1
    console "# fill " fill_counter ": " context:fill_mode " " curves:size eol
  if draw_fill and 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_color context:fill_gamut context:fill_color context:fill_opacity)
  curves size := 0

pdf_instruction S
  new_curve false
  if draw_stroke and context:stroke_mode<>0
  curves size := 0

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


pdf_instruction B
  new_curve false
  curves size := 0


pdf_instruction B
  new_curve false
  if debug_fill
    fill_counter += 1
    console "# fill " fill_counter ": " context:fill_mode " " curves:size eol
  if draw_fill and 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_color context:fill_gamut context:fill_color context:fill_opacity)
  if draw_stroke and context:stroke_mode<>0
  if draw_stroke and context:stroke_mode<>0
    draw stroke curves context:line_width "cap "+(string con
    draw stroke curves context:line_width "cap "+(string context:line_cap)+" join "+(string context:line_join)+" miter "+(string context:line_miter) transform addressof:(real_color context:stroke_gamut context:stroke_color context:stroke_opacity)
  curves size := 0

pdf_instruction 'B*'
  new_curve false
  curves size := 0

pdf_instruction 'B*'
  new_curve false
  if debug_fill
    fill_counter += 1
    console "# fill " fill_counter ": " context:fill_mode " " curves:size eol
  if draw_fill and 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_color context:fill_gamut context:fill_color context:fill_opacity)
  if draw_stroke and context:stroke_mode<>0
  if draw_stroke and context:stroke_mode<>0
    draw stroke curves context:line_width "cap "+(string con
    draw stroke curves context:line_width "cap "+(string context:line_cap)+" join "+(string context:line_join)+" miter "+(string context:line_miter) transform addressof:(real_color context:stroke_gamut context:stroke_color context:stroke_opacity)
  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
  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 debug_shading
    console "shading type " st ": " ; display addressof:d true ; console eol
  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
  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
      if draw_shading
        draw image p transform
      var Array:ColorBuffer cs
      if (f first "C0")<>null
        var ColorBuffer c0 ; memory_clear addressof:c0 gamut:pixel_size
        for (var Int i) 0 gamut:dimension-1
          var Float v := ((f first "C0") as Array):i as Float
          if v=defined and v>=(-1e-6) and v<=1+1e-6
            c0:bytes i := cast 255*v Int
        bytes_fill (addressof:c0 translate Byte gamut:dimension) 1 gamut:transparency
        cs += c0
      if (f first "C1")<>null
        var ColorBuffer c1 ; memory_clear addressof:c0 gamut:pixel_size
        for (var Int i) 0 gamut:dimension-1
          var Float v := ((f first "C1") as Array):i as Float
          if v=defined and v>=(-1e-6) and v<=1+1e-6
            c1:bytes i := cast 255*v Int
        bytes_fill (addressof:c1 translate Byte gamut:dimension) 1 gamut:transparency
        cs += c1
      if ((f 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 f (var Link:ImageReadFilter decoder) (var Str decoder_options)
        if exists:s
          cs size := 0
          while not s:atend
            s raw_read addressof:(var ColorBuffer cc) gamut:dimension
            bytes_fill (addressof:cc translate Byte gamut:dimension) 1 gamut:transparency
            cs += cc
          if debug_shading
            console "shading data count is " count eol
        raw_stream configure "seek "+string:current_seek
      if cs:size>=2
        if draw_shading
          var Link:ImagePacked p :> new ImagePacked
          p setup (image_prototype context:clip_x0 context:clip_y0 context:clip_x1 context:clip_y1 300 300 1 1 image_adjust_extend gamut) ""
          if st=2
            p axial_shading p0 p1 gamut cs
          eif st=3
            p radial_shading p0 r0 p1 r1 gamut cs
          draw image p transform
      else
        warning "Failed to discover shading colors"
    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


    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


if debug_image
  module "/pliant/graphic/image/convert.pli"
  module "/pliant/graphic/filter/io.pli"
  gvar Int image_counter := 0

pdf_instruction Do
  function predictor a b c -> r
    arg Int a b c r
    var Int p := a+b-c
    var Int pa := abs p-a
    var Int pb := abs p-b
    var Int pc := abs p-c
    r := shunt pa<=pb and pa<=pc a pb<=pc b c
  var Str id := pick:0 as Ident
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 (pick:0 as Ident)) true ; console eol
  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 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 gamut :> colorspace solve:(d fir
        var Link:ColorGamut gamut0 :> colorspace solve:(d first "ColorSpace") ""
        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
        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
            gamut :> pdf gamut
            var ColorBuffer c0 ; memory_clear addressof:c0 g
            var ColorBuffer c1 := real_color context:fill_ga
            if gamut:model=color_gamut_additive
              bytes_fill addressof:c0 1 gamut:dimension
            var ColorBuffer c1 := real_color context:fill_gamut context:fill_color context:fill_opacity
        eif bpc=1
          mask := true
          var ColorBuffer c0 ; memory_clear addressof:c0 gam
          var ColorBuffer c1 ; bytes_fill addressof:c1 1 gam
        eif bpc=1
          mask := true
          var ColorBuffer c0 ; memory_clear addressof:c0 gam
          var ColorBuffer c1 ; bytes_fill addressof:c1 1 gam
        if debug or debug_image
          console "Do " size_x " x " size_y " " 
        if debug_image
          image_counter += 1
          console "draw image " image_counter ": " size_x " x " size_y " x " bpc
          if exists:gamut
          if exists:gamut
            console gamut:name " "
          console (shunt mask "MASK" "") eol
          display a true ; console eol
            console " " gamut:name
          console (shunt mask " MASK" "") " transparency " context:transparency (shunt gamut:name<>gamut0:name " NONZERO" "") " " ; display a true ; console eol
        if not exists:gamut
          # console "unsupported colorspace " ; display a tr
          var Str name := (solve (solve:(d first "ColorSpace
          if name=""
            name := solve:(d first "ColorSpace") as Ident
          warning "unsupported image colorspace "+name ; lea
        if not exists:gamut
          # console "unsupported colorspace " ; display a tr
          var Str name := (solve (solve:(d first "ColorSpace
          if name=""
            name := solve:(d first "ColorSpace") as Ident
          warning "unsupported image colorspace "+name ; lea
        var CBool reverse := (solve:(d first "ColorSpace") a
        # var CBool reverse := (solve:(d first "ColorSpace") as Ident)="DeviceGray" and gamut:name<>"grey"
        var CBool reverse := false
        if gamut:model=color_gamut_substractive and gamut:dimension=1
          if pdf:gamut:name="grey"
            gamut0 :> pdf gamut
            gamut :> pdf gamut
            reverse := true
          eif (solve:(d first "ColorSpace") as Ident)="DeviceGray"
            reverse := true
        if mask
        if mask
          reverse := ((solve:(d first "Decode") as Array):0 
          reverse := ((solve:(d first "Decode") as Array):0 as Float)<>undefined and ((solve:(d first "Decode") as Array):0 as Float)<>1
        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 Link:Dictionary parameters :> solve:(d first "De
        var Int predictor := solve:(parameters first "Predic
        if predictor=undefined
          predictor := 1
        var Int pred_columns := solve:(parameters first "Col
        var Int pred_bits := solve:(parameters first "BitsPe
        var Int pred_colors := solve:(parameters first "Colo
        var Int pred_step := undefined
        var Int pred_left := undefined
        if pred_columns<>undefined and pred_bits<>undefined 
          pred_step := max (pred_columns*pred_bits*pred_colo
          pred_left := max (pred_bits*pred_colors+7)\8 1
        if size_x<=0 or size_y<=0
          severe "incorrect image size" ; leave load
        var Link:ImagePrototype img
        if 1n*size_x*size_y*gamut:pixel_size>=packed or mask
          if debug_do
            console "*"
          img :> new ImagePacked
        else
          if debug_do
            console "+"
          img :> new ImagePixmap
        img setup (image_prototype 0 0 1 1 size_x size_y gam
        (raw_stream query "seek") parse (var Intn current_se
        raw_stream configure "seek "+(string img_object:seek
        var Link:Stream pixels :> filter d (var Link:ImageRe
        if not exists:pixels
          warning "unsupported image encoding" ; leave load
        if exists:decoder
          if (decoder open pixels "" (var ImagePrototype h))
            warning "failed to setup image decoder" ; leave 
        var Int line_size := shunt mask (img:size_x+7)\8 img
        var Int line_size := shunt mask (img:size_x+7)\8 addressof:gamut<>addressof:gamut0 size_x*gamut0:pixel_size img:line_size
        var Address buffer := (memory_zallocate line_size+im
        var Address previous := (memory_zallocate line_size+
        var Address final := memory_zallocate line_size null
        var Address final2 := memory_zallocate img:line_size
        var Address buffer := (memory_zallocate line_size+im
        var Address previous := (memory_zallocate line_size+
        var Address final := memory_zallocate line_size null
        var Address final2 := memory_zallocate img:line_size
        var CBool passed := false
        part read_lines
        part read_lines
          (raw_stream query "seek") parse (var Intn current_seek)
          raw_stream configure "seek "+(string img_object:seek)
          var Link:Stream pixels :> filter d (var Link:ImageReadFilter decoder) (var Str decoder_options)
          if not exists:pixels
            warning "unsupported image encoding" ; leave read_lines
          if exists:decoder
            if (decoder open pixels decoder_options+" size_x "+string:size_x+" size_y "+string:size_y+" bpc "+string:bpc+" line_size "+string:line_size (var ImagePrototype h))=failure
              warning "failed to setup image decoder" ; decoder :> null map ImageReadFilter ; leave read_lines
          for (var Int y) 0 size_y-1
            var Int offset := 0
            while offset<line_size
              var Int algo := 0 ; var Int step := line_size-
              if predictor=1
                void
              eif predictor=15
                pixels raw_read addressof:(var uInt8 algo8) 
                if pred_step=defined
                  step := min step pred_step
              else
                algo := predictor-10
              if exists:decoder
                if (decoder readline buffer)=failure
                  warning "failed to read image line "+(stri
              else
                pixels raw_read buffer step
              var Address cur := buffer
              var Address stop := buffer translate Byte step
              var Int left := shunt pred_left<>undefined and
              var Int top := (cast previous Int).-.(cast buf
              var Int topleft := left+top
              if algo=0
                void
              eif algo=1
                cur := cur translate Byte -left
                while cur<>stop
                  cur map uInt8 := (cur map uInt8)+(cur map 
                  cur := cur translate uInt8 1
              eif algo=2
                while cur<>stop
                  cur map uInt8 := (cur map uInt8)+(cur map 
                  cur := cur translate uInt8 1
              eif algo=3
                while cur<>stop
                  cur map uInt8 := (cur map uInt8)+((cur map
                  cur := cur translate uInt8 1
              eif algo=4
                while cur<>stop
                  cur map uInt8 := (cur map uInt8)+(predicto
                  cur := cur translate uInt8 1
              else
                # warning "Unsupported image predictor "+str
                warning "Unsupported image predictor "+strin
              memory_copy buffer (final translate Byte offse
              memory_copy buffer previous step
              offset += step
            if (exists context:gradation)
              var Pointer:(Array uInt8 256) gradation :> con
              var Address cur := final ; var Address stop :=
              while cur<>stop
                cur map uInt8 := gradation (cur map uInt8)
                cur := cur translate uInt8 1
            if reverse
              bytes_copy_255minus final 1 final 1 line_size
          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
            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 := final translate Byte line_size
              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 (dest map uInt8 i)<>0 255 0
                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
            else
              img write 0 size_y-1-y size_x final
          passed := true
          ok := true
        if exists:decoder
          if decoder:close=failure
        if exists:decoder
          if decoder:close=failure
            warning "failed to read image" ; leave load
            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
        memory_free (buffer translate Byte -(img:pixel_size)
        memory_free (previous translate Byte -(img:pixel_siz
        memory_free final
        memory_free final2
        img configure "shrink"
        raw_stream configure "seek "+string:current_seek
        if pixels=failure
          warning "failed to read image" ; leave load
        if exists:pixels and pixels=failure
          warning "failed to read image" ; ok := false
        (addressof:ca omap PDFImageCache) image :> img
        (addressof:ca omap PDFImageCache) image :> img
        ok := passed
        if debug_image and ok
          img options += " image_counter "+string:image_counter
          var Link:ImageConvert conv :> new ImageConvert
          conv bind img color_gamut:"rgb" "fast"
          conv save "file:/tmp/image/"+(right string:image_counter 4 "0")+".jpeg" ""
      if ok
        cache_ready ca
      else
        cache_cancel ca
        warning "failed to load image"
        return
    else
      if debug_do
        console "-"
      if ok
        cache_ready ca
      else
        cache_cancel ca
        warning "failed to load image"
        return
    else
      if debug_do
        console "-"
    if draw_image
    if draw_image # and image_counter<>230
      draw image (addressof:ca omap PDFImageCache):image con
  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)
      draw image (addressof:ca omap PDFImageCache):image con
  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
    stream :> filter (a map Dictionary) (var Link:ImageReadFilter decoder) (var Str decoder_options)
    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 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
    process_instructions
    if debug_form
      console "# form end (group model is " (shunt context:gs_count>0 "clip" "standard") " opacity " context:fill_opacity " mixture " context:mixture ")" eol
    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
    colorspace_dict :> colorspace_memo
    xobject_dict :> xobject_memo
    gs_dict :> gs_memo
    font_dict :> gs_memo
    shading_dict :> gs_memo
    raw_stream configure "seek "+string:current_seek
    stream :> current_stream
    if (entry_type addressof:draw)=DrawDisplayList
      context t := memo_t
      draw :> memo_draw
      var Transform2 ct := context t
      memo_draw include sub DrawTransform "xx "+(string ct:x
      var Str transparency := (shunt context:gs_count>0 " flat_transparency" "")+(shunt context:mixture<>"" and context:mixture<>"Normal" " flat_transparency mixture "+(string context:mixture) "")+(shunt context:fill_opacity<>1 " flat_transparency opacity "+(string context:fill_opacity) "")
      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)+transparency
      do_object attached := addressof sub
    if debug_do
      console "Do first" eol
  else
      do_object attached := addressof sub
    if debug_do
      console "Do first" eol
  else
    if debug
      console "unexpected Do usage (Subtype = "+subtype+")" eol
    warning "unexpected Do usage (Subtype = "+subtype+")"


pdf_instruction ID
  var Int isize_x := undefined ; var Int isize_y := undefine
  var Link:ColorGamut gamut :> null map ColorGamut ; var CBo
  for (var Int i) 0 count-2 step 2
    var Str id := (pick i+1) as Ident
    if id="W"
      isize_x := pick:i as Int
    eif id="H"
      isize_y := pick:i as Int
    eif id="BPC"
      bpc := pick:i as Int
      if bpc<>8
        warning "Unsupported "+string:bpc+" bits per compone
    eif id="CS"
      var Str cs := pick:i as Ident
      if separated and (cs="DeviceGray" or cs="G")
    warning "unexpected Do usage (Subtype = "+subtype+")"


pdf_instruction ID
  var Int isize_x := undefined ; var Int isize_y := undefine
  var Link:ColorGamut gamut :> null map ColorGamut ; var CBo
  for (var Int i) 0 count-2 step 2
    var Str id := (pick i+1) as Ident
    if id="W"
      isize_x := pick:i as Int
    eif id="H"
      isize_y := pick:i as Int
    eif id="BPC"
      bpc := pick:i as Int
      if bpc<>8
        warning "Unsupported "+string:bpc+" bits per compone
    eif id="CS"
      var Str cs := pick:i as Ident
      if separated and (cs="DeviceGray" or cs="G")
        gamut :> color_gamut "pantone:"+(pdf:gamut query "co
        gamut :> color_gamut pdf:color_device+":"+(pdf:gamut query "component_name "+string:page_num) ; reverse := true
      eif cs="DeviceGray" or cs="G"
      eif cs="DeviceGray" or cs="G"
        gamut :> color_gamut "pantone:process_black" ; rever
        gamut :> color_gamut pdf:color_device+":process_black" ; reverse := true
      else
        warning "unsupported inline image colorspace '"+cs+"
    else
      warning "unsupported inline image attribute '"+id+"'" 
  if not exists:gamut
    warning "unsupported inline image gamut" ; return
  if isize_x<=0 or isize_y<=0 or isize_x>2^14 or isize_y>2^1
    warning "inline image overflow" ; return
  var Link:ImagePacked packed :> new ImagePacked
  packed setup (image_prototype 0 0 1 1 isize_x isize_y gamu
  var Address buffer := memory_allocate packed:line_size nul
  for (var Int iy) 0 isize_y-1
    pdf:stream raw_read buffer packed:line_size
    if reverse
      bytes_copy_255minus buffer 1 buffer 1 packed:line_size
    packed write 0 isize_y-1-iy isize_x buffer
  memory_free buffer
  draw image packed context:t
  pop count
  if token<>"EI"
    warning "unexpected end of inline image"



pdf_instruction Tf
  text fontdef :> solve:(font_dict first (pick:1 as Ident)) 
  var Pointer:PDFObject img_object :> cobject
      else
        warning "unsupported inline image colorspace '"+cs+"
    else
      warning "unsupported inline image attribute '"+id+"'" 
  if not exists:gamut
    warning "unsupported inline image gamut" ; return
  if isize_x<=0 or isize_y<=0 or isize_x>2^14 or isize_y>2^1
    warning "inline image overflow" ; return
  var Link:ImagePacked packed :> new ImagePacked
  packed setup (image_prototype 0 0 1 1 isize_x isize_y gamu
  var Address buffer := memory_allocate packed:line_size nul
  for (var Int iy) 0 isize_y-1
    pdf:stream raw_read buffer packed:line_size
    if reverse
      bytes_copy_255minus buffer 1 buffer 1 packed:line_size
    packed write 0 isize_y-1-iy isize_x buffer
  memory_free buffer
  draw image packed context:t
  pop count
  if token<>"EI"
    warning "unexpected end of inline image"



pdf_instruction Tf
  text fontdef :> solve:(font_dict first (pick:1 as Ident)) 
  var Pointer:PDFObject img_object :> cobject
  var Str name := solve:(text:fontdef first "BaseFont") as I
  var Str id := shunt (options option "share_fonts_with_same
  text name := solve:(text:fontdef first "BaseFont") as Ident
  var Str id := shunt (options option "share_fonts_with_same_name") and text:name<>"" text:name img_object:cache_id 
  if (cache_open "/pliant/graphic/pdf/font/"+id Font ((addre
    if debug_font
  if (cache_open "/pliant/graphic/pdf/font/"+id Font ((addre
    if debug_font
      console "font name '" name "' " (shunt (exists text:fo
      console "font name '" text:name "' " (shunt (exists text:font) "yes" "no") " " img_object:cache_id eol
      console "font def " ; display (addressof text:fontdef)
    part compute_the_encoding
      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
      # text:font encoding := charsets "MacRomanEncoding"
      var Str charset := (text:fontdef first "Encoding") as 
      if exists:(charsets first charset)
      var Str charset := (text:fontdef first "Encoding") as 
      if exists:(charsets first charset)
        text encoding := charsets first charset
        text:font encoding := charsets first charset
        if debug_font
          console "font charset " charset eol
      var Link:Dictionary enc :> solve:(text:fontdef first "
      var Str charset := (enc first "BaseEncoding") as Ident
      if exists:(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
        text:font encoding := charsets first charset
        if debug_font
          console "font charset " charset eol
      if (enc first "Differences")<>null
        if debug_font
          console "font encoding differences"
        var Link:Array diff :> solve:(enc first "Differences") as Array
        var Int char := undefined
        for (var Int i) 0 diff:size-1
          if (diff:i is Int)
            char := diff:i as Int
          if (diff:i as Ident)<>"" and char>=0 and char<2^16
            var Pointer:Int unicode :> postscript_glyphs first (diff:i as Ident)
            if exists:unicode
              while char>=text:font:encoding:size
                text:font encoding += undefined
              text:font:encoding char := unicode
              if debug_font
                console " " char "->" unicode
            char += 1
        if debug_font
          console eol
      if solve:(text:fontdef first "ToUnicode")<>null
      if solve:(text:fontdef first "ToUnicode")<>null
        if debug_font
          console "font unicode mapping" eol
        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: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
        var Link:Stream s :> filter mapping (var Link:ImageReadFilter decoder) (var Str decoder_options)
        while not s:atend
          var Str l := s readline
        while not s:atend
          var Str l := s readline
          if debug_font_mapping
            console "  " l eol
          if (l parse (var Int drop) word:"begincodespacerange")
            var Str l := s readline
            if debug_font_mapping
              console "  " l eol
            if (l parse "<" any:(var Str code_begin) ">" "<" any:(var Str code_end) ">")
              if unhexa:code_end>=256
                text:font options += " pdf_char16"
          if (l parse (var Int drop) word:"beginbfchar")
          if (l parse (var Int drop) word:"beginbfchar")
            while (s:readline parse "<" any:(var Str code8) 
            while { var Str l := s readline ; if debug_font_mapping (console "  " l eol) ; l parse "<" any:(var Str code8) ">" "<" any:(var Str code16) ">" }
              var Int char := unhexa code8
              var Int char := unhexa code8
              if char>=0 and char<256
                text:encoding char := unhexa code16
              if char>=0 and char<2^16
                while char>=text:font:encoding:size
                  text:font encoding += undefined
                text:font:encoding char := unhexa code16
              eif debug_font_mapping
                console "  unicode unexpected mapping " char eol
        raw_stream configure "seek "+string:current_seek
        raw_stream configure "seek "+string:current_seek
    text:font encoding := text encoding
    var CBool loaded := false
    part load_the_font
    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 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 Link:Stream src :> filter ff (var Link:ImageReadFilter decoder) (var Str decoder_options)
            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 font"
            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 font"
              if not (options option "nopliantfont") and (te
              if not (options option "nopliantfont") and (text:font load_postscript temp "")=success and text:font:chars:size>0
                loaded := true
                loaded := true
                if debug
                if debug_font
                  console "loaded Type1 font at " cobject:se
              eif not (options option "nofreetypefont") and 
                loaded := true
                  console "loaded Type1 font at " cobject:se
              eif not (options option "nofreetypefont") and 
                loaded := true
                if debug
                  console "loaded FreeType font at " cobject
                if debug_font
                  console "loaded FreeType font at " cobject:seek
                  console " (with characters"
                  for (var Int i) 0 2^16
                    if exists:(text:font:chars first i)
                      console " " i
                  console ")"
                  console eol
              else
              else
                if debug
                if debug_font
                  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
                  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
              var Link:Stream src :> filter proc (var Link:ImageReadFilter decoder) (var Str decoder_options)
              console "glyph " (diff:i as Ident) eol
              while not src:atend
                console "  " src:readline eol
              raw_stream configure "seek "+string:current_se
              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 not loaded
        if not (options option "nobuiltinfont")
          var Data:FontFile basefont :> font_database:data:font (font_database:data:alias text:name)
          if exists:basefont
            if (text:font load_postscript basefont:file "")=success
              loaded := true
        if not (options option "nofontwarning") or not loaded
          warning "Font '"+text:name+"' is missing"+(shunt loaded ", using builtin one" "")
        if debug_font
          console "Font '"+text:name+"' is missing"+(shunt loaded ", using builtin one" "") eol
    if loaded
      cache_ready ((addressof Link:Font text:font) map Link:CachePrototype)
    else
      if debug or debug_font
        console "Font '"+text:name+"' is missing" eol
      cache_cancel ((addressof Link:Font text:font) map Link:CachePrototype)
      text font :> null map Font
  if (exists text:font)
    text encoding := text:font encoding
  text scale := pick:0 as Float
  pop 2


pdf_instruction TL
  if (exists text:font)
    text encoding := text:font encoding
  text scale := pick:0 as Float
  pop 2


pdf_instruction TL
  text leading := pick:0 as Float
  text leading := -(pick:0 as Float)
  pop


pdf_instruction 'T*'
  pop


pdf_instruction 'T*'
  text tlm := compose (transform 0 -(text:leading) 1 1 0 0) 
  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 debug
    if not (exists text:font)
      return 
    if debug_text
      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 -(
      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 ColorBuffer color := real_color context:fill_gamut context:fill_color context:fill_opacity
    if debug_text
      console "original color"
      for (var Int i) 0 context:fill_gamut:dimension-1
        console " " (cast ((addressof context:fill_color) map uInt8 i) Int)
      console " transparency"
      for (var Int i) 0 context:fill_gamut:transparency-1
        console " " (cast ((addressof context:fill_color) map uInt8 context:fill_gamut:dimension+i) Int)
      console " mode " context:transparency eol
      console "color"
      for (var Int i) 0 gamut:dimension-1
        console " " (cast (addressof:color map uInt8 i) Int)
      console " transparency"
      for (var Int i) 0 gamut:transparency-1
        console " " (cast (addressof:color map uInt8 gamut:dimension+i) Int)
      console eol
    var Str32 txt32
    if (text:font:options option "pdf_char16")
      txt32 := repeat txt:len\2 " "
      for (var Int i) 0 txt32:len-1
        txt32 i := character32 (txt:characters map uInt16_hi i)
    else
      txt32 := txt
    var Str32 unicode := txt32
    for (var Int i) 0 unicode:len-1
      var Int c := txt32:i number
      unicode i := character32 (shunt c>=0 and c<text:encoding:size text:encoding:c undefined)
      if not exists:(text:font:chars first unicode:i:number)
        unicode i := character32 2^30+txt32:i:number
    if debug_text
      console "unicode is "
      for (var Int i) 0 unicode:len-1
        console (shunt unicode:i:number>=32 and unicode:i:number<128 (character unicode:i:number) "?")
      console " ("
      for (var Int i) 0 unicode:len-1
        console " " unicode:i:number
      console ")" eol
    for (var Int i) 0 offsets:size-1
      offsets i := -(offsets:i/1000)
    if offsets:size=txt32:len
      offsets += 0
    var Int firstchar := (text:fontdef first "FirstChar") as
    if firstchar<0
      firstchar := 0
    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 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
    for (var Int i) 0 txt32:len-1
      var Int c := txt32:i number
      var Int width := (((text:fontdef first "Widths") as Ar
      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
      if width<>undefined
        offsets i+1 += width/1000-(text:font length (unicode i 1) null)
      offsets i+1 += (shunt c=32 text:wordspace text:charspace)/text:scale
    var Float length := text:font length unicode null
    for (var Int i) 0 offsets:size-1
      length += offsets i
    if debug
      console "length is"
      for (var Int i) 0 unicode:len-1
        console " " offsets:i
      console " -> " length eol
      length += offsets i
    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
      if draw_text
        draw text unicode font kerning undefined t addressof
      memory_free kerning
    else
      for (var Int i) 0 txt:len-1
        if draw_text
          draw text (unicode i 1) font null undefined t addr
        t := compose (transform offsets:i 0 1 1 0 0) t
    text tm := compose (transform length 0 1 1 0 0) text:tm
    for (var Int i) 0 offsets:size-1
      offsets i /= text:font:vector:length
    if draw_text
      draw text unicode text:font (addressof offsets:0) t addressof:color
    var Vector2 v := text:font vector
    var Float f := text:scale*length/v:length
    text tm := compose (transform f*v:x f*v:y 1 1 0 0) text:tm
    


pdf_instruction TJ
  var Link:Array a :> pick:0 as Array
  var Str txt := "" ; var Array:Float offsets


pdf_instruction TJ
  var Link:Array a :> pick:0 as Array
  var Str txt := "" ; var Array:Float offsets
  for (var Int i) 0 a:size-1 step 2
    txt += a:i as Str
    while offsets:size<txt:len-1
      offsets += 0
    if i+1<a:size
      offsets += a:(i+1) as Float
    else
      offsets += 0
  for (var Int i) 0 a:size-1
    if (a:i is Str)
      txt += a:i as Str
      while offsets:size<txt:len
        offsets += 0
    eif (a:i is Float)
      if offsets:size=txt:len
        offsets += 0
      offsets txt:len += a:i as Float
  draw_text txt offsets
  pop


pdf_instruction quote
  draw_text txt offsets
  pop


pdf_instruction quote
  text tlm := compose (transform 0 -(text:leading) 1 1 0 0) 
  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



  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



pdf_instruction BX
  void


pdf_instruction EX
  void


#-----------------------------------------------------------
#   main function



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
#-----------------------------------------------------------
#   main function



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 "pantone"
    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
    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 "Metadata") true ; console eol
      stream configure "seek "+(string cobject:seek)
      stream :> filter (solve:(root first "Metadata") as Dictionary) (var Link:ImageReadFilter decoder) (var Str decoder_options)
      while not stream:atend
        console "  " stream:readline eol
      stream :> raw_stream
      console "default gray " ; display solve:(root first "DefaultGray") true ; console eol
      console "default rgb " ; display solve:(root first "DefaultRGB") true ; console eol
    var Link:Dictionary pages :> solve:(root first "Pages") 
    if debug or debug_header
      console "pages " ; display addressof:pages ; console e
    pdf scan_pages_list addressof:pages (var Array pages_arr
    pdf draw :> draw
    var CBool first_page := true
    if separated
      var Str gamutname := options option "gamut" Str
      pdf gamut :> color_gamut gamutname
      if pdf:gamut=failure
        return (failure "Incorrect gamut '"+gamutname+"' ("+
    for (var Int page_num) (shunt separated 0 (options optio
      pdf page_num := page_num
      context fill_mode := 0
      context stroke_mode := 0
      context transparency := 0
      context line_width := 0
      text font :> null map Font
      text fontdef :> new Dictionary
      text scale := 1
      text tlm := transform 0 0 1 1 0 0
      text tm := text tlm
      if separated
        memory_clear (addressof context:fill_color) pdf:gamu
        memory_clear (addressof context:stroke_color) pdf:ga
        if page_num<pdf:gamut:dimension
          context fill_mode := 1
          context:fill_color:bytes page_num := 255
          context:fill_color:bytes pdf:gamut:dimension+page_
          context stroke_mode := 1
          context:stroke_color:bytes page_num := 255
          context:stroke_color:bytes pdf:gamut:dimension+pag
      else
    var Link:Dictionary pages :> solve:(root first "Pages") 
    if debug or debug_header
      console "pages " ; display addressof:pages ; console e
    pdf scan_pages_list addressof:pages (var Array pages_arr
    pdf draw :> draw
    var CBool first_page := true
    if separated
      var Str gamutname := options option "gamut" Str
      pdf gamut :> color_gamut gamutname
      if pdf:gamut=failure
        return (failure "Incorrect gamut '"+gamutname+"' ("+
    for (var Int page_num) (shunt separated 0 (options optio
      pdf page_num := page_num
      context fill_mode := 0
      context stroke_mode := 0
      context transparency := 0
      context line_width := 0
      text font :> null map Font
      text fontdef :> new Dictionary
      text scale := 1
      text tlm := transform 0 0 1 1 0 0
      text tm := text tlm
      if separated
        memory_clear (addressof context:fill_color) pdf:gamu
        memory_clear (addressof context:stroke_color) pdf:ga
        if page_num<pdf:gamut:dimension
          context fill_mode := 1
          context:fill_color:bytes page_num := 255
          context:fill_color:bytes pdf:gamut:dimension+page_
          context stroke_mode := 1
          context:stroke_color:bytes page_num := 255
          context:stroke_color:bytes pdf:gamut:dimension+pag
      else
        context fill_gamut :> color_gamut "pantone:process_b
        context fill_mode := 1
        context fill_gamut :> color_gamut pdf:color_device+":process_black+transparencies"
        context:fill_color:bytes 0 := 255
        context:fill_color:bytes 1 := 255
        context:fill_color:bytes 0 := 255
        context:fill_color:bytes 1 := 255
        context stroke_mode := 1
        context stroke_gamut :> color_gamut pdf:color_device+":process_black+transparencies"
        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
      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
      # 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
      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
      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
      if debug_header
        console "ressources " ; display addressof:res ; console eol
      pdf xobject_dict :> solve:(res first "XObject") as Dic
      pdf colorspace_dict :> solve:(res first "ColorSpace") 
      pdf xobject_dict :> solve:(res first "XObject") as Dic
      pdf colorspace_dict :> solve:(res first "ColorSpace") 
      # console "colorspaces are " ; display addressof:color
      if debug_header
        console "colorspaces are " ; display addressof:colorspace_dict true ; console eol
      if first_page
        var Str gamutname := options option "gamut" Str
        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
      if first_page
        var Str gamutname := options option "gamut" Str
        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
            each colorspace colorspace_dict
            var Str suggest := "" ; var CBool suggested := false
            each colorspace colorspace_dict getkey key
              (var Array:Str inks) size := 0
              var Link:Array a :> solve:colorspace as Array
              (var Array:Str inks) size := 0
              var Link:Array a :> solve:colorspace as Array
              if a:size>=2 and (a:0 as Ident)="Separation"
              if a:size>=2 and (a:0 as Ident)="Separation" and (a:1 as Ident)<>"All"
                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 "
                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
              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 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
            var Str selected := ""
              if i<inks:size and csname:len>0 and (csname parse (var Int j) any) and j+(shunt (csname csname:len-1 1)="b" 8 0)=already:size
                if not suggested
                  suggest := inks i ; suggested := true
                eif suggest<>inks:i
                  suggest := ""
                if debug_gamut
                  console "suggest " key " " already:size " -> " suggest eol
            var Str selected := suggest
            each k possible
              if not exists:(rejected first k)
                if selected=""
                  selected := k
            each k possible
              if not exists:(rejected first k)
                if selected=""
                  selected := k
                else
                eif suggest=""
                  if debug_gamut
                  if debug_gamut
                    each colorspace colorspace_dict
                      console "colorspace " ; display colors
                    each colorspace colorspace_dict getkey key
                      console "colorspace " key " is " ; display colorspace true ; console eol
                  return (failure "Ambigious inks order betw
            if selected<>""
              gamutname += selected+"+"
              already insert selected selected
              restart gamut_lap
          if gamutname<>""
                  return (failure "Ambigious inks order betw
            if selected<>""
              gamutname += selected+"+"
              already insert selected selected
              restart gamut_lap
          if gamutname<>""
            gamutname := "pantone:"+gamutname+"transparencie
            gamutname := pdf:color_device+":"+gamutname+"transparencies"
          else
          else
            gamutname := "rgb"
            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 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 eol
      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 (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:content false ; console eol
        if not (addressof:content is Dictionary)
          return failure:"no page content"
        stream configure "seek "+(string cobject:seek)
        if not (addressof:content is Dictionary)
          return failure:"no page content"
        stream configure "seek "+(string cobject:seek)
        stream :> filter content (var Link:ImageReadFilter d
        stream :> filter content (var Link:ImageReadFilter decoder) (var Str decoder_options)
        # console "stream is " entry_type:(addressof stream:stream_driver):name eol
        process_instructions
        stream :> raw_stream
        if pdf:status=failure
          return pdf:status
        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
      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