Patch title: Release 87 bulk changes
Abstract:
File: /pliant/graphic/image/resampling.pli
Key:
    Removed line
    Added line
module "/pliant/language/compiler.pli"
submodule "prototype.pli"
module "/pliant/language/compiler/type/inherit.pli"
module "/pliant/graphic/misc/int.pli"
module "/pliant/graphic/misc/mtbuffer.pli"


type ImageResampling
  inherit ImagePrototype
  field Link:ImagePrototype image
  field Float translate_x translate_y
  field CBool same_resolution
  field Array:Int xs offsets
  field Float delta_x step_x delta_y step_y
  field Int start_x stop_x
  field MtBuffer buffers

ImagePrototype maybe ImageResampling


method r map_pixel x y xx yy
  arg_rw ImageResampling r ; arg Int x y ; arg_w Float xx yy
  var Float mm_x := r:x0+(x+0.5)*(r:x1-r:x0)/r:size_x
  mm_x -= r translate_x
  xx := (mm_x-r:image:x0)/(r:image:x1-r:image:x0)*r:image:size_x-0.5
  var Float mm_y := r:y0+(y+0.5)*(r:y1-r:y0)/r:size_y
  mm_y -= r translate_y
  yy := (mm_y-r:image:y0)/(r:image:y1-r:image:y0)*r:image:size_y-0.5


method r bind image x0 y0 x1 y1 size_x size_y tx ty -> status
  arg_rw ImageResampling r ; arg ImagePrototype image ; arg Float x0 y0 x1 y1 ; arg Int size_x size_y ; arg Float tx ty ; arg ExtendedStatus status
  addressof:r map ImagePrototype := addressof:image map ImagePrototype
  r x0 := x0 ; r y0 := y0 ; r x1 := x1 ; r y1 := y1
  r size_x := size_x ; r size_y := size_y
  r image :> image
  r translate_x := tx ; r translate_y := ty
  r map_pixel 0 0 r:delta_x r:delta_y
  r map_pixel 1 1 r:step_x r:step_y ; r step_x -= r delta_x ; r step_y -= r delta_y
  r same_resolution := (abs (x1-x0)/size_x-(image:x1-image:x0)/image:size_x)<1e-6 and (abs (y1-y0)/size_y-(image:y1-image:y0)/image:size_y)<1e-6
  r:xs size := r size_x ; r:offsets size := r size_x
  r start_x := 0 ; r stop_x := r:size_x
  for (var Int x) 0 r:size_x-1
    var Int ix := cast r:delta_x+x*r:step_x Int
    if ix<0
      r start_x := x+1
      if r:step_x>=0
        r start_x := x+1
      else
        r stop_x := min x r:stop_x
    eif ix>=r:image:size_x
      r stop_x := min x r:stop_x
      if r:step_x>=0
        r stop_x := min x r:stop_x
      else
        r start_x := x+1
    else
      r:xs x := ix ; r:offsets x := ix*image:pixel_size
  r:buffers size := image line_size
  status := success

method r bind image x0 y0 x1 y1 size_x size_y -> status
  arg_rw ImageResampling r ; arg ImagePrototype image ; arg Float x0 y0 x1 y1 ; arg Int size_x size_y ; arg ExtendedStatus status
  status := r bind image x0 y0 x1 y1 size_x size_y 0 0

method r setup image options -> status
  oarg_rw ImageResampling r ; arg ImagePrototype image ; arg Str options ; arg ExtendedStatus status
  if not ((options (options option_position "area" 0) options:len) parse word:"area" (var Float x0) (var Float y0) (var Float x1) (var Float y1) any)
    x0 := image x0 ; y0 := image y0 ; x1 := image x1 ; y1 := image y1
  if not ((options (options option_position "size" 0) options:len) parse word:"size" (var Int size_x) (var Int size_y) any)
    return failure:"Resampled image size not specified"
  if not ((options (options option_position "translate" 0) options:len) parse word:"translate" (var Float tx) (var Float ty) any)
    tx := 0 ; ty := 0
  status := r bind (addressof:image omap ImagePrototype) x0 y0 x1 y1 size_x size_y tx ty


method r read x y count adr
  arg_rw ImageResampling r ; arg Int x y count ; arg Address adr
  check x>=0 and count>=0 and x+count<=r:size_x and y>=0 and y<r:size_y
  var Int iy := cast r:delta_y+y*r:step_y Int
  if iy<0 or iy>=r:image:size_y
    memory_clear adr count*r:pixel_size
  eif x<r:start_x
    var Int n := min r:start_x-x count
    memory_clear adr n*r:pixel_size
    if n<count
      r read x+n y count-n (adr translate Byte n*r:pixel_size)
  eif x+count>r:stop_x
    var Int n := min x+count-r:stop_x count
    memory_clear (adr translate Byte (count-n)*r:pixel_size) n*r:pixel_size
    if n<count
      r read x y count-n adr
  else
    var Address buffer := r:buffers allocate
    var Int done := 0
    while done<count
      var Int ix0 := r:xs x+done
      var Int ix1 := (r:xs x+count-1)+1
      if ix1<ix0
        swap ix0 ix1
      var Address map := r:image read_map ix0 iy 1 ix1-ix0 (var Int map_count)
      var Address buf ; var Int step
      if map<>null
        buf := map translate Byte -ix0*r:pixel_size
        if map_count=ix1-ix0
          step := count-done
        else
          var Int step := bound (cast ((ix0+map_count)-r:delta_x)/r:step_x Int)-(x+done) 1 count-done
          while (r:xs x+done+step-1)>=ix0+map_count
            step -= 1
      else
        r:image read ix0 iy ix1-ix0 (buffer translate Byte ix0*r:pixel_size)
        buf := buffer ; step := count-done
      if r:same_resolution
        memory_copy (buf translate Byte (r:offsets x+done)) (adr translate Byte done*r:pixel_size) step*r:pixel_size
      else
        var Address ptr := addressof (r:offsets x+done)
        var Address cur := adr translate Byte done*r:pixel_size ; var Address stop := cur translate Byte step*r:pixel_size
        while cur<>stop
          memory_copy (buf translate Byte (ptr map Int)) cur r:pixel_size
          cur := cur translate Byte r:pixel_size
          ptr := ptr translate Int 1
      if map<>null
        r:image read_unmap ix0 iy map_count map
      done += step
    r:buffers free buffer


export ImageResampling '. bind'