/pliant/graphic/color/gamut.pli
1	abstract
2	['ColorGamut' data type is defining how a pixel is encoded, I mean the meaning of various bits.]
3
4	# Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
5	# Copyright  Heliogroup
6	#
7	# This program is free software; you can redistribute it and/or
8	# modify it under the terms of the GNU General Public License version 2
9	# as published by the Free Software Foundation.
10	#
11	# This program is distributed in the hope that it will be useful,
12	# but WITHOUT ANY WARRANTY; without even the implied warranty of
13	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14	# GNU General Public License for more details.
15	#
16	# You should have received a copy of the GNU General Public License
17	# version 2 along with this program; if not, write to the Free Software
18	# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
19
20
21	module "/pliant/language/compiler.pli"
22	module "/pliant/language/context.pli"
23	module "/pliant/language/os.pli"
24	module "/pliant/language/compiler/type/inherit.pli"
25	module "/pliant/math/functions.pli"
26	module "/pliant/math/curven.pli"
27	module "/pliant/math/matrix.pli"
28	module "color.pli"
29	module "ink.pli"
30	module "gradation.pli"
31	module "spectrum.pli"
32	module "/pliant/graphic/misc/int.pli"
33	module "/pliant/graphic/misc/float.pli"
34	module "/pliant/graphic/misc/bytes.pli"
35	module "/pliant/graphic/misc/vector.pli"
36	module "/pliant/language/stream.pli"
37	module "/pliant/admin/md5.pli"
38	module "database.pli"
39	module "adjust.pli"
40	module "/pliant/language/data/cache.pli"
41
42	constant hash_conversion true
43	constant hash_rgb true
44	constant direct_is_linear true
45
46	constant verify false
47	if verify
48	gvar CBool advanced
49	else
50	constant advanced true
51	constant advanced2 true
52
53
54
55	#   prototype
56
57
58	public
59
60	constant color_gamut_additive 1
61	constant color_gamut_substractive 2
62	constant gamut_maximum_dimension 32
63
64	type ColorBuffer
65	field (Array uInt8 gamut_maximum_dimension) bytes
66
67	type ColorGamut
68	inherit CachePrototype
69	field Int pixel_size
70	field Int dimension
71	field Int transparency <- 0
72	field Int padding <- 0
73	field Int bits_per_component <- 8
74	field Str name
75	field Int model <- 0
76	field ExtendedStatus status <- failure
77
78	CachePrototype maybe ColorGamut
79
80	method p update stream -> status # avoid clashing with CachePrototype
81	oarg_rw ColorGamut p ; arg_rw Stream stream ; arg ExtendedStatus status
82	generic
83	status := failure "not implemented"
84
85	method p dump stream -> status
86	oarg_rw ColorGamut p ; arg_rw Stream stream ; arg ExtendedStatus status
87	generic
88	status := failure "not implemented"
89
90	method p sleep
91	oarg_rw ColorGamut p
92	generic
93
94	method p drop
95	oarg_rw ColorGamut p
96	generic
97
98	method g decode pixel components
99	oarg ColorGamut g ; arg Address pixel ; arg_w (Array Float32 gamut_maximum_dimension) components
100	generic
101
102	method g encode components pixel
103	oarg ColorGamut g ; arg (Array Float32 gamut_maximum_dimension) components ; arg Address pixel
104	generic
105
106	method g opacity_decode pixel opacity
107	oarg ColorGamut g ; arg Address pixel ; arg_w (Array Float32 gamut_maximum_dimension) opacity
108	generic
109	if g:transparency=0
110	for (var Int i) 0 g:dimension-1
111	opacity i := 1
112	eif g:transparency=1
113	for (var Int i) 0 g:dimension-1
114	opacity i := (pixel map uInt8 g:dimension)/255
115	eif g:transparency=g:dimension
116	for (var Int i) 0 g:dimension-1
117	opacity i := (pixel map uInt8 g:dimension+i)/255
118	else
119	error "Inconsistent transparency in gamut "+g:name
120
121	method g opacity_encode opacity pixel
122	oarg ColorGamut g ; arg (Array Float32 gamut_maximum_dimension) opacity ; arg Address pixel
123	generic
124	if g:transparency=1
125	pixel map uInt8 g:dimension := bound (cast opacity:0*255 Int) 0 255
126	eif g:transparency=g:dimension
127	for (var Int i) 0 g:dimension-1
128	pixel map uInt8 g:dimension+i := bound (cast opacity:i*255 Int) 0 255
129
130	method g simulate pixel -> color
131	oarg ColorGamut g ; arg Address pixel ; arg ColorXYZ color
132	generic
133
134	method g simulate2 pixel -> filter
135	oarg ColorGamut g ; arg Address pixel ; arg ColorSpectrum32 filter
136	generic
137	filter := var ColorSpectrum empty_spectrum
138
139	method g formulate color options pixel
140	oarg ColorGamut g ; arg ColorXYZ color ; arg Str options ; arg Address pixel
141	generic
142
143	method g formulate color pixel
144	oarg ColorGamut g ; arg ColorXYZ color ; arg Address pixel
145	g formulate color "" pixel
146
147	method g speedup src_gamut options -> speedup
148	oarg ColorGamut g src_gamut ; arg Str options ; arg Arrow speedup
149	generic
150	speedup := null
151
152	method g query question -> answer
153	oarg ColorGamut g ; arg Str question answer
154	generic
155	answer := ""
156
157	method g configure parameter value -> status
158	oarg_rw ColorGamut g ; arg Str parameter value ; arg ExtendedStatus status
159	generic
160	status := failure "unsupported"
161
162	function 'cast ExtendedStatus' g -> status
163	arg ColorGamut g; arg ExtendedStatus status
164	extension
165	status := g status
166
167
168	function transparency_convert src_pixels src_gamut dest_pixels dest_gamut count
169	arg Address src_pixels dest_pixels ; oarg ColorGamut src_gamut dest_gamut ; arg Int count
170	if dest_gamut:transparency=0
171	return
172	var Address src := src_pixels translate Byte src_gamut:dimension ; var Int src_psize := src_gamut pixel_size
173	var Address dest := dest_pixels translate Byte dest_gamut:dimension ; var Int dest_psize := dest_gamut pixel_size
174	var Address stop := dest translate Byte count*dest_psize
175	if src_gamut:transparency=0
176	while dest<>stop
177	dest map uInt8 := 255
178	dest := dest translate Byte dest_psize
179	eif src_gamut:transparency=1
180	while dest<>stop
181	dest map uInt8 := src map uInt8
182	src := src translate Byte src_psize ; dest := dest translate Byte dest_psize
183	else
184	var Int last := src_gamut:transparency-1
185	while dest<>stop
186	var Int opacity := 0
187	for (var Int i) 0 last
188	opacity := max opacity (src map uInt8 i)
189	dest map uInt8 := opacity
190	src := src translate Byte src_psize ; dest := dest translate Byte dest_psize
191	if dest_gamut:transparency>1
192	var Address dest := dest_pixels translate Byte dest_gamut:dimension
193	var Address stop := dest translate Byte count*dest_psize
194	var Int last := dest_gamut:transparency-1
195	while dest<>stop
196	var Int opacity := dest map uInt8
197	for (var Int i) 1 last
198	dest map uInt8 i := opacity
199	dest := dest translate Byte dest_psize
200
201	function default_convert src_pixels src_gamut dest_pixels dest_gamut count
202	arg Address src_pixels dest_pixels ; oarg ColorGamut src_gamut dest_gamut ; arg Int count
203	var Str options := (dest_gamut query "options") option "convert_adjust" Str
204	var Address s := src_pixels ; var Int src_psize := src_gamut pixel_size
205	var Address stop := src_pixels translate Byte count*src_psize
206	var Address d := dest_pixels ; var Int dest_psize := dest_gamut pixel_size
207	while s<>stop
208	if s<>src_pixels and not (memory_different s src_psize (s translate Byte -src_psize) src_psize)
209	memory_copy (d translate Byte -dest_psize) d dest_psize
210	else
211	var ColorXYZ color := src_gamut simulate s
212	color_adjust color options
213	dest_gamut formulate color d
214	s := s translate Byte src_psize ; d := d translate Byte dest_psize
215	transparency_convert src_pixels src_gamut dest_pixels dest_gamut count
216
217	method dest_gamut convert src_gamut src_pixels dest_pixels count speedup
218	oarg ColorGamut dest_gamut src_gamut ; arg Address src_pixels dest_pixels ; arg Int count ; arg Address speedup
219	generic
220	default_convert src_pixels src_gamut dest_pixels dest_gamut count
221
222	export '. convert'
223
224
225
226	#   additive (RGB)
227
228
229	type ColorGamutRGB
230	inherit ColorGamut
231	field CBool reversed
232	field Str options
233
234	ColorGamut maybe ColorGamutRGB
235
236
237	method g decode pixel components
238	oarg ColorGamutRGB g ; arg Address pixel ; arg_w (Array Float32 gamut_maximum_dimension) components
239	addressof:components map ColorRGB := pixel map ColorRGB888
240
241	method g encode components pixel
242	oarg ColorGamutRGB g ; arg (Array Float32 gamut_maximum_dimension) components ; arg Address pixel
243	pixel map ColorRGB888 := addressof:components map ColorRGB
244
245	method g query question -> answer
246	oarg ColorGamutRGB g ; arg Str question answer
247	if question="options"
248	answer := g options
249	else
250	answer := ""
251
252	method g configure parameter value -> status
253	oarg_rw ColorGamutRGB g ; arg Str parameter value ; arg ExtendedStatus status
254	if parameter="options"
255	g options := value
256	else
257	status := failure "unsupported"
258
259	method g simulate pixel -> color
260	oarg ColorGamutRGB g ; arg Address pixel ; arg ColorXYZ color
261	var Address rgb
262	if g:reversed
263	rgb := addressof (var Int32 buffer)
264	for (var Int c) 0 2
265	rgb map uInt8 c := pixel map uInt8 2-c
266	else
267	rgb := pixel
268	color := cast (rgb map ColorRGB888) ColorXYZ
269
270	method g formulate color options pixel
271	oarg ColorGamutRGB g ; arg ColorXYZ color ; arg Str options ; arg Address pixel
272	var ColorRGB888 rgb := cast color ColorRGB888
273	if g:reversed
274	for (var Int c) 0 2
275	pixel map uInt8 c := addressof:rgb map uInt8 2-c
276	else
277	pixel map ColorRGB888 := rgb
278
279
280
281	#   additive (XYZ)
282
283
284	type ColorGamutXYZ
285	inherit ColorGamut
286
287	ColorGamut maybe ColorGamutXYZ
288
289
290	method g decode pixel components
291	oarg ColorGamutXYZ g ; arg Address pixel ; arg_w (Array Float32 gamut_maximum_dimension) components
292	memory_copy pixel addressof:components 3*Float32:size
293
294	method g encode components pixel
295	oarg ColorGamutXYZ g ; arg (Array Float32 gamut_maximum_dimension) components ; arg Address pixel
296	memory_copy addressof:components pixel 3*Float32:size
297
298	method g simulate pixel -> color
299	oarg ColorGamutXYZ g ; arg Address pixel ; arg ColorXYZ color
300	memory_copy pixel addressof:color 3*Float32:size
301
302	method g formulate color options pixel
303	oarg ColorGamutXYZ g ; arg ColorXYZ color ; arg Str options ; arg Address pixel
304	memory_copy addressof:color pixel 3*Float32:size
305
306
307
308	#   grid based conversion
309
310
311	constant grid_conversion_release 13
312
313
314	type ColorGridConversion
315	inherit CachePrototype
316	field Array:Float32 mapping
317	field Int dim
318	field Int steps
319	field Int done
320	field Int computed
321	field Str key
322	field CBool inheritate
323	field Link:Function convert_function
324	field Str convert_name
325	field Arrow convert_param
326
327	CachePrototype maybe ColorGridConversion
328
329
330	function standard_convert_function src_pixel src_gamut dest_pixel dest_gamut param
331	arg Address src_pixel ; oarg ColorGamut src_gamut ; arg Address dest_pixel ; oarg ColorGamut dest_gamut ; arg Address param
332	var Str options := (dest_gamut query "options") option "convert_adjust" Str
333	var ColorXYZ color := src_gamut simulate src_pixel
334	color_adjust color options
335	dest_gamut formulate color dest_pixel
336
337	method conv compute src_gamut dest_gamut steps cached inheritate
338	arg_w ColorGridConversion conv ; oarg ColorGamut src_gamut dest_gamut ; arg Int steps ; arg CBool cached inheritate
339	var Int dim := src_gamut dimension
340	conv dim := dim
341	conv steps := steps
342	conv:mapping size := steps^dim*dest_gamut:dimension
343	for (var Int i) 0 steps^dim-1
344	conv:mapping i*dest_gamut:dimension := undefined
345	conv done := 0
346	conv computed := 0
347	if cached
348	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+" "+conv:convert_name+" "+string:grid_conversion_release
349	(var Stream s) open "data:/pliant/graphic/cache/"+conv:key+".bin" in+safe
350	if s=success
351	while s:readline<>""
352	void
353	s raw_read (addressof conv:mapping:0) conv:mapping:size*Float32:size
354	if s=success
355	for (var Int i) 0 steps^dim-1
356	if (conv:mapping i*dest_gamut:dimension)=defined
357	conv:done += 1
358	else
359	for (var Int i) 0 steps^dim-1
360	conv:mapping i*dest_gamut:dimension := undefined
361	if inheritate
362	check cached
363	conv inheritate := inheritate
364	if not (exists conv:convert_function)
365	conv convert_function :> the_function standard_convert_function Address ColorGamut Address ColorGamut Address
366
367	function convert_function_prototype src_pixel src_gamut dest_pixel dest_gamut param fun
368	arg Address src_pixel ; oarg ColorGamut src_gamut ; arg Address dest_pixel ; oarg ColorGamut dest_gamut ; arg Address param ; arg Function fun
369	indirect
370
371	method conv compute_node index src_gamut dest_gamut
372	arg_rw ColorGridConversion conv ; arg Int index ; oarg ColorGamut src_gamut dest_gamut
373	var Pointer:Float32 p :> conv:mapping index*dest_gamut:dimension
374	var ColorBuffer src_pixel dest_pixel
375	for (var Int d) 0 conv:dim-1
376	src_pixel:bytes d := (index\conv:steps^d)%conv:steps*255\(conv:steps-1)
377	convert_function_prototype addressof:src_pixel src_gamut addressof:dest_pixel dest_gamut conv:convert_param conv:convert_function
378	dest_gamut decode addressof:dest_pixel (var (Array Float32 gamut_maximum_dimension) components)
379	for (var Int d) dest_gamut:dimension-1 0 step -1
380	addressof:p map Float32 d := components d
381
382	function color_grid_conversion src_gamut dest_gamut steps cached -> conv
383	oarg ColorGamut src_gamut dest_gamut ; arg Int steps ; arg CBool cached ; arg Link:ColorGridConversion conv
384	later
385
386	function color_gamut name options -> g
387	arg Str name options ; arg Link:ColorGamut g
388	later
389
390	method conv compute_node2 index src_gamut dest_gamut
391	arg_rw ColorGridConversion conv ; arg Int index ; oarg ColorGamut src_gamut dest_gamut
392	if conv:inheritate and src_gamut:model=color_gamut_substractive and dest_gamut:model=color_gamut_substractive
393	var Int selected_dim := 0 ; var Int selected_index := 0 ; var Str selected_inks := ""
394	for (var Int d) 0 conv:dim-1
395	var Int i := (index\conv:steps^d)%conv:steps
396	if i<>0
397	selected_index += i*conv:steps^selected_dim
398	selected_inks += "+"+(src_gamut query "component_name "+string:d)
399	selected_dim += 1
400	if selected_dim>0 and selected_dim<conv:dim
401	var Link:ColorGamut selected_gamut :> color_gamut (src_gamut query "device")+":"+(selected_inks 1 selected_inks:len) (src_gamut query "extra")
402	if selected_gamut=success
403	var Link:ColorGridConversion selected_conv :> color_grid_conversion selected_gamut dest_gamut conv:steps true
404	if (selected_conv:mapping selected_index*dest_gamut:dimension)=undefined
405	part compute "recurse compute lazy color conversion grid node "+(string conv:done)+"/"+(string conv:steps^conv:dim)+" ("+src_gamut:name+" -> "+dest_gamut:name+")"
406	selected_conv compute_node2 selected_index selected_gamut dest_gamut
407	for (var Int d) dest_gamut:dimension-1 0 step -1
408	conv:mapping index*dest_gamut:dimension+d := selected_conv:mapping selected_index*dest_gamut:dimension+d
409	conv done += 1
410	return
411	part compute "compute lazy color conversion grid node "+(string conv:done)+"/"+(string conv:steps^conv:dim)+" ("+src_gamut:name+" -> "+dest_gamut:name+")"
412	conv compute_node index src_gamut dest_gamut
413	conv done += 1
414	conv computed += 1
415	if conv:key<>""
416	if conv:computed%(shunt dest_gamut:name="XYZ" 4096 64)=0 or conv:done=conv:steps^conv:dim
417	(var Stream s) open "data:/pliant/graphic/cache/"+conv:key+".bin" out+safe+mkdir
418	s writeline "Pliant color conversion"
419	s writeline "source_gamut "+(string src_gamut:name)
420	s writeline "source_options "+string:(src_gamut query "signature")
421	s writeline "destination_gamut "+(string dest_gamut:name)
422	s writeline "destination_options "+string:(dest_gamut query "signature")
423	s writeline "steps "+(string conv:steps)
424	s writeline "release "+string:grid_conversion_release
425	s writeline ""
426	s raw_write (addressof conv:mapping:0) conv:mapping:size*Float32:size
427	s close
428	# if not hurry
429	#   console "."
430
431	method conv apply src_pixel src_gamut dest_pixel dest_gamut
432	arg_rw ColorGridConversion conv ; arg Address src_pixel ; oarg ColorGamut src_gamut ; arg Address dest_pixel ; oarg ColorGamut dest_gamut
433	check conv:dim=src_gamut:dimension
434	check src_gamut:pixel_size=src_gamut:dimension
435	if true
436	part apply
437	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)
438	if index>=0
439	conv compute_node2 index src_gamut dest_gamut
440	restart apply
441	else
442	var Int dim := conv dim ; var Int steps := conv steps
443	var Int base := 0
444	var Int n := 0
445	var (Array Int gamut_maximum_dimension) gs # grid step
446	var (Array Float32 gamut_maximum_dimension) remain
447	var Int unit := 1
448	for (var Int d) 0 src_gamut:dimension-1
449	var Int v := src_pixel map uInt8 d
450	if v=0
451	void
452	eif v=255
453	base += (steps-1)*unit
454	else
455	var Int i := min v*(steps-1)\255 steps-2
456	gs n := unit
457	base += i*unit
458	remain n := ( v - i*255\(steps-1) ) / ( (i+1)*255\(steps-1) - i*255\(steps-1) )
459	n += 1
460	unit *= steps
461	var (Array Float32 gamut_maximum_dimension) result
462	for (var Int d) 0 dest_gamut:dimension-1
463	result d := 0
464	for (var Int u) 0 2^n-1
465	var Int index := base ; var Float f := 1
466	for (var Int d) 0 n-1
467	if (u .and. 2^d)<>0
468	index += gs d
469	f *= remain d
470	else
471	f *= 1-remain:d
472	var Pointer:(Array Float32 gamut_maximum_dimension) p :> addressof:(conv:mapping index*dest_gamut:dimension) map (Array Float32 gamut_maximum_dimension)
473	if p:0=undefined
474	conv compute_node2 index src_gamut dest_gamut
475	for (var Int d) 0 dest_gamut:dimension-1
476	result d += f*p:d
477	dest_gamut encode result dest_pixel
478
479
480	function color_grid_conversion src_gamut dest_gamut steps cached -> conv
481	oarg ColorGamut src_gamut dest_gamut ; arg Int steps ; arg CBool cached ; arg Link:ColorGridConversion conv
482	var Int dim := src_gamut dimension
483	var Int steps1 := shunt steps=defined steps src_gamut:model=color_gamut_additive 33 dim<=4 17 dim<=6 9 5
484	var Str k := (string src_gamut:name)+" "+string:(src_gamut query "signature")+" "+(string dest_gamut:name)+" "+string:(dest_gamut query "signature")+" "+string:steps1
485	if (cache_open "/pliant/color/conversion/"+k ColorGridConversion ((addressof Link:ColorGridConversion conv) map Link:CachePrototype))
486	conv compute src_gamut dest_gamut steps1 cached cached
487	cache_ready ((addressof Link:ColorGridConversion conv) map Link:CachePrototype)
488
489	export ColorGridConversion '. convert_function' '. convert_name' '. convert_param' '. compute' '. apply'
490
491
492
493
494	#   grid based simulation
495
496
497	type ColorGridSimulation
498	inherit CachePrototype
499	field Curven curve
500	field Array:Str ink
501	field CBool logarithm <- true
502
503	CachePrototype maybe ColorGridSimulation
504
505
506	function color_grid_simulation name -> grid
507	arg Str name ; arg Link:ColorGridSimulation grid
508	if (cache_open "/pliant/color/simulation/"+name ColorGridSimulation ((addressof Link:ColorGridSimulation grid) map Link:CachePrototype))
509	(var Stream s) open "data:/pliant/graphic/color/"+name in+safe
510	if s=failure
511	cache_cancel ((addressof Link:ColorGridSimulation grid) map Link:CachePrototype)
512	grid :> null map ColorGridSimulation
513	return
514	var (Array Array:Float) nodes
515	var Array:Float middle density maxi
516	while not s:atend and { var Str l := s readline ; l<>"" }
517	if (l parse word:"ink" (var Str inkname) any:(var Str values))
518	grid ink += inkname
519	var Int i := nodes size
520	nodes size += 1
521	middle += l option "middle" Float 0
522	density += l option "density" Float 1
523	maxi += l option "maxi" Float 255
524	while (values parse (var Float f) any:(var Str remain))
525	nodes nodes:size-1 += (unexposure f/maxi:i/density:i middle:i)*maxi:i
526	values := remain
527	eif (l parse "linear")
528	grid logarithm := false
529	grid:curve resize ColorSpectrum32:size\Float32:size nodes:size nodes
530	var ColorSpectrum32 w32 := var ColorSpectrum32 undefined_spectrum
531	while not s:atend
532	var Str l := s readline
533	if (l parse any:(var Str all) ":" (var ColorSpectrum cs) )
534	(var Array:Float params) size := nodes size
535	for (var Int i) 0 params:size-1
536	if (all parse params:i any:(var Str remain))
537	all := remain
538	else
539	error error_id_corrupted "Incorrect line in gamut measures files "+s:name+" ("+l+")"
540	params i := (unexposure params:i/maxi:i/density:i middle:i)*maxi:i
541	if w32=undefined
542	w32 := cs
543	var ColorSpectrum32 cs32 := cs/w32
544	(var Array:Float point) size := ColorSpectrum32:size\Float32:size
545	for (var Int i) 0 point:size-1
546	point i := addressof:cs32 map Float32 i
547	if grid:logarithm
548	point i := log point:i
549	grid:curve define params point
550	cache_ready ((addressof Link:ColorGridSimulation grid) map Link:CachePrototype)
551
552
553	gvar (Array Int 256) bits_count_array
554
555	function init_bits_count
556	for (var Int i) 0 255
557	bits_count_array i := 0
558	for (var Int j) 0 7
559	if (i .and. 2^j)<>0
560	bits_count_array i += 1
561	init_bits_count
562
563	function bits_count u -> n
564	arg uInt u ; arg Int n
565	n := bits_count_array (u .and. 255)
566	if u>=256
567	n += bits_count_array u\256
568
569
570
571	#   substractive (inks)
572
573
574	type ColorComponent
575	field Link:ColorInk ink
576	field Str name
577
578	type ColorGrid
579	field Link:ColorGridSimulation simulation
580	field Array:Int indice ; field uInt mask
581	field Str name
582
583	type ColorFormulateUsing
584	field Array:Int using
585	field Float hue
586
587	type ColorGamutSubstractive
588	inherit ColorGamut
589	field Array:ColorComponent component
590	field Array:ColorGrid grid
591	field Array:ColorFormulateUsing formulate_using
592	field Str device options extra
593	field Float deaden <- 0
594	field CBool multiple_transparency <- false
595	field CBool no_opacity <- false
596	field CBool reverse_printing <- false
597	field Int negatives <- 0
598	field Link:ColorGridConversion fast_simulation
599	field Link:ColorGamut another_gamut
600	field Link:ColorGamut xyz_gamut
601
602	ColorGamut maybe ColorGamutSubstractive
603
604
605	method g decode pixel components
606	oarg ColorGamutSubstractive g ; arg Address pixel ; arg_w (Array Float32 gamut_maximum_dimension) components
607	for (var Int i) 0 g:dimension-1
608	components i := g:component:i:ink:gradation decode (pixel map uInt8 i)
609
610	method g encode components pixel
611	oarg ColorGamutSubstractive g ; arg (Array Float32 gamut_maximum_dimension) components ; arg Address pixel
612	for (var Int i) 0 g:dimension-1
613	pixel map uInt8 i := g:component:i:ink:gradation encode components:i
614
615	method gamut apply_opacity src dest
616	arg ColorGamutSubstractive gamut ; arg Address src dest
617	memory_copy src dest gamut:pixel_size
618	if gamut:reverse_printing
619	for (var Int i) gamut:dimension-1 0 step -1
620	var Pointer:ColorInk ink :> gamut:component:i ink
621	if ink:opacity=defined and ink:opacity>0
622	var Float d := ink:gradation decode (dest map uInt8 i)
623	if d>0
624	var Float f := 1-ink:opacity*d
625	for (var Int j) i+1 gamut:dimension-1
626	var Pointer:uInt8 p :> dest map uInt8 j
627	var Pointer:ColorGradation g :> gamut:component:j:ink gradation
628	p := g encode (g decode p)*f
629	else
630	for (var Int i) 0 gamut:dimension-1
631	var Pointer:ColorInk ink :> gamut:component:i ink
632	if ink:opacity=defined and ink:opacity>0
633	var Float d := ink:gradation decode (dest map uInt8 i)
634	if d>0
635	var Float f := 1-ink:opacity*d
636	for (var Int j) 0 i-1
637	var Pointer:uInt8 p :> dest map uInt8 j
638	var Pointer:ColorGradation g :> gamut:component:j:ink gradation
639	p := g encode (g decode p)*f
640
641	function curven_simulation g pixel -> f
642	arg ColorGrid g ; arg Address pixel ; arg ColorSpectrum32 f
643	(var Array:Float params) size := g:indice size
644	for (var Int i) 0 params:size-1
645	var Int j := g:indice i
646	if j<>undefined
647	params i := pixel map uInt8 j
648	pixel map uInt8 j := 0
649	else
650	params i := 0
651	var Array:Float point := g:simulation:curve apply params
652	check point:size=ColorSpectrum32:size\Float32:size
653	if g:simulation:logarithm
654	for (var Int i) 0 point:size-1
655	addressof:f map Float32 i := exp point:i
656	else
657	for (var Int i) 0 point:size-1
658	addressof:f map Float32 i := point i
659
660	method gamut simulate2 pixel -> filter
661	oarg ColorGamutSubstractive gamut ; arg Address pixel ; arg ColorSpectrum32 filter
662	part simulate "substractive color simulation "+gamut:name
663	var ColorBuffer pixel2
664	if gamut:no_opacity
665	memory_copy pixel addressof:pixel2 gamut:pixel_size
666	else
667	gamut apply_opacity pixel addressof:pixel2
668	filter := cast 0 ColorSpectrum32
669	var uInt mask := 0
670	for (var Int i) 0 gamut:dimension-1
671	if (addressof:pixel2 map uInt8 i)<>0
672	mask += 2^i
673	part apply_best_grid
674	var Int maxi := 1 ; var Int selected := undefined
675	for (var Int i) 0 gamut:grid:size-1
676	var Pointer:ColorGrid g :> gamut:grid i
677	var Int n := bits_count mask .and. g:mask
678	if n>maxi
679	selected := i ; maxi := n
680	if selected<>undefined
681	var Pointer:ColorGrid g :> gamut:grid selected
682	filter += exposure (-1)*log:(curven_simulation g addressof:pixel2) (-gamut:deaden)
683	mask := mask .and. .not. g:mask
684	restart apply_best_grid
685	for (var Int i) 0 gamut:component:size-1
686	if ((mask .or. gamut:negatives) .and. 2^i)<>0
687	var Pointer:ColorComponent c :> gamut:component i
688	var Pointer:ColorInk ink :> c ink
689	if ink:deaden=gamut:deaden
690	filter += ink:deaden_filter (addressof:pixel2 map uInt8 i)
691	else
692	filter += exposure (-1)*(log ink:filter:(addressof:pixel2 map uInt8 i)) (-gamut:deaden)
693	filter := exp (-1)*(unexposure filter (-gamut:deaden))
694
695	method gamut simulate pixel -> color
696	oarg ColorGamutSubstractive gamut ; arg Address pixel ; arg ColorXYZ color
697	if (exists gamut:fast_simulation)
698	((addressof gamut:fast_simulation) omap ColorGridConversion) apply pixel gamut:another_gamut addressof:color gamut:xyz_gamut
699	else
700	color := filter_XYZ (gamut simulate2 pixel)
701	color_adjust color (gamut:options option "simulate_adjust" Str)
702
703	method gamut try_formulate1 wished pixel using maximum limit l c -> distance
704	oarg ColorGamut gamut ; arg ColorXYZ wished ; arg Address pixel ; arg Array:Int using maximum ; arg Int limit ; arg Float l c distance
705	check using:size=3
706	var ColorXYZ got := gamut simulate pixel
707	distance := cmc_distance wished got l c
708	var Int step := 4
709	(var Matrix m) resize 3 3
710	part improve
711	for (var Int dim) 0 2
712	var Int d := using dim
713	memory_copy pixel addressof:(var ColorBuffer pixel1) gamut:pixel_size
714	var Int v := pixel1:bytes d
715	if true
716	var Int v1 := shunt v+step<256 v+step v-step
717	pixel1:bytes d := v1
718	var ColorXYZ got1 := gamut simulate addressof:pixel1
719	m 0 dim := (got1:X-got:X)/(v1-v)
720	m 1 dim := (got1:Y-got:Y)/(v1-v)
721	m 2 dim := (got1:Z-got:Z)/(v1-v)
722	else
723	var Int v1 v2
724	if v-step\2<0
725	v1 := 0 ; v2 := step
726	eif v+step\2>255
727	v1 := 255-step ; v2 := 255
728	else
729	v1 := v-step\2 ; v2 := v+step\2
730	pixel1:bytes d := v1
731	var ColorXYZ got1 := gamut simulate addressof:pixel1
732	pixel1:bytes d := v2
733	var ColorXYZ got2 := gamut simulate addressof:pixel1
734	m 0 dim := (got2:X-got1:X)/step
735	m 1 dim := (got2:Y-got1:Y)/step
736	m 2 dim := (got2:Z-got1:Z)/step
737	var Matrix m1 := m^(-1)
738	if m1=failure
739	leave improve
740	(var Matrix diff) resize 3 1
741	diff 0 0 := wished:X-got:X
742	diff 1 0 := wished:Y-got:Y
743	diff 2 0 := wished:Z-got:Z
744	var Matrix coef := m1*diff
745	var CBool different := false
746	for (var Int dim) 0 2
747	if abs:(coef dim 0)>1e9
748	leave improve
749	var Int d := using dim
750	pixel1:bytes d := min (max (pixel map uInt8 d)+(cast (coef dim 0) Int) 0) maximum:d
751	if limit<>undefined
752	var Int total := 0
753	for (var Int d) 0 gamut:dimension-1
754	total += pixel map uInt8 d
755	if total>limit
756	for (var Int d) 0 gamut:dimension-1
757	pixel1:bytes d := cast pixel1:bytes:d*limit/total Int
758	var CBool different := false
759	for (var Int dim) 0 2
760	var Int d := using dim
761	if pixel1:bytes:d<>(pixel map uInt8 d)
762	different := true
763	if not different
764	leave improve
765	var ColorXYZ got1 := gamut simulate addressof:pixel1
766	var Float dist1 := cmc_distance wished got1 l c
767	if dist1<distance
768	memory_copy addressof:pixel1 pixel gamut:pixel_size ; got := got1 ; distance := dist1
769	restart improve
770
771	method gamut try_formulate2 wished pixel using maximum limit l c -> distance
772	oarg ColorGamut gamut ; arg ColorXYZ wished ; arg Address pixel ; arg Array:Int using maximum ; arg Int limit ; arg Float l c distance
773	var Int dimension := using size
774	distance := cmc_distance wished (gamut simulate pixel) l c
775	var Int step := 4
776	while step>0
777	var CBool again := false
778	memory_copy pixel addressof:(var ColorBuffer pixel2) gamut:pixel_size
779	for (var Int i) 0 3^dimension-1
780	part try_one
781	memory_copy pixel addressof:(var ColorBuffer pixel1) gamut:pixel_size
782	var Int ii := i
783	for (var Int dim) 0 dimension-1
784	var Int d := using dim
785	var Int delta := ii%3-1 ; ii \= 3
786	if delta<0
787	if pixel1:bytes:d<step
788	leave try_one
789	pixel1:bytes d -= step
790	eif delta>0
791	if pixel1:bytes:d+step>maximum:d
792	leave try_one
793	pixel1:bytes d += step
794	if limit=defined
795	var Int total := 0
796	for (var Int d) 0 gamut:dimension-1
797	total += pixel1:bytes d
798	if total>limit
799	leave try_one
800	var Float dist1 := cmc_distance wished (gamut simulate addressof:pixel1) l c
801	if dist1<distance
802	memory_copy addressof:pixel1 addressof:pixel2 gamut:pixel_size ; distance := dist1
803	again := true
804	memory_copy addressof:pixel2 pixel gamut:pixel_size
805	if not again
806	step \= 2
807
808	method gamut fill_pixel using options pixel
809	oarg ColorGamutSubstractive gamut ; arg Array:Int using ; arg Str options ; arg Address pixel
810	if advanced
811	memory_clear pixel gamut:pixel_size
812	else
813	# for compatibility reasons, but useless
814	for (var Int i) 0 gamut:pixel_size-1
815	pixel map uInt8 i := options option "start"+string:i Int 0
816	for (var Int i) 0 using:size-1
817	var Str ink := gamut query "component_name "+(string using:i)
818	if (gamut:options option "initial_"+ink)
819	pixel map uInt8 using:i := cast (gamut:options option "initial_"+ink Float)*255 Int
820
821	method gamut do_formulate color options pixel -> distance
822	oarg ColorGamutSubstractive gamut ; arg ColorXYZ color ; arg Str options ; arg Address pixel ; arg Float distance
823	var Str opt := options+" "+(gamut query "options")
824	(var Array:Int maximum) size := gamut dimension
825	for (var Int dim) 0 gamut:dimension-1
826	if not ((gamut query "component_maximum "+string:dim) parse maximum:dim)
827	maximum dim := 255
828	var Int limit
829	var Float flimit := opt option "limit" Float
830	if flimit=defined
831	limit := cast flimit*255 Int
832	else
833	limit := undefined
834	var Float l := opt option "cmc_l" Float cmc_distance_l_parameter
835	var Float c := opt option "cmc_c" Float cmc_distance_c_parameter
836	var Float epsilon := opt option "epsilon" Float 0.5
837	var CBool incremental := opt option "incremental"
838	distance := 1e10
839	if advanced and not (opt option "conservative")
840	part compose
841	(var Array:ColorBuffer tests) size := gamut:formulate_using size
842	(var Array:Float distances) size := gamut:formulate_using size
843	for (var Int i) 0 gamut:formulate_using:size-1
844	if incremental
845	memory_copy pixel (addressof tests:i) gamut:pixel_size
846	else
847	gamut fill_pixel gamut:formulate_using:i:using opt (addressof tests:i)
848	distances i := undefined
849	var Float hue := (cast color ColorLCh) h
850	var (Index Float Int) combinations
851	for (var Int i) 0 gamut:formulate_using:size-1
852	if gamut:formulate_using:i:using:size=3
853	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
854	each ii combinations
855	distances ii := gamut try_formulate1 color (addressof tests:ii) gamut:formulate_using:ii:using maximum limit l c
856	if distances:ii<distance
857	memory_copy (addressof tests:ii) pixel gamut:pixel_size ; distance := distances ii
858	if distance<epsilon
859	leave compose
860	var Float mi := opt option "cmc_maximum_improvement" Float (shunt advanced2 20 1e6)
861	for (var Int i) 0 gamut:formulate_using:size-1
862	if distances:i=undefined or distances:i<distance+mi
863	var Float d := gamut try_formulate2 color (addressof tests:i) gamut:formulate_using:i:using maximum limit l c
864	if d<distance
865	memory_copy (addressof tests:i) pixel gamut:pixel_size ; distance := d
866	if distance<epsilon
867	leave compose
868	else
869	for (var Int i) 0 gamut:formulate_using:size-1
870	var ColorBuffer test
871	if incremental
872	memory_copy pixel addressof:test gamut:pixel_size
873	else
874	gamut fill_pixel gamut:formulate_using:i:using opt addressof:test
875	var Float d := gamut try_formulate2 color addressof:test gamut:formulate_using:i:using maximum limit l c
876	if d<distance
877	memory_copy addressof:test pixel gamut:pixel_size ; distance := d
878	if (opt option "removal") and gamut:dimension=4
879	if not ((opt (opt option_position "removal" 0) opt:len) parse word:"removal" (var Int b0) (var Int b1) any)
880	b0 := 0 ; b1 := 0
881	var Int black := pixel map uInt8 3
882	if black>=b1
883	void
884	eif black<b0
885	black := 0
886	else
887	black := b1*(black-b0)\(b1-b0)
888	(var Array:Int using) size := 3
889	using 0 := 0 ; using 1 := 1 ; using 2 := 2
890	gamut fill_pixel using opt addressof:(var ColorBuffer test) ; test:bytes 3 := black
891	if advanced
892	gamut try_formulate1 color addressof:test using maximum limit l c
893	d := gamut try_formulate2 color addressof:test using maximum limit l c
894	if d<distance or d<epsilon
895	memory_copy addressof:test pixel gamut:pixel_size ; distance := d
896
897	method gamut formulate color options pixel
898	oarg ColorGamutSubstractive gamut ; arg ColorXYZ color ; arg Str options ; arg Address pixel
899	if verify
900	advanced := true
901	var Float distance0 := gamut do_formulate color options pixel
902	if distance0>0.5
903	advanced := false
904	var Float distance1 := gamut do_formulate color options pixel
905	if distance1-distance0>0.5
906	console "color formulation warning: " (string distance0 "fixed 1") " instead of " (string distance1 "fixed 1") ", delta is " (string distance0-distance1 "fixed 1") eol
907	if distance0-distance1>0.5
908	console "color formulation ERROR: " (string distance0 "fixed 1") " instead of " (string distance1 "fixed 1") ", delta is " (string distance0-distance1 "fixed 1") eol
909	else
910	gamut do_formulate color options pixel
911
912
913	method g query question -> answer
914	oarg ColorGamutSubstractive g ; arg Str question answer
915	if (question parse word:"component_name" (var Int i)) and i>=0 and i<g:component:size
916	answer := g:component:i name
917	eif (question parse word:"component_maximum" (var Int i)) and i>=0 and i<g:component:size
918	answer := string g:component:i:ink:maximum
919	eif (question parse word:"component_options" (var Int i)) and i>=0 and i<g:component:size
920	answer := g:component:i:ink options
921	eif question="device"
922	answer := g device
923	eif question="grids"
924	answer := ""
925	for (var Int i) 0 g:grid:size-1
926	answer += (shunt i<>0 " " "")+g:grid:i:name
927	eif question="formulates"
928	answer := ""
929	for (var Int i) 0 g:formulate_using:size-1
930	answer += (shunt i<>0 " " "")
931	for (var Int j) 0 g:formulate_using:i:using:size-1
932	answer += (shunt j<>0 "+" "")+(g:component g:formulate_using:i:using:j):name
933	eif question="options"
934	answer := g options
935	eif question="extra"
936	answer := g extra
937	eif question="signature"
938	answer := g options
939	for (var Int i) 0 g:dimension-1
940	answer += " "+(string g:component:i:name)+" "+(string g:component:i:ink:options)
941	else
942	answer := ""
943
944
945
946	#   building a gamut from name using colors database
947
948
949	function rgb_gamut g name transparency padding reversed options
950	arg_rw ColorGamutRGB g ; arg Str name ; arg Int transparency padding ; arg CBool reversed ; arg Str options
951	g name := name
952	g pixel_size := 3+transparency+padding
953	g dimension := 3
954	g transparency := transparency
955	g padding := padding
956	g model := color_gamut_additive
957	g reversed := reversed
958	g status := success
959	g options := options
960
961	function color_gamut name options -> g
962	arg Str name options ; arg Link:ColorGamut g
963	var Pointer:Type t
964	if (name parse any:(var Str device) ":" any:(var Str inks))
965	t :> ColorGamutSubstractive
966	eif name="grey"
967	t :> ColorGamut
968	eif name="XYZ"
969	t :> ColorGamutXYZ
970	else
971	t :> ColorGamutRGB
972	plugin extra_types
973	if (cache_open "/pliant/color/gamut/"+string:name+options t ((addressof Link:ColorGamut g) map Link:CachePrototype))
974	g name := name
975	part build
976	if t=ColorGamut
977	g pixel_size := 1
978	g dimension := 1
979	g model := color_gamut_additive
980	g status := success
981	eif t=ColorGamutRGB
982	var Pointer:ColorGamutRGB ga :> addressof:g map ColorGamutRGB
983	if name="rgb"
984	rgb_gamut ga name 0 0 false options
985	eif name="rgb32"
986	rgb_gamut ga name 0 1 false options
987	eif name="bgr"
988	rgb_gamut ga name 0 0 true options
989	eif name="bgr32"
990	rgb_gamut ga name 0 1 true options
991	eif name="rgba"
992	rgb_gamut ga name 1 0 false options
993	else
994	g status := failure
995	eif t=ColorGamutXYZ
996	g pixel_size := 3*Float32:size
997	g dimension := 3
998	g model := color_gamut_additive
999	g status := success
1000	eif t=ColorGamutSubstractive
1001	var Pointer:ColorGamutSubstractive gs :> addressof:g map ColorGamutSubstractive
1002	gs model := color_gamut_substractive
1003	gs device := device
1004	gs extra := options
1005	gs options := options+(shunt options<>"" and color_database:data:device:device:options<>"" " " "")+color_database:data:device:device:options
1006	gs deaden := gs:options option "deaden" Float 0
1007	gs no_opacity := gs:options option "no_opacity"
1008	inks := replace inks "cmyk" "process_cyan+process_magenta+process_yellow+process_black" ; var Int dim := 0
1009	while inks<>""
1010	if not (inks eparse any:(var Str ink) "+" any:(var Str remain))
1011	ink := inks ; remain := ""
1012	if ink="transparency"
1013	gs transparency := 1
1014	eif ink="transparencies"
1015	gs multiple_transparency := true
1016	else
1017	gs:component size := dim+1
1018	var Pointer:ColorComponent gc :> gs:component dim
1019	gc name := ink
1020	if (ink eparse any:(var Str base) "#" any)
1021	ink := base
1022	gc ink :> color_ink (shunt (ink search ":" -1)=(-1) device+":"+ink ink) options
1023	var Int i := 0
1024	while gc:ink=failure and { var Str device2 := gs:options option "inherit" i Str ; device2<>"" }
1025	gc ink :> color_ink device2+":"+ink options
1026	i += 1
1027	if gc:ink=failure
1028	g status := failure (shunt (exists color_database:data:device:device:channel:ink) "Bad" "Unknown")+" '"+ink+"' ink"
1029	leave build
1030	if (gc:ink:options option "negative")
1031	gs negatives += 2^dim
1032	dim += 1
1033	if (gc:ink:options option "reverse_printing")
1034	gs reverse_printing := true
1035	if (ink search ":" -1)<>(-1) and (gc:ink:options option "deaden")
1036	gs deaden := gc:ink deaden
1037	inks := remain
1038	if gs:multiple_transparency
1039	gs transparency := dim
1040	gs dimension := dim
1041	gs pixel_size := gs:dimension+gs:transparency
1042	if (gs:options option "formulate" Str)<>""
1043	var Int i := 0
1044	while { var Str inks := gs:options option "formulate" i Str ; inks<>"" }
1045	i += 1
1046	part add_combination
1047	var ColorFormulateUsing using
1048	using:using size := 0
1049	while inks<>""
1050	if not (inks eparse any:(var Str ink) "+" any:(var Str remain))
1051	ink := inks ; remain := ""
1052	part seach_ink
1053	for (var Int j) 0 gs:dimension-1
1054	if gs:component:j:name=ink
1055	using using += j
1056	leave seach_ink
1057	console "formulate using missing ink " ink eol
1058	leave add_combination
1059	inks := remain
1060	using hue := undefined
1061	gs formulate_using += using
1062	eif gs:dimension>=4
1063	var Int darkest := gs:options option "darkest" Int
1064	if darkest=undefined
1065	darkest := 0 ; var Float Ymini := 1e6
1066	for (var Int i) 0 gs:dimension-1
1067	var Float Y := (filter_XYZ gs:component:i:ink:s100/gs:component:i:ink:s0) Y
1068	if Y<Ymini
1069	darkest := i ; Ymini := Y
1070	var (Index Float Int) hues
1071	for (var Int i) 0 gs:dimension-1
1072	if i<>darkest and not (gs:component:i:ink:options option "no_formulate")
1073	hues insert (cast (filter_XYZ gs:component:i:ink:s100/gs:component:i:ink:s0) ColorLCh):h i
1074	each hue hues
1075	var Pointer:Int hue2 :> hues next hue
1076	if not exists:hue2
1077	hue2 :> hues first
1078	var ColorFormulateUsing using
1079	using:using size := 3
1080	using:using 0 := darkest
1081	using:using 1 := hue
1082	using:using 2 := hue2
1083	var Float h1 := hues key hue
1084	var Float h2 := hues key hue2
1085	if h2<h1
1086	h2 += 360
1087	var Float h := (h1+h2)/2
1088	if h>=360
1089	h -= 360
1090	using hue := h
1091	gs formulate_using += using
1092	else
1093	gs:formulate_using size := 1
1094	gs:formulate_using:0:using size := gs dimension
1095	for (var Int i) 0 gs:formulate_using:0:using:size-1
1096	gs:formulate_using:0:using i := i
1097	gs:formulate_using:0 hue := undefined
1098	var Array:FileInfo grids := file_list "data:/pliant/graphic/color/"+device+"/" standard
1099	for (var Int i) 0 grids:size-1
1100	(var Stream s) open grids:i:name in+safe
1101	(var Array:Int indice) size := 0 ; var uInt mask := 0
1102	while not s:atend and { var Str l := s readline ; l<>"" }
1103	if (l parse word:"ink" (var Str inkname) any:(var Str values))
1104	indice += undefined
1105	for (var Int j) 0 gs:dimension-1
1106	if gs:component:j:name=inkname
1107	indice indice:size-1 := j
1108	if (indice indice:size-1)<>undefined
1109	mask += 2^(indice indice:size-1)
1110	if bits_count:mask>=2
1111	var ColorGrid grid
1112	grid indice := indice
1113	grid mask := mask
1114	grid name := device+"/"+grids:i:name_without_path
1115	gs grid += grid
1116	# console "gamut " name " is using " gs:grid:size " grids" eol
1117	for (var Int i) 0 gs:grid:size-1
1118	gs:grid:i simulation :> color_grid_simulation gs:grid:i:name
1119	if not (exists gs:grid:i:simulation)
1120	g status := failure "Corrupted color grid "+gs:grid:i:name
1121	leave build
1122	gs status := shunt gs:pixel_size<=gamut_maximum_dimension success failure:"Too many components"
1123	plugin extra_gamuts
1124	if g:status=success
1125	cache_ready ((addressof Link:ColorGamut g) map Link:CachePrototype)
1126	else
1127	cache_cancel ((addressof Link:ColorGamut g) map Link:CachePrototype)
1128	var ExtendedStatus status := g status
1129	g :> new ColorGamut
1130	g status := status
1131
1132	function color_gamut name -> g
1133	arg Str name ; arg Link:ColorGamut g
1134	g :> color_gamut name ""
1135
1136	export color_gamut
1137
1138
1139
1140	#   many components conversions
1141
1142
1143	type ColorPartConversion
1144	field Array:Int mapping
1145	field Link:ColorGamut gamut
1146	field Link:ColorGridConversion grid
1147
1148	type ColorDirectConversion
1149	field Int src
1150	field Array:Float dest
1151
1152	type ColorSplitConversion
1153	field Array:ColorDirectConversion direct
1154	field Array:ColorPartConversion part
1155	field CBool single <- false
1156	field CBool opacity <- false
1157	field Float limit
1158	if hash_conversion
1159	field Address cache_buffer <- null
1160	field uInt cache_size
1161
1162	if hash_conversion
1163	function destroy conv
1164	arg_w ColorSplitConversion conv
1165	memory_free conv:cache_buffer
1166
1167
1168	function color_split_conversion src_gamut dest_gamut device grid options -> conv
1169	oarg ColorGamut src_gamut dest_gamut ; arg Data:ColorDevice device ; arg ColorGridConversion grid ; arg Str options ; arg Link:ColorSplitConversion conv
1170	conv :> new ColorSplitConversion
1171	var Str direct_device := (dest_gamut query "options") option "device" Str
1172	if direct_device<>""
1173	for (var Int i) 0 src_gamut:dimension-1
1174	var Str optionsi := src_gamut query "component_options "+string:i
1175	var Int i2 := 0
1176	while { var Int pos := optionsi option_position "map" i2 -1 ; pos<>(-1) }
1177	if ((optionsi pos optionsi:len) parse word:"map" (var Str dev) (var Str formula) any)
1178	if dev=direct_device
1179	var ColorDirectConversion direct
1180	direct src := i
1181	direct:dest size := dest_gamut dimension
1182	for (var Int j) 0 dest_gamut:dimension-1
1183	direct:dest j := formula option (dest_gamut query "component_name "+string:j) Float 0
1184	conv direct += direct
1185	i2 += 1
1186	if exists:grid and conv:direct:size=0
1187	var ColorPartConversion part
1188	part grid :> grid
1189	conv part += part
1190	conv single := true
1191	else
1192	# check (entry_type addressof:src_gamut)=ColorGamutSubstractive
1193	for (var Int i) 0 src_gamut:dimension-1
1194	var Pointer:ColorInk ink1 :> (addressof:src_gamut map ColorGamutSubstractive):component:i ink
1195	if ink1:opacity=defined and ink1:opacity>0
1196	conv opacity := true
1197	var (Dictionary Str Int) component
1198	for (var Int i) 0 src_gamut:dimension-1
1199	part add_component
1200	for (var Int j) 0 conv:direct:size-1
1201	if conv:direct:j:src=i and not ((src_gamut query "component_options "+string:i) option "visible")
1202	leave add_component
1203	component insert (src_gamut query "component_name "+string:i) i
1204	while component:size>0
1205	var Int best_count := 0 ; var Str best_grid ; var Int best_steps
1206