Patch title: Release 94 bulk changes
Abstract:
File: /pliant/graphic/color/gamut.pli
Key:
    Removed line
    Added line
   
abstract
  ['ColorGamut' data type is defining how a pixel is encoded


module "/pliant/language/compiler.pli"
module "/pliant/language/context.pli"
module "/pliant/language/os.pli"
module "/pliant/language/compiler/type/inherit.pli"
module "/pliant/math/functions.pli"
module "/pliant/math/curven.pli"
abstract
  ['ColorGamut' data type is defining how a pixel is encoded


module "/pliant/language/compiler.pli"
module "/pliant/language/context.pli"
module "/pliant/language/os.pli"
module "/pliant/language/compiler/type/inherit.pli"
module "/pliant/math/functions.pli"
module "/pliant/math/curven.pli"
module "/pliant/math/matrix.pli"
module "color.pli"
module "ink.pli"
module "gradation.pli"
module "spectrum.pli"
module "/pliant/graphic/misc/int.pli"
module "/pliant/graphic/misc/float.pli"
module "/pliant/graphic/misc/bytes.pli"
module "color.pli"
module "ink.pli"
module "gradation.pli"
module "spectrum.pli"
module "/pliant/graphic/misc/int.pli"
module "/pliant/graphic/misc/float.pli"
module "/pliant/graphic/misc/bytes.pli"
module "/pliant/graphic/misc/vector.pli"
module "/pliant/language/stream.pli"
module "/pliant/admin/md5.pli"
module "database.pli"
module "adjust.pli"
module "/pliant/language/data/cache.pli"

constant hash_conversion true
constant hash_rgb true
module "/pliant/language/stream.pli"
module "/pliant/admin/md5.pli"
module "database.pli"
module "adjust.pli"
module "/pliant/language/data/cache.pli"

constant hash_conversion true
constant hash_rgb true
constant logarithm_grid true
constant direct_is_linear true


constant verify false
if verify
  gvar CBool advanced
else
  constant advanced true
constant advanced2 true



#-----------------------------------------------------------
#   prototype



  CachePrototype maybe ColorGamut
  
#-----------------------------------------------------------
#   prototype



  CachePrototype maybe ColorGamut
  
  method p drop # avoid clashing with CachePrototype
  method p update stream -> status # avoid clashing with CachePrototype
    oarg_rw ColorGamut p ; arg_rw Stream stream ; arg ExtendedStatus status
    generic
    status := failure "not implemented"
  
  method p dump stream -> status
    oarg_rw ColorGamut p ; arg_rw Stream stream ; arg ExtendedStatus status
    generic
    status := failure "not implemented"

  method p sleep
    oarg_rw ColorGamut p
    generic

    oarg_rw ColorGamut p
    generic

  method p drop
    oarg_rw ColorGamut p
    generic

  method g decode pixel components
    oarg ColorGamut g ; arg Address pixel ; arg_w (Array Flo
    generic


function default_convert src_pixels src_gamut dest_pixels de
  arg Address src_pixels dest_pixels ; oarg ColorGamut src_g
  method g decode pixel components
    oarg ColorGamut g ; arg Address pixel ; arg_w (Array Flo
    generic


function default_convert src_pixels src_gamut dest_pixels de
  arg Address src_pixels dest_pixels ; oarg ColorGamut src_g
  var Str options := dest_gamut query "options"
  var Str options := (dest_gamut query "options") option "convert_adjust" Str
  var Address s := src_pixels ; var Int src_psize := src_gam
  var Address stop := src_pixels translate Byte count*src_ps
  var Address d := dest_pixels ; var Int dest_psize := dest_
  while s<>stop
    if s<>src_pixels and not (memory_different s src_psize (
      memory_copy (d translate Byte -dest_psize) d dest_psiz
    else
      var ColorXYZ color := src_gamut simulate s
      color_adjust color options
      dest_gamut formulate color d
    s := s translate Byte src_psize ; d := d translate Byte 
  transparency_convert src_pixels src_gamut dest_pixels dest


  var Address s := src_pixels ; var Int src_psize := src_gam
  var Address stop := src_pixels translate Byte count*src_ps
  var Address d := dest_pixels ; var Int dest_psize := dest_
  while s<>stop
    if s<>src_pixels and not (memory_different s src_psize (
      memory_copy (d translate Byte -dest_psize) d dest_psiz
    else
      var ColorXYZ color := src_gamut simulate s
      color_adjust color options
      dest_gamut formulate color d
    s := s translate Byte src_psize ; d := d translate Byte 
  transparency_convert src_pixels src_gamut dest_pixels dest


constant grid_conversion_release 11
constant grid_conversion_cache 16
constant grid_conversion_release 13


type ColorGridConversion
  inherit CachePrototype
  field Array:Float32 mapping
  field Int dim
  field Int steps
  field Int done


type ColorGridConversion
  inherit CachePrototype
  field Array:Float32 mapping
  field Int dim
  field Int steps
  field Int done
  field Int computed
  field Str key


method conv compute src_gamut dest_gamut steps cached
  arg_w ColorGridConversion conv ; oarg ColorGamut src_gamut
  var Int dim := src_gamut dimension
  conv dim := dim
  conv steps := steps
  conv:mapping size := steps^dim*dest_gamut:dimension
  for (var Int i) 0 steps^dim-1
    conv:mapping i*dest_gamut:dimension := undefined
  conv done := 0
  field Str key


method conv compute src_gamut dest_gamut steps cached
  arg_w ColorGridConversion conv ; oarg ColorGamut src_gamut
  var Int dim := src_gamut dimension
  conv dim := dim
  conv steps := steps
  conv:mapping size := steps^dim*dest_gamut:dimension
  for (var Int i) 0 steps^dim-1
    conv:mapping i*dest_gamut:dimension := undefined
  conv done := 0
  conv computed := 0
  if cached
    conv key := string_md5_hexa_signature (string src_gamut:
    (var Stream s) open "data:/pliant/graphic/cache/"+conv:k
    if s=success
      while s:readline<>""
        void
      s raw_read (addressof conv:mapping:0) conv:mapping:siz
      if s=success
        for (var Int i) 0 steps^dim-1
          if (conv:mapping i*dest_gamut:dimension)=defined
            conv:done += 1
      else
        for (var Int i) 0 steps^dim-1
          conv:mapping i*dest_gamut:dimension := undefined

method conv compute_node index src_gamut dest_gamut
  arg_rw ColorGridConversion conv ; arg Int index ; oarg Col
  if cached
    conv key := string_md5_hexa_signature (string src_gamut:
    (var Stream s) open "data:/pliant/graphic/cache/"+conv:k
    if s=success
      while s:readline<>""
        void
      s raw_read (addressof conv:mapping:0) conv:mapping:siz
      if s=success
        for (var Int i) 0 steps^dim-1
          if (conv:mapping i*dest_gamut:dimension)=defined
            conv:done += 1
      else
        for (var Int i) 0 steps^dim-1
          conv:mapping i*dest_gamut:dimension := undefined

method conv compute_node index src_gamut dest_gamut
  arg_rw ColorGridConversion conv ; arg Int index ; oarg Col
  var Str options := dest_gamut query "options"
  var Str options := (dest_gamut query "options") option "convert_adjust" Str
  var Pointer:Float32 p :> conv:mapping index*dest_gamut:dim
  var ColorBuffer src_pixel dest_pixel
  for (var Int d) 0 conv:dim-1
    src_pixel:bytes d := (index\conv:steps^d)%conv:steps*255
  var ColorXYZ color := src_gamut simulate addressof:src_pix
  color_adjust color options
  dest_gamut formulate color addressof:dest_pixel
  dest_gamut decode addressof:dest_pixel (var (Array Float32
  for (var Int d) dest_gamut:dimension-1 0 step -1
    addressof:p map Float32 d := components d
  var Pointer:Float32 p :> conv:mapping index*dest_gamut:dim
  var ColorBuffer src_pixel dest_pixel
  for (var Int d) 0 conv:dim-1
    src_pixel:bytes d := (index\conv:steps^d)%conv:steps*255
  var ColorXYZ color := src_gamut simulate addressof:src_pix
  color_adjust color options
  dest_gamut formulate color addressof:dest_pixel
  dest_gamut decode addressof:dest_pixel (var (Array Float32
  for (var Int d) dest_gamut:dimension-1 0 step -1
    addressof:p map Float32 d := components d
  conv done += 1


function color_grid_conversion src_gamut dest_gamut steps cached -> conv
  oarg ColorGamut src_gamut dest_gamut ; arg Int steps ; arg CBool cached ; arg Link:ColorGridConversion conv
  later

function color_gamut name options -> g
  arg Str name options ; arg Link:ColorGamut g
  later

method conv compute_node2 index src_gamut dest_gamut
  arg_rw ColorGridConversion conv ; arg Int index ; oarg Col
method conv compute_node2 index src_gamut dest_gamut
  arg_rw ColorGridConversion conv ; arg Int index ; oarg Col
  var CBool hurry := dest_gamut:name="XYZ"
  # if not hurry
  #   console "compute lazy color conversion grid node "+(st
  if conv:key<>"" and src_gamut:model=color_gamut_substractive and dest_gamut:model=color_gamut_substractive
    var Int selected_dim := 0 ; var Int selected_index := 0 ; var Str selected_inks := ""
    for (var Int d) 0 conv:dim-1
      var Int i := (index\conv:steps^d)%conv:steps
      if i<>0
        selected_index += i*conv:steps^selected_dim
        selected_inks += "+"+(src_gamut query "component_name "+string:d)
        selected_dim += 1
    if selected_dim>0 and selected_dim<conv:dim
      var Link:ColorGamut selected_gamut :> color_gamut (src_gamut query "device")+":"+(selected_inks 1 selected_inks:len) (src_gamut query "extra")
      if selected_gamut=success
        var Link:ColorGridConversion selected_conv :> color_grid_conversion selected_gamut dest_gamut conv:steps true
        if (selected_conv:mapping selected_index*dest_gamut:dimension)=undefined
          part compute "recurse compute lazy color conversion grid node "+(string conv:done)+"/"+(string conv:steps^conv:dim)+" ("+src_gamut:name+" -> "+dest_gamut:name+")"
            selected_conv compute_node2 selected_index selected_gamut dest_gamut
        for (var Int d) dest_gamut:dimension-1 0 step -1
          conv:mapping index*dest_gamut:dimension+d := selected_conv:mapping selected_index*dest_gamut:dimension+d
        conv done += 1
        return
  part compute "compute lazy color conversion grid node "+(s
    conv compute_node index src_gamut dest_gamut
  part compute "compute lazy color conversion grid node "+(s
    conv compute_node index src_gamut dest_gamut
    conv done += 1
    conv computed += 1
  if conv:key<>""
  if conv:key<>""
    if conv:done%(shunt hurry 4096 256)=0 or conv:done=conv:
    if conv:computed%(shunt dest_gamut:name="XYZ" 4096 64)=0 or conv:done=conv:steps^conv:dim
      (var Stream s) open "data:/pliant/graphic/cache/"+conv
      s writeline "Pliant color conversion"
      s writeline "source_gamut "+(string src_gamut:name)
      s writeline "source_options "+string:(src_gamut query 
      s writeline "destination_gamut "+(string dest_gamut:na
      s writeline "destination_options "+string:(dest_gamut 
      s writeline "steps "+(string conv:steps)
      s writeline "release "+string:grid_conversion_release
      s writeline ""
      s raw_write (addressof conv:mapping:0) conv:mapping:si
      s close
      # if not hurry
      #   console "."

method conv apply src_pixel src_gamut dest_pixel dest_gamut
  arg_rw ColorGridConversion conv ; arg Address src_pixel ; 
      (var Stream s) open "data:/pliant/graphic/cache/"+conv
      s writeline "Pliant color conversion"
      s writeline "source_gamut "+(string src_gamut:name)
      s writeline "source_options "+string:(src_gamut query 
      s writeline "destination_gamut "+(string dest_gamut:na
      s writeline "destination_options "+string:(dest_gamut 
      s writeline "steps "+(string conv:steps)
      s writeline "release "+string:grid_conversion_release
      s writeline ""
      s raw_write (addressof conv:mapping:0) conv:mapping:si
      s close
      # if not hurry
      #   console "."

method conv apply src_pixel src_gamut dest_pixel dest_gamut
  arg_rw ColorGridConversion conv ; arg Address src_pixel ; 
  var Int dim := conv dim ; var Int steps := conv steps
  var Int base := 0  
  var Int n := 0
  var (Array Int gamut_maximum_dimension) gs # grid step
  var (Array Float gamut_maximum_dimension) remain
  check conv:dim=src_gamut:dimension
  check src_gamut:pixel_size=src_gamut:dimension
  check src_gamut:pixel_size=src_gamut:dimension
  var Int unit := 1
  for (var Int d) 0 src_gamut:dimension-1
    var Int v := src_pixel map uInt8 d
    if v=0
      void
    eif v=255
      base += (steps-1)*unit
    else
      var Int i := min v*(steps-1)\255 steps-2
      gs n := unit
      base += i*unit
      remain n := ( v - i*255\(steps-1) ) / ( (i+1)*255\(ste
      n += 1
    unit *= steps
  var (Array Float32 gamut_maximum_dimension) result
  for (var Int d) 0 dest_gamut:dimension-1
    result d := 0
  for (var Int u) 0 2^n-1
    var Int index := base ; var Float f := 1
    for (var Int d) 0 n-1
      if (u .and. 2^d)<>0
        index += gs d
        f *= remain d
  if true
    part apply
      var Int index := vector_apply_grid src_gamut:dimension dest_gamut:dimension conv:steps (addressof conv:mapping:0) src_pixel addressof:(var (Array Float32 gamut_maximum_dimension) result)
      if index>=0
        conv compute_node2 index src_gamut dest_gamut
        restart apply
  else
    var Int dim := conv dim ; var Int steps := conv steps
    var Int base := 0  
    var Int n := 0
    var (Array Int gamut_maximum_dimension) gs # grid step
    var (Array Float32 gamut_maximum_dimension) remain
    var Int unit := 1
    for (var Int d) 0 src_gamut:dimension-1
      var Int v := src_pixel map uInt8 d
      if v=0
        void
      eif v=255
        base += (steps-1)*unit
      else
      else
        f *= 1-remain:d
    var Pointer:Float32 p :> conv:mapping index*dest_gamut:d
    if p=undefined
      conv compute_node2 index src_gamut dest_gamut
        var Int i := min v*(steps-1)\255 steps-2
        gs n := unit
        base += i*unit
        remain n := ( v - i*255\(steps-1) ) / ( (i+1)*255\(steps-1) - i*255\(steps-1) )
        n += 1
      unit *= steps
    var (Array Float32 gamut_maximum_dimension) result
    for (var Int d) 0 dest_gamut:dimension-1
    for (var Int d) 0 dest_gamut:dimension-1
      result d += f*p
      p :> addressof:p map Float32 1
      result d := 0
    for (var Int u) 0 2^n-1
      var Int index := base ; var Float f := 1
      for (var Int d) 0 n-1
        if (u .and. 2^d)<>0
          index += gs d
          f *= remain d
        else
          f *= 1-remain:d
      var Pointer:(Array Float32 gamut_maximum_dimension) p :> addressof:(conv:mapping index*dest_gamut:dimension) map (Array Float32 gamut_maximum_dimension)
      if p:0=undefined
        conv compute_node2 index src_gamut dest_gamut
      for (var Int d) 0 dest_gamut:dimension-1
        result d += f*p:d
  dest_gamut encode result dest_pixel


function color_grid_conversion src_gamut dest_gamut steps ca
  oarg ColorGamut src_gamut dest_gamut ; arg Int steps ; arg
  dest_gamut encode result dest_pixel


function color_grid_conversion src_gamut dest_gamut steps ca
  oarg ColorGamut src_gamut dest_gamut ; arg Int steps ; arg
  var Str k := (string src_gamut:name)+" "+string:(src_gamut
  if (cache_open "/pliant/color/grid/"+k ColorGridConversion
    var Int dim := src_gamut dimension
    conv compute src_gamut dest_gamut (shunt steps=defined s
  var Int dim := src_gamut dimension
  var Int steps1 := shunt steps=defined steps src_gamut:model=color_gamut_additive 33 dim<=4 17 dim<=6 9 5
  var Str k := (string src_gamut:name)+" "+string:(src_gamut query "signature")+" "+(string dest_gamut:name)+" "+string:(dest_gamut query "signature")+" "+string:steps1
  if (cache_open "/pliant/color/conversion/"+k ColorGridConversion ((addressof Link:ColorGridConversion conv) map Link:CachePrototype))
    conv compute src_gamut dest_gamut steps1 cached
    cache_ready ((addressof Link:ColorGridConversion conv) m


#-----------------------------------------------------------
    cache_ready ((addressof Link:ColorGridConversion conv) m


#-----------------------------------------------------------
#   grid based simulation


type ColorGridSimulation
  inherit CachePrototype
  field Curven curve
  field Array:Str ink
  field CBool logarithm <- true

CachePrototype maybe ColorGridSimulation


function color_grid_simulation name -> grid
  arg Str name ; arg Link:ColorGridSimulation grid
  if (cache_open "/pliant/color/simulation/"+name ColorGridSimulation ((addressof Link:ColorGridSimulation grid) map Link:CachePrototype))
    (var Stream s) open "data:/pliant/graphic/color/"+name in+safe
    if s=failure
      cache_cancel ((addressof Link:ColorGridSimulation grid) map Link:CachePrototype)
      grid :> null map ColorGridSimulation
      return
    var (Array Array:Float) nodes
    var Array:Float middle density maxi
    while not s:atend and { var Str l := s readline ; l<>"" }
      if (l parse word:"ink" (var Str inkname) any:(var Str values))
        grid ink += inkname
        var Int i := nodes size
        nodes size += 1
        middle += l option "middle" Float 0
        density += l option "density" Float 1
        maxi += l option "maxi" Float 255
        while (values parse (var Float f) any:(var Str remain))
          nodes nodes:size-1 += (unexposure f/maxi:i/density:i middle:i)*maxi:i
          values := remain
      eif (l parse "linear")
        grid logarithm := false
    grid:curve resize ColorSpectrum32:size\Float32:size nodes:size nodes
    var ColorSpectrum32 w32 := var ColorSpectrum32 undefined_spectrum
    while not s:atend
      var Str l := s readline
      if (l parse any:(var Str all) ":" (var ColorSpectrum cs) )
        (var Array:Float params) size := nodes size
        for (var Int i) 0 params:size-1
          if (all parse params:i any:(var Str remain))
            all := remain
          else
            error error_id_corrupted "Incorrect line in gamut measures files "+s:name+" ("+l+")"
          params i := (unexposure params:i/maxi:i/density:i middle:i)*maxi:i
        if w32=undefined
          w32 := cs
        var ColorSpectrum32 cs32 := cs/w32
        (var Array:Float point) size := ColorSpectrum32:size\Float32:size
        for (var Int i) 0 point:size-1
          point i := addressof:cs32 map Float32 i
          if grid:logarithm
            point i := log point:i
        grid:curve define params point
    cache_ready ((addressof Link:ColorGridSimulation grid) map Link:CachePrototype)


gvar (Array Int 256) bits_count_array

function init_bits_count
  for (var Int i) 0 255
    bits_count_array i := 0
    for (var Int j) 0 7
      if (i .and. 2^j)<>0
         bits_count_array i += 1
init_bits_count

function bits_count u -> n
  arg uInt u ; arg Int n
  n := bits_count_array (u .and. 255)
  if u>=256
    n += bits_count_array u\256


#-------------------------------------------------------------------------
#   substractive (inks)


type ColorComponent
  field Link:ColorInk ink
#   substractive (inks)


type ColorComponent
  field Link:ColorInk ink
  field Link:Curven curve
  field Str name
  field Str name

type ColorGrid
  field Link:ColorGridSimulation simulation
  field Array:Int indice ; field uInt mask
  field Array:Int indice ; field uInt mask
  field Str name


type ColorFormulateUsing
  field Array:Int using
  field Float hue

type ColorGamutSubstractive
  inherit ColorGamut
  field Array:ColorComponent component
type ColorGamutSubstractive
  inherit ColorGamut
  field Array:ColorComponent component
  field Str device options
  field Array:ColorGrid grid
  field Array:ColorFormulateUsing formulate_using
  field Str device options extra
  field Float deaden <- 0
  field Float deaden <- 0
  field CBool composed <- false
  field CBool multiple_transparency <- false
  field CBool no_opacity <- false
  field CBool reverse_printing <- false
  field Int negatives <- 0
  field Link:ColorGridConversion fast_simulation
  field Link:ColorGamut another_gamut
  field Link:ColorGamut xyz_gamut
  
ColorGamut maybe ColorGamutSubstractive



  field CBool multiple_transparency <- false
  field CBool no_opacity <- false
  field CBool reverse_printing <- false
  field Int negatives <- 0
  field Link:ColorGridConversion fast_simulation
  field Link:ColorGamut another_gamut
  field Link:ColorGamut xyz_gamut
  
ColorGamut maybe ColorGamutSubstractive



method gamut dispatch_pixel pixel plus minus
  arg ColorGamutSubstractive gamut ; arg Address pixel plus 
  if gamut:composed
    memory_clear plus gamut:component:size
    memory_copy pixel plus gamut:dimension
    memory_clear minus gamut:component:size
    for (var Int i) gamut:dimension gamut:component:size-1
      var Pointer:ColorComponent c :> gamut:component i
      if (exists c:curve)
        for (var Int j) 0 c:indice:size-1
          var Int k := c:indice j
          if k<>undefined
            minus map uInt8 k := plus map uInt8 k
        plus map uInt8 i := 1
    for (var Int i) gamut:dimension gamut:component:size-1
      var Pointer:ColorComponent c :> gamut:component i
      if not (exists c:curve)
        var Int m := 255
        for (var Int j) 0 c:indice:size-1
          m := min m (plus map uInt8 c:indice:j)
        plus map uInt8 i := m
    for (var Int i) gamut:dimension gamut:component:size-1
      var Pointer:ColorComponent ci :> gamut:component i
      if not (exists ci:curve)
        for (var Int j) 0 gamut:component:size-1
          var Pointer:ColorComponent cj :> gamut:component j
          if (ci:mask .or. cj:mask)=ci:mask and i<>j
            minus map uInt8 j := max (cast (minus map uInt8 
  else
    memory_copy pixel plus gamut:dimension
    memory_clear minus gamut:dimension

function curven_simulation c pixel -> f
  arg ColorComponent c ; arg Address pixel ; arg ColorSpectr
  (var Array:Float params) size := c:indice size
function curven_simulation g pixel -> f
  arg ColorGrid g ; arg Address pixel ; arg ColorSpectrum32 f
  (var Array:Float params) size := g:indice size
  for (var Int i) 0 params:size-1
  for (var Int i) 0 params:size-1
    var Int j := c:indice i
    var Int j := g:indice i
    if j<>undefined
      params i := pixel map uInt8 j
    if j<>undefined
      params i := pixel map uInt8 j
      pixel map uInt8 j := 0
    else
      params i := 0
    else
      params i := 0
  var Array:Float point := c:curve apply params
  var Array:Float point := g:simulation:curve apply params
  check point:size=ColorSpectrum32:size\Float32:size
  check point:size=ColorSpectrum32:size\Float32:size
  for (var Int i) 0 point:size-1
    if logarithm_grid
  if g:simulation:logarithm
    for (var Int i) 0 point:size-1
      addressof:f map Float32 i := exp point:i
      addressof:f map Float32 i := exp point:i
    else
  else
    for (var Int i) 0 point:size-1
      addressof:f map Float32 i := point i

method gamut simulate2 pixel -> filter
  oarg ColorGamutSubstractive gamut ; arg Address pixel ; ar
  part simulate "substractive color simulation "+gamut:name
    var ColorBuffer pixel2
    if gamut:no_opacity
      memory_copy pixel addressof:pixel2 gamut:pixel_size
    else
      gamut apply_opacity pixel addressof:pixel2
    filter := cast 0 ColorSpectrum32
      addressof:f map Float32 i := point i

method gamut simulate2 pixel -> filter
  oarg ColorGamutSubstractive gamut ; arg Address pixel ; ar
  part simulate "substractive color simulation "+gamut:name
    var ColorBuffer pixel2
    if gamut:no_opacity
      memory_copy pixel addressof:pixel2 gamut:pixel_size
    else
      gamut apply_opacity pixel addressof:pixel2
    filter := cast 0 ColorSpectrum32
    var ColorBuffer plus_buffer minus_buffer
    var Address plus minus
    if gamut:component:size<=gamut_maximum_dimension
      plus := addressof plus_buffer ; minus := addressof min
    else
      plus := memory_allocate gamut:component:size null ; mi
    gamut dispatch_pixel addressof:pixel2 plus minus
    var ColorSpectrum32 strongest := cast 1 ColorSpectrum32
    var Int negatives := gamut negatives
    var uInt mask := 0
    for (var Int i) 0 gamut:dimension-1
      if (addressof:pixel2 map uInt8 i)<>0
        mask += 2^i
    part apply_best_grid
      var Int maxi := 1 ; var Int selected := undefined
      for (var Int i) 0 gamut:grid:size-1
        var Pointer:ColorGrid g :> gamut:grid i
        var Int n := bits_count mask .and. g:mask
        if n>maxi
          selected := i ; maxi := n
      if selected<>undefined
        var Pointer:ColorGrid g :> gamut:grid selected
        filter += exposure (-1)*log:(curven_simulation g addressof:pixel2) (-gamut:deaden)
        mask := mask .and. .not. g:mask
        restart apply_best_grid
    for (var Int i) 0 gamut:component:size-1
    for (var Int i) 0 gamut:component:size-1
      var Int p := plus map uInt8 i
      var Int m := minus map uInt8 i
      var CBool positive := (negatives .and. 2^i)=0
      if (shunt positive p>m p<>255)
      if ((mask .or. gamut:negatives) .and. 2^i)<>0
        var Pointer:ColorComponent c :> gamut:component i
        var Pointer:ColorInk ink :> c ink
        var Pointer:ColorComponent c :> gamut:component i
        var Pointer:ColorInk ink :> c ink
        if (exists c:curve)
          filter += exposure (-1)*log:(curven_simulation c p
        eif ink:deaden=gamut:deaden
          filter += ink:deaden_filter:p
          if m>0
            check positive
            filter += (-1)*ink:deaden_filter:m
        if ink:deaden=gamut:deaden
          filter += ink:deaden_filter (addressof:pixel2 map uInt8 i)
        else
        else
          filter += exposure (-1)*(log ink:filter:p) (-gamut
          if m>0
            check positive
            filter += (-1)*(exposure (-1)*(log ink:filter:m)
          filter += exposure (-1)*(log ink:filter:(addressof:pixel2 map uInt8 i)) (-gamut:deaden)
    filter := exp (-1)*(unexposure filter (-gamut:deaden))
    filter := exp (-1)*(unexposure filter (-gamut:deaden))
    if gamut:component:size>gamut_maximum_dimension
      memory_free plus ; memory_free minus

method gamut simulate pixel -> color
  oarg ColorGamutSubstractive gamut ; arg Address pixel ; ar
  if (exists gamut:fast_simulation)
    ((addressof gamut:fast_simulation) omap ColorGridConvers
  else
    color := filter_XYZ (gamut simulate2 pixel)

method gamut simulate pixel -> color
  oarg ColorGamutSubstractive gamut ; arg Address pixel ; ar
  if (exists gamut:fast_simulation)
    ((addressof gamut:fast_simulation) omap ColorGridConvers
  else
    color := filter_XYZ (gamut simulate2 pixel)
    color_adjust color (gamut:options option "gamut_adjust" 
    color_adjust color (gamut:options option "simulate_adjust" Str)


method gamut try_formulate1 wished pixel using maximum limit l c -> distance
  oarg ColorGamut gamut ; arg ColorXYZ wished ; arg Address pixel ; arg Array:Int using maximum ; arg Int limit ; arg Float l c distance
  check using:size=3
  var ColorXYZ got := gamut simulate pixel
  distance := cmc_distance wished got l c
  var Int step := 4
  (var Matrix m) resize 3 3
  part improve
    for (var Int dim) 0 2
      var Int d := using dim
      memory_copy pixel addressof:(var ColorBuffer pixel1) gamut:pixel_size
      var Int v := pixel1:bytes d
      if true
        var Int v1 := shunt v+step<256 v+step v-step
        pixel1:bytes d := v1
        var ColorXYZ got1 := gamut simulate addressof:pixel1
        m 0 dim := (got1:X-got:X)/(v1-v)
        m 1 dim := (got1:Y-got:Y)/(v1-v)
        m 2 dim := (got1:Z-got:Z)/(v1-v)
      else
        var Int v1 v2
        if v-step\2<0
          v1 := 0 ; v2 := step
        eif v+step\2>255
          v1 := 255-step ; v2 := 255
        else
          v1 := v-step\2 ; v2 := v+step\2
        pixel1:bytes d := v1
        var ColorXYZ got1 := gamut simulate addressof:pixel1
        pixel1:bytes d := v2
        var ColorXYZ got2 := gamut simulate addressof:pixel1
        m 0 dim := (got2:X-got1:X)/step
        m 1 dim := (got2:Y-got1:Y)/step
        m 2 dim := (got2:Z-got1:Z)/step
    var Matrix m1 := m^(-1)
    if m1=failure
      leave improve
    (var Matrix diff) resize 3 1
    diff 0 0 := wished:X-got:X
    diff 1 0 := wished:Y-got:Y
    diff 2 0 := wished:Z-got:Z
    var Matrix coef := m1*diff
    var CBool different := false
    for (var Int dim) 0 2
      if abs:(coef dim 0)>1e9
        leave improve
      var Int d := using dim
      pixel1:bytes d := min (max (pixel map uInt8 d)+(cast (coef dim 0) Int) 0) maximum:d
    if limit<>undefined
      var Int total := 0
      for (var Int d) 0 gamut:dimension-1
        total += pixel map uInt8 d
      if total>limit
        for (var Int d) 0 gamut:dimension-1
          pixel1:bytes d := cast pixel1:bytes:d*limit/total Int
    var CBool different := false
    for (var Int dim) 0 2
      var Int d := using dim
      if pixel1:bytes:d<>(pixel map uInt8 d)
        different := true
    if not different
      leave improve
    var ColorXYZ got1 := gamut simulate addressof:pixel1
    var Float dist1 := cmc_distance wished got1 l c
    if dist1<distance
      memory_copy addressof:pixel1 pixel gamut:pixel_size ; got := got1 ; distance := dist1
      restart improve


method gamut try_formulate wished pixel using l c -> distanc
  oarg ColorGamut gamut ; arg ColorXYZ wished ; arg Address 
  (var Array:Int maximum) size := gamut dimension
  for (var Int dim) 0 gamut:dimension-1
    if not ((gamut query "component_maximum "+string:dim) pa
      maximum dim := 255
  var Int limit
  var Float flimit := (gamut query "options") option "limit"
  if flimit=defined
    limit := cast flimit*255 Int
  else
    limit := undefined
method gamut try_formulate2 wished pixel using maximum limit l c -> distance
  oarg ColorGamut gamut ; arg ColorXYZ wished ; arg Address pixel ; arg Array:Int using maximum ; arg Int limit ; arg Float l c distance
  var Int dimension := using size
  distance := cmc_distance wished (gamut simulate pixel) l c
  var Int dimension := using size
  distance := cmc_distance wished (gamut simulate pixel) l c
  var Int step := 4 ; var CBool again := true
  var Int step := 4
  while step>0
  while step>0
    again := false
    var CBool again := false
    memory_copy pixel addressof:(var ColorBuffer pixel2) gam
    for (var Int i) 0 3^dimension-1
      part try_one
        memory_copy pixel addressof:(var ColorBuffer pixel1)
        var Int ii := i
        for (var Int dim) 0 dimension-1
          var Int d := using dim
          var Int delta := ii%3-1 ; ii \= 3
          if delta<0
            if pixel1:bytes:d<step
              leave try_one
            pixel1:bytes d -= step
          eif delta>0
            if pixel1:bytes:d+step>maximum:d
              leave try_one
            pixel1:bytes d += step
        if limit=defined
          var Int total := 0
          for (var Int d) 0 gamut:dimension-1
            total += pixel1:bytes d
          if total>limit
            leave try_one
        var Float dist1 := cmc_distance wished (gamut simula
        if dist1<distance
          memory_copy addressof:pixel1 addressof:pixel2 gamu
          again := true
    memory_copy addressof:pixel2 pixel gamut:pixel_size
    if not again
    memory_copy pixel addressof:(var ColorBuffer pixel2) gam
    for (var Int i) 0 3^dimension-1
      part try_one
        memory_copy pixel addressof:(var ColorBuffer pixel1)
        var Int ii := i
        for (var Int dim) 0 dimension-1
          var Int d := using dim
          var Int delta := ii%3-1 ; ii \= 3
          if delta<0
            if pixel1:bytes:d<step
              leave try_one
            pixel1:bytes d -= step
          eif delta>0
            if pixel1:bytes:d+step>maximum:d
              leave try_one
            pixel1:bytes d += step
        if limit=defined
          var Int total := 0
          for (var Int d) 0 gamut:dimension-1
            total += pixel1:bytes d
          if total>limit
            leave try_one
        var Float dist1 := cmc_distance wished (gamut simula
        if dist1<distance
          memory_copy addressof:pixel1 addressof:pixel2 gamu
          again := true
    memory_copy addressof:pixel2 pixel gamut:pixel_size
    if not again
      step -= 1 ; again := true
      step \= 2


method gamut fill_pixel pixel
  oarg ColorGamutSubstractive gamut ; arg Address pixel
  memory_clear pixel gamut:pixel_size
  for (var Int i) 0 gamut:dimension-1
    var Str ink := gamut query "component_name "+string:i
    if (gamut:options option "initial_"+ink)
      pixel map uInt8 i := cast (gamut:options option "initi
method gamut fill_pixel using options pixel
  oarg ColorGamutSubstractive gamut ; arg Array:Int using ; arg Str options ; arg Address pixel
  if advanced
    memory_clear pixel gamut:pixel_size
  else
    # for compatibility reasons, but useless
    for (var Int i) 0 gamut:pixel_size-1
      pixel map uInt8 i := options option "start"+string:i Int 0
    for (var Int i) 0 using:size-1
      var Str ink := gamut query "component_name "+(string using:i)
      if (gamut:options option "initial_"+ink)
        pixel map uInt8 using:i := cast (gamut:options option "initial_"+ink Float)*255 Int


method gamut formulate color options pixel
  oarg ColorGamutSubstractive gamut ; arg ColorXYZ color ; a
method gamut do_formulate color options pixel -> distance
  oarg ColorGamutSubstractive gamut ; arg ColorXYZ color ; arg Str options ; arg Address pixel ; arg Float distance
  var Str opt := options+" "+(gamut query "options")
  var Str opt := options+" "+(gamut query "options")
  if not ((opt (opt option_position "removal" 0) opt:len) pa
    b0 := 0 ; b1 := 0
  var Float epsilon := opt option "epsilon" Float 0.5
  (var Array:Int maximum) size := gamut dimension
  for (var Int dim) 0 gamut:dimension-1
    if not ((gamut query "component_maximum "+string:dim) parse maximum:dim)
      maximum dim := 255
  var Int limit
  var Float flimit := opt option "limit" Float
  if flimit=defined
    limit := cast flimit*255 Int
  else
    limit := undefined
  var Float l := opt option "cmc_l" Float cmc_distance_l_par
  var Float c := opt option "cmc_c" Float cmc_distance_c_par
  var Float l := opt option "cmc_l" Float cmc_distance_l_par
  var Float c := opt option "cmc_c" Float cmc_distance_c_par
  if gamut:dimension>=4
    var Int darkest := opt option "darkest" Int
    if darkest=undefined
      darkest := 0 ; var Float Ymini := 1e6
      for (var Int i) 0 gamut:dimension-1
        var Float Y := (filter_XYZ gamut:component:i:ink:s10
        if Y<Ymini
          darkest := i ; Ymini := Y
    var Float distance := 1e10
    (var Array:Int using) size := 3 ; using 2 := darkest
    for using:0 0 gamut:dimension-1
      for using:1 using:0+1 gamut:dimension-1
        if using:0<>darkest and using:1<>darkest
          memory_clear addressof:(var ColorBuffer test) gamu
          var Float d := gamut try_formulate color addressof
  var Float epsilon := opt option "epsilon" Float 0.5
  distance := 1e10
  if advanced
    part compose
      (var Array:ColorBuffer tests) size := gamut:formulate_using size
      (var Array:Float distances) size := gamut:formulate_using size
      for (var Int i) 0 gamut:formulate_using:size-1
        gamut fill_pixel gamut:formulate_using:i:using opt (addressof tests:i)
        distances i := undefined
      var Float hue := (cast color ColorLCh) h
      var (Index Float Int) combinations
      for (var Int i) 0 gamut:formulate_using:size-1
        if gamut:formulate_using:i:using:size=3
          combinations insert (min (min (abs hue-gamut:formulate_using:i:hue-360) (abs hue-gamut:formulate_using:i:hue)) (abs hue-gamut:formulate_using:i:hue+360)) i
      each ii combinations
        distances ii := gamut try_formulate1 color (addressof tests:ii) gamut:formulate_using:ii:using maximum limit l c
        if distances:ii<distance
          memory_copy (addressof tests:ii) pixel gamut:pixel_size ; distance := distances ii
          if distance<epsilon
            leave compose
      var Float mi := opt option "cmc_maximum_improvement" Float (shunt advanced2 20 1e6)
      for (var Int i) 0 gamut:formulate_using:size-1
        if distances:i=undefined or distances:i<distance+mi
          var Float d := gamut try_formulate2 color (addressof tests:i) gamut:formulate_using:i:using maximum limit l c
          if d<distance
          if d<distance
            memory_copy addressof:test pixel gamut:pixel_siz
    if (opt option "removal") and gamut:dimension=4 and dark
      using 0 := 0 ; using 1 := 1 ; using 2 := 2
      memory_clear addressof:test gamut:pixel_size ; test:by
      var Float d := gamut try_formulate color addressof:tes
            memory_copy (addressof tests:i) pixel gamut:pixel_size ; distance := d
            if distance<epsilon
              leave compose
  else
    for (var Int i) 0 gamut:formulate_using:size-1
      gamut fill_pixel gamut:formulate_using:i:using opt addressof:(var ColorBuffer test)
      var Float d := gamut try_formulate2 color addressof:test gamut:formulate_using:i:using maximum limit l c
      if d<distance
        memory_copy addressof:test pixel gamut:pixel_size ; 
      if d<distance
        memory_copy addressof:test pixel gamut:pixel_size ; 
      var Int black := pixel map uInt8 3
      if black>=b1
        void
      eif black<b0
        black := 0
      else
        black := b1*(black-b0)\(b1-b0)
      gamut fill_pixel addressof:test ; test:bytes 3 := blac
      using 0 := 0 ; using 1 := 1 ; using 2 := 2
      d := gamut try_formulate color addressof:test using l 
      if d<distance or d<epsilon
        memory_copy addressof:test pixel gamut:pixel_size ; 
  if (opt option "removal") and gamut:dimension=4
    if not ((opt (opt option_position "removal" 0) opt:len) parse word:"removal" (var Int b0) (var Int b1) any)
      b0 := 0 ; b1 := 0
    var Int black := pixel map uInt8 3
    if black>=b1
      void
    eif black<b0
      black := 0
    else
      black := b1*(black-b0)\(b1-b0)
    (var Array:Int using) size := 3
    using 0 := 0 ; using 1 := 1 ; using 2 := 2
    gamut fill_pixel using opt addressof:(var ColorBuffer test) ; test:bytes 3 := black
    if advanced
      gamut try_formulate1 color addressof:test using maximum limit l c
    d := gamut try_formulate2 color addressof:test using maximum limit l c
    if d<distance or d<epsilon
      memory_copy addressof:test pixel gamut:pixel_size ; distance := d

method gamut formulate color options pixel
  oarg ColorGamutSubstractive gamut ; arg ColorXYZ color ; arg Str options ; arg Address pixel
  if verify
    advanced := true
    var Float distance0 := gamut do_formulate color options pixel
    if distance0>0.5
      advanced := false
      var Float distance1 := gamut do_formulate color options pixel
      if distance1-distance0>0.5
        console "color formulation warning: " (string distance0 "fixed 1") " instead of " (string distance1 "fixed 1") ", delta is " (string distance0-distance1 "fixed 1") eol
      if distance0-distance1>0.5
        console "color formulation ERROR: " (string distance0 "fixed 1") " instead of " (string distance1 "fixed 1") ", delta is " (string distance0-distance1 "fixed 1") eol
  else
  else
    gamut fill_pixel pixel
    (var Array:Int using) size := gamut dimension
    for (var Int i) 0 using:size-1
      using i := i
    gamut try_formulate color pixel using l c
    gamut do_formulate color options pixel


method g query question -> answer
  oarg ColorGamutSubstractive g ; arg Str question answer
  if (question parse word:"component_name" (var Int i)) and 
    answer := g:component:i name
  eif (question parse word:"component_maximum" (var Int i)) 
    answer := string g:component:i:ink:maximum
  eif (question parse word:"component_options" (var Int i)) 
    answer := g:component:i:ink options


method g query question -> answer
  oarg ColorGamutSubstractive g ; arg Str question answer
  if (question parse word:"component_name" (var Int i)) and 
    answer := g:component:i name
  eif (question parse word:"component_maximum" (var Int i)) 
    answer := string g:component:i:ink:maximum
  eif (question parse word:"component_options" (var Int i)) 
    answer := g:component:i:ink options
  eif question="device"
    answer := g device
  eif question="grids"
    answer := ""
    for (var Int i) 0 g:grid:size-1
      answer += (shunt i<>0 " " "")+g:grid:i:name
  eif question="formulates"
    answer := ""
    for (var Int i) 0 g:formulate_using:size-1
      answer += (shunt i<>0 " " "")
      for (var Int j) 0 g:formulate_using:i:using:size-1
        answer += (shunt j<>0 "+" "")+(g:component g:formulate_using:i:using:j):name
  eif question="options"
    answer := g options
  eif question="options"
    answer := g options
  eif question="extra"
    answer := g extra
  eif question="signature"
  eif question="signature"
    answer := g:options+(shunt g:no_opacity " no_opacity" ""
    answer := g options
    for (var Int i) 0 g:dimension-1
      answer += " "+(string g:component:i:name)+" "+(string 
  else
    answer := ""


    for (var Int i) 0 g:dimension-1
      answer += " "+(string g:component:i:name)+" "+(string 
  else
    answer := ""


method g add_component device inks -> status
  arg_rw ColorGamutSubstractive g ; arg Str device inks ; ar
  g:component size += 1
  var Pointer:ColorComponent c :> g:component g:component:si
  c mask := 0
  var Str all := inks ; c:indice size := 0
  while all<>""
    if not (all parse any:(var Str ink) "+" any:(var Str rem
      ink := all ; remain := ""
    part search_component
      for (var Int i) 0 g:dimension-1
        if g:component:i:name=ink
          c mask := c:mask .or. g:component:i:mask
          c indice += i
          leave search_component
      g:component size -= 1
      return failure
    all := remain
  if c:indice:size<2
    g:component size -= 1
    return failure
  c ink :> color_ink device+inks
  c name := inks
  status := success


#-----------------------------------------------------------
#   building a gamut from name using colors database



function color_gamut name options -> g
  arg Str name options ; arg Link:ColorGamut g
  var Pointer:Type t
  if (name parse any:(var Str device) ":" any:(var Str inks)
    t :> ColorGamutSubstractive
  eif name="grey"
    t :> ColorGamut
  eif name="XYZ"
    t :> ColorGamutXYZ
  else
    t :> ColorGamutRGB
  plugin extra_types
  if (cache_open "/pliant/color/gamut/"+string:name+options 
    g name := name
    part build
      if t=ColorGamut
        g pixel_size := 1
        g dimension := 1
        g model := color_gamut_additive
        g status := success
      eif t=ColorGamutRGB
        var Pointer:ColorGamutRGB ga :> addressof:g map Colo
        if name="rgb"
          rgb_gamut ga name 0 0 false options
        eif name="rgb32"
          rgb_gamut ga name 0 1 false options
        eif name="bgr"
          rgb_gamut ga name 0 0 true options
        eif name="bgr32"
          rgb_gamut ga name 0 1 true options
        eif name="rgba"
          rgb_gamut ga name 1 0 false options
        else
          g status := failure
      eif t=ColorGamutXYZ
        g pixel_size := 3*Float32:size
        g dimension := 3
        g model := color_gamut_additive
        g status := success
      eif t=ColorGamutSubstractive
        var Pointer:ColorGamutSubstractive gs :> addressof:g
        gs model := color_gamut_substractive
        gs device := device
#-----------------------------------------------------------
#   building a gamut from name using colors database



function color_gamut name options -> g
  arg Str name options ; arg Link:ColorGamut g
  var Pointer:Type t
  if (name parse any:(var Str device) ":" any:(var Str inks)
    t :> ColorGamutSubstractive
  eif name="grey"
    t :> ColorGamut
  eif name="XYZ"
    t :> ColorGamutXYZ
  else
    t :> ColorGamutRGB
  plugin extra_types
  if (cache_open "/pliant/color/gamut/"+string:name+options 
    g name := name
    part build
      if t=ColorGamut
        g pixel_size := 1
        g dimension := 1
        g model := color_gamut_additive
        g status := success
      eif t=ColorGamutRGB
        var Pointer:ColorGamutRGB ga :> addressof:g map Colo
        if name="rgb"
          rgb_gamut ga name 0 0 false options
        eif name="rgb32"
          rgb_gamut ga name 0 1 false options
        eif name="bgr"
          rgb_gamut ga name 0 0 true options
        eif name="bgr32"
          rgb_gamut ga name 0 1 true options
        eif name="rgba"
          rgb_gamut ga name 1 0 false options
        else
          g status := failure
      eif t=ColorGamutXYZ
        g pixel_size := 3*Float32:size
        g dimension := 3
        g model := color_gamut_additive
        g status := success
      eif t=ColorGamutSubstractive
        var Pointer:ColorGamutSubstractive gs :> addressof:g
        gs model := color_gamut_substractive
        gs device := device
        gs options := color_database:data:device:device opti
        gs extra := options
        gs options := options+(shunt options<>"" and color_database:data:device:device:options<>"" " " "")+color_database:data:device:device:options
        gs deaden := gs:options option "deaden" Float 0
        gs deaden := gs:options option "deaden" Float 0
        gs no_opacity := options option "no_opacity"
        gs no_opacity := gs:options option "no_opacity"
        inks := replace inks "cmyk" "process_cyan+process_ma
        while inks<>""
          if not (inks eparse any:(var Str ink) "+" any:(var
            ink := inks ; remain := ""
          if ink="transparency"
            gs transparency := 1
          eif ink="transparencies"
            gs multiple_transparency := true
          else
            gs:component size := dim+1
            var Pointer:ColorComponent gc :> gs:component di
            gc name := ink
            if (ink eparse any:(var Str base) "#" any)
              ink := base
            gc ink :> color_ink (shunt (ink search ":" -1)=(
        inks := replace inks "cmyk" "process_cyan+process_ma
        while inks<>""
          if not (inks eparse any:(var Str ink) "+" any:(var
            ink := inks ; remain := ""
          if ink="transparency"
            gs transparency := 1
          eif ink="transparencies"
            gs multiple_transparency := true
          else
            gs:component size := dim+1
            var Pointer:ColorComponent gc :> gs:component di
            gc name := ink
            if (ink eparse any:(var Str base) "#" any)
              ink := base
            gc ink :> color_ink (shunt (ink search ":" -1)=(
            var Int i := 0
            while gc:ink=failure and { var Str device2 := gs:options option "inherit" i Str ; device2<>"" }
              gc ink :> color_ink device2+":"+ink options
              i += 1
            if gc:ink=failure
              g status := failure (shunt (exists color_datab
              leave build
            if gc:ink=failure
              g status := failure (shunt (exists color_datab
              leave build
            gc mask := 2^dim
            if (gc:ink:options option "negative")
              gs negatives += 2^dim
            dim += 1
            if (gc:ink:options option "reverse_printing")
              gs reverse_printing := true
            if (ink search ":" -1)<>(-1) and (gc:ink:options
              gs deaden := gc:ink deaden
          inks := remain
        if gs:multiple_transparency 
          gs transparency := dim
        gs dimension := dim
        gs pixel_size := gs:dimension+gs:transparency
            if (gc:ink:options option "negative")
              gs negatives += 2^dim
            dim += 1
            if (gc:ink:options option "reverse_printing")
              gs reverse_printing := true
            if (ink search ":" -1)<>(-1) and (gc:ink:options
              gs deaden := gc:ink deaden
          inks := remain
        if gs:multiple_transparency 
          gs transparency := dim
        gs dimension := dim
        gs pixel_size := gs:dimension+gs:transparency
        var Str opt := options+" "+color_database:data:devic
        if (opt option "composed")
          each ch color_database:data:device:device:channel 
            if (keyof:ch search "+" -1)<>(-1)
              if (gs add_component device+":" keyof:ch)=succ
                gs composed := true
        var Str measure := options option "measure" Str devi
        (var Stream s) open "data:/pliant/graphic/gamut/"+me
        if s=success
          gs:component size += 1
          var Pointer:ColorComponent c :> gs:component gs:co
          var Int count := 0
          c:indice size := 0
          var (Array Array:Float) grid
        if (gs:options option "formulate" Str)<>""
          var Int i := 0
          while { var Str inks := gs:options option "formulate" i Str ; inks<>"" }
            i += 1
            part add_combination
              var ColorFormulateUsing using
              using:using size := 0
              while inks<>""
                if not (inks eparse any:(var Str ink) "+" any:(var Str remain))
                  ink := inks ; remain := ""
                part seach_ink
                  for (var Int j) 0 gs:dimension-1
                    if gs:component:i:name=ink
                      using using += j
                      leave seach_ink
                  leave add_combination
              using hue := undefined
              gs formulate_using += using
        eif gs:dimension>=4
          var Int darkest := gs:options option "darkest" Int
          if darkest=undefined
            darkest := 0 ; var Float Ymini := 1e6
            for (var Int i) 0 gs:dimension-1
              var Float Y := (filter_XYZ gs:component:i:ink:s100/gs:component:i:ink:s0) Y
              if Y<Ymini
                darkest := i ; Ymini := Y
          var (Index Float Int) hues
          for (var Int i) 0 gs:dimension-1
            if i<>darkest and not (gs:component:i:ink:options option "no_formulate")
              hues insert (cast (filter_XYZ gs:component:i:ink:s100/gs:component:i:ink:s0) ColorLCh):h i
          each hue hues
            var Pointer:Int hue2 :> hues next hue
            if not exists:hue2
              hue2 :> hues first
            var ColorFormulateUsing using
            using:using size := 3
            using:using 0 := darkest
            using:using 1 := hue
            using:using 2 := hue2
            var Float h1 := hues key hue
            var Float h2 := hues key hue2
            if h2<h1
              h2 += 360
            var Float h := (h1+h2)/2
            if h>=360
              h -= 360
            using hue := h
            gs formulate_using += using
        else
          gs:formulate_using size := 1
          gs:formulate_using:0:using size := gs dimension
          for (var Int i) 0 gs:formulate_using:0:using:size-1
            gs:formulate_using:0:using i := i
          gs:formulate_using:0 hue := undefined
        var Array:FileInfo grids := file_list "data:/pliant/graphic/color/"+device+"/" standard
        for (var Int i) 0 grids:size-1
          (var Stream s) open grids:i:name in+safe
          (var Array:Int indice) size := 0 ; var uInt mask := 0
          while not s:atend and { var Str l := s readline ; 
            if (l parse word:"ink" (var Str inkname) any:(va
          while not s:atend and { var Str l := s readline ; 
            if (l parse word:"ink" (var Str inkname) any:(va
              grid size += 1
              while (values parse (var Float f) any:(var Str
                grid grid:size-1 += f
                values := remain
              c indice += undefined
              for (var Int i) 0 gs:dimension-1
                if gs:component:i:name=inkname
                  c:indice c:indice:size-1 := i
              if (c:indice c:indice:size-1)<>undefined
                count += 1
          if count>=2
            c curve :> new Curven
            c:curve resize ColorSpectrum32:size\Float32:size
            var ColorSpectrum32 w32 := var ColorSpectrum32 u
            while not s:atend
              var Str l := s readline
              if (l parse any:(var Str all) ":" (var ColorSp
                (var Array:Float params) size := grid size
                for (var Int i) 0 params:size-1
                  if (all parse params:i any:(var Str remain
                    all := remain
                  else
                    error error_id_corrupted "Incorrect line
                if w32=undefined
                  w32 := cs
                var ColorSpectrum32 cs32 := cs/w32
                (var Array:Float point) size := ColorSpectru
                for (var Int i) 0 point:size-1
                  point i := addressof:cs32 map Float32 i
                  if logarithm_grid
                    point i := log point:i
                c:curve define params point
            gs composed := true
          else
            gs:component size -= 1
              indice += undefined
              for (var Int j) 0 gs:dimension-1
                if gs:component:j:name=inkname
                  indice indice:size-1 := j
              if (indice indice:size-1)<>undefined
                mask += 2^(indice indice:size-1)
          if bits_count:mask>=2
            var ColorGrid grid
            grid indice := indice
            grid mask := mask
            grid name := device+"/"+grids:i:name_without_path
            gs grid += grid
        # console "gamut " name " is using " gs:grid:size " grids" eol
        for (var Int i) 0 gs:grid:size-1
          gs:grid:i simulation :> color_grid_simulation gs:grid:i:name
          if not (exists gs:grid:i:simulation)
            g status := failure "Corrupted color grid "+gs:grid:i:name
            leave build
        gs status := shunt gs:pixel_size<=gamut_maximum_dime
    plugin extra_gamuts
    if g:status=success
      cache_ready ((addressof Link:ColorGamut g) map Link:Ca
    else
      cache_cancel ((addressof Link:ColorGamut g) map Link:C
      var ExtendedStatus status := g status
      g :> new ColorGamut
      g status := status


        gs status := shunt gs:pixel_size<=gamut_maximum_dime
    plugin extra_gamuts
    if g:status=success
      cache_ready ((addressof Link:ColorGamut g) map Link:Ca
    else
      cache_cancel ((addressof Link:ColorGamut g) map Link:C
      var ExtendedStatus status := g status
      g :> new ColorGamut
      g status := status


type ColorDirectConversion
  field Int src
  field Array:Float dest

type ColorSplitConversion
type ColorSplitConversion
  field Array:ColorDirectConversion direct
  field Array:ColorPartConversion part
  field CBool single <- false
  field CBool opacity <- false
  field Float limit
  if hash_conversion
    field Address cache_buffer <- null
    field uInt cache_size


function color_split_conversion src_gamut dest_gamut device 
  oarg ColorGamut src_gamut dest_gamut ; arg Data:ColorDevic
  conv :> new ColorSplitConversion
  field Array:ColorPartConversion part
  field CBool single <- false
  field CBool opacity <- false
  field Float limit
  if hash_conversion
    field Address cache_buffer <- null
    field uInt cache_size


function color_split_conversion src_gamut dest_gamut device 
  oarg ColorGamut src_gamut dest_gamut ; arg Data:ColorDevic
  conv :> new ColorSplitConversion
  if exists:grid
  var Str direct_device := (dest_gamut query "options") option "device" Str
  if direct_device<>""
    for (var Int i) 0 src_gamut:dimension-1
      var Str optionsi := src_gamut query "component_options "+string:i
      var Int i2 := 0
      while { var Int pos := optionsi option_position "map" i2 -1 ; pos<>(-1) }
        if ((optionsi pos optionsi:len) parse word:"map" (var Str dev) (var Str formula) any)
          if dev=direct_device
            var ColorDirectConversion direct
            direct src := i
            direct:dest size := dest_gamut dimension
            for (var Int j) 0 dest_gamut:dimension-1
              direct:dest j := formula option (dest_gamut query "component_name "+string:j) Float 0
            conv direct += direct
        i2 += 1
  if exists:grid and conv:direct:size=0
    var ColorPartConversion part
    part grid :> grid
    conv part += part
    conv single := true
  else
    # check (entry_type addressof:src_gamut)=ColorGamutSubst
    for (var Int i) 0 src_gamut:dimension-1
      var Pointer:ColorInk ink1 :> (addressof:src_gamut map 
      if ink1:opacity=defined and ink1:opacity>0
        conv opacity := true
    var (Dictionary Str Int) component
    for (var Int i) 0 src_gamut:dimension-1
    var ColorPartConversion part
    part grid :> grid
    conv part += part
    conv single := true
  else
    # check (entry_type addressof:src_gamut)=ColorGamutSubst
    for (var Int i) 0 src_gamut:dimension-1
      var Pointer:ColorInk ink1 :> (addressof:src_gamut map 
      if ink1:opacity=defined and ink1:opacity>0
        conv opacity := true
    var (Dictionary Str Int) component
    for (var Int i) 0 src_gamut:dimension-1
      component insert (src_gamut query "component_name "+st
      part add_component
        for (var Int j) 0 conv:direct:size-1
          if conv:direct:j:src=i and not ((src_gamut query "component_options "+string:i) option "visible")
            leave add_component
        component insert (src_gamut query "component_name "+string:i) i
    while component:size>0
      var Int best_count := 0 ; var Str best_grid ; var Int 
      if (options option "grid" Str)<>""
        var Str all := options option "grid" Str ; var Int c
        while all<>""
          if not (all parse any:(var Str ink) "+" any:(var S
            ink := all ; remain := ""
          if exists:(component first ink)
            count += 1
          all := remain
        best_count := count ; best_grid := options option "g
      if best_count<2
        each g device:grid
          var Str all := keyof g ; var Int count := 0
          while all<>""
            if not (all parse any:(var Str ink) "+" any:(var
              ink := all ; remain := ""
            if exists:(component first ink)
              count += 1
            all := remain
          if count>best_count
            best_count := count ; best_grid := keyof g ; bes
      if best_count>1
        var ColorPartConversion part
        part:mapping size := 0
        var Str all := best_grid
        while all<>""
          if not (all parse any:(var Str ink) "+" any:(var S
            ink := all ; remain := ""
          if exists:(component first ink)
            part mapping += component first ink
            component -= component first ink
          else
            part mapping += undefined
          all := remain
        part gamut :> color_gamut keyof:device+":"+best_grid
        if part:gamut=failure
          console "Incorrect gamut " keyof:device+":"+best_g
          conv :> null map ColorSplitConversion
          return
        part grid :> color_grid_conversion part:gamut dest_g
        conv part += part
      else
        each comp component
          var ColorPartConversion part
          part:mapping size := 1
          part:mapping 0 := comp
          part gamut :> color_gamut keyof:device+":"+(compon
          if part:gamut=failure
            console "Incorrect gamut " keyof:device+":"+(com
            conv :> null map ColorSplitConversion
            return
          part grid :> color_grid_conversion part:gamut dest
          conv part += part
        component := var (Dictionary Str Int) empty_dict
  conv limit := (dest_gamut query "options") option "limit" 
  if hash_conversion
    conv cache_size := options option "hash" Int 63541
    conv cache_buffer := memory_zallocate conv:cache_size*(u


method conv apply src_pixel src_gamut dest_pixel dest_gamut
  arg_rw ColorSplitConversion conv ; arg Address src_pixel ;
  # check (entry_type addressof:src_gamut)=ColorGamutSubstra
  if hash_conversion
    var Int src_psize := src_gamut pixel_size
    var Int dest_psize := dest_gamut pixel_size
    var uInt key := 0
    update_hash_key key src_pixel src_psize
    key %= conv cache_size
    var Pointer:uInt sem :> (conv:cache_buffer translate Byt
    var Address ptr := addressof:sem translate uInt 1
    part aquire
      var uInt u := atomic_read_and_set sem 2
      if u=1 # cell is defined and not locked
        if not (memory_different ptr src_psize src_pixel src
          memory_copy (ptr translate Byte src_psize) dest_pi
          sem := 1
          return
        sem := 1
      eif u=0 # cell is not defined
        sem := 0
      else # u=2 : cell is locked
        os_yield
        restart aquire
  if conv:single
    conv:part:0:grid apply src_pixel src_gamut dest_pixel de
  else
    var Address ptr0
    if conv:opacity
      (addressof:src_gamut map ColorGamutSubstractive) apply
      ptr0 := addressof pixel0
    else
      ptr0 := src_pixel
    var (Array Float32 gamut_maximum_dimension) result
    for (var Int j) 0 dest_gamut:dimension-1
      result j := 0
    while component:size>0
      var Int best_count := 0 ; var Str best_grid ; var Int 
      if (options option "grid" Str)<>""
        var Str all := options option "grid" Str ; var Int c
        while all<>""
          if not (all parse any:(var Str ink) "+" any:(var S
            ink := all ; remain := ""
          if exists:(component first ink)
            count += 1
          all := remain
        best_count := count ; best_grid := options option "g
      if best_count<2
        each g device:grid
          var Str all := keyof g ; var Int count := 0
          while all<>""
            if not (all parse any:(var Str ink) "+" any:(var
              ink := all ; remain := ""
            if exists:(component first ink)
              count += 1
            all := remain
          if count>best_count
            best_count := count ; best_grid := keyof g ; bes
      if best_count>1
        var ColorPartConversion part
        part:mapping size := 0
        var Str all := best_grid
        while all<>""
          if not (all parse any:(var Str ink) "+" any:(var S
            ink := all ; remain := ""
          if exists:(component first ink)
            part mapping += component first ink
            component -= component first ink
          else
            part mapping += undefined
          all := remain
        part gamut :> color_gamut keyof:device+":"+best_grid
        if part:gamut=failure
          console "Incorrect gamut " keyof:device+":"+best_g
          conv :> null map ColorSplitConversion
          return
        part grid :> color_grid_conversion part:gamut dest_g
        conv part += part
      else
        each comp component
          var ColorPartConversion part
          part:mapping size := 1
          part:mapping 0 := comp
          part gamut :> color_gamut keyof:device+":"+(compon
          if part:gamut=failure
            console "Incorrect gamut " keyof:device+":"+(com
            conv :> null map ColorSplitConversion
            return
          part grid :> color_grid_conversion part:gamut dest
          conv part += part
        component := var (Dictionary Str Int) empty_dict
  conv limit := (dest_gamut query "options") option "limit" 
  if hash_conversion
    conv cache_size := options option "hash" Int 63541
    conv cache_buffer := memory_zallocate conv:cache_size*(u


method conv apply src_pixel src_gamut dest_pixel dest_gamut
  arg_rw ColorSplitConversion conv ; arg Address src_pixel ;
  # check (entry_type addressof:src_gamut)=ColorGamutSubstra
  if hash_conversion
    var Int src_psize := src_gamut pixel_size
    var Int dest_psize := dest_gamut pixel_size
    var uInt key := 0
    update_hash_key key src_pixel src_psize
    key %= conv cache_size
    var Pointer:uInt sem :> (conv:cache_buffer translate Byt
    var Address ptr := addressof:sem translate uInt 1
    part aquire
      var uInt u := atomic_read_and_set sem 2
      if u=1 # cell is defined and not locked
        if not (memory_different ptr src_psize src_pixel src
          memory_copy (ptr translate Byte src_psize) dest_pi
          sem := 1
          return
        sem := 1
      eif u=0 # cell is not defined
        sem := 0
      else # u=2 : cell is locked
        os_yield
        restart aquire
  if conv:single
    conv:part:0:grid apply src_pixel src_gamut dest_pixel de
  else
    var Address ptr0
    if conv:opacity
      (addressof:src_gamut map ColorGamutSubstractive) apply
      ptr0 := addressof pixel0
    else
      ptr0 := src_pixel
    var (Array Float32 gamut_maximum_dimension) result
    for (var Int j) 0 dest_gamut:dimension-1
      result j := 0
    if direct_is_linear and conv:direct:size>0
      src_gamut decode src_pixel (var (Array Float32 gamut_maximum_dimension) f)
      for (var Int i) 0 conv:direct:size-1
        var Pointer:ColorDirectConversion direct :> conv:direct i
        var Float v := f direct:src
        if v<>0
          for (var Int j) 0 direct:dest:size-1
            result j += v*direct:dest:j
    for (var Int i) 0 conv:part:size-1
      var Pointer:ColorPartConversion part :> conv:part i
      var ColorBuffer pixel1
      for (var Int j) 0 part:mapping:size-1
        if part:mapping:j=defined
          addressof:pixel1 map uInt8 j := ptr0 map uInt8 par
        else
          addressof:pixel1 map uInt8 j := 0
      var ColorBuffer pixel2
      conv:part:i:grid apply addressof:pixel1 part:gamut add
      dest_gamut decode addressof:pixel2 (var (Array Float32
      for (var Int j) 0 dest_gamut:dimension-1
        result j += f:j*(1-result:j)
    if conv:limit=defined
      var Float total := 0
      for (var Int j) 0 dest_gamut:dimension-1
        total += result j
      if total>conv:limit
        var Float remove := (total-conv:limit)/(shunt dest_g
        for (var Int j) 0 dest_gamut:dimension-1
          if j<>3 # leave black unmodified
            result j -= remove
    dest_gamut encode result dest_pixel
    for (var Int i) 0 conv:part:size-1
      var Pointer:ColorPartConversion part :> conv:part i
      var ColorBuffer pixel1
      for (var Int j) 0 part:mapping:size-1
        if part:mapping:j=defined
          addressof:pixel1 map uInt8 j := ptr0 map uInt8 par
        else
          addressof:pixel1 map uInt8 j := 0
      var ColorBuffer pixel2
      conv:part:i:grid apply addressof:pixel1 part:gamut add
      dest_gamut decode addressof:pixel2 (var (Array Float32
      for (var Int j) 0 dest_gamut:dimension-1
        result j += f:j*(1-result:j)
    if conv:limit=defined
      var Float total := 0
      for (var Int j) 0 dest_gamut:dimension-1
        total += result j
      if total>conv:limit
        var Float remove := (total-conv:limit)/(shunt dest_g
        for (var Int j) 0 dest_gamut:dimension-1
          if j<>3 # leave black unmodified
            result j -= remove
    dest_gamut encode result dest_pixel
    if not direct_is_linear
      for (var Int i) 0 conv:direct:size-1
        var Pointer:ColorDirectConversion direct :> conv:direct i
        var Int v := src_pixel map uInt8 direct:src
        if v<>0
          for (var Int j) 0 direct:dest:size-1
            var Float w := direct:dest j
            if w<>0
              dest_pixel map uInt8 j := min (cast (dest_pixel map uInt8 j) + v*w Int) 255
  if hash_conversion
    part lock
      var uInt u := atomic_read_and_set sem 2
      if u=2
        os_yield
        restart lock
    memory_copy src_pixel ptr src_psize
    memory_copy dest_pixel (ptr translate Byte src_psize) de
    sem := 1



method dest_gamut convert src_gamut src_pixels dest_pixels c
  oarg ColorGamutRGB dest_gamut ; oarg ColorGamut src_gamut 
  if speedup<>null
    if entry_type:speedup=Void
      var Link:ColorGamutSubstractive g :> addressof:src_gam
  if hash_conversion
    part lock
      var uInt u := atomic_read_and_set sem 2
      if u=2
        os_yield
        restart lock
    memory_copy src_pixel ptr src_psize
    memory_copy dest_pixel (ptr translate Byte src_psize) de
    sem := 1



method dest_gamut convert src_gamut src_pixels dest_pixels c
  oarg ColorGamutRGB dest_gamut ; oarg ColorGamut src_gamut 
  if speedup<>null
    if entry_type:speedup=Void
      var Link:ColorGamutSubstractive g :> addressof:src_gam
      var Address s := src_pixels ; var Address stop := src_
      var Address d := dest_pixels
      var Address s := src_pixels ; var Int src_psize := src_gamut pixel_size
      var Address stop := src_pixels translate Byte count*g:pixel_size
      var Address d := dest_pixels ; var Int dest_psize := dest_gamut pixel_size
      while s<>stop
      while s<>stop
        (var ColorFast cf) init
        if g:reverse_printing
          for (var Int i) g:dimension-1 0 step -1
            cf apply g:component:i:ink (s map uInt8 i)
        if s<>src_pixels and not (memory_different s src_psize (s translate Byte -src_psize) src_psize)
          memory_copy (d translate Byte -dest_psize) d dest_psize
        else
        else
          for (var Int i) 0 g:dimension-1
            cf apply g:component:i:ink (s map uInt8 i)
        cf terminate (d map ColorRGB888)
        s := s translate Byte g:pixel_size ; d := d translat
          (var ColorFast cf) init
          if g:reverse_printing
            for (var Int i) g:dimension-1 0 step -1
              cf apply g:component:i:ink (s map uInt8 i)
          else
            for (var Int i) 0 g:dimension-1
              cf apply g:component:i:ink (s map uInt8 i)
          cf terminate (d map ColorRGB888)
        s := s translate Byte src_psize ; d := d translate Byte dest_psize
      transparency_convert src_pixels src_gamut dest_pixels 
    eif entry_type:speedup=ColorGridConversion
      var Link:ColorGridConversion gconv :> speedup map Colo
      var Address s := src_pixels ; var Int src_psize := src
      var Address stop := src_pixels translate Byte count*sr
      var Address d := dest_pixels ; var Int dest_psize := d
      while s<>stop
        if s<>src_pixels and not (memory_different s src_psi
          memory_copy (d translate Byte -dest_psize) d dest_
        else
          gconv apply s src_gamut d dest_gamut
        s := s translate Byte src_psize ; d := d translate B
      transparency_convert src_pixels src_gamut dest_pixels 
    eif entry_type:speedup=ColorSplitConversion
      var Link:ColorSplitConversion sconv :> speedup map Col
      var Address s := src_pixels ; var Int src_psize := src
      var Address stop := src_pixels translate Byte count*sr
      var Address d := dest_pixels ; var Int dest_psize := d
      while s<>stop
        if s<>src_pixels and not (memory_different s src_psi
          memory_copy (d translate Byte -dest_psize) d dest_
        else
          sconv apply s src_gamut d dest_gamut
        s := s translate Byte src_psize ; d := d translate B
      transparency_convert src_pixels src_gamut dest_pixels 
  eif src_gamut:model=color_gamut_additive
    var CBool src_gamut_reversed := (addressof:src_gamut map
    if dest_gamut:pixel_size=src_gamut:pixel_size and dest_g
      memory_copy src_pixels dest_pixels count*dest_gamut:pi
    else
      if dest_gamut:pixel_size=1
        bytes_copy (src_pixels translate uInt8 src_gamut:dim
      eif src_gamut:pixel_size=1
        for (var Int c) 0 2
          bytes_copy src_pixels src_gamut:pixel_size (dest_p
      eif dest_gamut:reversed=src_gamut_reversed
        bytes_copy24 src_pixels src_gamut:pixel_size dest_pi
      else
        for (var Int c) 0 2
          bytes_copy (src_pixels translate uInt8 2-c) src_ga
      if dest_gamut:transparency=1 and src_gamut:transparenc
        bytes_copy (src_pixels translate uInt8 src_gamut:dim
      eif dest_gamut:transparency=1
        bytes_fill (dest_pixels translate uInt8 dest_gamut:d
  else
    default_convert src_pixels src_gamut dest_pixels dest_ga



method g speedup src_gamut options -> speedup
  oarg ColorGamutSubstractive g ; oarg ColorGamut src_gamut 
      transparency_convert src_pixels src_gamut dest_pixels 
    eif entry_type:speedup=ColorGridConversion
      var Link:ColorGridConversion gconv :> speedup map Colo
      var Address s := src_pixels ; var Int src_psize := src
      var Address stop := src_pixels translate Byte count*sr
      var Address d := dest_pixels ; var Int dest_psize := d
      while s<>stop
        if s<>src_pixels and not (memory_different s src_psi
          memory_copy (d translate Byte -dest_psize) d dest_
        else
          gconv apply s src_gamut d dest_gamut
        s := s translate Byte src_psize ; d := d translate B
      transparency_convert src_pixels src_gamut dest_pixels 
    eif entry_type:speedup=ColorSplitConversion
      var Link:ColorSplitConversion sconv :> speedup map Col
      var Address s := src_pixels ; var Int src_psize := src
      var Address stop := src_pixels translate Byte count*sr
      var Address d := dest_pixels ; var Int dest_psize := d
      while s<>stop
        if s<>src_pixels and not (memory_different s src_psi
          memory_copy (d translate Byte -dest_psize) d dest_
        else
          sconv apply s src_gamut d dest_gamut
        s := s translate Byte src_psize ; d := d translate B
      transparency_convert src_pixels src_gamut dest_pixels 
  eif src_gamut:model=color_gamut_additive
    var CBool src_gamut_reversed := (addressof:src_gamut map
    if dest_gamut:pixel_size=src_gamut:pixel_size and dest_g
      memory_copy src_pixels dest_pixels count*dest_gamut:pi
    else
      if dest_gamut:pixel_size=1
        bytes_copy (src_pixels translate uInt8 src_gamut:dim
      eif src_gamut:pixel_size=1
        for (var Int c) 0 2
          bytes_copy src_pixels src_gamut:pixel_size (dest_p
      eif dest_gamut:reversed=src_gamut_reversed
        bytes_copy24 src_pixels src_gamut:pixel_size dest_pi
      else
        for (var Int c) 0 2
          bytes_copy (src_pixels translate uInt8 2-c) src_ga
      if dest_gamut:transparency=1 and src_gamut:transparenc
        bytes_copy (src_pixels translate uInt8 src_gamut:dim
      eif dest_gamut:transparency=1
        bytes_fill (dest_pixels translate uInt8 dest_gamut:d
  else
    default_convert src_pixels src_gamut dest_pixels dest_ga



method g speedup src_gamut options -> speedup
  oarg ColorGamutSubstractive g ; oarg ColorGamut src_gamut 
  var Data:ColorDevice device
  if (entry_type addressof:src_gamut)=ColorGamutSubstractive
    device :> color_database:data:device (addressof:src_gamu
  if (entry_type addressof:src_gamut)=ColorGamutSubstractive
    var (Link Array:Int) mapping :> new Array:Int
    for (var Int i) 0 src_g:dimension-1
      part map_component
        for (var Int j) 0 g:dimension-1
          if src_g:component:i:name=g:component:j:name
            mapping += i ; mapping += j
            leave map_component
    speedup := addressof mapping
  else
    fast_simulation_sem request
    if (options option "hurry") and not (exists g:fast_simul
      (addressof:g omap ColorGamutSubstractive) another_gamu
      (addressof:g omap ColorGamutSubstractive) xyz_gamut :>
      (addressof:g omap ColorGamutSubstractive) fast_simulat
    fast_simulation_sem release
    if device:grid:size>0
      var Link:ColorSplitConversion sconv :> color_split_con
      speedup := addressof sconv
  part setup "color conversion speedup "+src_gamut:name+" -> "+g:name+" with options "+options
    var Data:ColorDevice device
    if (entry_type addressof:src_gamut)=ColorGamutSubstractive
      device :> color_database:data:device (addressof:src_gamut map ColorGamutSubstractive):device
    if (entry_type addressof:src_gamut)=ColorGamutSubstractive and { var Link:ColorGamutSubstractive src_g :> addressof:src_gamut map ColorGamutSubstractive ; src_g:device=g:device }
      var (Link Array:Int) mapping :> new Array:Int
      for (var Int i) 0 src_g:dimension-1
        part map_component
          for (var Int j) 0 g:dimension-1
            if src_g:component:i:name=g:component:j:name
              mapping += i ; mapping += j
              leave map_component
      speedup := addressof mapping
    else
    else
      var Link:ColorGridConversion gconv :> color_grid_conve
      if hash_rgb
        var Link:ColorSplitConversion sconv :> color_split_c
      fast_simulation_sem request
      if (options option "hurry") and not (exists g:fast_simulation) and g:dimension<=4
        (addressof:g omap ColorGamutSubstractive) another_gamut :> color_gamut g:name g:options+" another"
        (addressof:g omap ColorGamutSubstractive) xyz_gamut :> color_gamut "XYZ"
        (addressof:g omap ColorGamutSubstractive) fast_simulation :> color_grid_conversion g:another_gamut g:xyz_gamut (options option "hurry" Int 33) false
      fast_simulation_sem release
      if device:grid:size>0
        var Link:ColorSplitConversion sconv :> color_split_conversion src_gamut g device (null map ColorGridConversion) options
        speedup := addressof sconv
      else
        speedup := addressof sconv
      else
        speedup := addressof gconv
        var Link:ColorGridConversion gconv :> color_grid_conversion src_gamut g (options option "grid_steps" Int) true
        if hash_rgb
          var Link:ColorSplitConversion sconv :> color_split_conversion src_gamut g device gconv options
          speedup := addressof sconv
        else
          speedup := addressof gconv


export color_gamut_compute color_gamut_profile


export color_gamut_compute color_gamut_profile