Patch title: Release 90 bulk changes
Abstract:
File: /graphic/sample/test.pli
Key:
    Removed line
    Added line
   
module "/pliant/language/unsafe.pli"
module "/pliant/language/stream.pli"
module "/pliant/language/context.pli"
module "/pliant/admin/file.pli"
module "/pliant/admin/execute.pli"
module "/pliant/graphic/image/prototype.pli"
module "/pliant/graphic/filter/io.pli"
module "/helio/graphic/filter/postscript.pli"
module "/pliant/graphic/image/packed.pli"
module "/pliant/graphic/image/lazy.pli"
module "/pliant/graphic/draw/prototype.pli"
module "/pliant/graphic/image/transparency.pli"
module "/pliant/graphic/draw/image.pli"
module "/helio/graphic/image/compare.pli"
module "/pliant/graphic/color/gamut.pli"
module "/pliant/graphic/image/convert.pli"
module "/pliant/graphic/image/antialiasing.pli"
module "/pliant/language/debug/profiler.pli"
module "/pliant/graphic/vfilter/prototype.pli"
module "/pliant/graphic/vfilter/all.pli"

# memory assigned for ripping
constant packed_memory memory_physical\2
constant clear_memory memory_physical\16
constant report_dpi 75
constant profile false
constant profile_recurse 2^30
constant displaylist false

if displaylist
  module "/pliant/graphic/draw/displaylist.pli"

method p mm_x i -> x
  arg ImagePrototype p ; arg Int i ; arg Float x
  x := p:x0+i/p:size_x*(p:x1-p:x0)

method p mm_y i -> y
  arg ImagePrototype p ; arg Int i ; arg Float y
  y := p:y0+i/p:size_y*(p:y1-p:y0)

function pdf_rip filename options pdf -> status
  arg Str filename options ; oarg_rw ImagePacked pdf ; arg ExtendedStatus status
  # console "recommended draw tile is " pdf:recommended_draw_tile " / " pdf:size_y eol
  if displaylist
    var DateTime start := datetime
    var Link:DrawDisplayList list :> new DrawDisplayList
    list bind pdf:gamut
    status := list load filename options
    if status=failure
      return
    var Float opentime := datetime:seconds-start:seconds
  if pdf:gamut:name<>"rgb"
    var Link:ImageTransparency transp :> new ImageTransparency
    status := transp bind pdf ""
    if status=failure
      console "oops: failed to bind transparency" eol
      return
  else
    transp :> addressof:pdf map ImageTransparency
  var Link:DrawImage draw :> new DrawImage
  draw image :> transp
  var Int y := 0 ; var Int lap := 0
  while y<pdf:size_y
    pdf clip_y0 := y ; pdf clip_y1 := pdf size_y ; pdf auto_clip := true
    if displaylist
      pdf clip_y1 := min pdf:clip_y1 y+pdf:recommended_draw_tile
    var ColorBuffer pixel ; memory_clear addressof:pixel pdf:pixel_size
    if pdf:gamut:name="rgb"
      addressof:pixel map Int := -1
    for (var Int iy) pdf:clip_y0 pdf:clip_y1-1
      pdf fill 0 iy pdf:size_x addressof:pixel
    if displaylist
      list replay draw (pdf mm_x 0) (pdf mm_y pdf:clip_y0) (pdf mm_x pdf:size_x) (pdf mm_y pdf:clip_y1)
    else
      status := draw load filename options
      if status=failure
        return
    y := pdf clip_y1 ; lap += 1
    pdf clip_y0 := 0 ; pdf clip_y1 := pdf size_y ; pdf auto_clip := false
    pdf shrink
    if y<>pdf:size_y
      pdf disk_shrink
  status := success ; status message := string:lap+" lap "+(string pdf:packed_size\2^20)+"/"+(string memory_current_used\2^20)+" MB"
  if displaylist
    status message := (string opentime "fixed 0")+" open "+status:message


method p component x y c -> v
  oarg_rw ImagePrototype p ; arg Int x y c v
  if x>=0 and x<p:size_x and y>=0 and y<p:size_y
    p read x y 1 addressof:(var ColorBuffer pixel)
    v := addressof:pixel map uInt8 c
  else
    v := 0

method p component x y c n mi ma
  oarg_rw ImagePrototype p ; arg Int x y c n ; arg_w Int mi ma
  mi := 255 ; ma := 0
  for (var Int iy) -n n
    for (var Int ix) -n n
      var Int v := p component x+ix y+iy c
      mi := min mi v
      ma := max ma v

function image_compare img1 img2 comp -> status
  oarg_rw ImagePrototype img1 img2 comp ; arg ExtendedStatus status
  status := success ; status message := "" ; var Int count := 0 ; var Int maxi := 0
  var Int psize := img1 pixel_size ; var Int dim := img1:gamut dimension
  var Address buf1 := memory_allocate img1:line_size null
  var Address buf2 := memory_allocate img2:line_size null
  var Int bottom_margin := cast 10/(comp:y1-comp:y0)*comp:size_y Int
  for (var Int y) 0 comp:size_y-1-bottom_margin
    var uInt8 white := 255 ; comp fill 0 y comp:size_x addressof:white
    img1 read 0 y img1:size_x buf1 ; var Address p1 := buf1
    img2 read 0 y img2:size_x buf2 ; var Address p2 := buf2
    for (var Int x) 0 comp:size_x-1
      if (memory_compare p1 dim p2 dim)<>compare_equal
        var Int err := 0
        for (var Int c) 0 dim-1
          err := max err (abs (cast (p1 map uInt8 c) Int)-(cast (p2 map uInt8 c) Int))
        if err>3
          var Int err := 0
          for (var Int c) 0 dim-1
            if (abs (cast (p1 map uInt8 c) Int)-(cast (p2 map uInt8 c) Int))>2
              img1 component x y c 2 (var Int mi1) (var Int ma1)
              img2 component x y c 2 (var Int mi2) (var Int ma2)
              if ma1<mi2
                err := max err mi2-ma1
              eif ma2<mi1
                err := max err mi1-ma2
          if err>3
            var uInt8 p3 := 255-err ; comp write x y 1 addressof:p3
            count += 1 ; maxi := max maxi err
            status := failure string:count+" "+string:maxi
      p1 := p1 translate Byte psize
      p2 := p2 translate Byte psize
  memory_free buf1
  memory_free buf2

function test1 filename label dpi -> status
  arg Str filename label ; arg Int dpi ; arg ExtendedStatus status
  var DateTime start := datetime
  console "ripping " label" PostScript            [cr]"
  var Link:ImageLazy ps :> new ImageLazy
  status := ps bind filename "resolution "+string:dpi+" transparency"
  if status=failure
    console "failed to open PostScript: " status:message eol
    return
  status := ps save "file:/tmp/ps.packed" ""
  if status=failure
    console "failed to RIP PostScript: " status:message eol
    return
  var Str message := (string datetime:seconds-start:seconds "fixed 0")
  memory_checkup
  start := datetime
  console "building " label " PDF               [cr]"
  execute "gs -sDEVICE=pdfwrite -dCompressPages=false -dEncodeColorImages=false -dEncodeGrayImages=false -dEncodeMonoImages=false -sOutputFile=/tmp/test.pdf -dNOPAUSE "+file_os_name:filename+" -c quit" output "file:/dev/null" error "file:/dev/null"
  message += " "+(string datetime:seconds-start:seconds "fixed 0")
  memory_checkup
  start := datetime
  console "ripping " label " PDF               [cr]"
  var Link:ImagePacked pdf :> new ImagePacked
  pdf setup (image_prototype 0 0 ps:x1-ps:x0 ps:y1-ps:y0 ps:size_x ps:size_y ps:gamut) "packed_cache_size "+string:packed_memory+" clear_cache_size "+string:clear_memory
  if profile
    profiler_recurse := profile_recurse
    profiler_start
  status := pdf_rip "file:/tmp/test.pdf" "separated" pdf
  # status := pdf_rip "file:/testai/ec1217.pdf" "" pdf
  if profile
    profiler_stop
    (var Stream s) open "file:/tmp/profiler.txt" out+safe
    profiler_report "" "" s
    (var Stream s) open "file:/tmp/profiler.txt" in+safe
    (var Stream s2) open "file:/tmp/profiler2.txt" out+safe
    while not s:atend
      var Str l := s readline
      if (l parse (var Str fun) (var Str pos) (var Int ticks))
        s2 writeline l
        profiler_report fun pos s2
        s2 writeline ""
    s close
    s2 close
  if status=failure
    console "failed to load PDF: " status:message eol
    return
  message += "+"+(string datetime:seconds-start:seconds "fixed 0")+" "+status:message
  memory_checkup
  console "comparing " label "              [cr]"
  var Link:ImageLazy ps :> new ImageLazy
  ps bind "file:/tmp/ps.packed" "backward 4"
  var Link:ImagePacked comp :> new ImagePacked
  comp setup (image_prototype pdf:x0 pdf:y0 pdf:x1 pdf:y1 pdf:size_x pdf:size_y color_gamut:"grey") ""
  status := image_compare ps pdf comp
  memory_checkup
  if status=success
    status message := message
  if status=failure
    console "storing " label " PNG reports           [cr]"
    var Link:ImageLazy ps :> new ImageLazy
    ps bind "file:/tmp/ps.packed" "backward 2"
    var Link:ImageConvert conv :> new ImageConvert
    conv bind ps color_gamut:"rgb" "fast"
    var Link:ImageAntiAliasing aa :> new ImageAntiAliasing
    aa bind conv (max dpi\report_dpi 1) (max dpi\report_dpi 1)
    aa save "file:/tmp/ps.png" ""
    var Link:ImageConvert conv :> new ImageConvert
    conv bind pdf color_gamut:"rgb" "fast"
    var Link:ImageAntiAliasing aa :> new ImageAntiAliasing
    aa bind conv (max dpi\report_dpi 1) (max dpi\report_dpi 1)
    aa save "file:/tmp/pdf.png" ""
    var Link:ImageAntiAliasing aa :> new ImageAntiAliasing
    aa bind comp (max dpi\report_dpi 1) (max dpi\report_dpi 1)
    aa save "file:/tmp/compare.png" ""
    memory_checkup

function test dpi
  arg Int dpi
  var Array:FileInfo files := file_list "file:/test/" standard+recursive
  (var Stream log) open "file:/tmp/test.log" out+nocache
  var Int passed := 0 ; var Int failed := 0
  for (var Int i) 0 files:size-1
    if files:i:extension=".ps.gz"
      log writechars files:i:name+" "
      file_copy "gzip:"+files:i:name "file:/tmp/test.ps" reduced
      var ExtendedStatus status := test1 "file:/tmp/test.ps" files:i:name_without_path dpi
      log writeline (shunt status=success "passed" "FAILED")+" "+status:message+" ("+(string memory_current_used\2^20)+"/"+(string memory_maximum_consumed\2^20)+" MB)"
      console files:i:name " " (shunt status=success "passed" "FAILED") " " status:message " "
      console "(" memory_current_used\2^20 "/" memory_maximum_consumed\2^20 " MB)" eol
      if status=success
        passed += 1
      else
        failed += 1
    else
      file_delete files:i:name
  console passed " passed, " failed " failed" eol

function test filename dpi
  arg Str filename ; arg Int dpi
  var ExtendedStatus status := test1 filename "" dpi
  console filename " " (shunt status=success "passed" "FAILED") " " status:message eol


function image_delta img1 img2 sum diff
  oarg_rw ImagePrototype img1 img2 ; arg_w Float sum diff
  sum := 0 ; diff := 0
  var Int psize := img1 pixel_size ; var Int dim := img1:gamut dimension
  var Address buf1 := memory_allocate img1:line_size null
  var Address buf2 := memory_allocate img2:line_size null
  for (var Int y) 0 img1:size_y-1
    img1 read 0 y img1:size_x buf1 ; var Address p1 := buf1
    img2 read 0 y img2:size_x buf2 ; var Address p2 := buf2
    var Int s := 0 ; var Int d := 0
    for (var Int x) 0 img1:size_x-1
      if (memory_compare p1 dim p2 dim)<>compare_equal
        for (var Int c) 0 dim-1
          s += (cast (p1 map uInt8 c) Int)-(cast (p2 map uInt8 c) Int)
          d += abs (cast (p1 map uInt8 c) Int)-(cast (p2 map uInt8 c) Int)
      p1 := p1 translate Byte psize
      p2 := p2 translate Byte psize
    sum += s ; diff += d
  memory_free buf1
  memory_free buf2
  sum /= img1 size_x ; sum /= img1 size_y ; sum /= dim
  diff /= img1 size_x ; diff /= img1 size_y ; diff /= dim


function quality filename
  arg Str filename
  var Int base := 150 ; var Int factor := 8
  var Link:ImageLazy hr :> new ImageLazy
  var ExtendedStatus status := hr bind filename "resolution "+(string base*factor)+" antialiasing "+string:factor+" "+string:factor+" transparency"
  if status=failure
    console "failed to open PostScript: " status:message eol
    return
  # console "ps hr is " hr:x0 " " hr:y0 " " hr:x1 " " hr:y1 " : " hr:size_x " x " hr:size_y eol
  var Link:ImageAntiAliasing aa :> new ImageAntiAliasing
  aa bind hr factor factor
  var Link:ImageLazy lr :> new ImageLazy
  var ExtendedStatus status := lr bind filename "resolution "+(string base)+" transparency"
  if status=failure
    console "failed to open PostScript: " status:message eol
    return
  # console "ps lr is " lr:x0 " " lr:y0 " " lr:x1 " " lr:y1 " : " lr:size_x " x " lr:size_y eol
  image_delta lr aa (var Float sum) (var Float diff)
  console "PostScript sum " sum " diff " diff eol
  execute "gs -sDEVICE=pdfwrite -dCompressPages=false -dEncodeColorImages=false -dEncodeGrayImages=false -dEncodeMonoImages=false -sOutputFile=/tmp/test.pdf -dNOPAUSE "+file_os_name:filename+" -c quit" output "file:/dev/null" error "file:/dev/null"
  var Link:ImagePacked pdf_hr :> new ImagePacked
  pdf_hr setup (image_prototype 0 0 hr:x1-hr:x0 hr:y1-hr:y0 hr:size_x hr:size_y hr:gamut) "packed_cache_size "+string:packed_memory+" clear_cache_size "+string:clear_memory
  status := pdf_rip "file:/tmp/test.pdf" "separated strict" pdf_hr
  if status=failure
    console "failed to load PDF: " status:message eol
    return
  # console "pdf hr is " pdf_hr:x0 " " pdf_hr:y0 " " pdf_hr:x1 " " pdf_hr:y1 " : " pdf_hr:size_x " x " pdf_hr:size_y eol
  var Link:ImageAntiAliasing aa :> new ImageAntiAliasing
  aa bind pdf_hr factor factor
  var Link:ImagePacked pdf_lr :> new ImagePacked
  pdf_lr setup (image_prototype 0 0 lr:x1-lr:x0 lr:y1-lr:y0 lr:size_x lr:size_y lr:gamut) "packed_cache_size "+string:packed_memory+" clear_cache_size "+string:clear_memory
  status := pdf_rip "file:/tmp/test.pdf" "separated strict" pdf_lr
  if status=failure
    console "failed to load PDF: " status:message eol
    return
  # console "pdf lr is " pdf_lr:x0 " " pdf_lr:y0 " " pdf_lr:x1 " " pdf_lr:y1 " : " pdf_lr:size_x " x " pdf_lr:size_y eol
  image_delta pdf_lr aa (var Float sum) (var Float diff)
  console "PDF sum " sum " diff " diff eol


function pdf filename gamutname page dpi -> status
  arg Str filename gamutname ; arg Int page ; arg Int dpi ; arg ExtendedStatus status
  var Link:DrawImage draw :> new DrawImage
  var DateTime start := datetime
  status := draw load filename "filter [dq].pdf[dq] page "+string:page+" resolution "+(string 4*dpi)+" verbose"+(shunt gamutname<>"" " gamut "+string:gamutname "")
  console (shunt status=success "ok" "FAILED") " " status:message " in " (string datetime:seconds-start:seconds "fixed 0") " seconds" eol
  if status=success
    console "gamut is " draw:draw_image:gamut:name eol
  each w draw:warnings
    console "  warning: " w eol
  if status=success
    var Link:ImageConvert conv :> new ImageConvert
    conv bind draw:draw_image color_gamut:"rgb" "fast"
    var Link:ImageAntiAliasing aa :> new ImageAntiAliasing
    aa bind conv 4 4
    aa save "file:/tmp/pdf.png" ""
    

export test quality pdf