/pliant/graphic/color/adjust.pli
 
 1  module "/pliant/language/compiler.pli" 
 2  module "/pliant/math/functions.pli" 
 3  module "/pliant/math/curve.pli" 
 4  module "spectrum.pli" 
 5  module "color.pli" 
 6  module "database.pli" 
 7   
 8   
 9  constant h 6.6262e-34 
 10  constant c 2.99792458e8 
 11  constant k 1.3807e-23 
 12   
 13  function planck_law t w -> e 
 14    arg Float e 
 15    := (2*h*c^2)/w^5/((exp h*c/w/k/t)-1) 
 16   
 17  function planckian_radiator t -> s 
 18    arg Float t ; arg ColorSpectrum s 
 19    set_step 10 
 20    for (var Int i) 380 780 step 10 
 21      set_measure i (planck_law i*1e-9) 
 22   
 23   
 24  function color_do_adjust xyz options 
 25    arg_rw ColorXYZ xyz ; arg Str options 
 26    if options:len=0 
 27      return 
 28    var ColorXYZn xyzn := cast xyz ColorXYZn 
 29    var Float dull := options option "dull" Float 
 30    if dull=defined and dull<0 
 31      var Float := options option "dull_X" Float dull ; xyzn := z+xyzn:X*(1-z) 
 32      var Float := options option "dull_Y" Float dull ; xyzn := z+xyzn:Y*(1-z) 
 33      var Float := options option "dull_Z" Float dull ; xyzn := z+xyzn:Z*(1-z) 
 34    var Float exposure := options option "exposure" Float 
 35    var Float dark := options option "dark" Float 
 36    var Float light := options option "light" Float 
 37    var Float contrast := options option "contrast" Float 
 38    if exposure=defined or dark=defined or light=defined or contrast=defined 
 39      xyzn := exposure xyzn:0.25 
 40      xyzn := exposure xyzn:0.25 
 41      xyzn := exposure xyzn:0.25 
 42      if exposure=defined 
 43        xyzn := exposure xyzn:exposure 
 44        xyzn := exposure xyzn:exposure 
 45        xyzn := exposure xyzn:exposure 
 46      if dark=defined 
 47        var Float := xyzn:^ (1+dark) ; if f=defined { xyzn := f } 
 48        var Float := xyzn:^ (1+dark) ; if f=defined { xyzn := f } 
 49        var Float := xyzn:^ (1+dark) ; if f=defined { xyzn := f } 
 50      if light=defined 
 51        var Float := (1-xyzn:X) ^ (1+light) ; if f=defined { xyzn := 1-f } 
 52        var Float := (1-xyzn:Y) ^ (1+light) ; if f=defined { xyzn := 1-f } 
 53        var Float := (1-xyzn:Z) ^ (1+light) ; if f=defined { xyzn := 1-f } 
 54      if contrast=defined 
 55        var Float := (xyzn:Y-0.5)*contrast 
 56        xyzn := exposure xyzn:f 
 57        xyzn := exposure xyzn:f 
 58        xyzn := exposure xyzn:f 
 59      xyzn := unexposure xyzn:0.25 
 60      xyzn := unexposure xyzn:0.25 
 61      xyzn := unexposure xyzn:0.25 
 62    if dull=defined and dull>0 
 63      var Float := options option "dull_X" Float dull ; xyzn := z+xyzn:X*(1-z) 
 64      var Float := options option "dull_Y" Float dull ; xyzn := z+xyzn:Y*(1-z) 
 65      var Float := options option "dull_Z" Float dull ; xyzn := z+xyzn:Z*(1-z) 
 66    var Float s_temperature := options option "source_temperature" Float 5000 
 67    var Float temperature := options option "temperature" Float 5000 
 68    var Float s_orthogonal := options option "source_orthogonal" Float 5000 
 69    var Float orthogonal := options option "orthogonal" Float 5000 
 70    if temperature<>s_temperature or orthogonal<>s_orthogonal or (options search "grey_" -1)<>(-1) 
 71      var ColorSpectrum32 := cast ColorSpectrum32 
 72      var ColorSpectrum32 so := cast ColorSpectrum32 
 73      if temperature<>s_temperature 
 74        *= (planckian_radiator temperature)/(planckian_radiator s_temperature) 
 75      if orthogonal<>s_orthogonal 
 76        so *= (planckian_radiator orthogonal)/(planckian_radiator s_orthogonal) 
 77      for (var Int i) 0 3 
 78        var Str color := shunt i="cyan" i="magenta" i="yellow" "black" 
 79        var Float extra := options option "grey_"+color Float 
 80        if extra=defined 
 81          var Data:ColorChannel primary :> color_database:data:device:"default":channel:color 
 82          *= (primary:s100/primary:s0)^extra 
 83      var ColorXYZn filter := cast filter_XYZ:ColorXYZn 
 84      var ColorXYZn filtero := cast filter_XYZ:so ColorXYZn 
 85      xyzn := exposure xyzn:X (filter:X/filter:Y-1)/2-(filtero:Z/filtero:Y-1)/2 
 86      xyzn := exposure xyzn:Z (filter:Z/filter:Y-1)/2+(filtero:X/filtero:Y-1)/2 
 87    var Float saturation 
 88    if ((options (options option_position "saturation" options:len) options:len) parse word:"saturation" (var Float saturation0) (var Float saturation1) any) 
 89      var Float := exposure xyzn:0.25 
 90      saturation := (1-l)*saturation0+l*saturation1 
 91    else 
 92      saturation := options option "saturation" Float 
 93    if saturation=defined 
 94      xyzn := xyzn:X*(1+saturation)-saturation*xyzn:Y 
 95      xyzn := xyzn:Z*(1+saturation)-saturation*xyzn:Y 
 96    xyz := cast xyzn ColorXYZ 
 97   
 98  function color_adjust xyz options 
 99    arg_rw ColorXYZ xyz ; arg Str options 
 100    if options:len<>0 
 101      color_do_adjust xyz options 
 102      var Str extra := options option "extra" Str 
 103      if extra<>"" 
 104        color_do_adjust xyz extra 
 105      var Str invert := options option "invert" Str 
 106      if invert<>"" 
 107        var ColorXYZ ref := xyz 
 108        color_do_adjust ref invert 
 109        xyz += xyz:X-ref:X 
 110        xyz += xyz:Y-ref:Y 
 111        xyz += xyz:Z-ref:Z 
 112   
 113   
 114  function color_do_adjust filter options 
 115    arg_rw ColorSpectrum32 filter ; arg Str options 
 116    if options:len=0 
 117      return 
 118    var Float dull := options option "dull" Float 
 119    if dull=defined and dull<0 
 120      filter := (cast dull ColorSpectrum32)+(1-dull)*filter 
 121    var Float exposure := options option "exposure" Float 
 122    var Float dark := options option "dark" Float 
 123    var Float light := options option "light" Float 
 124    if exposure=defined or dark=defined or light=defined 
 125      filter := exposure filter 0.25 
 126      if exposure=defined 
 127        filter := exposure filter exposure 
 128      if dark=defined 
 129        filter := filter ^ (1+dark) 
 130      if light=defined 
 131        filter := (cast ColorSpectrum32) - ( (cast ColorSpectrum32)+(-1)*filter ) ^ (1+light) 
 132      filter := unexposure filter 0.25 
 133    if dull=defined and dull>0 
 134      filter := (cast dull ColorSpectrum32)+(1-dull)*filter 
 135    var Float saturation := options option "saturation" Float 
 136    if saturation=defined 
 137      var Float := filter_XYZn:filter Y 
 138      filter := (1+saturation)*filter-saturation*(cast ColorSpectrum32) 
 139   
 140  function color_adjust filter options 
 141    arg_rw ColorSpectrum32 filter ; arg Str options 
 142    if options:len<>0 
 143      color_do_adjust filter options 
 144      var Str extra := options option "extra" Str 
 145      if extra<>"" 
 146        color_do_adjust filter extra 
 147      var Str invert := options option "invert" Str 
 148      if invert<>"" 
 149        var ColorSpectrum32 ref := filter 
 150        color_do_adjust ref invert 
 151        filter := 2*filter+(-1)*ref 
 152   
 153   
 154  function dot_adjust x spec -> y 
 155    arg Float y ; arg Str spec 
 156    # curve x and y range is 0 1 
 157    var Str header := spec option "header" Str 
 158    var Str header2 := spec option "header2" Str 
 159    var Float density := spec option header+"density" Float (spec option header2+"density" Float 1) 
 160    var Float middle := spec option header+"middle" Float (spec option header2+"middle" Float 0) 
 161    var Float bottom := spec option header+"bottom" Float (spec option header2+"bottom" Float middle) 
 162    var Float bottom2 := spec option header+"bottom2" Float (spec option header2+"bottom2" Float bottom) 
 163    var Float top := spec option header+"top" Float (spec option header2+"top" Float middle) 
 164    var Float top2 := spec option header+"top2" Float (spec option header2+"top2" Float top) 
 165    var Float f0 := 0.5+0.5*(sin pi*( (0.5+0.5*(sin pi*(0.5-x)))^0.5)) 
 166    var Float xx := 1-(1-x)^2 ; if xx=undefined { xx := 1 } 
 167    var Float f00 := 0.5+0.5*(sin pi*( (0.5+0.5*(sin pi*(0.5-xx)))^0.5)) 
 168    var Float f1 := 0.5+0.5*(sin pi*( (0.5+0.5*(sin pi*(x-0.5)))^0.5)) 
 169    var Float xx := x^2 ; if xx=undefined { xx := 0 } 
 170    var Float f11 := 0.5+0.5*(sin pi*( (0.5+0.5*(sin pi*(xx-0.5)))^0.5)) 
 171    # y := (exposure x f0*bottom+(1-f0-f1)*middle+f1*top)*density 
 172    := (exposure f00*bottom2+(f0-f00)*bottom+(1-f0-f1)*middle+(f1-f11)*top+f11*top2)*density 
 173   
 174  function dot_unadjust y spec -> x 
 175    arg Float y ; arg Str spec 
 176    var Str header := spec option "header" Str 
 177    var Str header2 := spec option "header2" Str 
 178    var Float density := spec option header+"density" Float (spec option header2+"density" Float 1) 
 179    var Float middle := spec option header+"middle" Float (spec option header2+"middle" Float 0) 
 180    var Float bottom := spec option header+"bottom" Float (spec option header2+"bottom" Float middle) 
 181    var Float bottom2 := spec option header+"bottom2" Float (spec option header2+"bottom2" Float bottom) 
 182    var Float top := spec option header+"top" Float (spec option header2+"top" Float middle) 
 183    var Float top2 := spec option header+"top2" Float (spec option header2+"top2" Float top) 
 184    var Float bottom_power := spec option header+"bottom_power" Float (spec option header2+"bottom_power" Float 0) 
 185    var Float top_power := spec option header+"top_power" Float (spec option header2+"top_power" Float 0) 
 186    var Float f0 := 0.5+0.5*(sin pi*( (0.5+0.5*(sin pi*(0.5-y)))^0.5)) 
 187    var Float yy := 1-(1-y)^2 ; if yy=undefined { yy := 1 } 
 188    var Float f00 := 0.5+0.5*(sin pi*( (0.5+0.5*(sin pi*(0.5-yy)))^0.5)) 
 189    var Float f1 := 0.5+0.5*(sin pi*( (0.5+0.5*(sin pi*(y-0.5)))^0.5)) 
 190    var Float yy := y^2 ; if yy=undefined { yy := 0 } 
 191    var Float f11 := 0.5+0.5*(sin pi*( (0.5+0.5*(sin pi*(yy-0.5)))^0.5)) 
 192    # x := (unexposure y f0*bottom+(1-f0-f1)*middle+f1*top)^(exp exp:1*((1-y)*bottom_power+y*top_power))/density 
 193    := (unexposure 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 
 194    if x=undefined 
 195      := 0 
 196   
 197  function dot_adjust_optimize spec -> spec2 
 198    arg Str spec spec2 
 199    var Str header := spec option "header" Str 
 200    var Str header2 := spec option "header2" Str 
 201    var Float density := spec option header+"density" Float (spec option header2+"density" Float 1) 
 202    var Float middle := spec option header+"middle" Float (spec option header2+"middle" Float 0) 
 203    var Float bottom := spec option header+"bottom" Float (spec option header2+"bottom" Float middle) 
 204    var Float bottom2 := spec option header+"bottom2" Float (spec option header2+"bottom2" Float bottom) 
 205    var Float top := spec option header+"top" Float (spec option header2+"top" Float middle) 
 206    var Float top2 := spec option header+"top2" Float (spec option header2+"top2" Float top) 
 207    var Float bottom_power := spec option header+"bottom_power" Float (spec option header2+"bottom_power" Float 0) 
 208    var Float top_power := spec option header+"top_power" Float (spec option header2+"top_power" Float 0) 
 209    spec2 := "" 
 210    if density<>1 
 211      spec2 += " density "+string:density 
 212    if middle<>0 
 213      spec2 += " middle "+string:middle 
 214    if bottom<>middle 
 215      spec2 += " bottom "+string:bottom 
 216    if bottom2<>bottom 
 217      spec2 += " bottom2 "+string:bottom2 
 218    if top<>middle 
 219      spec2 += " top "+string:top 
 220    if top2<>top 
 221      spec2 += " top2 "+string:top2 
 222    if bottom_power<>0 
 223      spec2 += " bottom_power "+string:bottom_power 
 224    if top_power<>0 
 225      spec2 += " top_power "+string:top_power 
 226    spec2 := spec2 spec2:len 
 227   
 228  export color_adjust dot_adjust dot_unadjust dot_adjust_optimize 
 229   
 230   
 231