/pliant/graphic/color/ink.pli
 
 1  abstract 
 2    [Inks simulation] 
 3   
 4   
 5  module "/pliant/language/compiler.pli" 
 6  module "/pliant/math/functions.pli" 
 7  module "/pliant/graphic/misc/float.pli" 
 8  module "spectrum.pli" 
 9  module "color.pli" 
 10  module "adjust.pli" 
 11  module "gradation.pli" 
 12  module "database.pli" 
 13  module "/pliant/language/data/cache.pli" 
 14  module "/pliant/language/compiler/type/inherit.pli" 
 15  module "/pliant/math/curven.pli" 
 16   
 17  constant standard_dot_growth 0.05 
 18  constant extrapolation_exposure 0.25 
 19   
 20   
 21 
 
 22   
 23   
 24  function ink_simulation d s0 s100 f -> s 
 25    arg Float d ; arg ColorSpectrum32 s0 s100 ; arg Function f ; arg ColorSpectrum32 s 
 26    indirect 
 27   
 28  function ink_density color s0 s100 f mode maxi err -> d 
 29    arg ColorSpectrum32 color s0 s100 ; arg Function f ; arg Int mode ; arg Float maxi ; arg_w Float err ; arg Float d 
 30    # mode 0 = raw scalar product, 1 = weighed scalar product, 2 = cmc distance 
 31    := maxi/2 ; var Float step := maxi/4 
 32    while step>=0.0001 
 33      var ColorSpectrum32 got := ink_simulation s0 s100 f 
 34      var ColorSpectrum32 derive := (ink_simulation (min d+0.02 maxi-0.01) s0 s100 f)-(ink_simulation (max d-0.02 0.01) s0 s100 f) 
 35      # var ColorSpectrum32 derive := got-(cast 1 ColorSpectrum32) 
 36      var Float scalprod 
 37      if mode=0 
 38        scalprod := (color-got)*derive integral 
 39      else 
 40        scalprod := (color-got)*derive*Y_spectrum integral 
 41      if scalprod=undefined 
 42        := undefined 
 43        err := undefined 
 44        return 
 45      eif scalprod>0 
 46        += step 
 47      eif scalprod<0 
 48        -= step 
 49      step := step*0.5 
 50    if mode=2 
 51      var ColorXYZ wished := filter_XYZ color/s0 
 52      err := cmc_distance (filter_XYZ (ink_simulation s0 s100 f)/s0) wished 
 53      step := 0.01 
 54      while step>=0.0001 
 55        if d>=step and { var Float err2 := cmc_distance (filter_XYZ (ink_simulation d-step s0 s100 f)/s0) wished ; err2<err } 
 56          -= step ; err := err2 
 57        eif d+step<=maxi and { var Float err2 := cmc_distance (filter_XYZ (ink_simulation d+step s0 s100 f)/s0) wished ; err2<err } 
 58          += step ; err := err2 
 59        else 
 60          step /= 2     
 61      got := ink_simulation s0 s100 f 
 62    err := ((color-got)*Y_spectrum):modulus/((s100-s0)*Y_spectrum):modulus 
 63   
 64   
 65  function ink_linear_simulation d s0 s100 -> s 
 66    arg Float d ; arg ColorSpectrum32 s0 s100 ; arg ColorSpectrum32 s 
 67    := (1-d)*s0+d*s100 
 68    
 69  function ink_linear color s0 s100 -> d 
 70    arg ColorSpectrum32 color s0 s100 ; arg Float d 
 71    := ink_density color s0 s100 (the_function ink_linear_simulation Float ColorSpectrum32 ColorSpectrum32 -> ColorSpectrum32) 1 1 (var Float err) 
 72   
 73   
 74  function ink_thickness_simulation d s0 s100 -> s 
 75    arg Float d ; arg ColorSpectrum32 s0 s100 ; arg ColorSpectrum32 s 
 76    # s := s0^(1-d)*s100^d 
 77    := (s100/s0)^d*s0 
 78   
 79  function ink_thickness color s0 s100 -> d 
 80    arg ColorSpectrum32 color s0 s100 ; arg Float d 
 81    := ink_density color s0 s100 (the_function ink_thickness_simulation Float ColorSpectrum32 ColorSpectrum32 -> ColorSpectrum32) 1 1 (var Float err) 
 82   
 83  function ink_thickness color s0 s100 maxi -> d 
 84    arg ColorSpectrum32 color s0 s100 ; arg Float maxi ; arg Float d 
 85    := ink_density color s0 s100 (the_function ink_thickness_simulation Float ColorSpectrum32 ColorSpectrum32 -> ColorSpectrum32) maxi (var Float err) 
 86   
 87   
 88  function ink_surface_simulation d s0 s50 s100 -> s 
 89    arg Float d ; arg ColorSpectrum32 s0 s50 s100 ; arg ColorSpectrum32 s 
 90    # s := (1-d)*(1-2*d)*s0+4*d*(1-d)*s50+d*(2*d-1)*s100 
 91    := (1-d)*(1-d)*s0+2*d*(1-d)*(2*s50-0.5*s0-0.5*s100)+d*d*s100 
 92   
 93  function ink_surface_simulation d s0 s100 -> s 
 94    arg Float d ; arg ColorSpectrum32 s0 s100 ; arg ColorSpectrum32 s 
 95    := (1-d)*(1-d)*s0+2*d*(1-d)*(s0^0.5*s100^0.5)+d*d*s100 
 96   
 97  function ink_surface color s0 s100 -> d 
 98    arg ColorSpectrum32 color s0 s100 ; arg Float d 
 99    := ink_density color s0 s100 (the_function ink_surface_simulation Float ColorSpectrum32 ColorSpectrum32 -> ColorSpectrum32) 1 1 (var Float err) 
 100   
 101   
 102  function ink_dot_growth d growth -> d2 
 103    arg Float growth d2 
 104    # d2 := d+4*growth*d*(1-d) 
 105    d2 := exposure growth 
 106   
 107  function ink_density_simulation d s0 s100 -> s 
 108    arg Float d ; arg ColorSpectrum32 s0 s100 ; arg ColorSpectrum32 s 
 109    := ink_surface_simulation (ink_dot_growth standard_dot_growth) s0 s100 
 110   
 111  function ink_density color s0 s100 -> d 
 112    arg ColorSpectrum32 color s0 s100 ; arg Float d 
 113    := ink_density color s0 s100 (the_function ink_density_simulation Float ColorSpectrum32 ColorSpectrum32 -> ColorSpectrum32) 1 1 (var Float err) 
 114   
 115   
 116  export ink_linear_simulation ink_linear 
 117  export ink_thickness_simulation ink_thickness 
 118  export ink_surface_simulation ink_surface 
 119  export ink_dot_growth 
 120  export ink_density_simulation ink_density 
 121   
 122   
 123 
 
 124   
 125   
 126  type ColorFast 
 127    field ColorRGB rgb 
 128     
 129  type ColorInkFastFilter 
 130    field Float32 r_filter r_generator 
 131    field Float32 g_filter g_generator 
 132    field Float32 b_filter b_generator 
 133   
 134  type ColorInk 
 135    inherit CachePrototype 
 136    field (Array ColorInkFastFilter encoded_resolution) fast_filter 
 137    field (Array ColorSpectrum32 encoded_resolution) filter 
 138    field ColorGradation gradation 
 139    field ColorSpectrum32 s0 s50 s100 
 140    field Float opacity 
 141    field Float deaden 
 142    field (Array ColorSpectrum32 encoded_resolution) deaden_filter 
 143    field Int maximum 
 144    field Str options 
 145    field Status status <- failure 
 146   
 147  CachePrototype maybe ColorInk 
 148   
 149  function 'cast Status' ink -> status 
 150    arg ColorInk ink ; arg Status status 
 151    extension 
 152    status := ink status 
 153   
 154   
 155  gvar Dictionary colors 
 156  gvar Sem sem 
 157   
 158   
 159  doc 
 160    [Here is how an ink is assumed to modify a color (fast and unaccurate algorithm):] 
 161   
 162  method cf init 
 163    arg_w ColorFast cf 
 164    cf:rgb := 1 ; cf:rgb := 1 ; cf:rgb := 1 
 165   
 166  method cf apply ink l 
 167    arg_rw ColorFast cf ; arg ColorInk ink ; arg Int l 
 168    var Pointer:ColorInkFastFilter :> ink:fast_filter l 
 169    cf:rgb := cf:rgb:r*p:r_filter+p:r_generator 
 170    cf:rgb := cf:rgb:g*p:g_filter+p:g_generator 
 171    cf:rgb := cf:rgb:b*p:b_filter+p:b_generator 
 172   
 173  method cf terminate rgb 
 174    arg_rw ColorFast cf ; arg_w ColorRGB888 rgb 
 175    rgb := cf rgb 
 176   
 177   
 178  doc 
 179    [And this is the function that will load (compute and cache) the ink definition from the Pliant color database.] 
 180   
 181   
 182  function adjust f0 options quantity -> f 
 183    arg ColorSpectrum32 f0 ; arg Str options ; arg Float quantity ; arg ColorSpectrum32 f 
 184    := f0 
 185    if f=undefined 
 186      return 
 187    var Float zero := options option "zero" Float 
 188    if zero=defined 
 189      := (cast -zero ColorSpectrum32)+(1+zero)*f 
 190    color_adjust f (options option "ink_adjust" Str) 
 191    var Float density := options option "density" Float 1 
 192    if density<>1 
 193      := f^density 
 194    if quantity>0 
 195      for (var Int i) 0 3 
 196        var Str color := shunt i="cyan" i="magenta" i="yellow" "black" 
 197        var Float extra := options option color Float 
 198        if extra=defined 
 199          var Data:ColorChannel primary :> color_database:data:device:"default":channel:color 
 200          *= (primary:s100/primary:s0)^(extra*quantity) 
 201   
 202  function color_ink name options -> ink 
 203    arg Str name options ; arg Link:ColorInk ink 
 204    if (cache_open "/pliant/color/ink/"+string:name+options ColorInk ((addressof Link:ColorInk ink) map Link:CachePrototype)) 
 205      part build 
 206        if not (name parse any:(var Str device_id) ":" any:(var Str channel_id)) 
 207          device_id := "default" ; channel_id := name 
 208        var Data:ColorChannel channel :> color_database:data:device:device_id:channel:channel_id 
 209        if not exists:channel and (exists color_database:data:device:device_id:alias:channel_id) 
 210          var Str alias := color_database:data:device:device_id:alias:channel_id 
 211          channel :> color_database:data:device:device_id:channel:alias 
 212        if channel:s0=undefined or channel:s100=undefined 
 213          ink status := failure 
 214          leave build 
 215        var Str opt := options+" "+channel:options+" "+color_database:data:device:device_id:options 
 216        ink s0 := adjust channel:s0 opt 0 
 217        ink s50 := adjust channel:s50 opt 0.5 
 218        ink s100 := adjust channel:s100 opt 1 
 219        ink opacity := opt option "opacity" Float 0 
 220        ink deaden := opt option "deaden" Float 0 
 221        ink maximum := opt option "maximum" Int 255 
 222        var CBool negative := opt option "negative" 
 223        var CBool linear := opt option "linear" 
 224        var CBool surface := opt option "surface" 
 225        var Int maxi := shunt (exists channel:sample:"255") 255 100 
 226        ink options := opt 
 227        var (Index Int ColorSpectrum32) samples 
 228        each sample channel:sample 
 229          if (keyof:sample parse (var Int index)) 
 230            samples insert index (adjust color_spectrum32:sample opt index/maxi) 
 231        (var (Array Array:Float) points) size := 1 
 232        each sample2 samples 
 233          points += (samples key sample2)/maxi 
 234        var Curven curven 
 235        curven resize ColorSpectrum32:size\Float32:size points 
 236        (var Array:Float param) size := 1 
 237        (var Array:Float point) size := ColorSpectrum32:size\Float32:size 
 238        each sample2 samples 
 239          param := (samples key sample2)/maxi 
 240          for (var Int i) 0 ColorSpectrum32:size\Float32:size-1 
 241            point := addressof:sample2 map Float32 i 
 242            if not linear 
 243              point := log point:i 
 244          curven define param point 
 245        for (var Int l) 0 encoded_resolution-1 
 246          var Float := exposure (shunt negative encoded_resolution-1-l)/(encoded_resolution-1) (opt option "middle" Float 0)  
 247          var ColorSpectrum32 s 
 248          if surface and samples:size=2 
 249            := ink_surface_simulation ink:s0 ink:s100 
 250          eif surface and samples:size=and ink:s50<>undefined 
 251            := ink_surface_simulation ink:s0 ink:s50 ink:s100 
 252          else 
 253            param := d 
 254            point := curven apply param 
 255            for (var Int i) 0 ColorSpectrum32:size\Float32:size-1 
 256              if not linear 
 257                point := exp point:i 
 258              addressof:map Float32 := point i 
 259          if not (opt option "invisible") 
 260            := ink_thickness ink:s0 ink:s100 
 261          if l=or l=encoded_resolution-1 
 262            := shunt d<0.001 0 d>0.999 1 d 
 263          ink:gradation:decode_table := shunt negative 1-d 
 264          ink:filter := s/ink:s0 
 265          ink:deaden_filter := exposure (-1)*(log ink:filter:l) (-ink:deaden) 
 266          var Pointer:ColorInkFastFilter :> ink:fast_filter l 
 267          var ColorRGB rgb := cast (filter_XYZ ink:filter:l) ColorRGB 
 268          rgb := bound rgb:0 1 
 269          rgb := bound rgb:0 1 
 270          rgb := bound rgb:0 1 
 271          var Float := l/(encoded_resolution-1)*ink:opacity*ink:opacity 
 272          r_filter := (1-o)*rgb:r ; r_generator := o*rgb:r 
 273          g_filter := (1-o)*rgb:g ; g_generator := o*rgb:g 
 274          b_filter := (1-o)*rgb:b ; b_generator := o*rgb:b 
 275        ink status := success 
 276        ink:gradation compute 
 277        if ink:gradation=failure 
 278          ink status := failure 
 279      if ink:status=success 
 280        cache_ready ((addressof Link:ColorInk ink) map Link:CachePrototype) 
 281      else 
 282        cache_cancel ((addressof Link:ColorInk ink) map Link:CachePrototype) 
 283   
 284  function color_ink name -> ink 
 285    arg Str name ; arg Link:ColorInk ink 
 286    ink :> color_ink name "" 
 287   
 288   
 289  export ColorInk 'cast Status' color_ink 
 290  export '. filter' '. gradation' '. s0' '. s50' '. s100' 
 291  export '. opacity' '. maximum' '. options' 
 292  export '. deaden' '. deaden_filter' 
 293  export ColorFast '. init' '. apply' '. terminate'