2
/* Try to make a Matrix ... works for Vector/Image/Real, plus image/real
5
= to_matrix x.expr, is_Expression x
7
= oo_unary_function to_matrix_op x, is_class x
10
to_matrix_op = Operator "to_matrix" tom Operator_type.COMPOUND false;
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");
20
= (im_vips2mask ((double) i)).value, is_image i
21
= error (_ "not image");
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
29
= to_image x.expr, is_Expression x
31
= Image (image_set_type
32
(Image_type.colour_spaces.lookup 0 1 x.colour_space)
35
= oo_unary_function to_image_op x, is_class x
38
to_image_op = Operator "to_image" toi Operator_type.COMPOUND false;
42
= Image (mtoi [[x]]), is_real x
43
= Image (mtoi [x]), is_real_list x
44
= Image (mtoi x), is_matrix x
45
= error (_ "bad arguments to " ++ "to_image");
49
= im_mask2vips (Matrix m), width != 3
50
= joinup (im_mask2vips (Matrix m))
57
b1 = extract_area 0 0 1 height i;
58
b2 = extract_area 1 0 1 height i;
59
b3 = extract_area 2 0 1 height i;
64
// like to_image, but we do 1x1 pixel + x, then embed it up
65
// always make an unwrapped image for speed ... this gets used by ifthenelse
66
// and stuff like that
67
// format can be NULL, meaning set format from x
68
to_image_size width height bands format x
73
// we want x to set the target format if we don't have one, so we
74
// can't use image_new
75
im = im_black 1 1 bands + x;
77
= clip2fmt format im, format != NULL
79
im'' = embed 1 0 0 width height im';
82
/* Try to make a Colour.
85
= to_colour x.expr, is_Expression x
87
= to_colour (extract_area x.left x.top 1 1 x.image), is_Mark x
88
= oo_unary_function to_colour_op x, is_class x
91
to_colour_op = Operator "to_colour" toc Operator_type.COMPOUND false;
94
= Colour (colour_space (get_type x))
95
(map mean (bandsplit (get_image x))),
96
has_image x && has_type x
97
= Colour "sRGB" [x, x, x], is_real x // since Colour can't do mono
98
= Colour "sRGB" x, is_real_list x && is_list_len 3 x
99
= map toc x, is_matrix x
100
= error (_ "bad arguments to " ++ "to_colour");
103
= table.get_name type, table.has_name type
104
= error (_ "unable to make Colour from " ++ table.get_name type ++
107
table = Image_type.colour_spaces;
111
/* Try to make a real. (not a Real!)
114
= to_real x.expr, is_Expression x
115
= oo_unary_function to_real_op x, is_class x
118
to_real_op = Operator "to_real" tor Operator_type.COMPOUND false;
122
= abs x, is_complex x
125
= error (_ "bad arguments to " ++ "to_real");
128
/* Try to make a list ... ungroup, basically. We remove the innermost layer of
132
= x.value, is_Group x && !contains_Group x.value
133
= Group (map to_list x.value), is_Group x
136
/* Try to make a group. The innermost list objects become Group()'d.
139
= Group x, is_list x && !contains_Group x
140
= Group (map to_group x.value), is_Group x
143
/* Parse a positive integer.
148
acc sofar ch = sofar * 10 + parse_c ch;
150
/* Turn a char digit to a number.
153
= error (_ "not a digit"), !is_digit ch
154
= (int) ch - (int) '0';
157
/* Parse an integer, with an optional sign character.
160
= error (_ "badly formed number"), !is_list_len 2 parts
163
parts = splitpl [member "+-", is_digit] l;
165
n = parse_pint parts?1;
167
= 1, parts?0 == [] || parts?0 == "+"
172
* [+-]?[0-9]*([.][0-9]*)?(e[0-9]+)?
175
= err, !is_list_len 4 parts
176
= (ipart + fpart) * 10 ** exp
178
err = error (_ "badly formed number");
181
member "+-0123456789", member ".0123456789",
182
member "eE", member "+-0123456789"
185
ipart = parse_int parts?0;
188
= err, parts?1?0 != '.'
189
= parse_pint (tl parts?1) / 10 ** (len parts?1 - 1);
191
= 0, parts?2 == [] && parts?3 == []
197
/* Parse a time in "hh:mm:ss" into seconds.
199
We could do this in one line :)
201
= (sum @ map2 multiply (iterate (multiply 60) 1) @ reverse @ map
202
parse_pint @ map (subscript (splitpl [is_digit, equal ':', is_digit,
203
equal ':', is_digit] l))) [0,2,4];
205
but it's totally unreadable.
209
= error (_ "badly formed time"), !is_list_len 5 parts
210
= s + 60 * m + 60 * 60 * h
212
parts = splitpl [is_digit, equal ':', is_digit, equal ':', is_digit] l;
213
h = parse_int parts?0;
214
m = parse_int parts?2;
215
s = parse_int parts?4;
218
/* matrix to convert D65 XYZ to D50 XYZ ... direct conversion, found by
219
* measuring a macbeth chart in D50 and D65 and doing a LMS to get a matrix
221
D652D50_direct = Matrix
222
[[ 1.13529, -0.0604663, -0.0606321 ],
223
[ 0.0975399, 0.935024, -0.0256156 ],
224
[ -0.0336428, 0.0414702, 0.994135 ]];
226
D502D65_direct = D652D50_direct ** -1;
228
/* Convert normalised XYZ to bradford RGB.
231
[[0.8951, 0.2664, -0.1614],
232
[-0.7502, 1.7135, 0.0367],
233
[0.0389, -0.0685, 1.0296]];
235
/* Convert bradford RGB to normalised XYZ.
237
RGBbrad2XYZ = XYZ2RGBbrad ** -1;
239
D93_whitepoint = Vector [89.7400, 100, 130.7700];
240
D75_whitepoint = Vector [94.9682, 100, 122.5710];
241
D65_whitepoint = Vector [95.0470, 100, 108.8827];
242
D55_whitepoint = Vector [95.6831, 100, 92.0871];
243
D50_whitepoint = Vector [96.4250, 100, 82.4680];
244
A_whitepoint = Vector [109.8503, 100, 35.5849]; // 2856K
245
B_whitepoint = Vector [99.0720, 100, 85.2230]; // 4874K
246
C_whitepoint = Vector [98.0700, 100, 118.2300]; // 6774K
247
E_whitepoint = Vector [100, 100, 100]; // ill. free
248
D3250_whitepoint = Vector [105.6590, 100, 45.8501];
251
$D93 => D93_whitepoint,
252
$D75 => D75_whitepoint,
253
$D65 => D65_whitepoint,
254
$D55 => D55_whitepoint,
255
$D50 => D50_whitepoint,
260
$D3250 => D3250_whitepoint
263
/* Convert D50 XYZ to D65 using the bradford chromatic adaptation approx.
268
xyz' = xyz / D50_whitepoint;
270
rgb = recomb XYZ2RGBbrad xyz';
272
// move white in bradford RGB
273
rgb' = rgb / Vector [0.94, 1.02, 1.33];
275
xyz'' = recomb RGBbrad2XYZ rgb';
278
xyz''' = xyz'' * D65_whitepoint;
281
/* Convert D65 XYZ to D50 using the bradford approx.
286
xyz' = xyz / D65_whitepoint;
288
rgb = recomb XYZ2RGBbrad xyz';
290
// move white in bradford RGB
291
rgb' = rgb * Vector [0.94, 1.02, 1.33];
293
xyz'' = recomb RGBbrad2XYZ rgb';
295
xyz''' = xyz'' * D50_whitepoint;
298
/* Convert D50 XYZ to Lab.
301
= im_XYZ2Lab_temp xyz
302
D50_whitepoint.value?0
303
D50_whitepoint.value?1
304
D50_whitepoint.value?2;
306
= im_Lab2XYZ_temp lab
307
D50_whitepoint.value?0
308
D50_whitepoint.value?1
309
D50_whitepoint.value?2;
311
/* ... and mono conversions
314
= (image_set_type Image_type.B_W @
315
clip2fmt (get_header "BandFmt" in) @
316
recomb (Matrix [[.3, .6, .1]])) in;
318
= image_set_type Image_type.sRGB (in ++ in ++ in);
320
im_sRGB2Lab = im_XYZ2Lab @ im_sRGB2XYZ;
322
im_Lab2sRGB = im_XYZ2sRGB @ im_Lab2XYZ;
324
// from the 16 bit RGB and GREY formats
325
im_1628 x = im_clip (x >> 8);
328
im_8216 x = (im_clip2us x) << 8;
329
im_f216 x = im_clip2us (x * 256);
332
= (image_set_type Image_type.GREY16 @
333
clip2fmt (get_header "BandFmt" in) @
334
recomb (Matrix [[.3, .6, .1]])) in;
336
= image_set_type Image_type.RGB16 (in ++ in ++ in);
338
/* apply a func to an image ... make it 1 or 3 bands, and reapply other bands
339
* on the way out. Except if it's LABPACK.
342
= fn x, b == 1 || b == 3 || c == Image_coding.LABPACK
349
= extract_bands 0 3 x, b > 3
350
= extract_bands 0 1 x;
352
= extract_bands 3 (b - 3) x, b > 3
353
= extract_bands 1 (b - 1) x;
355
x'' = x' ++ clip2fmt (get_format x') tail;
358
/* Any 1-ary colour op, applied to Vector/Image/Matrix or image
361
= oo_unary_function colour_op x, is_class x
362
= colour_apply fn x, is_image x
363
= colour_apply fn [x], is_real x
364
= error (_ "bad arguments to " ++ "colour_unary")
366
// COMPOUND_REWRAP ... signal to the colour class to go to image and
368
colour_op = Operator "colour_unary"
369
colour_object Operator_type.COMPOUND_REWRAP false;
372
= colour_real_list x, is_real_list x
373
= map colour_real_list x, is_matrix x
374
= colour_apply fn x, is_image x
375
= error (_ "bad arguments to " ++ "colour_unary");
378
= (to_matrix (fn (float) (to_image (Vector l)).value)).value?0;
381
/* Any symmetric 2-ary colour op, applied to Vector/Image/Matrix or image ...
382
* name is op name for error messages etc.
384
colour_binary name fn x y
385
= oo_binary_function colour_op x y, is_class x
386
= oo_binary'_function colour_op x y, is_class y
387
= fn x y, is_image x && is_image y
388
= error (_ "bad arguments to " ++ name)
390
colour_op = Operator name
391
colour_object Operator_type.COMPOUND_REWRAP true;
394
= fn x y, is_image x && is_image y
395
= colour_real_list fn x y, is_real_list x && is_real_list y
396
= map (colour_real_list fn x) y, is_real_list x && is_matrix y
397
= map (colour_real_list (converse fn) y) x,
398
is_matrix x && is_real_list y
399
= map2 (colour_real_list fn) x y, is_matrix x && is_matrix y
400
= error (_ "bad arguments to " ++ name);
402
colour_real_list fn l1 l2
403
= (to_matrix (fn i1 i2)).value?0
405
i1 = (float) (to_image (Vector l1)).value;
406
i2 = (float) (to_image (Vector l2)).value;
410
_colour_conversion_table = [
411
/* Lines are [space-from, space-to, conversion function]. Could do
412
* this as a big array, but table lookup feels safer.
414
[B_W, B_W, image_set_type B_W],
415
[B_W, XYZ, im_sRGB2XYZ @ im_mono2sRGB @ im_clip],
416
[B_W, YXY, im_XYZ2Yxy @ im_sRGB2XYZ @ im_mono2sRGB @ im_clip],
417
[B_W, LAB, im_sRGB2Lab @ im_mono2sRGB @ im_clip],
418
[B_W, LCH, im_Lab2LCh @ im_sRGB2Lab @ im_mono2sRGB @ im_clip],
419
[B_W, UCS, im_XYZ2UCS @ im_sRGB2XYZ @ im_mono2sRGB @ im_clip],
420
[B_W, RGB, im_XYZ2disp @ im_sRGB2XYZ @ im_mono2sRGB @ im_clip],
421
[B_W, sRGB, im_mono2sRGB @ im_clip],
422
[B_W, RGB16, image_set_type RGB16 @ im_8216 @ im_mono2sRGB],
423
[B_W, GREY16, image_set_type GREY16 @ im_8216],
424
[B_W, LABQ, im_Lab2LabQ @ im_sRGB2Lab @ im_mono2sRGB @ im_clip],
425
[B_W, LABS, im_LabQ2LabS @ im_Lab2LabQ @ im_sRGB2Lab @
426
im_mono2sRGB @ im_clip],
428
[XYZ, B_W, im_sRGB2mono @ im_XYZ2sRGB @ im_clip2f],
429
[XYZ, XYZ, image_set_type XYZ],
430
[XYZ, YXY, im_XYZ2Yxy @ im_clip2f],
431
[XYZ, LAB, im_XYZ2Lab @ im_clip2f],
432
[XYZ, LCH, im_Lab2LCh @ im_XYZ2Lab],
433
[XYZ, UCS, im_XYZ2UCS @ im_clip2f],
434
[XYZ, RGB, im_XYZ2disp @ im_clip2f],
435
[XYZ, sRGB, im_XYZ2sRGB @ im_clip2f],
436
[XYZ, LABQ, im_Lab2LabQ @ im_XYZ2Lab @ im_clip2f],
437
[XYZ, LABS, im_LabQ2LabS @ im_Lab2LabQ @ im_XYZ2Lab @ im_clip2f],
439
[YXY, B_W, im_sRGB2mono @ im_XYZ2sRGB @ im_Yxy2XYZ @ im_clip2f],
440
[YXY, XYZ, im_Yxy2XYZ @ im_clip2f],
441
[YXY, YXY, image_set_type YXY],
442
[YXY, LAB, im_XYZ2Lab @ im_Yxy2XYZ @ im_clip2f],
443
[YXY, LCH, im_Lab2LCh @ im_XYZ2Lab @ im_Yxy2XYZ @ im_clip2f],
444
[YXY, UCS, im_XYZ2UCS @ im_Yxy2XYZ @ im_clip2f],
445
[YXY, RGB, im_XYZ2disp @ im_Yxy2XYZ @ im_clip2f],
446
[YXY, sRGB, im_XYZ2sRGB @ im_Yxy2XYZ @ im_clip2f],
447
[YXY, LABQ, im_Lab2LabQ @ im_XYZ2Lab @ im_Yxy2XYZ @ im_clip2f],
448
[YXY, LABS, im_LabQ2LabS @ im_Lab2LabQ @ im_XYZ2Lab @ im_Yxy2XYZ @
451
[LAB, B_W, im_sRGB2mono @ im_Lab2sRGB @ im_Lab2XYZ @ im_clip2f],
452
[LAB, XYZ, im_Lab2XYZ @ im_clip2f],
453
[LAB, YXY, im_XYZ2Yxy @ im_Lab2XYZ @ im_clip2f],
454
[LAB, LAB, image_set_type LAB @ im_clip2f],
455
[LAB, LCH, im_Lab2LCh @ im_clip2f],
456
[LAB, UCS, im_Lab2UCS @ im_clip2f],
457
[LAB, RGB, im_Lab2disp @ im_clip2f],
458
[LAB, sRGB, im_Lab2sRGB @ im_clip2f],
459
[LAB, LABQ, im_Lab2LabQ @ im_clip2f],
460
[LAB, LABS, im_Lab2LabS @ im_clip2f],
462
[LCH, B_W, im_sRGB2mono @ im_Lab2sRGB @ im_LCh2Lab @ im_clip2f],
463
[LCH, XYZ, im_Lab2XYZ @ im_LCh2Lab @ im_clip2f],
464
[LCH, YXY, im_XYZ2Yxy @ im_Lab2sRGB @ im_LCh2Lab @ im_clip2f],
465
[LCH, LAB, im_LCh2Lab @ im_clip2f],
466
[LCH, LCH, image_set_type LCH],
467
[LCH, UCS, im_LCh2UCS @ im_clip2f],
468
[LCH, RGB, im_Lab2disp @ im_LCh2Lab @ im_clip2f],
469
[LCH, sRGB, im_Lab2sRGB @ im_LCh2Lab @ im_clip2f],
470
[LCH, LABQ, im_Lab2LabQ @ im_LCh2Lab @ im_clip2f],
471
[LCH, LABS, im_LabQ2LabS @ im_Lab2LabQ @ im_LCh2Lab @ im_clip2f],
473
[UCS, B_W, im_sRGB2mono @ im_XYZ2sRGB @ im_UCS2XYZ @ im_clip2f],
474
[UCS, XYZ, im_UCS2XYZ @ im_clip2f],
475
[UCS, YXY, im_XYZ2Yxy @ im_Lab2XYZ @ im_UCS2Lab @ im_clip2f],
476
[UCS, LAB, im_UCS2Lab @ im_clip2f],
477
[UCS, LCH, im_UCS2LCh @ im_clip2f],
478
[UCS, UCS, image_set_type UCS],
479
[UCS, RGB, im_Lab2disp @ im_UCS2Lab @ im_clip2f],
480
[UCS, sRGB, im_Lab2sRGB @ im_UCS2Lab @ im_clip2f],
481
[UCS, LABQ, im_Lab2LabQ @ im_UCS2Lab @ im_clip2f],
482
[UCS, LABS, im_LabQ2LabS @ im_Lab2LabQ @ im_UCS2Lab @ im_clip2f],
484
[RGB, B_W, im_sRGB2mono @ im_XYZ2sRGB @ im_disp2XYZ @ im_clip],
485
[RGB, XYZ, im_disp2XYZ @ im_clip],
486
[RGB, YXY, im_XYZ2Yxy @ im_disp2XYZ @ im_clip],
487
[RGB, LAB, im_disp2Lab @ im_clip],
488
[RGB, LCH, im_Lab2LCh @ im_disp2Lab @ im_clip],
489
[RGB, UCS, im_Lab2UCS @ im_disp2Lab @ im_clip],
490
[RGB, RGB, image_set_type RGB],
491
[RGB, sRGB, im_XYZ2sRGB @ im_disp2XYZ @ im_clip],
492
[RGB, RGB16, image_set_type RGB16 @ im_8216],
493
[RGB, GREY16, image_set_type GREY16 @ im_8216 @ im_sRGB2mono],
494
[RGB, LABQ, im_Lab2LabQ @ im_disp2Lab @ im_clip],
495
[RGB, LABS, im_LabQ2LabS @ im_Lab2LabQ @ im_disp2Lab @ im_clip],
497
[sRGB, B_W, im_sRGB2mono],
498
[sRGB, XYZ, im_sRGB2XYZ @ im_clip],
499
[sRGB, YXY, im_XYZ2Yxy @ im_sRGB2XYZ @ im_clip],
500
[sRGB, LAB, im_sRGB2Lab @ im_clip],
501
[sRGB, LCH, im_Lab2LCh @ im_sRGB2Lab @ im_clip],
502
[sRGB, UCS, im_XYZ2UCS @ im_sRGB2XYZ @ im_clip],
503
[sRGB, RGB, im_XYZ2disp @ im_sRGB2XYZ @ im_clip],
504
[sRGB, sRGB, image_set_type sRGB],
505
[sRGB, RGB16, image_set_type RGB16 @ im_8216],
506
[sRGB, GREY16, image_set_type GREY16 @ im_8216 @ im_sRGB2mono],
507
[sRGB, LABQ, im_Lab2LabQ @ im_sRGB2Lab @ im_clip],
508
[sRGB, LABS, im_LabQ2LabS @ im_Lab2LabQ @ im_sRGB2Lab @ im_clip],
510
[RGB16, B_W, im_1628 @ im_sRGB2mono],
511
[RGB16, RGB, image_set_type RGB @ im_1628],
512
[RGB16, sRGB, image_set_type sRGB @ im_1628],
513
[RGB16, RGB16, image_set_type RGB16],
514
[RGB16, GREY16, im_RGB162GREY16],
516
[GREY16, B_W, image_set_type B_W @ im_1628],
517
[GREY16, RGB, im_mono2sRGB @ im_1628],
518
[GREY16, sRGB, im_mono2sRGB @ im_1628],
519
[GREY16, RGB16, im_GREY162RGB16],
520
[GREY16, GREY16, image_set_type GREY16],
522
[LABQ, B_W, im_sRGB2mono @ im_Lab2sRGB @ im_LabQ2Lab],
523
[LABQ, XYZ, im_Lab2XYZ @ im_LabQ2Lab],
524
[LABQ, YXY, im_XYZ2Yxy @ im_Lab2XYZ @ im_LabQ2Lab],
525
[LABQ, LAB, im_LabQ2Lab],
526
[LABQ, LCH, im_Lab2LCh @ im_LabQ2Lab],
527
[LABQ, UCS, im_Lab2UCS @ im_LabQ2Lab],
528
[LABQ, RGB, im_LabQ2disp],
529
[LABQ, sRGB, im_Lab2sRGB @ im_LabQ2Lab],
530
[LABQ, LABQ, image_set_type LABQ],
531
[LABQ, LABS, im_LabQ2LabS],
533
[LABS, B_W, im_sRGB2mono @ im_Lab2sRGB @ im_LabQ2Lab @
534
im_LabS2LabQ @ im_clip2s],
535
[LABS, XYZ, im_Lab2XYZ @ im_LabQ2Lab @ im_LabS2LabQ @ im_clip2s],
536
[LABS, YXY, im_XYZ2Yxy @
537
im_Lab2XYZ @ im_LabQ2Lab @ im_LabS2LabQ @ im_clip2s],
538
[LABS, LAB, im_LabS2Lab],
539
[LABS, LCH, im_Lab2LCh @ im_LabQ2Lab @ im_LabS2LabQ @ im_clip2s],
540
[LABS, UCS, im_Lab2UCS @ im_LabQ2Lab @ im_LabS2LabQ @ im_clip2s],
541
[LABS, RGB, im_LabQ2disp @ im_LabS2LabQ @ im_clip2s],
542
[LABS, sRGB, im_XYZ2sRGB @
543
im_Lab2XYZ @ im_LabQ2Lab @ im_LabS2LabQ @ im_clip2s],
544
[LABS, LABQ, im_LabS2LabQ @ im_clip2s],
545
[LABS, LABS, image_set_type LABS]
548
/* From Image_type ... repeat here for brevity. Use same ordering as
549
* in Colour menu for consistency.
565
/* Transform between two colour spaces.
567
colour_transform from to in
568
= colour_unary _colour_conversion_table?i?2 in, i >= 0
569
= error (_ "unable to convert " ++ Image_type.type_names.get_name from ++
570
_ " to " ++ Image_type.type_names.get_name to)
572
match x = x?0 == from && x?1 == to;
573
i = index match _colour_conversion_table;
576
/* Transform to a colour space, assuming the type field in the input is
579
colour_transform_to to in = colour_transform (get_type in) to in;
581
/* String for path separator on this platform.
583
path_separator = expand "$SEP";
585
/* Form a relative pathname.
586
* path_relative ["home", "john"] == "home/john"
587
* path_relative [] == ""
589
path_relative l = join_sep path_separator l;
591
/* Form an absolute pathname.
592
* path_absolute ["home", "john"] == "/home/john"
593
* path_absolute [] == "/"
594
* If the first component looks like 'A:', don't add an initial separator.
598
len l?0 > 1 && is_letter l?0?0 && l?0?1 == ':'
599
= path_separator ++ path_relative l;
602
* path_parse "/home/john" == ["home", "john"]
603
* path_parse "home/john" == ["home", "john"]
606
= split (equal path_separator?0) str;
added
removed
share/nip2/compat/7.26/_convert.def
