Patch title: Release 92 bulk changes
Abstract:
File: /graphic/color/adjust.pli
Key:
    Removed line
    Added line
module "/pliant/language/compiler.pli"
module "/pliant/math/functions.pli"
module "spectrum.pli"
module "color.pli"
module "database.pli"


constant h 6.6262e-34
constant c 2.99792458e8
constant k 1.3807e-23

function planck_law t w -> e
  arg Float t w e
  e := (2*h*c^2)/w^5/((exp h*c/w/k/t)-1)

function planckian_radiator t -> s
  arg Float t ; arg ColorSpectrum s
  s set_step 10
  for (var Int i) 380 780 step 10
    s set_measure i (planck_law t i*1e-9)


function color_do_adjust xyz options
  arg_rw ColorXYZ xyz ; arg Str options
  if options:len=0
    return
  var ColorXYZn xyzn := cast xyz ColorXYZn
  var Float dull := options option "dull" Float
  if dull=defined and dull<0
    var Float z := options option "dull_X" Float dull ; xyzn X := z+xyzn:X*(1-z)
    var Float z := options option "dull_Y" Float dull ; xyzn Y := z+xyzn:Y*(1-z)
    var Float z := options option "dull_Z" Float dull ; xyzn Z := z+xyzn:Z*(1-z)
  var Float exposure := options option "exposure" Float
  var Float dark := options option "dark" Float
  var Float light := options option "light" Float
  var Float contrast := options option "contrast" Float
  if exposure=defined or dark=defined or light=defined or contrast=defined
    xyzn X := exposure xyzn:X 0.25
    xyzn Y := exposure xyzn:Y 0.25
    xyzn Z := exposure xyzn:Z 0.25
    if exposure=defined
      xyzn X := exposure xyzn:X exposure
      xyzn Y := exposure xyzn:Y exposure
      xyzn Z := exposure xyzn:Z exposure
    if dark=defined
      var Float f := xyzn:X ^ (1+dark) ; if f=defined { xyzn X := f }
      var Float f := xyzn:Y ^ (1+dark) ; if f=defined { xyzn Y := f }
      var Float f := xyzn:Z ^ (1+dark) ; if f=defined { xyzn Z := f }
    if light=defined
      var Float f := (1-xyzn:X) ^ (1+light) ; if f=defined { xyzn X := 1-f }
      var Float f := (1-xyzn:Y) ^ (1+light) ; if f=defined { xyzn Y := 1-f }
      var Float f := (1-xyzn:Z) ^ (1+light) ; if f=defined { xyzn Z := 1-f }
    if contrast=defined
      var Float f := (xyzn:Y-0.5)*contrast
      xyzn X := exposure xyzn:X f
      xyzn Y := exposure xyzn:Y f
      xyzn Z := exposure xyzn:Z f
    xyzn X := unexposure xyzn:X 0.25
    xyzn Y := unexposure xyzn:Y 0.25
    xyzn Z := unexposure xyzn:Z 0.25
  if dull=defined and dull>0
    var Float z := options option "dull_X" Float dull ; xyzn X := z+xyzn:X*(1-z)
    var Float z := options option "dull_Y" Float dull ; xyzn Y := z+xyzn:Y*(1-z)
    var Float z := options option "dull_Z" Float dull ; xyzn Z := z+xyzn:Z*(1-z)
  var Float s_temperature := options option "source_temperature" Float 5000
  var Float temperature := options option "temperature" Float 5000
  var Float s_orthogonal := options option "source_orthogonal" Float 5000
  var Float orthogonal := options option "orthogonal" Float 5000
  if temperature<>s_temperature or orthogonal<>s_orthogonal or (options search "grey_" -1)<>(-1)
    var ColorSpectrum32 s := cast 1 ColorSpectrum32
    var ColorSpectrum32 so := cast 1 ColorSpectrum32
    if temperature<>s_temperature
      s *= (planckian_radiator temperature)/(planckian_radiator s_temperature)
    if orthogonal<>s_orthogonal
      so *= (planckian_radiator orthogonal)/(planckian_radiator s_orthogonal)
    for (var Int i) 0 3
      var Str color := shunt i=0 "cyan" i=1 "magenta" i=2 "yellow" "black"
      var Float extra := options option "grey_"+color Float
      if extra=defined
        var Data:ColorChannel primary :> color_database:data:device:"default":channel:color
        s *= (primary:s100/primary:s0)^extra
    var ColorXYZn filter := cast filter_XYZ:s ColorXYZn
    var ColorXYZn filtero := cast filter_XYZ:so ColorXYZn
    xyzn X := exposure xyzn:X (filter:X/filter:Y-1)/2-(filtero:Z/filtero:Y-1)/2
    xyzn Z := exposure xyzn:Z (filter:Z/filter:Y-1)/2+(filtero:X/filtero:Y-1)/2
  var Float saturation
  if ((options (options option_position "saturation" options:len) options:len) parse word:"saturation" (var Float saturation0) (var Float saturation1) any)
    var Float l := exposure xyzn:Y 0.25
    saturation := (1-l)*saturation0+l*saturation1
  else
    saturation := options option "saturation" Float
  if saturation=defined
    xyzn X := xyzn:X*(1+saturation)-saturation*xyzn:Y
    xyzn Z := xyzn:Z*(1+saturation)-saturation*xyzn:Y
  xyz := cast xyzn ColorXYZ

function color_adjust xyz options
  arg_rw ColorXYZ xyz ; arg Str options
  if options:len<>0
    color_do_adjust xyz options
    var Str extra := options option "extra" Str
    if extra<>""
      color_do_adjust xyz extra
    var Str invert := options option "invert" Str
    if invert<>""
      var ColorXYZ ref := xyz
      color_do_adjust ref invert
      xyz X += xyz:X-ref:X
      xyz Y += xyz:Y-ref:Y
      xyz Z += xyz:Z-ref:Z


function color_do_adjust filter options
  arg_rw ColorSpectrum32 filter ; arg Str options
  if options:len=0
    return
  var Float dull := options option "dull" Float
  if dull=defined and dull<0
    filter := (cast dull ColorSpectrum32)+(1-dull)*filter
  var Float exposure := options option "exposure" Float
  var Float dark := options option "dark" Float
  var Float light := options option "light" Float
  if exposure=defined or dark=defined or light=defined
    filter := exposure filter 0.25
    if exposure=defined
      filter := exposure filter exposure
    if dark=defined
      filter := filter ^ (1+dark)
    if light=defined
      filter := (cast 1 ColorSpectrum32) - ( (cast 1 ColorSpectrum32)+(-1)*filter ) ^ (1+light)
    filter := unexposure filter 0.25
  if dull=defined and dull>0
    filter := (cast dull ColorSpectrum32)+(1-dull)*filter
  var Float saturation := options option "saturation" Float
  if saturation=defined
    var Float Y := filter_XYZn:filter Y
    filter := (1+saturation)*filter-saturation*(cast Y ColorSpectrum32)

function color_adjust filter options
  arg_rw ColorSpectrum32 filter ; arg Str options
  if options:len<>0
    color_do_adjust filter options
    var Str extra := options option "extra" Str
    if extra<>""
      color_do_adjust filter extra
    var Str invert := options option "invert" Str
    if invert<>""
      var ColorSpectrum32 ref := filter
      color_do_adjust ref invert
      filter := 2*filter+(-1)*ref


export color_adjust