Patch title: Release 92 bulk changes
Abstract:
File: /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"
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"


type ColorFast
  field ColorRGB rgb
module "gradation.pli"
module "database.pli"
module "/pliant/language/data/cache.pli"
module "/pliant/language/compiler/type/inherit.pli"


type ColorFast
  field ColorRGB rgb
  field Float specular
  
type ColorInkFastFilter
  field Float32 r_filter r_generator
  field Float32 g_filter g_generator
  field Float32 b_filter b_generator

type ColorInk
  inherit CachePrototype
  field (Array ColorInkFastFilter encoded_resolution) fast_f
  field (Array ColorSpectrum32 encoded_resolution) filter
  field ColorGradation gradation
  field ColorSpectrum32 s0 s50 s100
  
type ColorInkFastFilter
  field Float32 r_filter r_generator
  field Float32 g_filter g_generator
  field Float32 b_filter b_generator

type ColorInk
  inherit CachePrototype
  field (Array ColorInkFastFilter encoded_resolution) fast_f
  field (Array ColorSpectrum32 encoded_resolution) filter
  field ColorGradation gradation
  field ColorSpectrum32 s0 s50 s100
  field ColorSpectrum32 f0 f50 f100
  field Float opacity
  field Float opacity
  field Float specular
  field Float deaden
  field (Array ColorSpectrum32 encoded_resolution) deaden_filter
  field Int maximum
  field Str options
  field Status status <- failure


method cf init
  arg_w ColorFast cf
  cf:rgb r := 1 ; cf:rgb g := 1 ; cf:rgb b := 1
  field Int maximum
  field Str options
  field Status status <- failure


method cf init
  arg_w ColorFast cf
  cf:rgb r := 1 ; cf:rgb g := 1 ; cf:rgb b := 1
  cf specular := 0

method cf apply ink l
  arg_rw ColorFast cf ; arg ColorInk ink ; arg Int l
  var Pointer:ColorInkFastFilter p :> ink:fast_filter l
  cf:rgb r := cf:rgb:r*p:r_filter+p:r_generator
  cf:rgb g := cf:rgb:g*p:g_filter+p:g_generator
  cf:rgb b := cf:rgb:b*p:b_filter+p:b_generator

method cf apply ink l
  arg_rw ColorFast cf ; arg ColorInk ink ; arg Int l
  var Pointer:ColorInkFastFilter p :> ink:fast_filter l
  cf:rgb r := cf:rgb:r*p:r_filter+p:r_generator
  cf:rgb g := cf:rgb:g*p:g_filter+p:g_generator
  cf:rgb b := cf:rgb:b*p:b_filter+p:b_generator
  cf specular := ink specular

method cf terminate rgb
  arg_rw ColorFast cf ; arg_w ColorRGB888 rgb

method cf terminate rgb
  arg_rw ColorFast cf ; arg_w ColorRGB888 rgb
  var Float s := cf specular
  cf:rgb r += s ; cf:rgb g += s ; cf:rgb b += s
  rgb := cf rgb



function adjust f0 options quantity -> f
  arg ColorSpectrum32 f0 ; arg Str options ; arg Float quant
  f := f0
  if f=undefined
    return
  rgb := cf rgb



function adjust f0 options quantity -> f
  arg ColorSpectrum32 f0 ; arg Str options ; arg Float quant
  f := f0
  if f=undefined
    return
  var Float zero := options option "zero" Float
  if zero=defined
    f := (cast -zero ColorSpectrum32)+(1+zero)*f
  color_adjust f (options option "ink_adjust" Str)
  var Float density := options option "density" Float 1
  if density<>1
    f := f^density
  var Float density := options option "density" Float 1
  if density<>1
    f := f^density
  var Float specular := options option "active_specular" Flo
  if specular<>0
    f := max (1+specular)*f-(cast specular ColorSpectrum32) 
  if quantity>0
    for (var Int i) 0 3
      var Str color := shunt i=0 "cyan" i=1 "magenta" i=2 "y
      var Float extra := options option color Float
      if extra=defined
        var Data:ColorChannel primary :> color_database:data
        f *= (primary:s100/primary:s0)^(extra*quantity)

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
  if quantity>0
    for (var Int i) 0 3
      var Str color := shunt i=0 "cyan" i=1 "magenta" i=2 "y
      var Float extra := options option color Float
      if extra=defined
        var Data:ColorChannel primary :> color_database:data
        f *= (primary:s100/primary:s0)^(extra*quantity)

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 specular := opt option "specular" 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 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
      for (var Int l) 0 encoded_resolution-1
        var Float d := ink_dot_growth (shunt negative encode
        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
          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
      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 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
      for (var Int l) 0 encoded_resolution-1
        var Float d := ink_dot_growth (shunt negative encode
        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
          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
        if specular<>0
          s := max (1+specular)*s-(cast specular ColorSpectr
        ink:gradation:decode_table l := shunt negative 1-d d
        ink:filter l := s/ink:s0
        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:l) (-ink:deaden)
        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
        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 f0 := cast 1 ColorSpectrum32
      if ink:s50<>undefined
        ink f50 := (2*ink:s50-0.5*ink:s0-0.5*ink:s100)/ink:s
      else
        ink f50 := (ink:s0^0.5*ink:s100^0.5)/ink:s0
      ink f100 := ink:s100/ink:s0
      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
      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' '. f
export '. filter' '. gradation' '. s0' '. s50' '. s100'
export '. opacity' '. maximum' '. options'
export '. deaden' '. deaden_filter'
export ColorFast '. init' '. apply' '. terminate'
export ColorFast '. init' '. apply' '. terminate'