Patch title: Release 94 bulk changes
Abstract:
File: /pliant/graphic/color/ink.pli
Key:
    Removed line
    Added line
   
abstract
  [Inks simulation]


module "/pliant/language/compiler.pli"
module "/pliant/math/functions.pli"
module "/pliant/graphic/misc/float.pli"
module "spectrum.pli"
module "color.pli"
module "adjust.pli"
module "gradation.pli"
module "database.pli"
module "/pliant/language/data/cache.pli"
module "/pliant/language/compiler/type/inherit.pli"
abstract
  [Inks simulation]


module "/pliant/language/compiler.pli"
module "/pliant/math/functions.pli"
module "/pliant/graphic/misc/float.pli"
module "spectrum.pli"
module "color.pli"
module "adjust.pli"
module "gradation.pli"
module "database.pli"
module "/pliant/language/data/cache.pli"
module "/pliant/language/compiler/type/inherit.pli"
module "/pliant/math/curven.pli"




function ink_thickness color s0 s100 maxi -> d
  arg ColorSpectrum32 color s0 s100 ; arg Float maxi ; arg Float d
  d := ink_density color s0 s100 (the_function ink_thickness_simulation Float ColorSpectrum32 ColorSpectrum32 -> ColorSpectrum32) 1 maxi (var Float err)



function ink_surface_simulation d s0 s50 s100 -> s
  arg Float d ; arg ColorSpectrum32 s0 s50 s100 ; arg ColorS
  # s := (1-d)*(1-2*d)*s0+4*d*(1-d)*s50+d*(2*d-1)*s100
  s := (1-d)*(1-d)*s0+2*d*(1-d)*(2*s50-0.5*s0-0.5*s100)+d*d*


function ink_dot_growth d growth -> d2
  arg Float d growth d2
function ink_surface_simulation d s0 s50 s100 -> s
  arg Float d ; arg ColorSpectrum32 s0 s50 s100 ; arg ColorS
  # s := (1-d)*(1-2*d)*s0+4*d*(1-d)*s50+d*(2*d-1)*s100
  s := (1-d)*(1-d)*s0+2*d*(1-d)*(2*s50-0.5*s0-0.5*s100)+d*d*


function ink_dot_growth d growth -> d2
  arg Float d growth d2
  d2 := d+4*growth*d*(1-d)
  # d2 := d+4*growth*d*(1-d)
  d2 := exposure d growth


function color_ink name options -> ink
  arg Str name options ; arg Link:ColorInk ink
  if (cache_open "/pliant/color/ink/"+string:name+options Co
    part build
      if not (name parse any:(var Str device_id) ":" any:(va
        device_id := "default" ; channel_id := name
      var Data:ColorChannel channel :> color_database:data:d
      if not exists:channel and (exists color_database:data:
        var Str alias := color_database:data:device:device_i
        channel :> color_database:data:device:device_id:chan
      if channel:s0=undefined or channel:s100=undefined
        ink status := failure
        leave build
      var Str opt := options+" "+channel:options+" "+color_d
      ink s0 := adjust channel:s0 opt 0
      ink s50 := adjust channel:s50 opt 0.5
      ink s100 := adjust channel:s100 opt 1


function color_ink name options -> ink
  arg Str name options ; arg Link:ColorInk ink
  if (cache_open "/pliant/color/ink/"+string:name+options Co
    part build
      if not (name parse any:(var Str device_id) ":" any:(va
        device_id := "default" ; channel_id := name
      var Data:ColorChannel channel :> color_database:data:d
      if not exists:channel and (exists color_database:data:
        var Str alias := color_database:data:device:device_i
        channel :> color_database:data:device:device_id:chan
      if channel:s0=undefined or channel:s100=undefined
        ink status := failure
        leave build
      var Str opt := options+" "+channel:options+" "+color_d
      ink s0 := adjust channel:s0 opt 0
      ink s50 := adjust channel:s50 opt 0.5
      ink s100 := adjust channel:s100 opt 1
      if (opt option "align" Str)<>""
        if not ((opt option "align" Str) parse any:(var Str 
          ink status := failure
          leave build
        var Data:ColorChannel align :> color_database:data:d
        if align:s0=failure or align:s100=failure
          ink status := failure
          leave build
        var Float d := ink_density align:s100/align:s0*ink:s
        console "align for ink " device_id " " channel_id " 
        ink s100 := (ink:s100/ink:s0)^d*ink:s0
      ink opacity := opt option "opacity" Float 0
      ink deaden := opt option "deaden" Float 0
      ink maximum := opt option "maximum" Int 255
      var CBool negative := opt option "negative"
      var CBool linear := opt option "linear"
      ink opacity := opt option "opacity" Float 0
      ink deaden := opt option "deaden" Float 0
      ink maximum := opt option "maximum" Int 255
      var CBool negative := opt option "negative"
      var CBool linear := opt option "linear"
      var CBool thickness := opt option "thickness"
      var CBool surface := opt option "surface"
      var Int maxi := shunt (exists channel:sample:"255") 25
      ink options := opt
      var (Index Int ColorSpectrum32) samples
      each sample channel:sample
        if (keyof:sample parse (var Int index))
          samples insert index (adjust color_spectrum32:samp
      var Int maxi := shunt (exists channel:sample:"255") 25
      ink options := opt
      var (Index Int ColorSpectrum32) samples
      each sample channel:sample
        if (keyof:sample parse (var Int index))
          samples insert index (adjust color_spectrum32:samp
      var Float dot := opt option "dot" Float 0
      (var (Array Array:Float) points) size := 1
      each sample2 samples
        points 0 += (samples key sample2)/maxi
      var Curven curven
      curven resize ColorSpectrum32:size\Float32:size 1 points
      (var Array:Float param) size := 1
      (var Array:Float point) size := ColorSpectrum32:size\Float32:size
      each sample2 samples
        param 0 := (samples key sample2)/maxi
        for (var Int i) 0 ColorSpectrum32:size\Float32:size-1
          point i := addressof:sample2 map Float32 i
          if not linear
            point i := log point:i
        curven define param point
      for (var Int l) 0 encoded_resolution-1
      for (var Int l) 0 encoded_resolution-1
        var Float d := ink_dot_growth (shunt negative encode
        var Float d := exposure (shunt negative encoded_resolution-1-l l)/(encoded_resolution-1) (opt option "middle" Float 0) 
        var ColorSpectrum32 s
        var ColorSpectrum32 s
        if samples:size=3 and ink:s50<>undefined
          s := ink_surface_simulation d ink:s0 ink:s50 ink:s
        eif samples:size=2 # we have only 0 and 100% so we a
        if surface and samples:size=2
          s := ink_surface_simulation d ink:s0 ink:s100
          s := ink_surface_simulation d ink:s0 ink:s100
        else # we have more than three values, so we assume 
          var Pointer:ColorSpectrum32 a :> samples first
          var Pointer:ColorSpectrum32 b :> samples next a
          while (samples key b)<d*maxi
            a :> b ; b :> samples next a
          s := unexposure (ink_linear_simulation (d*maxi-(sa
          if not linear
            d := ink_surface s ink:s0 ink:s100
        if thickness
          var Float d2 := ink_thickness s ink:s0 ink:s100
          s := ink_thickness_simulation d2 ink:s0 ink:s100
        var Float specular := options option "passive_specul
        eif surface and samples:size=3 and ink:s50<>undefined
          s := ink_surface_simulation d ink:s0 ink:s50 ink:s100
        else
          param 0 := d
          point := curven apply param
          for (var Int i) 0 ColorSpectrum32:size\Float32:size-1
            if not linear
              point i := exp point:i
            addressof:s map Float32 i := point i
        if not (opt option "invisible")
          d := ink_thickness s ink:s0 ink:s100
        if l=0 or l=encoded_resolution-1
          d := shunt d<0.001 0 d>0.999 1 d
        ink:gradation:decode_table l := shunt negative 1-d d
        ink:filter l := s/ink:s0
        ink:deaden_filter l := exposure (-1)*(log ink:filter
        var Pointer:ColorInkFastFilter p :> ink:fast_filter 
        var ColorRGB rgb := cast (filter_XYZ ink:filter:l) C
        rgb r := bound rgb:r 0 1
        rgb g := bound rgb:g 0 1
        rgb b := bound rgb:b 0 1
        var Float o := l/(encoded_resolution-1)*ink:opacity*
        p r_filter := (1-o)*rgb:r ; p r_generator := o*rgb:r
        p g_filter := (1-o)*rgb:g ; p g_generator := o*rgb:g
        p b_filter := (1-o)*rgb:b ; p b_generator := o*rgb:b
      ink status := success
      ink:gradation compute
      if ink:gradation=failure
        ink status := failure
    if ink:status=success
      cache_ready ((addressof Link:ColorInk ink) map Link:Ca
    else
      cache_cancel ((addressof Link:ColorInk ink) map Link:C


export ColorInk 'cast Status' color_ink
export '. filter' '. gradation' '. s0' '. s50' '. s100'
export '. opacity' '. maximum' '. options'
export '. deaden' '. deaden_filter'
export ColorFast '. init' '. apply' '. terminate'
        ink:gradation:decode_table l := shunt negative 1-d d
        ink:filter l := s/ink:s0
        ink:deaden_filter l := exposure (-1)*(log ink:filter
        var Pointer:ColorInkFastFilter p :> ink:fast_filter 
        var ColorRGB rgb := cast (filter_XYZ ink:filter:l) C
        rgb r := bound rgb:r 0 1
        rgb g := bound rgb:g 0 1
        rgb b := bound rgb:b 0 1
        var Float o := l/(encoded_resolution-1)*ink:opacity*
        p r_filter := (1-o)*rgb:r ; p r_generator := o*rgb:r
        p g_filter := (1-o)*rgb:g ; p g_generator := o*rgb:g
        p b_filter := (1-o)*rgb:b ; p b_generator := o*rgb:b
      ink status := success
      ink:gradation compute
      if ink:gradation=failure
        ink status := failure
    if ink:status=success
      cache_ready ((addressof Link:ColorInk ink) map Link:Ca
    else
      cache_cancel ((addressof Link:ColorInk ink) map Link:C


export ColorInk 'cast Status' color_ink
export '. filter' '. gradation' '. s0' '. s50' '. s100'
export '. opacity' '. maximum' '. options'
export '. deaden' '. deaden_filter'
export ColorFast '. init' '. apply' '. terminate'