1
2/* Try to make a Matrix ... works for Vector/Image/Real, plus image/real
3 */
4to_matrix x
5	= to_matrix x.expr, is_Expression x
6	= x, is_Matrix x
7	= oo_unary_function to_matrix_op x, is_class x
8	= tom x
9{
10	to_matrix_op = Operator "to_matrix" tom Operator_type.COMPOUND false;
11
12	tom x
13		= Matrix (itom x), is_image x
14		= Matrix [[x]], is_real x
15		= Matrix [x], is_real_list x
16		= Matrix x, is_matrix x
17		= error (_ "bad arguments to " ++ "to_matrix");
18
19	itom i
20		= (im_vips2mask ((double) i)).value, is_image i
21		= error (_ "not image");
22}
23
24/* Try to make an Image ... works for Vector/Matrix/Real, plus image/real
25 * Special case for Colour ... pull out the colour_space and set Type in the
26 * image.
27 */
28to_image x
29	= to_image x.expr, is_Expression x
30	= Image x.value, is_Plot x
31	= x, is_Image x
32	= Image (image_set_type
33			(Image_type.colour_spaces.lookup 0 1 x.colour_space)
34			(mtoi [x.value])),
35		is_Colour x
36	= oo_unary_function to_image_op x, is_class x
37	= toi x
38{
39	to_image_op = Operator "to_image" toi Operator_type.COMPOUND false;
40
41	toi x
42		= Image x, is_image x
43		= Image (mtoi [[x]]), is_real x
44		= Image (mtoi [x]), is_real_list x
45		= Image (mtoi x), is_matrix x
46		= error (_ "bad arguments to " ++ "to_image");
47
48	// [[real]] -> image
49	mtoi m
50		= im_mask2vips (Matrix m), width != 3
51		= joinup (im_mask2vips (Matrix m))
52	{
53		width = len m?0;
54		height = len m;
55		joinup i
56			= b1 ++ b2 ++ b3
57		{
58			b1 = extract_area 0 0 1 height i;
59			b2 = extract_area 1 0 1 height i;
60			b3 = extract_area 2 0 1 height i;
61		}
62	}
63}
64
65// like to_image, but we do 1x1 pixel + x, then embed it up
66// always make an unwrapped image for speed ... this gets used by ifthenelse
67// and stuff like that
68// format can be NULL, meaning set format from x
69to_image_size width height bands format x
70	= x, is_image x
71	= x.value, is_Image x
72	= im''
73{
74	// we want x to set the target format if we don't have one, so we
75	// can't use image_new
76	im = im_black 1 1 bands + x;
77	im'
78		= clip2fmt format im, format != NULL
79		= im;
80	im'' = embed 1 0 0 width height im';
81}
82
83/* Try to make a Colour.
84 */
85to_colour x
86	= to_colour x.expr, is_Expression x
87	= x, is_Colour x
88	= to_colour (extract_area x.left x.top 1 1 x.image), is_Mark x
89	= oo_unary_function to_colour_op x, is_class x
90	= toc x
91{
92	to_colour_op = Operator "to_colour" toc Operator_type.COMPOUND false;
93
94	toc x
95		= Colour (colour_space (get_type x))
96			(map mean (bandsplit (get_image x))),
97			has_image x && has_type x
98		= Colour "sRGB" [x, x, x], is_real x	// since Colour can't do mono
99		= Colour "sRGB" x, is_real_list x && is_list_len 3 x
100		= map toc x, is_matrix x
101		= error (_ "bad arguments to " ++ "to_colour");
102
103	colour_space type
104		= table.get_name type, table.has_name type
105		= error (_ "unable to make Colour from " ++ table.get_name type ++
106			_ " image")
107	{
108		table = Image_type.colour_spaces;
109	}
110}
111
112/* Try to make a real. (not a Real!)
113 */
114to_real x
115	= to_real x.expr, is_Expression x
116	= oo_unary_function to_real_op x, is_class x
117	= tor x
118{
119	to_real_op = Operator "to_real" tor Operator_type.COMPOUND false;
120
121	tor x
122		= x, is_real x
123		= abs x, is_complex x
124		= 1, is_bool x && x
125		= 0, is_bool x && !x
126		= error (_ "bad arguments to " ++ "to_real");
127}
128
129to_int x = (int) (to_real x);
130
131/* Try to make a list ... ungroup, basically. We remove the innermost layer of
132 * Groups.
133 */
134to_list x
135	= x.value, is_Group x && !contains_Group x.value
136	= Group (map to_list x.value), is_Group x
137	= x;
138
139/* Try to make a group. The outermost list objects become Group()'d.
140 */
141to_group x
142	= Group x, is_list x
143	= Group (map to_group x.value), is_Group x
144	= x;
145
146/* Parse a positive integer.
147 */
148parse_pint l
149	= foldl acc 0 l
150{
151	acc sofar ch = sofar * 10 + parse_c ch;
152
153	/* Turn a char digit to a number.
154	 */
155	parse_c ch
156		= error (_ "not a digit"), !is_digit ch
157		= (int) ch - (int) '0';
158}
159
160/* Parse an integer, with an optional sign character.
161 */
162parse_int l
163	= error (_ "badly formed number"), !is_list_len 2 parts
164	= sign * n
165{
166	parts = splitpl [member "+-", is_digit] l;
167
168	n = parse_pint parts?1;
169	sign
170		= 1, parts?0 == [] || parts?0 == "+"
171		= -1;
172}
173
174/* Parse a float.
175 *	[+-]?[0-9]*([.][0-9]*)?(e[0-9]+)?
176 */
177parse_float l
178	= err, !is_list_len 4 parts
179	= sign * (abs ipart + fpart) * 10 ** exp
180{
181	err = error (_ "badly formed number");
182
183	parts = splitpl [
184		member "+-0123456789",
185		member ".0123456789",
186		member "eE",
187		member "+-0123456789"
188	] l;
189
190	ipart = parse_int parts?0;
191	sign
192		= 1, ipart > 0
193		= -1;
194	fpart
195		= 0, parts?1 == [];
196		= err, parts?1?0 != '.'
197		= parse_pint (tl parts?1) / 10 ** (len parts?1 - 1);
198	exp
199		= 0, parts?2 == [] && parts?3 == []
200		= err, parts?2 == []
201		= parse_int parts?3;
202
203}
204
205/* Parse a time in "hh:mm:ss" into seconds.
206
207We could do this in one line :)
208
209	= (sum @ map2 multiply (iterate (multiply 60) 1) @ reverse @ map
210	parse_pint @ map (subscript (splitpl [is_digit, equal ':', is_digit,
211	equal ':', is_digit] l))) [0,2,4];
212
213but it's totally unreadable.
214
215 */
216parse_time l
217	= error (_ "badly formed time"), !is_list_len 5 parts
218	= s + 60 * m + 60 * 60 * h
219{
220	parts = splitpl [is_digit, equal ':', is_digit, equal ':', is_digit] l;
221	h = parse_int parts?0;
222	m = parse_int parts?2;
223	s = parse_int parts?4;
224}
225
226/* matrix to convert D65 XYZ to D50 XYZ ... direct conversion, found by
227 * measuring a macbeth chart in D50 and D65 and doing a LMS to get a matrix
228 */
229D652D50_direct = Matrix
230	[[ 1.13529, -0.0604663, -0.0606321 ],
231	 [ 0.0975399, 0.935024, -0.0256156 ],
232	 [ -0.0336428, 0.0414702, 0.994135 ]];
233
234D502D65_direct = D652D50_direct ** -1;
235
236/* Convert normalised XYZ to bradford RGB.
237 */
238XYZ2RGBbrad = Matrix
239	[[0.8951,  0.2664, -0.1614],
240	 [-0.7502,  1.7135,  0.0367],
241	 [0.0389, -0.0685,  1.0296]];
242
243/* Convert bradford RGB to normalised XYZ.
244 */
245RGBbrad2XYZ = XYZ2RGBbrad ** -1;
246
247D93_whitepoint = Vector [89.7400, 100, 130.7700];
248D75_whitepoint = Vector [94.9682, 100, 122.5710];
249D65_whitepoint = Vector [95.0470, 100, 108.8827];
250D55_whitepoint = Vector [95.6831, 100, 92.0871];
251D50_whitepoint = Vector [96.4250, 100, 82.4680];
252A_whitepoint = Vector [109.8503, 100, 35.5849]; 	// 2856K
253B_whitepoint = Vector [99.0720, 100, 85.2230];		// 4874K
254C_whitepoint = Vector [98.0700, 100, 118.2300];		// 6774K
255E_whitepoint = Vector [100, 100, 100];			// ill. free
256D3250_whitepoint = Vector [105.6590, 100, 45.8501];
257
258Whitepoints = Enum [
259	$D93 => D93_whitepoint,
260	$D75 => D75_whitepoint,
261	$D65 => D65_whitepoint,
262	$D55 => D55_whitepoint,
263	$D50 => D50_whitepoint,
264	$A => A_whitepoint,
265	$B => B_whitepoint,
266	$C => C_whitepoint,
267	$E => E_whitepoint,
268	$D3250 => D3250_whitepoint
269];
270
271/* Convert D50 XYZ to D65 using the bradford chromatic adaptation approx.
272 */
273im_D502D65 xyz
274	= xyz'''
275{
276	xyz' = xyz / D50_whitepoint;
277
278	rgb = recomb XYZ2RGBbrad xyz';
279
280	// move white in bradford RGB
281	rgb' = rgb / Vector [0.94, 1.02, 1.33];
282
283	xyz'' = recomb RGBbrad2XYZ rgb';
284
285	// back to D65
286	xyz''' = xyz'' * D65_whitepoint;
287}
288
289/* Convert D65 XYZ to D50 using the bradford approx.
290 */
291im_D652D50 xyz
292	= xyz'''
293{
294	xyz' = xyz / D65_whitepoint;
295
296	rgb = recomb XYZ2RGBbrad xyz';
297
298	// move white in bradford RGB
299	rgb' = rgb * Vector [0.94, 1.02, 1.33];
300
301	xyz'' = recomb RGBbrad2XYZ rgb';
302
303	xyz''' = xyz'' * D50_whitepoint;
304}
305
306/* Convert D50 XYZ to Lab.
307 */
308im_D50XYZ2Lab xyz
309	= im_XYZ2Lab_temp xyz
310		D50_whitepoint.value?0
311		D50_whitepoint.value?1
312		D50_whitepoint.value?2;
313im_D50Lab2XYZ lab
314	= im_Lab2XYZ_temp lab
315		D50_whitepoint.value?0
316		D50_whitepoint.value?1
317		D50_whitepoint.value?2;
318
319/* ... and mono conversions
320 */
321im_sRGB2mono in
322	= (image_set_type Image_type.B_W @
323		clip2fmt (get_header "BandFmt" in) @
324			recomb (Matrix [[.3, .6, .1]])) in;
325im_mono2sRGB in
326	= image_set_type Image_type.sRGB (in ++ in ++ in);
327
328im_sRGB2Lab = im_XYZ2Lab @ im_sRGB2XYZ;
329
330im_Lab2sRGB = im_XYZ2sRGB @ im_Lab2XYZ;
331
332// from the 16 bit RGB and GREY formats
333im_1628 x = im_clip (x >> 8);
334im_162f x = x / 256;
335
336im_8216 x = (im_clip2us x) << 8;
337im_f216 x = im_clip2us (x * 256);
338
339im_RGB162GREY16 in
340	= (image_set_type Image_type.GREY16 @
341		clip2fmt (get_header "BandFmt" in) @
342			recomb (Matrix [[.3, .6, .1]])) in;
343im_GREY162RGB16 in
344	= image_set_type Image_type.RGB16 (in ++ in ++ in);
345
346/* apply a func to an image ... make it 1 or 3 bands, and reapply other bands
347 * on the way out. Except if it's LABPACK.
348 */
349colour_apply fn x
350	= fn x, b == 1 || b == 3 || c == Image_coding.LABPACK
351	= x''
352{
353	b = get_bands x;
354	c = get_coding x;
355
356	first
357		= extract_bands 0 3 x, b > 3
358		= extract_bands 0 1 x;
359	tail
360		= extract_bands 3 (b - 3) x, b > 3
361		= extract_bands 1 (b - 1) x;
362	x' = fn first;
363	x'' = x' ++ clip2fmt (get_format x') tail;
364}
365
366/* Any 1-ary colour op, applied to Vector/Image/Matrix or image
367 */
368colour_unary fn x
369	= oo_unary_function colour_op x, is_class x
370	= colour_apply fn x, is_image x
371	= colour_apply fn [x], is_real x
372	= error (_ "bad arguments to " ++ "colour_unary")
373{
374	// COMPOUND_REWRAP ... signal to the colour class to go to image and
375	// back
376	colour_op = Operator "colour_unary"
377		colour_object Operator_type.COMPOUND_REWRAP false;
378
379	colour_object x
380		= colour_real_list x, is_real_list x
381		= map colour_real_list x, is_matrix x
382		= colour_apply fn x, is_image x
383		= error (_ "bad arguments to " ++ "colour_unary");
384
385	colour_real_list l
386		= (to_matrix (fn (float) (to_image (Vector l)).value)).value?0;
387}
388
389/* Any symmetric 2-ary colour op, applied to Vector/Image/Matrix or image ...
390 * name is op name for error messages etc.
391 */
392colour_binary name fn x y
393	= oo_binary_function colour_op x y, is_class x
394	= oo_binary'_function colour_op x y, is_class y
395	= fn x y, is_image x && is_image y
396	= error (_ "bad arguments to " ++ name)
397{
398	colour_op = Operator name
399		colour_object Operator_type.COMPOUND_REWRAP true;
400
401	colour_object x y
402		= fn x y, is_image x && is_image y
403		= colour_real_list fn x y, is_real_list x && is_real_list y
404		= map (colour_real_list fn x) y, is_real_list x && is_matrix y
405		= map (colour_real_list (converse fn) y) x,
406			is_matrix x && is_real_list y
407		= map2 (colour_real_list fn) x y, is_matrix x && is_matrix y
408		= error (_ "bad arguments to " ++ name);
409
410	colour_real_list fn l1 l2
411		= (to_matrix (fn i1 i2)).value?0
412	{
413		i1 = (float) (to_image (Vector l1)).value;
414		i2 = (float) (to_image (Vector l2)).value;
415	}
416}
417
418_colour_conversion_table = [
419	/* Lines are [space-from, space-to, conversion function]. Could do
420	 * this as a big array, but table lookup feels safer.
421	 */
422	[B_W, B_W, image_set_type B_W],
423	[B_W, XYZ, im_sRGB2XYZ @ im_mono2sRGB @ im_clip],
424	[B_W, YXY, im_XYZ2Yxy @ im_sRGB2XYZ @ im_mono2sRGB @ im_clip],
425	[B_W, LAB, im_sRGB2Lab @ im_mono2sRGB @ im_clip],
426	[B_W, LCH, im_Lab2LCh @ im_sRGB2Lab @ im_mono2sRGB @ im_clip],
427	[B_W, UCS, im_XYZ2UCS @ im_sRGB2XYZ @ im_mono2sRGB @ im_clip],
428	[B_W, RGB, im_XYZ2disp @ im_sRGB2XYZ @ im_mono2sRGB @ im_clip],
429	[B_W, sRGB, im_mono2sRGB @ im_clip],
430	[B_W, RGB16, image_set_type RGB16 @ im_8216 @ im_mono2sRGB],
431	[B_W, GREY16, image_set_type GREY16 @ im_8216],
432	[B_W, LABQ, im_Lab2LabQ @ im_sRGB2Lab @ im_mono2sRGB @ im_clip],
433	[B_W, LABS, im_LabQ2LabS @ im_Lab2LabQ @ im_sRGB2Lab @
434		im_mono2sRGB @ im_clip],
435
436	[XYZ, B_W, im_sRGB2mono @ im_XYZ2sRGB @ im_clip2f],
437	[XYZ, XYZ, image_set_type XYZ],
438	[XYZ, YXY, im_XYZ2Yxy @ im_clip2f],
439	[XYZ, LAB, im_XYZ2Lab @ im_clip2f],
440	[XYZ, LCH, im_Lab2LCh @ im_XYZ2Lab],
441	[XYZ, UCS, im_XYZ2UCS @ im_clip2f],
442	[XYZ, RGB, im_XYZ2disp @ im_clip2f],
443	[XYZ, sRGB, im_XYZ2sRGB @ im_clip2f],
444	[XYZ, LABQ, im_Lab2LabQ @ im_XYZ2Lab @ im_clip2f],
445	[XYZ, LABS, im_LabQ2LabS @ im_Lab2LabQ @ im_XYZ2Lab @ im_clip2f],
446
447	[YXY, B_W, im_sRGB2mono @ im_XYZ2sRGB @ im_Yxy2XYZ @ im_clip2f],
448	[YXY, XYZ, im_Yxy2XYZ @ im_clip2f],
449	[YXY, YXY, image_set_type YXY],
450	[YXY, LAB, im_XYZ2Lab @ im_Yxy2XYZ @ im_clip2f],
451	[YXY, LCH, im_Lab2LCh @ im_XYZ2Lab @ im_Yxy2XYZ @ im_clip2f],
452	[YXY, UCS, im_XYZ2UCS @ im_Yxy2XYZ @ im_clip2f],
453	[YXY, RGB, im_XYZ2disp @ im_Yxy2XYZ @ im_clip2f],
454	[YXY, sRGB, im_XYZ2sRGB @ im_Yxy2XYZ @ im_clip2f],
455	[YXY, LABQ, im_Lab2LabQ @ im_XYZ2Lab @ im_Yxy2XYZ @ im_clip2f],
456	[YXY, LABS, im_LabQ2LabS @ im_Lab2LabQ @ im_XYZ2Lab @ im_Yxy2XYZ @
457		im_clip2f],
458
459	[LAB, B_W, im_sRGB2mono @ im_Lab2sRGB @ im_Lab2XYZ @ im_clip2f],
460	[LAB, XYZ, im_Lab2XYZ @ im_clip2f],
461	[LAB, YXY, im_XYZ2Yxy @ im_Lab2XYZ @ im_clip2f],
462	[LAB, LAB, image_set_type LAB @ im_clip2f],
463	[LAB, LCH, im_Lab2LCh @ im_clip2f],
464	[LAB, UCS, im_Lab2UCS @ im_clip2f],
465	[LAB, RGB, im_Lab2disp @ im_clip2f],
466	[LAB, sRGB, im_Lab2sRGB @ im_clip2f],
467	[LAB, LABQ, im_Lab2LabQ @ im_clip2f],
468	[LAB, LABS, im_Lab2LabS @ im_clip2f],
469
470	[LCH, B_W, im_sRGB2mono @ im_Lab2sRGB @ im_LCh2Lab @ im_clip2f],
471	[LCH, XYZ, im_Lab2XYZ @ im_LCh2Lab @ im_clip2f],
472	[LCH, YXY, im_XYZ2Yxy @ im_Lab2XYZ @ im_LCh2Lab @ im_clip2f],
473	[LCH, LAB, im_LCh2Lab @ im_clip2f],
474	[LCH, LCH, image_set_type LCH],
475	[LCH, UCS, im_LCh2UCS @ im_clip2f],
476	[LCH, RGB, im_Lab2disp @ im_LCh2Lab @ im_clip2f],
477	[LCH, sRGB, im_Lab2sRGB @ im_LCh2Lab @ im_clip2f],
478	[LCH, LABQ, im_Lab2LabQ @ im_LCh2Lab @ im_clip2f],
479	[LCH, LABS, im_LabQ2LabS @ im_Lab2LabQ @ im_LCh2Lab @ im_clip2f],
480
481	[UCS, B_W, im_sRGB2mono @ im_XYZ2sRGB @ im_UCS2XYZ @ im_clip2f],
482	[UCS, XYZ, im_UCS2XYZ @ im_clip2f],
483	[UCS, YXY, im_XYZ2Yxy @ im_Lab2XYZ @ im_UCS2Lab @ im_clip2f],
484	[UCS, LAB, im_UCS2Lab @ im_clip2f],
485	[UCS, LCH, im_UCS2LCh @ im_clip2f],
486	[UCS, UCS, image_set_type UCS],
487	[UCS, RGB, im_Lab2disp @ im_UCS2Lab @ im_clip2f],
488	[UCS, sRGB, im_Lab2sRGB @ im_UCS2Lab @ im_clip2f],
489	[UCS, LABQ, im_Lab2LabQ @ im_UCS2Lab @ im_clip2f],
490	[UCS, LABS, im_LabQ2LabS @ im_Lab2LabQ @ im_UCS2Lab @ im_clip2f],
491
492	[RGB, B_W, im_sRGB2mono @ im_XYZ2sRGB @ im_disp2XYZ @ im_clip],
493	[RGB, XYZ, im_disp2XYZ @ im_clip],
494	[RGB, YXY, im_XYZ2Yxy @ im_disp2XYZ @ im_clip],
495	[RGB, LAB, im_disp2Lab @ im_clip],
496	[RGB, LCH, im_Lab2LCh @ im_disp2Lab @ im_clip],
497	[RGB, UCS, im_Lab2UCS @ im_disp2Lab @ im_clip],
498	[RGB, RGB, image_set_type RGB],
499	[RGB, sRGB, im_XYZ2sRGB @ im_disp2XYZ @ im_clip],
500	[RGB, RGB16, image_set_type RGB16 @ im_8216],
501	[RGB, GREY16, image_set_type GREY16 @ im_8216 @ im_sRGB2mono],
502	[RGB, LABQ, im_Lab2LabQ @ im_disp2Lab @ im_clip],
503	[RGB, LABS, im_LabQ2LabS @ im_Lab2LabQ @ im_disp2Lab @ im_clip],
504
505	[sRGB, B_W, im_sRGB2mono],
506	[sRGB, XYZ, im_sRGB2XYZ @ im_clip],
507	[sRGB, YXY, im_XYZ2Yxy @ im_sRGB2XYZ @ im_clip],
508	[sRGB, LAB, im_sRGB2Lab @ im_clip],
509	[sRGB, LCH, im_Lab2LCh @ im_sRGB2Lab @ im_clip],
510	[sRGB, UCS, im_XYZ2UCS @ im_sRGB2XYZ @ im_clip],
511	[sRGB, RGB, im_XYZ2disp @ im_sRGB2XYZ @ im_clip],
512	[sRGB, sRGB, image_set_type sRGB],
513	[sRGB, RGB16, image_set_type RGB16 @ im_8216],
514	[sRGB, GREY16, image_set_type GREY16 @ im_8216 @ im_sRGB2mono],
515	[sRGB, LABQ, im_Lab2LabQ @ im_sRGB2Lab @ im_clip],
516	[sRGB, LABS, im_LabQ2LabS @ im_Lab2LabQ @ im_sRGB2Lab @ im_clip],
517
518	[RGB16, B_W, im_1628 @ im_sRGB2mono],
519	[RGB16, RGB, image_set_type RGB @ im_1628],
520	[RGB16, sRGB, image_set_type sRGB @ im_1628],
521	[RGB16, RGB16, image_set_type RGB16],
522	[RGB16, GREY16, im_RGB162GREY16],
523
524	[GREY16, B_W, image_set_type B_W @ im_1628],
525	[GREY16, RGB, im_mono2sRGB @ im_1628],
526	[GREY16, sRGB, im_mono2sRGB @ im_1628],
527	[GREY16, RGB16, im_GREY162RGB16],
528	[GREY16, GREY16, image_set_type GREY16],
529
530	[LABQ, B_W, im_sRGB2mono @ im_Lab2sRGB @ im_LabQ2Lab],
531	[LABQ, XYZ, im_Lab2XYZ @ im_LabQ2Lab],
532	[LABQ, YXY, im_XYZ2Yxy @ im_Lab2XYZ @ im_LabQ2Lab],
533	[LABQ, LAB, im_LabQ2Lab],
534	[LABQ, LCH, im_Lab2LCh @ im_LabQ2Lab],
535	[LABQ, UCS, im_Lab2UCS @ im_LabQ2Lab],
536	[LABQ, RGB, im_LabQ2disp],
537	[LABQ, sRGB, im_Lab2sRGB @ im_LabQ2Lab],
538	[LABQ, LABQ, image_set_type LABQ],
539	[LABQ, LABS, im_LabQ2LabS],
540
541	[LABS, B_W, im_sRGB2mono @ im_Lab2sRGB @ im_LabQ2Lab @
542		im_LabS2LabQ @ im_clip2s],
543	[LABS, XYZ, im_Lab2XYZ @ im_LabQ2Lab @ im_LabS2LabQ @ im_clip2s],
544	[LABS, YXY, im_XYZ2Yxy @
545		im_Lab2XYZ @ im_LabQ2Lab @ im_LabS2LabQ @ im_clip2s],
546	[LABS, LAB, im_LabS2Lab],
547	[LABS, LCH, im_Lab2LCh @ im_LabQ2Lab @ im_LabS2LabQ @ im_clip2s],
548	[LABS, UCS, im_Lab2UCS @ im_LabQ2Lab @ im_LabS2LabQ @ im_clip2s],
549	[LABS, RGB, im_LabQ2disp @ im_LabS2LabQ @ im_clip2s],
550	[LABS, sRGB, im_XYZ2sRGB @
551		im_Lab2XYZ @ im_LabQ2Lab @ im_LabS2LabQ @ im_clip2s],
552	[LABS, LABQ, im_LabS2LabQ @ im_clip2s],
553	[LABS, LABS, image_set_type LABS]
554]
555{
556	/* From Image_type ... repeat here for brevity. Use same ordering as
557	 * in Colour menu for consistency.
558	 */
559	B_W = 1;
560	XYZ = 12;
561	YXY = 23;
562	LAB = 13;
563	LCH = 19;
564	UCS = 18;
565	RGB = 17;
566	sRGB = 22;
567	RGB16 = 25;
568	GREY16 = 26;
569	LABQ = 16;
570	LABS = 21;
571}
572
573/* Transform between two colour spaces.
574 */
575colour_transform from to in
576	= colour_unary _colour_conversion_table?i?2 in, i >= 0
577	= error (_ "unable to convert " ++ Image_type.type_names.get_name from ++
578		_ " to " ++ Image_type.type_names.get_name to)
579{
580	match x = x?0 == from && x?1 == to;
581	i = index match _colour_conversion_table;
582}
583
584/* Transform to a colour space, assuming the type field in the input is
585 * correct
586 */
587colour_transform_to to in = colour_transform (get_type in) to in;
588
589/* String for path separator on this platform.
590 */
591path_separator = expand "$SEP";
592
593/* Form a relative pathname.
594 * 	path_relative ["home", "john"] == "home/john"
595 * 	path_relative [] == ""
596 */
597path_relative l = join_sep path_separator l;
598
599/* Form an absolute pathname.
600 * 	path_absolute ["home", "john"] == "/home/john"
601 * 	path_absolute [] == "/"
602 * If the first component looks like 'A:', don't add an initial separator.
603 */
604path_absolute l
605	= path_relative l,
606		len l?0 > 1 && is_letter l?0?0 && l?0?1 == ':'
607	= path_separator ++ path_relative l;
608
609/* Parse a pathname.
610 *	path_parse "/home/john" == ["home", "john"]
611 *	path_parse "home/john" == ["home", "john"]
612 */
613path_parse str
614	= split (equal path_separator?0) str;
615
616