Patch title: Release 90 bulk changes
Abstract:
File: /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 "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/language/stream.pli"
module "/pliant/admin/md5.pli"
module "database.pli"
module "adjust.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 "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/language/stream.pli"
module "/pliant/admin/md5.pli"
module "database.pli"
module "adjust.pli"
module "/pliant/language/data/cache.pli"


  type ColorGamut


  type ColorGamut
    inherit CachePrototype
    field Int pixel_size
    field Int dimension
    field Int transparency <- 0
    field Int padding <- 0
    field Int bits_per_component <- 8
    field Str name
    field Int model <- 0
    field ExtendedStatus status <- failure
    field Int pixel_size
    field Int dimension
    field Int transparency <- 0
    field Int padding <- 0
    field Int bits_per_component <- 8
    field Str name
    field Int model <- 0
    field ExtendedStatus status <- failure

  CachePrototype maybe ColorGamut
  
  
  method p drop # avoid clashing with CachePrototype
    oarg_rw ColorGamut p
    generic

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


type ColorGamutSubstractive
  inherit ColorGamut
  field Array:ColorComponent component
  field Str device options
  field CBool multiple_transparency <- false
  method g decode pixel components
    oarg ColorGamut g ; arg Address pixel ; arg_w (Array Flo
    generic


type ColorGamutSubstractive
  inherit ColorGamut
  field Array:ColorComponent component
  field Str device options
  field CBool multiple_transparency <- false
  field CBool no_opacity <- true
  field CBool no_opacity <- false
  field CBool reverse_printing <- false
  field Int negatives <- 0
  
ColorGamut maybe ColorGamutSubstractive



method gamut apply_opacity src dest
  arg ColorGamutSubstractive gamut ; arg Address src dest
  memory_copy src dest gamut:pixel_size
  field Int negatives <- 0
  
ColorGamut maybe ColorGamutSubstractive



method gamut apply_opacity src dest
  arg ColorGamutSubstractive gamut ; arg Address src dest
  memory_copy src dest gamut:pixel_size
  for (var Int i) 0 gamut:dimension-1
    var Pointer:ColorInk ink :> gamut:component:i ink
    if ink:opacity=defined and ink:opacity>0
      var Float d := ink:gradation decode (dest map uInt8 i)
      if d>0
        var Float f := 1-ink:opacity*d
        for (var Int j) 0 i-1
          var Pointer:uInt8 p :> dest map uInt8 j
          var Pointer:ColorGradation g :> gamut:component:j:
          p := g encode (g decode p)*f
  if gamut:reverse_printing
    for (var Int i) gamut:dimension-1 0 step -1
      var Pointer:ColorInk ink :> gamut:component:i ink
      if ink:opacity=defined and ink:opacity>0
        var Float d := ink:gradation decode (dest map uInt8 i)
        if d>0
          var Float f := 1-ink:opacity*d
          for (var Int j) i+1 gamut:dimension-1
            var Pointer:uInt8 p :> dest map uInt8 j
            var Pointer:ColorGradation g :> gamut:component:j:ink gradation
            p := g encode (g decode p)*f
  else
    for (var Int i) 0 gamut:dimension-1
      var Pointer:ColorInk ink :> gamut:component:i ink
      if ink:opacity=defined and ink:opacity>0
        var Float d := ink:gradation decode (dest map uInt8 i)
        if d>0
          var Float f := 1-ink:opacity*d
          for (var Int j) 0 i-1
            var Pointer:uInt8 p :> dest map uInt8 j
            var Pointer:ColorGradation g :> gamut:component:j:ink gradation
            p := g encode (g decode p)*f




method gamut apply_deaden pixel filter
  arg ColorGamutSubstractive gamut ; arg Address pixel ; arg_rw ColorSpectrum32 filter
  var Float total := 0 ; var Float maxi := 0
  for (var Int i) 0 gamut:dimension-1
    var Pointer:ColorInk ink :> gamut:component:i ink
    var Float d := ink:gradation decode (pixel map uInt8 i)
    var Float deaden := d*ink:deaden
    total += deaden ; maxi := max maxi deaden
  if total>maxi
    filter += cast total-maxi ColorSpectrum32

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
    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
    if white_mapping
      filter := cast 1 ColorSpectrum32
    else
      var Pointer:ColorSpectrum32 s0 :> gamut:component:0:in
      var Float Y0 := illuminant_spectrum*s0 Y
      filter := (1/Y0)*s0
    var Int negatives := gamut negatives
    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)
        var Pointer:ColorComponent c :> gamut:component:i
        if m=0
          filter *= c:ink:filter p
        else
          check positive
          filter := filter*(c:ink:filter p)/(c:ink:filter m)

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
    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
    if white_mapping
      filter := cast 1 ColorSpectrum32
    else
      var Pointer:ColorSpectrum32 s0 :> gamut:component:0:in
      var Float Y0 := illuminant_spectrum*s0 Y
      filter := (1/Y0)*s0
    var Int negatives := gamut negatives
    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)
        var Pointer:ColorComponent c :> gamut:component:i
        if m=0
          filter *= c:ink:filter p
        else
          check positive
          filter := filter*(c:ink:filter p)/(c:ink:filter m)
    gamut apply_deaden pixel filter
    if gamut:component:size>gamut_maximum_dimension
      memory_free plus ; memory_free minus


method gamut try_formulate color pixel b0 b1 -> distance
  oarg ColorGamutSubstractive gamut ; arg ColorXYZ color ; a
  if gamut:dimension>=4
    if gamut:component:size>gamut_maximum_dimension
      memory_free plus ; memory_free minus


method gamut try_formulate color pixel b0 b1 -> distance
  oarg ColorGamutSubstractive gamut ; arg ColorXYZ color ; a
  if gamut:dimension>=4
    var Float best := 1e10 ; var Int black
    distance := 1e10
    (var Array:Int using) size := 3 ; using 2 := 3
    for using:0 0 gamut:dimension-1
      for using:1 using:0+1 gamut:dimension-1
        if using:0<>3 and using:1<>3
    (var Array:Int using) size := 3 ; using 2 := 3
    for using:0 0 gamut:dimension-1
      for using:1 using:0+1 gamut:dimension-1
        if using:0<>3 and using:1<>3
          memory_clear pixel gamut:pixel_size
          var Float d := gamut try_formulate color pixel usi
          if d<best
            best := d ; black := pixel map uInt8 3
          memory_clear addressof:(var ColorBuffer test) gamut:pixel_size
          var Float d := gamut try_formulate color addressof:test using
          if d<distance
            memory_copy addressof:test pixel gamut:pixel_size ; distance := d
    using 0 := 0 ; using 1 := 1 ; using 2 := 2
    using 0 := 0 ; using 1 := 1 ; using 2 := 2
    memory_clear pixel gamut:pixel_size ; pixel map uInt8 3 
    var Float d := gamut try_formulate color pixel using
    if d<best
      best := d ; black := 255
    memory_clear addressof:test gamut:pixel_size ; test:bytes 3 := 255
    var Float d := gamut try_formulate color addressof:test using
    if d<distance
      memory_copy addressof:test pixel gamut:pixel_size ; distance := d
    var Int black := pixel map uInt8 3
    if black>=b1
      void
    eif black<b0
      black := 0
    else
      black := b1*(black-b0)\(b1-b0)
    if black>=b1
      void
    eif black<b0
      black := 0
    else
      black := b1*(black-b0)\(b1-b0)
    gamut fill_pixel pixel ; pixel map uInt8 3 := black
    gamut fill_pixel addressof:test ; test:bytes 3 := black
    using 0 := 0 ; using 1 := 1 ; using 2 := 2
    using 0 := 0 ; using 1 := 1 ; using 2 := 2
    distance := gamut try_formulate color pixel using
    d := gamut try_formulate color addressof:test using
    if d<distance
      memory_copy addressof:test pixel gamut:pixel_size ; distance := d
  else
    gamut fill_pixel pixel
    (var Array:Int using) size := gamut dimension
    for (var Int i) 0 using:size-1
      using i := i
    distance := gamut try_formulate color pixel using


  else
    gamut fill_pixel pixel
    (var Array:Int using) size := gamut dimension
    for (var Int i) 0 using:size-1
      using i := i
    distance := gamut try_formulate color pixel using


function rgb_gamut name transparency padding reversed option
  arg Str name ; arg Int transparency padding ; arg CBool re
  g :> new ColorGamutRGB
function rgb_gamut g name transparency padding reversed options
  arg_rw ColorGamutRGB g ; arg Str name ; arg Int transparency padding ; arg CBool reversed ; arg Str options
  g name := name
  g pixel_size := 3+transparency+padding
  g dimension := 3
  g transparency := transparency
  g padding := padding
  g model := color_gamut_additive
  g reversed := reversed
  g status := success
  g options := options

function color_gamut name options -> g
  arg Str name options ; arg Link:ColorGamut g
  g name := name
  g pixel_size := 3+transparency+padding
  g dimension := 3
  g transparency := transparency
  g padding := padding
  g model := color_gamut_additive
  g reversed := reversed
  g status := success
  g options := options

function color_gamut name options -> g
  arg Str name options ; arg Link:ColorGamut g
  if name="rgb"
    g :> rgb_gamut name 0 0 false options
  eif name="rgb32"
    g :> rgb_gamut name 0 1 false options
  eif name="bgr"
    g :> rgb_gamut name 0 0 true options
  eif name="bgr32"
    g :> rgb_gamut name 0 1 true options
  eif name="rgba"
    g :> rgb_gamut name 1 0 false options
  var Pointer:Type t
  if (name parse any:(var Str device) ":" any:(var Str inks))
    t :> ColorGamutSubstractive
  eif name="grey"
  eif name="grey"
    g :> new ColorGamut
    g name := "grey"
    g pixel_size := 1
    g dimension := 1
    g model := color_gamut_additive
  eif (name parse any:(var Str device) ":" any:(var Str inks
    var Link:ColorGamutSubstractive gs :> new ColorGamutSubs
    gs name := name
    gs model := color_gamut_substractive
    inks := replace inks "cmyk" "process_cyan+process_magent
    while inks<>""
      if not (inks parse any:(var Str ink) "+" any:(var Str 
        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 dim
        gc name := ink
        if (ink parse any:(var Str base) "#" any)
          ink := base
        gc ink :> color_ink (shunt (ink search ":" -1)=(-1) 
        if gc:ink=failure
          g :> new ColorGamut
          g name := name
          g status := failure (shunt (exists color_database:
          return
        gc mask := 2^dim
        if (gc:ink:options option "negative")
          gs negatives += 2^dim
        dim += 1
      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:device:de
    if not (opt option "nocomposed")
      each ch color_database:data:device:device:channel
        if (keyof:ch search "+" -1)<>(-1)
          gs add_component device+":" keyof:ch
    gs device := device
    gs options := color_database:data:device:device options
    gs no_opacity := options option "no_opacity"
    gs status := success
    g :> gs 
    t :> ColorGamut
  else
  else
    g :> new ColorGamut
    t :> ColorGamutRGB
  plugin extra_types
  if (cache_open "/pliant/color/gamut/"+string:name+options t ((addressof Link:ColorGamut g) map Link:CachePrototype))
    g name := name
    g name := name
    g status := failure "Unsuppoted color gamut name ("+name
    console "no '"+name+"' gamut" eol
  plugin extra_gamuts
    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 ColorGamutRGB
        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=ColorGamutSubstractive
        var Pointer:ColorGamutSubstractive gs :> addressof:g map ColorGamutSubstractive
        gs model := color_gamut_substractive
        inks := replace inks "cmyk" "process_cyan+process_magenta+process_yellow+process_black" ; var Int dim := 0
        while inks<>""
          if not (inks parse any:(var Str ink) "+" any:(var Str remain))
            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 dim
            gc name := ink
            if (ink parse any:(var Str base) "#" any)
              ink := base
            gc ink :> color_ink (shunt (ink search ":" -1)=(-1) device+":"+ink ink) options
            if gc:ink=failure
              g status := failure (shunt (exists color_database:data:device:device:channel:ink) "Bad" "Unknown")+" '"+ink+"' ink"
              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
          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:device:device:options
        if not (opt option "nocomposed")
          each ch color_database:data:device:device:channel # SLOW !
            if (keyof:ch search "+" -1)<>(-1)
              gs add_component device+":" keyof:ch
        gs device := device
        gs options := color_database:data:device:device options
        gs no_opacity := options option "no_opacity"
        gs status := success
    plugin extra_gamuts
    if g:status=success
      cache_ready ((addressof Link:ColorGamut g) map Link:CachePrototype)
    else
      cache_cancel ((addressof Link:ColorGamut g) map Link:CachePrototype)
      g :> new ColorGamut




constant grid_conversion_release 9
constant grid_conversion_release 10
constant grid_conversion_cache 16


type ColorGridConversion
constant grid_conversion_cache 16


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

  field Array:Float32 mapping
  field Int dim
  field Int steps
  field Int done
  field Str key

CachePrototype maybe ColorGridConversion


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
  if cached
    conv key := string_md5_hexa_signature (string src_gamut:
  (var Stream s) open "data:/pliant/graphic/cache/"+conv:key
  if s=success
    while s:readline<>""
      void
    s raw_read (addressof conv:mapping:0) conv:mapping:size*
    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 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 src_gamut:pixel_size=src_gamut:dimension
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
  if cached
    conv key := string_md5_hexa_signature (string src_gamut:
  (var Stream s) open "data:/pliant/graphic/cache/"+conv:key
  if s=success
    while s:readline<>""
      void
    s raw_read (addressof conv:mapping:0) conv:mapping:size*
    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 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 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
  for (var Int d) 0 src_gamut:dimension-1
    var Int v := src_pixel map uInt8 d
    if v<>0 or src_gamut:model=color_gamut_additive
    if v=0
      void
    eif v=255
      base += (steps-1)*unit
    else
      var Int i := min v*(steps-1)\255 steps-2
      var Int i := min v*(steps-1)\255 steps-2
      gs n := steps^d
      base += i*gs:n
      gs n := unit
      base += i*unit
      remain n := ( v - i*255\(steps-1) ) / ( (i+1)*255\(ste
      n += 1
      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
      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
    for (var Int d) 0 dest_gamut:dimension-1
      result d += f*p
      p :> addressof:p map Float32 1
  dest_gamut encode result dest_pixel


  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
      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
    for (var Int d) 0 dest_gamut:dimension-1
      result d += f*p
      p :> addressof:p map Float32 1
  dest_gamut encode result dest_pixel


gvar Sem grid_sem
gvar Dictionary grid_dict

function color_grid_conversion src_gamut dest_gamut steps ca
  oarg ColorGamut src_gamut dest_gamut ; arg Int steps ; arg
function color_grid_conversion src_gamut dest_gamut steps ca
  oarg ColorGamut src_gamut dest_gamut ; arg Int steps ; arg
  grid_sem request
  var Str k := (string src_gamut:name)+" "+string:(src_gamut
  var Str k := (string src_gamut:name)+" "+string:(src_gamut
  var Pointer:Arrow c :> grid_dict first k
  if c<>null
    conv :> c map ColorGridConversion
  else
    if grid_dict:count>=grid_conversion_cache
      grid_dict := var Dictionary empty_dictionary
    conv :> new ColorGridConversion
  if (cache_open "/pliant/color/grid/"+k ColorGridConversion ((addressof Link:ColorGridConversion conv) map Link:CachePrototype))
    var Int dim := src_gamut:dimension
    conv compute src_gamut dest_gamut (shunt steps=defined s
    var Int dim := src_gamut:dimension
    conv compute src_gamut dest_gamut (shunt steps=defined s
    grid_dict insert k true addressof:conv
  grid_sem release
    cache_ready ((addressof Link:ColorGridConversion conv) map Link:CachePrototype)




function color_gamut_cache_reset
  grid_sem request
  grid_dict := var Dictionary empty_dictionary
  grid_sem release

export color_gamut_cache_reset


#-----------------------------------------------------------
#   many components conversions



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
      while s<>stop
        (var ColorFast cf) init
#-----------------------------------------------------------
#   many components conversions



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
      while s<>stop
        (var ColorFast cf) init
        for (var Int i) 0 g:dimension-1
          cf apply g:component:i:ink (s map uInt8 i)
        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 g:pixel_size ; d := d translat
      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



export color_gamut_compute color_gamut_profile
        cf terminate (d map ColorRGB888)
        s := s translate Byte g:pixel_size ; d := d translat
      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



export color_gamut_compute color_gamut_profile