Patch title: Release 83 bulk changes
Abstract:
File: /pliant/graphic/image/lut.pli
Key:
    Removed line
    Added line
module "/pliant/language/compiler.pli"
submodule "prototype.pli"
module "/pliant/language/compiler/type/inherit.pli"
module "/pliant/math/curve.pli"
module "/pliant/graphic/color/gamut.pli"
module "/pliant/graphic/color/spectrum.pli" # defines 'exposure'
module "/pliant/graphic/misc/int.pli"
module "/pliant/graphic/misc/float.pli"
module "/pliant/graphic/misc/mtbuffer.pli"

constant buggy true


type ImageLut
  inherit ImagePrototype
  field Link:ImagePrototype image
  field MtBuffer buffers
  field Array:(Array Float32 256) gradation
  field Array:Float32 remain
  field Float maxi
  field uInt random_bits ; field Int random_available

ImagePrototype maybe ImageLut


method c compute image
  arg_rw ImageLut c ; oarg ImagePrototype image
  addressof:c map ImagePrototype := addressof:image map ImagePrototype
  c image :> image
  c:buffers size := image line_size
  c:remain size := c:line_size+c:gamut:pixel_size
  for (var Int i) 0 c:remain:size-1
    c:remain i := 0
  c maxi := 0
  for (var Int d) 0 c:gradation:size-1
method l compute image
  arg_rw ImageLut l ; oarg ImagePrototype image
  addressof:l map ImagePrototype := addressof:image map ImagePrototype
  l image :> image
  l:buffers size := image line_size
  l:remain size := l:line_size+l:gamut:pixel_size
  for (var Int i) 0 l:remain:size-1
    l:remain i := 0
  l maxi := 0
  for (var Int d) 0 l:gradation:size-1
    for (var Int i) 0 254
      c maxi := max c:maxi (c:gradation:d i+1)-(c:gradation:d i)
  c random_available := 0
      l maxi := max l:maxi (l:gradation:d i+1)-(l:gradation:d i)
  l random_available := 0

method c bind image options -> status
  arg_rw ImageLut c ; oarg ImagePrototype image ; arg Str options ; arg ExtendedStatus status
  c:gradation size := image:gamut dimension
  for (var Int d) 0 c:gradation:size-1
method l bind image options -> status
  arg_rw ImageLut l ; oarg ImagePrototype image ; arg Str options ; arg ExtendedStatus status
  l:gradation size := image:gamut dimension
  for (var Int d) 0 l:gradation:size-1
    var Float exposure := options option "exposure"+string:d Float (options option "exposure" Float)
    var Float contrast := options option "contrast"+string:d Float (options option "contrast" Float)
    var Float multiply := options option "multiply"+string:d Float (options option "multiply" Float)
    var Float add := options option "add"+string:d Float (options option "add" Float)
    var Float minimum := options option "minimum"+string:d Float (options option "minimum" Float)
    var Float maximum := options option "maximum"+string:d Float (options option "maximum" Float)
    for (var Int i) 0 255
      var Float f := i/255
      if exposure=defined
        f := exposure f exposure
      if contrast=defined
        f := contrast f contrast
      if multiply=defined
        f *= multiply
      if add=defined
        f += add
      if minimum=defined
        f := min f minimum
      if maximum=defined
        f := max f maximum
      c:gradation:d i := f*255
  c compute image
      l:gradation:d i := f*255
  l compute image
  status := success

method c bind image curve range_x range_y options -> status
  arg_rw ImageLut c ; oarg ImagePrototype image ; arg Curve curve ; arg Float range_x range_y ; arg Str options ; arg ExtendedStatus status
  c:gradation size := image:gamut dimension
  for (var Int d) 0 c:gradation:size-1
method l bind image curve range_x range_y options -> status
  arg_rw ImageLut l ; oarg ImagePrototype image ; arg Curve curve ; arg Float range_x range_y ; arg Str options ; arg ExtendedStatus status
  l:gradation size := image:gamut dimension
  for (var Int d) 0 l:gradation:size-1
    for (var Int i) 0 255
      if (options option "invert")
        c:gradation:d i := (curve x i/255*range_y 1e-6)/range_x*255
        l:gradation:d i := (curve x i/255*range_y 1e-6)/range_x*255
      else
        c:gradation:d i := (curve y i/255*range_x 1e-6)/range_y*255
  c compute image
        l:gradation:d i := (curve y i/255*range_x 1e-6)/range_y*255
  l compute image
  if buggy
    if (options option "monotonous")
      for (var Int i) 0 999
        if (curve x_param (i+1)/1000)<=(curve x_param i/1000)
          return failure:"Gradation curve is buggy"
        if (curve y_param (i+1)/1000)<=(curve y_param i/1000)
          return failure:"Gradation curve is buggy"
      for (var Int d) 0 c:gradation:size-1
      for (var Int d) 0 l:gradation:size-1
        for (var Int i) 0 255
          if (c:gradation:d i)=undefined
          if (l:gradation:d i)=undefined
            return failure:"Gradation is not properly defined"
          if (c:gradation:d i)<(-0.1) or (c:gradation:d i)>255.1
          if (l:gradation:d i)<(-0.1) or (l:gradation:d i)>255.1
            return failure:"Gradation is out of range"
        for (var Int i) 0 254
          if (c:gradation:d i+1)<=(c:gradation:d i)
          if (l:gradation:d i+1)<=(l:gradation:d i)
            return failure:"Gradation is not monotonous"
      if c:maxi=undefined or c:maxi<0 or c:maxi>255
      if l:maxi=undefined or l:maxi<0 or l:maxi>255
        return failure:"Maximum gradation step is out of range"
  status := success


method c read x y count adr
  oarg_rw ImageLut c ; arg Int x y count ; arg Address adr
  var Int dim := c:gamut dimension
  var Int psize := c pixel_size
  check c:gradation:size=dim
  var Address buffer := c:buffers allocate
  c:image read x y count buffer
method l read x y count adr
  oarg_rw ImageLut l ; arg Int x y count ; arg Address adr
  var Int dim := l:gamut dimension
  var Int psize := l pixel_size
  check l:gradation:size=dim
  var Address buffer := l:buffers allocate
  l:image read x y count buffer
  var Address src := buffer
  var Address stop := src translate uInt8 count*psize
  var Address dest := adr
  var (Pointer Array:(Array Float32 256)) gradation :> c gradation
  var Pointer:Float32 remain :> c:remain x*psize
  var Float maxi := c maxi
  var uInt bits := c random_bits ; var Int available := c random_available
  var (Pointer Array:(Array Float32 256)) gradation :> l gradation
  var Pointer:Float32 remain :> l:remain x*psize
  var Float maxi := l maxi
  var uInt bits := l random_bits ; var Int available := l random_available
  while src<>stop
    for (var Int i) 0 dim-1
      var Pointer:(Array Float32 256) g :> gradation i
      var Float f := remain+g:(src map uInt8)
      var Int v := bound (cast f Int) 0 255
      dest map uInt8 := v
      f -= v
      if f<(-maxi)
        f := -maxi
      if f>maxi
        f := maxi
      if available=0
        memory_random addressof:bits uInt:size
        available := uInt:size*8
      if (bits .and. 1)<>0 # send to the right
        remain := 0
        addressof:remain map Float32 psize := f
      else # send to the bottom
        remain := f
      bits := bits\2 ; available -= 1
      src := src translate uInt8 1
      dest := dest translate uInt8 1
      remain :> addressof:remain map Float32 1
    if psize>dim
      memory_copy src dest psize-dim
      src := src translate uInt8 psize-dim
      dest := dest translate uInt8 psize-dim
      remain :> addressof:remain map Float32 psize-dim
  c random_bits := bits
  c random_available := available
  c:buffers free buffer
  l random_bits := bits
  l random_available := available
  l:buffers free buffer


export ImageLut '. bind'