module "/pliant/language/compiler.pli"
module "/pliant/math/functions.pli"
module "/pliant/math/curve.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


function dot_adjust x spec -> y
  arg Float x y ; arg Str spec
  # curve x and y range is 0 1
  var Str header := spec option "header" Str
  var Str header2 := spec option "header2" Str
  var Float density := spec option header+"density" Float (spec option header2+"density" Float 1)
  var Float middle := spec option header+"middle" Float (spec option header2+"middle" Float 0)
  var Float bottom := spec option header+"bottom" Float (spec option header2+"bottom" Float middle)
  var Float bottom2 := spec option header+"bottom2" Float (spec option header2+"bottom2" Float bottom)
  var Float top := spec option header+"top" Float (spec option header2+"top" Float middle)
  var Float top2 := spec option header+"top2" Float (spec option header2+"top2" Float top)
  var Float f0 := 0.5+0.5*(sin pi*( (0.5+0.5*(sin pi*(0.5-x)))^2 - 0.5))
  var Float xx := 1-(1-x)^2 ; if xx=undefined { xx := 1 }
  var Float f00 := 0.5+0.5*(sin pi*( (0.5+0.5*(sin pi*(0.5-xx)))^2 - 0.5))
  var Float f1 := 0.5+0.5*(sin pi*( (0.5+0.5*(sin pi*(x-0.5)))^2 - 0.5))
  var Float xx := x^2 ; if xx=undefined { xx := 0 }
  var Float f11 := 0.5+0.5*(sin pi*( (0.5+0.5*(sin pi*(xx-0.5)))^2 - 0.5))
  # y := (exposure x f0*bottom+(1-f0-f1)*middle+f1*top)*density
  y := (exposure x f00*bottom2+(f0-f00)*bottom+(1-f0-f1)*middle+(f1-f11)*top+f11*top2)*density

function dot_unadjust y spec -> x
  arg Float x y ; arg Str spec
  var Str header := spec option "header" Str
  var Str header2 := spec option "header2" Str
  var Float density := spec option header+"density" Float (spec option header2+"density" Float 1)
  var Float middle := spec option header+"middle" Float (spec option header2+"middle" Float 0)
  var Float bottom := spec option header+"bottom" Float (spec option header2+"bottom" Float middle)
  var Float bottom2 := spec option header+"bottom2" Float (spec option header2+"bottom2" Float bottom)
  var Float top := spec option header+"top" Float (spec option header2+"top" Float middle)
  var Float top2 := spec option header+"top2" Float (spec option header2+"top2" Float top)
  var Float bottom_power := spec option header+"bottom_power" Float (spec option header2+"bottom_power" Float 0)
  var Float top_power := spec option header+"top_power" Float (spec option header2+"top_power" Float 0)
  var Float f0 := 0.5+0.5*(sin pi*( (0.5+0.5*(sin pi*(0.5-y)))^2 - 0.5))
  var Float yy := 1-(1-y)^2 ; if yy=undefined { yy := 1 }
  var Float f00 := 0.5+0.5*(sin pi*( (0.5+0.5*(sin pi*(0.5-yy)))^2 - 0.5))
  var Float f1 := 0.5+0.5*(sin pi*( (0.5+0.5*(sin pi*(y-0.5)))^2 - 0.5))
  var Float yy := y^2 ; if yy=undefined { yy := 0 }
  var Float f11 := 0.5+0.5*(sin pi*( (0.5+0.5*(sin pi*(yy-0.5)))^2 - 0.5))
  # x := (unexposure y f0*bottom+(1-f0-f1)*middle+f1*top)^(exp exp:1*((1-y)*bottom_power+y*top_power))/density
  x := (unexposure y f00*bottom2+(f0-f00)*bottom+(1-f0-f1)*middle+(f1-f11)*top+f11*top2)^(exp exp:1*((1-y)*bottom_power+y*top_power))/density
  if x=undefined
    x := 0

function dot_adjust_optimize spec -> spec2
  arg Str spec spec2
  var Str header := spec option "header" Str
  var Str header2 := spec option "header2" Str
  var Float density := spec option header+"density" Float (spec option header2+"density" Float 1)
  var Float middle := spec option header+"middle" Float (spec option header2+"middle" Float 0)
  var Float bottom := spec option header+"bottom" Float (spec option header2+"bottom" Float middle)
  var Float bottom2 := spec option header+"bottom2" Float (spec option header2+"bottom2" Float bottom)
  var Float top := spec option header+"top" Float (spec option header2+"top" Float middle)
  var Float top2 := spec option header+"top2" Float (spec option header2+"top2" Float top)
  var Float bottom_power := spec option header+"bottom_power" Float (spec option header2+"bottom_power" Float 0)
  var Float top_power := spec option header+"top_power" Float (spec option header2+"top_power" Float 0)
  spec2 := ""
  if density<>1
    spec2 += " density "+string:density
  if middle<>0
    spec2 += " middle "+string:middle
  if bottom<>middle
    spec2 += " bottom "+string:bottom
  if bottom2<>bottom
    spec2 += " bottom2 "+string:bottom2
  if top<>middle
    spec2 += " top "+string:top
  if top2<>top
    spec2 += " top2 "+string:top2
  if bottom_power<>0
    spec2 += " bottom_power "+string:bottom_power
  if top_power<>0
    spec2 += " top_power "+string:top_power
  spec2 := spec2 1 spec2:len

export color_adjust dot_adjust dot_unadjust dot_adjust_optimize