Patch title: Release 82 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 "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/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"

constant specular_forwarding false

constant hash_conversion true constant hash_rgb true

method g configure parameter value -> status oarg_rw ColorGamut g ; arg Str parameter value ; arg ExtendedStatus status generic status := failure "unsupported"

function 'cast ExtendedStatus' g -> status arg ColorGamut g; arg ExtendedStatus status extension status := g status type ColorGamutRGB inherit ColorGamut field CBool reversed

field Str options

ColorGamut maybe ColorGamutRGB method g encode components pixel oarg ColorGamutRGB g ; arg (Array Float32 gamut_maximum_di pixel map ColorRGB888 := addressof:components map ColorRGB

method g query question -> answer oarg ColorGamutRGB g ; arg Str question answer if question="options" answer := g options else answer := ""

method g configure parameter value -> status oarg_rw ColorGamutRGB g ; arg Str parameter value ; arg ExtendedStatus status if parameter="options" g options := value else status := failure "unsupported"

method g simulate pixel -> color oarg ColorGamutRGB g ; arg Address pixel ; arg ColorXYZ co var Address rgb if g:reversed rgb := addressof (var Int32 buffer) for (var Int c) 0 2 rgb map uInt8 c := pixel map uInt8 2-c else rgb := pixel color := cast (rgb map ColorRGB888) ColorXYZ type ColorGamutSubstractive inherit ColorGamut field Array:ColorComponent component field Float specular <- 0

field Float overlapping <- 0

field Str device options field CBool multiple_transparency <- false field CBool no_opacity <- true field Int negatives <- 0 field Str device options field CBool multiple_transparency <- false field CBool no_opacity <- true field Int negatives <- 0

field Int smudges <- 0

ColorGamut maybe ColorGamutSubstractive method gamut simulate pixel -> color 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

if gamut:smudges<>0 var Int t := 0 for (var Int i) 0 gamut:dimension-1 t += pixel2:bytes i for (var Int i) 0 gamut:dimension-1 if (gamut:smudges .and. 2^i)<>0 var Int v := pixel2:bytes i pixel2:bytes i := bound (cast v*(1+(t-v)*gamut:com

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 var ColorSpectrum32 filter := cast 1 ColorSpectrum32 else var Pointer:ColorSpectrum32 s0 :> gamut:component:0:in var Float Y0 := illuminant_spectrum*s0 Y var ColorSpectrum32 filter := (1/Y0)*s0 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 var ColorSpectrum32 filter := cast 1 ColorSpectrum32 else var Pointer:ColorSpectrum32 s0 :> gamut:component:0:in var Float Y0 := illuminant_spectrum*s0 Y var ColorSpectrum32 filter := (1/Y0)*s0

var CBool ol := gamut:overlapping<>0 if ol var Float darkness := 0 for (var Int i) 0 gamut:component:size-1 var Int v := (plus map uInt8 i)-(minus map uInt8 i) if v>0 darkness += v*gamut:component:i:ink:darkness var Float a1 := gamut:overlapping*(1/255) var Float b1 := 1+darkness*a1

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 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)

if ol and positive var Float f := b1-a1*(p-m)*gamut:component:i:ink:d p := bound (cast p*f Int) 0 255 m := bound (cast m*f Int) 0 255

var Pointer:ColorComponent c :> gamut:component:i if m=0 var Pointer:ColorComponent c :> gamut:component:i if m=0

filter := filter*(c:ink:filter p)

filter *= c:ink:filter p

else check positive filter := filter*(c:ink:filter p)/(c:ink:filter m) else check positive filter := filter*(c:ink:filter p)/(c:ink:filter m)

if specular_forwarding if gamut:specular<>0 filter := (1-gamut:specular)*filter+(cast gamut:spec

color := filter_XYZ filter if gamut:component:size>gamut_maximum_dimension memory_free plus ; memory_free minus method gamut formulate color pixel oarg ColorGamutSubstractive gamut ; arg ColorXYZ color ; a part formulate "substractive color formulation "+gamut:nam var Str options := gamut query "options" if not ((options (options option_position "removal" 0) o b0 := 0 ; b1 := 0

var Float delta := options option "delta" Float 1e10

var Float d := gamut try_formulate color pixel b0 b1 var Float d := gamut try_formulate color pixel b0 b1

if d>1 and not (options option "hurry")

if d>delta

var ColorXYZn xyzn := cast color ColorXYZn xyzn Y := bound xyzn:Y 1/16 1-1/16 ; xyzn X := xyzn Y var ColorXYZ grey := cast xyzn ColorXYZ var Float desat := 0.5 ; var Float step := 0.25 while step>0.001 var ColorXYZ middle middle X := color:X*(1-desat)+grey:X*desat middle Y := color:Y*(1-desat)+grey:Y*desat middle Z := color:Z*(1-desat)+grey:Z*desat var Float d := gamut try_formulate middle pixel b0 b var ColorXYZn xyzn := cast color ColorXYZn xyzn Y := bound xyzn:Y 1/16 1-1/16 ; xyzn X := xyzn Y var ColorXYZ grey := cast xyzn ColorXYZ var Float desat := 0.5 ; var Float step := 0.25 while step>0.001 var ColorXYZ middle middle X := color:X*(1-desat)+grey:X*desat middle Y := color:Y*(1-desat)+grey:Y*desat middle Z := color:Z*(1-desat)+grey:Z*desat var Float d := gamut try_formulate middle pixel b0 b

if d<1+16*step

if d<delta+16*step

desat -= step else desat += step desat := bound desat 0 1 step *= 2/3 if desat>=0.5 var ColorLCh lch := cast color ColorLCh console "color calibration oops: desaturation is " (

function rgb_gamut name transparency padding reversed -> g arg Str name ; arg Int transparency padding ; arg CBool re

function rgb_gamut name transparency padding reversed options -> g arg Str name ; arg Int transparency padding ; arg CBool reversed ; arg Str options ; arg Link:ColorGamutRGB g

g :> new ColorGamutRGB 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 :> new ColorGamutRGB 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" function color_gamut name options -> g arg Str name options ; arg Link:ColorGamut g if name="rgb"

g :> rgb_gamut name 0 0 false

g :> rgb_gamut name 0 0 false options

eif name="rgb32" eif name="rgb32"

g :> rgb_gamut name 0 1 false

g :> rgb_gamut name 0 1 false options

eif name="bgr" eif name="bgr"

g :> rgb_gamut name 0 0 true

g :> rgb_gamut name 0 0 true options

eif name="bgr32" eif name="bgr32"

g :> rgb_gamut name 0 1 true

g :> rgb_gamut name 0 1 true options

eif name="rgba" eif name="rgba"

g :> rgb_gamut name 1 0 false

g :> rgb_gamut name 1 0 false options

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 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

if (ink search ":" -1)=(-1) ink := device+":"+ink gc ink :> color_ink ink options

gc ink :> color_ink (shunt (ink search ":" -1)=(-1) device+":"+ink ink) options

if gc:ink=failure g :> new ColorGamut 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 g status := failure (shunt (exists color_database: return gc mask := 2^dim if (gc:ink:options option "negative") gs negatives += 2^dim

if gc:ink:smudge<>0 gs smudges += 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 specular := opt option "specular" Float 0 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 specular := opt option "specular" Float 0

gs overlapping := opt option "overlapping" Float 0

gs device := device gs options := color_database:data:device:device options gs no_opacity := options option "no_opacity" gs status := success g :> gs else g :> new ColorGamut gs device := device gs options := color_database:data:device:device options gs no_opacity := options option "no_opacity" gs status := success g :> gs else g :> new ColorGamut

g name := name

g status := failure "Unsuppoted color gamut name ("+name console "no '"+name+"' gamut" eol plugin extra_gamuts

method conv compute src_gamut dest_gamut steps arg_w ColorGridConversion conv ; oarg ColorGamut src_gamut

method conv compute src_gamut dest_gamut steps cached arg_w ColorGridConversion conv ; oarg ColorGamut src_gamut dest_gamut ; arg Int steps ; arg CBool cached

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 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 key := string_md5_hexa_signature (string src_gamut:na

if cached conv key := string_md5_hexa_signature (string src_gamut:name)+" "+string:(src_gamut query "signature")+" "+(string dest_gamut:name)+" "+string:(dest_gamut query "signature")+" "+string:steps+" "+string:grid_conversion_release

(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 compute_node index src_gamut dest_gamut arg_rw ColorGridConversion conv ; arg Int index ; oarg Col var Str options := dest_gamut query "options" 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 (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 compute_node index src_gamut dest_gamut arg_rw ColorGridConversion conv ; arg Int index ; oarg Col var Str options := dest_gamut query "options" 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) 0 dest_gamut:dimension-1

for (var Int d) dest_gamut:dimension-1 0 step -1

addressof:p map Float32 d := components d conv done += 1 method conv compute_node2 index src_gamut dest_gamut arg_rw ColorGridConversion conv ; arg Int index ; oarg Col part compute "compute lazy color conversion grid node "+(s conv compute_node index src_gamut dest_gamut addressof:p map Float32 d := components d conv done += 1 method conv compute_node2 index src_gamut dest_gamut arg_rw ColorGridConversion conv ; arg Int index ; oarg Col part compute "compute lazy color conversion grid node "+(s conv compute_node index src_gamut dest_gamut

if conv:done%256=0 or conv:done=conv:steps^conv:dim (var Stream s) open "data:/pliant/graphic/cache/"+conv:k s writeline "Pliant color conversion" s writeline "source_gamut "+(string src_gamut:name) s writeline "source_options "+string:(src_gamut query "s s writeline "destination_gamut "+(string dest_gamut:name s writeline "destination_options "+string:(dest_gamut qu s writeline "steps "+(string conv:steps) s writeline "release "+string:grid_conversion_release s writeline "" s raw_write (addressof conv:mapping:0) conv:mapping:size s close console "."

if conv:key<>"" if conv:done%256=0 or conv:done=conv:steps^conv:dim

(var Stream s) open "data:/pliant/graphic/cache/"+conv:key+".bin" out+safe+mkdir s writeline "Pliant color conversion" s writeline "source_gamut "+(string src_gamut:name) s writeline "source_options "+string:(src_gamut query "signature") s writeline "destination_gamut "+(string dest_gamut:name) s writeline "destination_options "+string:(dest_gamut query "signature") s writeline "steps "+(string conv:steps) s writeline "release "+string:grid_conversion_release s writeline "" s raw_write (addressof conv:mapping:0) conv:mapping:size*Float32:size s close

console "."

function color_grid_conversion src_gamut dest_gamut steps -> oarg ColorGamut src_gamut dest_gamut ; arg Int steps ; arg

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

grid_sem request 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 var Int dim := src_gamut:dimension grid_sem request 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 var Int dim := src_gamut:dimension

conv compute src_gamut dest_gamut (shunt steps=defined s

conv compute src_gamut dest_gamut (shunt steps=defined steps src_gamut:model=color_gamut_additive 33 dim<=4 17 dim<=6 9 5) cached

grid_dict insert k true addressof:conv grid_sem release type ColorSplitConversion field Array:ColorPartConversion part

field CBool single <- false field CBool opacity <- false

if hash_conversion field Address cache_buffer

field uInt cache_size if hash_conversion function destroy conv arg_w ColorSplitConversion conv memory_free conv:cache_buffer

function color_split_conversion src_gamut dest_gamut device oarg ColorGamut src_gamut dest_gamut ; arg Data:ColorDevic

function color_split_conversion src_gamut dest_gamut device grid options -> conv oarg ColorGamut src_gamut dest_gamut ; arg Data:ColorDevice device ; arg ColorGridConversion grid ; arg Str options ; arg Link:ColorSplitConversion conv

conv :> new ColorSplitConversion conv :> new ColorSplitConversion

var (Dictionary Str Int) component for (var Int i) 0 src_gamut:dimension-1 component insert (src_gamut query "component_name "+stri while component:size>0 var Int best_count := 0 ; var Str best_grid ; var Int be if (options option "grid" Str)<>"" var Str all := options option "grid" Str ; var Int cou while all<>"" if not (all parse any:(var Str ink) "+" any:(var Str ink := all ; remain := "" if exists:(component first ink) count += 1 all := remain best_count := count ; best_grid := options option "gri if best_count<2 each g device:grid var Str all := keyof g ; var Int count := 0

if exists:grid

var ColorPartConversion part part grid :> grid conv part += part conv single := true else # check (entry_type addressof:src_gamut)=ColorGamutSubstractive for (var Int i) 0 src_gamut:dimension-1 var Pointer:ColorInk ink1 :> (addressof:src_gamut map ColorGamutSubstractive):component:i ink 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 "+string:i) i while component:size>0

var Int best_count := 0 ; var Str best_grid ; var Int best_steps if (options option "grid" Str)<>"" var Str all := options option "grid" Str ; var Int count := 0

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 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

if count>best_count best_count := count ; best_grid := keyof g ; best_ if best_count>1 console " conversion grid " best_grid eol var ColorPartConversion part part:mapping size := 0 var Str all := best_grid while all<>"" if not (all parse any:(var Str ink) "+" any:(var Str 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_gri conv :> null map ColorSplitConversion return part grid :> color_grid_conversion part:gamut dest_gam conv part += part else each comp component

best_count := count ; best_grid := options option "grid" Str ; best_steps := options option "grid_steps" Int undefined

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 Str remain)) ink := all ; remain := "" if exists:(component first ink) count += 1 all := remain if count>best_count best_count := count ; best_grid := keyof g ; best_steps := g if best_count>1

console " conversion grid " best_grid eol

var ColorPartConversion part var ColorPartConversion part

part:mapping size := 1 part:mapping 0 := comp part gamut :> color_gamut keyof:device+":"+(componen

part:mapping size := 0 var Str all := best_grid while all<>"" if not (all parse any:(var Str ink) "+" any:(var Str remain)) 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 "no_opacity"

if part:gamut=failure if part:gamut=failure

console "Incorrect gamut " keyof:device+":"+(compo

console "Incorrect gamut " keyof:device+":"+best_grid eol

conv :> null map ColorSplitConversion return conv :> null map ColorSplitConversion return

part grid :> color_grid_conversion part:gamut dest_g

part grid :> color_grid_conversion part:gamut dest_gamut best_steps true

conv part += part conv part += part

component := var (Dictionary Str Int) empty_dict

else

each comp component var ColorPartConversion part part:mapping size := 1 part:mapping 0 := comp part gamut :> color_gamut keyof:device+":"+(component key comp) "no_opacity" if part:gamut=failure console "Incorrect gamut " keyof:device+":"+(component key comp) eol conv :> null map ColorSplitConversion return part grid :> color_grid_conversion part:gamut dest_gamut undefined true conv part += part component := var (Dictionary Str Int) empty_dict

if hash_conversion

conv cache_size := options option "hash" Int 63541 conv cache_buffer := memory_zallocate conv:cache_size*(uInt:size+src_gamut:pixel_size+dest_gamut:pixel_size) addressof:conv

method conv apply src_pixel src_gamut dest_pixel dest_gamut arg_rw ColorSplitConversion conv ; arg Address src_pixel ; 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)=ColorGamutSubstract (addressof:src_gamut map ColorGamutSubstractive) apply_opa var (Array Float32 gamut_maximum_dimension) result for (var Int j) 0 dest_gamut:dimension-1 result j := 0 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 := addressof:pixel0 map else addressof:pixel1 map uInt8 j := 0 var ColorBuffer pixel2 conv:part:i:grid apply addressof:pixel1 part:gamut addre dest_gamut decode addressof:pixel2 (var (Array Float32 g # console "part " conv:part:i:gamut:name

# check (entry_type addressof:src_gamut)=ColorGamutSubstractive

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 Byte key*(uInt:size+src_psize+dest_psize)) map uInt 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_psize) memory_copy (ptr translate Byte src_psize) dest_pixel dest_psize 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 dest_gamut else var Address ptr0 if conv:opacity (addressof:src_gamut map ColorGamutSubstractive) apply_opacity src_pixel addressof:(var ColorBuffer pixel0) ptr0 := addressof pixel0 else ptr0 := src_pixel var (Array Float32 gamut_maximum_dimension) result

for (var Int j) 0 dest_gamut:dimension-1 for (var Int j) 0 dest_gamut:dimension-1

result j += f j # console " " (string f:j "fixed 3") # console eol dest_gamut encode result dest_pixel

result j := 0 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 part:mapping:j else addressof:pixel1 map uInt8 j := 0 var ColorBuffer pixel2 conv:part:i:grid apply addressof:pixel1 part:gamut addressof:pixel2 dest_gamut dest_gamut decode addressof:pixel2 (var (Array Float32 gamut_maximum_dimension) f) for (var Int j) 0 dest_gamut:dimension-1 result j += f:j*(1-result:j)

dest_gamut encode result dest_pixel 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) dest_psize sem := 1

method g speedup src_gamut options -> speedup oarg ColorGamutRGB g src_gamut ; arg Str options ; arg Arr if (entry_type addressof:src_gamut)=ColorGamutSubstractive speedup := addressof void

eif src_gamut:model=color_gamut_additive and g:options<>"" var Link:ColorGridConversion gconv :> new ColorGridConversion

gconv compute src_gamut g (min (max (g:options option "grid_steps" Int 17) 5) 65) false

if hash_rgb var Link:ColorSplitConversion sconv :> color_split_conversion src_gamut g (var Data:ColorDevice device) gconv options speedup := addressof sconv else speedup := addressof gconv

else speedup := null else speedup := null

method dest_gamut convert src_gamut src_pixels dest_pixels c oarg ColorGamutRGB dest_gamut ; oarg ColorGamut src_gamut method dest_gamut convert src_gamut src_pixels dest_pixels c oarg ColorGamutRGB dest_gamut ; oarg ColorGamut src_gamut

if src_gamut:model=color_gamut_additive

if speedup<>null if entry_type:speedup=Void var Link:ColorGamutSubstractive g :> addressof:src_gamut map ColorGamutSubstractive

var Address s := src_pixels ; var Address stop := src_pixels translate Byte count*g:pixel_size 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) cf terminate (d map ColorRGB888) s := s translate Byte g:pixel_size ; d := d translate Byte dest_gamut:pixel_size

transparency_convert src_pixels src_gamut dest_pixels dest_gamut count eif entry_type:speedup=ColorGridConversion var Link:ColorGridConversion gconv :> speedup map ColorGridConversion var Address s := src_pixels ; var Int src_psize := src_gamut pixel_size var Address stop := src_pixels translate Byte count*src_psize var Address d := dest_pixels ; var Int dest_psize := dest_gamut pixel_size while s<>stop 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 gconv apply s src_gamut d dest_gamut s := s translate Byte src_psize ; d := d translate Byte dest_psize transparency_convert src_pixels src_gamut dest_pixels dest_gamut count eif entry_type:speedup=ColorSplitConversion var Link:ColorSplitConversion sconv :> speedup map ColorSplitConversion var Address s := src_pixels ; var Int src_psize := src_gamut pixel_size var Address stop := src_pixels translate Byte count*src_psize var Address d := dest_pixels ; var Int dest_psize := dest_gamut pixel_size while s<>stop 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 sconv apply s src_gamut d dest_gamut s := s translate Byte src_psize ; d := d translate Byte dest_psize transparency_convert src_pixels src_gamut dest_pixels dest_gamut count 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 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:reversed=src_gamut_reversed

if dest_gamut:pixel_size=1

bytes_copy (src_pixels translate uInt8 src_gamut:dimension\2) src_gamut:pixel_size dest_pixels dest_gamut:pixel_size count eif src_gamut:pixel_size=1 for (var Int c) 0 2 bytes_copy src_pixels src_gamut:pixel_size (dest_pixels translate uInt8 c) dest_gamut:pixel_size count 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_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 3) src_gamut:

bytes_copy (src_pixels translate uInt8 src_gamut:dimension) src_gamut:pixel_size (dest_pixels translate uInt8 src_gamut:dimension) dest_gamut:pixel_size count

eif dest_gamut:transparency=1 eif dest_gamut:transparency=1

bytes_fill (dest_pixels translate uInt8 3) dest_gamu eif speedup<>null var Link:ColorGamutSubstractive g :> addressof:src_gamut var Address s := src_pixels ; var Address stop := src_pi var Address d := dest_pixels while s<>stop if g:overlapping<>0 var Float darkness := 0 for (var Int i) 0 g:dimension-1 var Int v := s map uInt8 i if v<>0 darkness += v*g:component:i:ink:darkness var Float a1 := g:overlapping*(1/255) var Float b1 := 1+darkness*a1 var ColorBuffer buf for (var Int i) 0 g:dimension-1 var Int v := s map uInt8 i if v<>0 v := bound (cast v*(b1-a1*v*g:component:i:ink:da buf:bytes i := v (var ColorFast cf) init for (var Int i) 0 g:dimension-1 cf apply g:component:i:ink buf:bytes:i cf terminate (d map ColorRGB888) else (var ColorFast cf) init 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 translate transparency_convert src_pixels src_gamut dest_pixels de

bytes_fill (dest_pixels translate uInt8 dest_gamut:dimension) dest_gamut:pixel_size count

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_gamut map ColorGamutSubstractive):device

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 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

eif (entry_type addressof:src_gamut)=ColorGamutSubstractiv var Link:ColorSplitConversion sconv :> color_split_conve

eif 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

var Link:ColorGridConversion gconv :> color_grid_convers 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

function color_gamut_profile src_gamut_name dest_gamut_name arg Str src_gamut_name dest_gamut_name filename ; arg Int var Link:ColorGamut src_gamut :> color_gamut src_gamut_nam var Link:ColorGamut dest_gamut :> color_gamut dest_gamut_n var Link:ColorGridConversion conv :> new ColorGridConversi var Int dim := src_gamut:dimension var Int default_steps := shunt dim<=3 and src_gamut:model=

conv compute src_gamut dest_gamut (shunt steps=defined ste

conv compute src_gamut dest_gamut (shunt steps=defined steps default_steps) true

conv dump filename src_gamut dest_gamut export color_gamut_compute color_gamut_profile