Patch title: Release 94 bulk changes
Abstract:
File: /pliant/graphic/image/rip.pli
Key:
    Removed line
    Added line
module "/pliant/install/minimal.pli"
module "/pliant/language/compiler.pli"
module "/pliant/language/context.pli"
module "/pliant/language/compiler/type/inherit.pli"
module "prototype.pli"
module "/pliant/graphic/color/gamut.pli"
module "pixmap.pli"
module "packed.pli"
module "/pliant/graphic/draw/prototype.pli"
module "/pliant/graphic/draw/image.pli"

constant default_rip_cache_size 4*2^20


type ImageRIPTile
  field Link:ImagePrototype cache
  field Sem sem

type ImageRIP
  inherit ImagePrototype
  field Link:DrawPrototype list
  field Link:Type draw_image_type
  field Str options
  field Link:ImagePrototype cache
  field Int base_y
  field Array:ImageRIPTile tile
  field CBool packed
  field Int step
  field Int burst
  field Int ripping


method rip bind list options -> status
  oarg_rw ImageRIP rip ; oarg DrawPrototype list ; arg Str options ; arg ExtendedStatus status
  var ImagePrototype proto := list image_prototype options
  addressof:rip map ImagePrototype := image_prototype proto options+(shunt options<>"" and proto:options<>"" " " "")+proto:options
  if rip:size_x<1 or rip:size_y<1
    return (failure "Incorrect "+(string rip:size_x)+" x "+(string rip:size_y)+" image size")
  rip list :> list
  rip options := options
  rip base_y := undefined
  if (options option "packed")
    rip cache :> new ImagePacked
  else
    rip cache :> new ImagePixmap
  var Int step := options option "step" Int rip:size_y
  rip packed := options option "packed"
  rip step := options option "step" Int rip:size_y
  var Int cache := options option "cache" Int default_rip_cache_size
  if cache=defined
    step := max (min step cache\rip:line_size) 1
  rip:cache setup (image_prototype 0 0 1 1 rip:size_x (min step rip:size_y) rip:gamut) options
    rip step := max (min rip:step cache\rip:line_size) 1
  rip:tile size := (rip:size_y+rip:step-1)\rip:step
  rip burst := options option "burst" Int (shunt (options option "burst") processor_count undefined)
  rip ripping := 0
  status := success


method rip do_rip t index
  oarg_rw ImageRIP rip ; arg_rw ImageRIPTile t ; arg Int index
  var Int base_y := index*rip:step
  var Int nb_y := min rip:step rip:size_y-base_y
  part rip "rip lines "+string:base_y+" to "+(string base_y+nb_y-1)+" out of "+(string rip:size_y)
    if rip:packed
      t cache :> new ImagePacked
    else
      t cache :> new ImagePixmap
    var Float unit_y := (rip:y1-rip:y0)/rip:size_y
    t:cache setup (image_prototype rip:x0 rip:y0+base_y*unit_y rip:x1 rip:y0+(base_y+nb_y)*unit_y rip:size_x nb_y rip:gamut) rip:options
    var ColorBuffer pixel ; memory_clear addressof:pixel rip:pixel_size
    if rip:gamut:model=color_gamut_additive
      addressof:pixel map Int := -1
    for (var Int iy) 0 t:cache:size_y-1
      t:cache fill 0 iy rip:size_x addressof:pixel
    var Link:DrawImage draw :> new DrawImage
    if (exists rip:draw_image_type)
      draw image_type :> rip draw_image_type
    draw bind t:cache rip:options
    var ImagePrototype proto := rip:list image_prototype rip:options
    draw setup proto rip:options+(shunt rip:options<>"" and proto:options<>"" " " "")+proto:options
    rip:list play draw rip:options


method rip access index
  oarg_rw ImageRIP rip ; arg Int index
  if index>=2
    var Pointer:ImageRIPTile t2 :> rip:tile index-2
    if t2:sem:nowait_request
      if (exists t2:cache)
        t2 cache :> null map ImagePrototype
      t2:sem release
  if rip:burst<>undefined
    for (var Int i2) index+1 (min index+rip:burst rip:tile:size-1)
      if rip:ripping<rip:burst
        var Pointer:ImageRIPTile t2 :> rip:tile i2
        if t2:sem:nowait_request
          if not (exists t2:cache)
            atomic_add rip:ripping 1
            var Link:ImageRIP rip2 :> rip
            thread
              rip2 do_rip t2 i2
              atomic_add rip2:ripping -1
              t2:sem release
          else
            t2:sem release


method rip read x y count adr
  oarg_rw ImageRIP rip ; arg Int x y count ; arg Address adr
  implicit rip
    if y<base_y or y>=base_y+cache:size_y
      base_y := min y size_y-cache:size_y
      var Float unit_y := (y1-y0)/size_y
      cache := image_prototype x0 y0+base_y*unit_y x1 y0+(base_y+cache:size_y)*unit_y size_x cache:size_y gamut
      var ColorBuffer pixel ; memory_clear addressof:pixel pixel_size
      if gamut:model=color_gamut_additive
        addressof:pixel map Int := -1
      for (var Int iy) 0 cache:size_y-1
        cache fill 0 iy size_x addressof:pixel
      var Link:DrawImage draw :> new DrawImage
      if (exists rip:draw_image_type)
        draw image_type :> rip draw_image_type
      draw bind cache rip:options
      var ImagePrototype proto := list image_prototype rip:options
      draw setup proto rip:options+(shunt rip:options<>"" and proto:options<>"" " " "")+proto:options
      list play draw rip:options
    cache read x y-base_y count adr
  var Int index := y\rip:step
  rip access index
  var Pointer:ImageRIPTile t :> rip:tile index
  t:sem rd_request
  if (exists t:cache)
    t:cache read x y%rip:step count adr
    t:sem rd_release
    return
  t:sem rd_release
  t:sem request
  if (exists t:cache)
    t:cache read x y%rip:step count adr
    t:sem release
    return
  atomic_add rip:ripping 1
  rip do_rip t index
  atomic_add rip:ripping -1
  t:cache read x y%rip:step count adr
  t:sem release


method rip read_map x y mini maxi count -> adr
  oarg_rw ImageRIP rip ; arg Int x y mini maxi ; arg_w Int count ; arg Address adr
  if y>=rip:base_y and y<rip:base_y+rip:cache:size_y
    adr := rip:cache read_map x y-rip:base_y mini maxi count
  var Int index := y\rip:step
  rip access index
  var Pointer:ImageRIPTile t :> rip:tile index
  t:sem rd_request
  if (exists t:cache)
    adr := t:cache read_map x y%rip:step mini maxi count
  else
    count := 0 ; adr := null
    t:sem rd_release

method rip read_unmap x y count adr
  oarg_rw ImageRIP rip ; arg Int x y count ; arg Address adr
  rip:cache read_unmap x y+rip:base_y count adr
  var Pointer:ImageRIPTile t :> rip:tile y\rip:step
  t:cache read_unmap x y%rip:step count adr
  t:sem rd_release


export ImageRIP '. bind' '. read' '. draw_image_type'