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, is_real x || is_image x 9 = error (_ "bad arguments to " ++ "to_matrix") 10{ 11 to_matrix_op = Operator "to_matrix" tom Operator_type.COMPOUND false; 12 13 tom x 14 = Matrix (itom x), is_image x 15 = Matrix [[x]], is_real x 16 = Matrix [x], is_real_list x 17 = Matrix x, is_matrix x 18 = error (_ "bad arguments to " ++ "to_matrix"); 19 20 itom i 21 = (im_vips2mask ((double) i)).value, 22 is_image i && get_bands i == 1 23 = (im_vips2mask ((double) i'')).value, 24 is_image i && get_bands i == 3 && get_width i == 1 25 = error (_ "not 1 band image, or 3 band 1 column image") 26 { 27 split = bandsplit i; 28 i' = im_insert (split?0) (split?1) 1 0; 29 i'' = im_insert i' (split?2) 2 0; 30 } 31} 32 33/* Try to make an Image ... works for Vector/Matrix/Real, plus image/real 34 * Special case for Colour ... pull out the colour_space and set Type in the 35 * image. 36 */ 37to_image x 38 = to_image x.expr, is_Expression x 39 = x, is_Image x 40 = Image (image_set_type 41 (Image_type.colour_spaces.lookup 0 1 x.colour_space) 42 (mtoi [x.value])), 43 is_Colour x 44 = oo_unary_function to_image_op x, is_class x 45 = toi x, is_real x || is_image x 46 = error (_ "bad arguments to " ++ "to_image") 47{ 48 to_image_op = Operator "to_image" toi Operator_type.COMPOUND false; 49 50 toi x 51 = Image x, is_image x 52 = Image (mtoi [[x]]), is_real x 53 = Image (mtoi [x]), is_real_list x 54 = Image (mtoi x), is_matrix x 55 = error (_ "bad arguments to " ++ "to_image"); 56 57 // [[real]] -> image 58 mtoi m 59 = im_mask2vips (Matrix m), width != 3 60 = joinup (im_mask2vips (Matrix m)) 61 { 62 width = len m?0; 63 height = len m; 64 joinup i 65 = b1 ++ b2 ++ b3 66 { 67 b1 = extract_area 0 0 1 height i; 68 b2 = extract_area 1 0 1 height i; 69 b3 = extract_area 2 0 1 height i; 70 } 71 } 72} 73 74/* Try to make a Colour. 75 */ 76to_colour x 77 = to_colour x.expr, is_Expression x 78 = x, is_Colour x 79 = Colour (colour_space (get_type x)) (map mean (bandsplit (get_image x))), 80 has_image x && has_type x 81 = error (_ "bad arguments to " ++ "to_colour") 82{ 83 colour_space type 84 = table.get_name type, table.has_name type 85 = error (_ "unable to make Colour from " ++ table.get_name type ++ 86 _ " image") 87 { 88 table = Image_type.colour_spaces; 89 } 90} 91 92/* Try to make a real. 93 */ 94to_real x 95 = to_real x.expr, is_Expression x 96 = to_real x.value, is_class x 97 = x, is_real x 98 = abs x, is_complex x 99 = 1, is_bool x && x 100 = 0, is_bool x && !x 101 = error (_ "bad arguments to " ++ "to_real"); 102 103/* Try to make a list ... ungroup, basically. Recurse for subgroups. 104 */ 105to_list x 106 = map to_list x.value, is_Group x 107 = x; 108 109/* Parse a positive integer. 110 */ 111parse_pint l 112 = foldl acc 0 l 113{ 114 acc sofar ch = sofar * 10 + parse_c ch; 115 116 /* Turn a char digit to a number. 117 */ 118 parse_c ch 119 = error (_ "not a digit"), !is_digit ch 120 = (int) ch - (int) '0'; 121} 122 123/* Parse an integer, with an optional sign character. 124 */ 125parse_int l 126 = error (_ "badly formed number"), len parts != 2 127 = sign * n 128{ 129 parts = splitpl [member "+-", is_digit] l; 130 131 n = parse_pint parts?1; 132 sign 133 = 1, parts?0 == [] || parts?0 == "+" 134 = -1; 135} 136 137/* Parse a float. 138 * [+-]?[0-9]*([.][0-9]*)?(e[0-9]+)? 139 */ 140parse_float l 141 = err, len parts != 4 142 = (ipart + fpart) * 10 ** exp 143{ 144 err = error (_ "badly formed number"); 145 146 parts = splitpl [ 147 member "+-0123456789", member ".0123456789", 148 member "eE", member "+-0123456789" 149 ] l; 150 151 ipart = parse_int parts?0; 152 fpart 153 = 0, parts?1 == []; 154 = err, parts?1?0 != '.' 155 = parse_pint (tl parts?1) / 10 ** (len parts?1 - 1); 156 exp 157 = 0, parts?2 == [] && parts?3 == [] 158 = err, parts?2 == [] 159 = parse_int parts?3; 160 161} 162 163// matrix to convert D65 XYZ to D50 XYZ ... direct conversion, found by 164// measuring a macbeth chart in D50 and D65 and doing a LMS to get a matrix 165D652D50_direct = Matrix 166 [[ 1.13529, -0.0604663, -0.0606321 ], 167 [ 0.0975399, 0.935024, -0.0256156 ], 168 [ -0.0336428, 0.0414702, 0.994135 ]]; 169 170D502D65_direct = D652D50_direct ** -1; 171 172/* Convert normalised XYZ to bradford RGB. 173 */ 174XYZ2RGBbrad = Matrix 175 [[0.8951, 0.2664, -0.1614], 176 [-0.7502, 1.7135, 0.0367], 177 [0.0389, -0.0685, 1.0296]]; 178 179/* Convert bradford RGB to normalised XYZ. 180 */ 181RGBbrad2XYZ = XYZ2RGBbrad ** -1; 182 183D93_whitepoint = Vector [89.7400, 100, 130.7700]; 184D75_whitepoint = Vector [94.9682, 100, 122.5710]; 185D65_whitepoint = Vector [95.0470, 100, 108.8827]; 186D55_whitepoint = Vector [95.6831, 100, 92.0871]; 187D50_whitepoint = Vector [96.4250, 100, 82.4680]; 188A_whitepoint = Vector [109.8503, 100, 35.5849]; // 2856K 189B_whitepoint = Vector [99.0720, 100, 85.2230]; // 4874K 190C_whitepoint = Vector [98.0700, 100, 118.2300]; // 6774K 191E_whitepoint = Vector [100, 100, 100]; // ill. free 192D3250_whitepoint = Vector [105.6590, 100, 45.8501]; 193 194Whitepoints = Enum [ 195 ["D93", D93_whitepoint], 196 ["D75", D75_whitepoint], 197 ["D65", D65_whitepoint], 198 ["D55", D55_whitepoint], 199 ["D50", D50_whitepoint], 200 ["A", A_whitepoint], 201 ["B", B_whitepoint], 202 ["C", C_whitepoint], 203 ["E", E_whitepoint], 204 ["D3250", D3250_whitepoint] 205]; 206 207/* Convert D50 XYZ to D65 using the bradford chromatic adaptation approx. 208 */ 209im_D502D65 xyz 210 = xyz''' 211{ 212 xyz' = xyz / D50_whitepoint; 213 214 rgb = recomb XYZ2RGBbrad xyz'; 215 216 // move white in bradford RGB 217 rgb' = rgb / Vector [0.94, 1.02, 1.33]; 218 219 xyz'' = recomb RGBbrad2XYZ rgb'; 220 221 // back to D65 222 xyz''' = xyz'' * D65_whitepoint; 223} 224 225/* Convert D65 XYZ to D50 using the bradford approx. 226 */ 227im_D652D50 xyz 228 = xyz''' 229{ 230 xyz' = xyz / D65_whitepoint; 231 232 rgb = recomb XYZ2RGBbrad xyz'; 233 234 // move white in bradford RGB 235 rgb' = rgb * Vector [0.94, 1.02, 1.33]; 236 237 xyz'' = recomb RGBbrad2XYZ rgb'; 238 239 xyz''' = xyz'' * D50_whitepoint; 240} 241 242/* Convert D50 XYZ to Lab. 243 */ 244im_D50XYZ2Lab xyz 245 = im_XYZ2Lab_temp xyz 246 D50_whitepoint.value?0 247 D50_whitepoint.value?1 248 D50_whitepoint.value?2; 249 250/* Convert D50 Lab to XYZ. 251 */ 252im_D50Lab2XYZ lab 253 = im_Lab2XYZ_temp lab 254 D50_whitepoint.value?0 255 D50_whitepoint.value?1 256 D50_whitepoint.value?2; 257 258/* ... and mono conversions 259 */ 260im_sRGB2mono in 261 = (image_set_type Image_type.B_W @ 262 clip2fmt (im_header_int "BandFmt" in) @ 263 recomb (Matrix [[.3, .6, .1]])) in; 264im_mono2sRGB in 265 = image_set_type Image_type.sRGB (in ++ in ++ in); 266 267im_sRGB2Lab in = im_XYZ2Lab (im_sRGB2XYZ in); 268 269im_Lab2sRGB in = im_XYZ2sRGB (im_Lab2XYZ in); 270 271/* apply a func to an image ... make it 1 or 3 bands, and reapply other bands 272 * on the way out. Except if it's LABPACK. 273 */ 274colour_apply fn x 275 = fn x, b == 1 || b == 3 || c == Image_coding.LABPACK 276 = x'' 277{ 278 b = get_bands x; 279 c = get_coding x; 280 281 first 282 = extract_bands 0 3 x, b > 3 283 = extract_bands 0 1 x; 284 tail 285 = extract_bands 3 (b - 3) x, b > 3 286 = extract_bands 1 (b - 1) x; 287 x' = fn first; 288 x'' = x' ++ clip2fmt (get_format x') tail; 289} 290 291/* Any 1-ary colour op, applied to Vector/Image/Matrix or image 292 */ 293colour_unary fn x 294 = oo_unary_function colour_op x, is_class x 295 = colour_apply fn x, is_image x 296 = colour_apply fn [x], is_real x 297 = error (_ "bad arguments to " ++ "colour_unary") 298{ 299 // COMPOUND_REWRAP ... signal to the colour class to go to image and 300 // back 301 colour_op = Operator "colour_unary" 302 colour_object Operator_type.COMPOUND_REWRAP false; 303 304 colour_object x 305 = colour_real_list x, is_real_list x 306 = map colour_real_list x, is_matrix x 307 = colour_apply fn x, is_image x 308 = error (_ "bad arguments to " ++ "colour_unary"); 309 310 colour_real_list l 311 = (to_matrix (fn (float) (to_image (Vector l)).value)).value?0; 312} 313 314/* Any symmetric 2-ary colour op, applied to Vector/Image/Matrix or image ... 315 * name is op name for error messages etc. 316 */ 317colour_binary name fn x y 318 = oo_binary_function colour_op x y, is_class x 319 = oo_binary'_function colour_op x y, is_class y 320 = fn x y, is_image x && is_image y 321 = error (_ "bad arguments to " ++ name) 322{ 323 colour_op = Operator name 324 colour_object Operator_type.COMPOUND_REWRAP true; 325 326 colour_object x y 327 = fn x y, is_image x && is_image y 328 = colour_real_list fn x y, is_real_list x && is_real_list y 329 = map (colour_real_list fn x) y, is_real_list x && is_matrix y 330 = map (colour_real_list (converse fn) y) x, 331 is_matrix x && is_real_list y 332 = map2 (colour_real_list fn) x y, is_matrix x && is_matrix y 333 = error (_ "bad arguments to " ++ name); 334 335 colour_real_list fn l1 l2 336 = (to_matrix (fn i1 i2)).value?0 337 { 338 i1 = (float) (to_image (Vector l1)).value; 339 i2 = (float) (to_image (Vector l2)).value; 340 } 341} 342 343_colour_conversion_table = [ 344 /* Lines are [space-from, space-to, conversion function]. Could do 345 * this as a big array, but table lookup feels safer. 346 */ 347 [B_W, B_W, image_set_type B_W], 348 [B_W, XYZ, im_sRGB2XYZ @ im_mono2sRGB @ im_clip], 349 [B_W, YXY, im_XYZ2Yxy @ im_sRGB2XYZ @ im_mono2sRGB @ im_clip], 350 [B_W, LAB, im_sRGB2Lab @ im_mono2sRGB @ im_clip], 351 [B_W, LCH, im_Lab2LCh @ im_sRGB2Lab @ im_mono2sRGB @ im_clip], 352 [B_W, UCS, im_XYZ2UCS @ im_sRGB2XYZ @ im_mono2sRGB @ im_clip], 353 [B_W, RGB, im_XYZ2disp @ im_sRGB2XYZ @ im_mono2sRGB @ im_clip], 354 [B_W, sRGB, im_mono2sRGB @ im_clip], 355 [B_W, LABQ, im_Lab2LabQ @ im_sRGB2Lab @ im_mono2sRGB @ im_clip], 356 [B_W, LABS, im_LabQ2LabS @ im_Lab2LabQ @ im_sRGB2Lab @ 357 im_mono2sRGB @ im_clip], 358 359 [XYZ, B_W, im_sRGB2mono @ im_XYZ2sRGB @ im_clip2f], 360 [XYZ, XYZ, image_set_type XYZ], 361 [XYZ, YXY, im_XYZ2Yxy @ im_clip2f], 362 [XYZ, LAB, im_XYZ2Lab @ im_clip2f], 363 [XYZ, LCH, im_Lab2LCh @ im_XYZ2Lab], 364 [XYZ, UCS, im_XYZ2UCS @ im_clip2f], 365 [XYZ, RGB, im_XYZ2disp @ im_clip2f], 366 [XYZ, sRGB, im_XYZ2sRGB @ im_clip2f], 367 [XYZ, LABQ, im_Lab2LabQ @ im_XYZ2Lab @ im_clip2f], 368 [XYZ, LABS, im_LabQ2LabS @ im_Lab2LabQ @ im_XYZ2Lab @ im_clip2f], 369 370 [YXY, B_W, im_sRGB2mono @ im_XYZ2sRGB @ im_Yxy2XYZ @ im_clip2f], 371 [YXY, XYZ, im_Yxy2XYZ @ im_clip2f], 372 [YXY, YXY, image_set_type YXY], 373 [YXY, LAB, im_XYZ2Lab @ im_Yxy2XYZ @ im_clip2f], 374 [YXY, LCH, im_Lab2LCh @ im_XYZ2Lab @ im_Yxy2XYZ @ im_clip2f], 375 [YXY, UCS, im_XYZ2UCS @ im_Yxy2XYZ @ im_clip2f], 376 [YXY, RGB, im_XYZ2disp @ im_Yxy2XYZ @ im_clip2f], 377 [YXY, sRGB, im_XYZ2sRGB @ im_Yxy2XYZ @ im_clip2f], 378 [YXY, LABQ, im_Lab2LabQ @ im_XYZ2Lab @ im_Yxy2XYZ @ im_clip2f], 379 [YXY, LABS, im_LabQ2LabS @ im_Lab2LabQ @ im_XYZ2Lab @ im_Yxy2XYZ @ 380 im_clip2f], 381 382 [LAB, B_W, im_sRGB2mono @ im_Lab2sRGB @ im_Lab2XYZ @ im_clip2f], 383 [LAB, XYZ, im_Lab2XYZ @ im_clip2f], 384 [LAB, YXY, im_XYZ2Yxy @ im_Lab2XYZ @ im_clip2f], 385 [LAB, LAB, image_set_type LAB @ im_clip2f], 386 [LAB, LCH, im_Lab2LCh @ im_clip2f], 387 [LAB, UCS, im_Lab2UCS @ im_clip2f], 388 [LAB, RGB, im_Lab2disp @ im_clip2f], 389 [LAB, sRGB, im_Lab2sRGB @ im_clip2f], 390 [LAB, LABQ, im_Lab2LabQ @ im_clip2f], 391 [LAB, LABS, im_Lab2LabS @ im_clip2f], 392 393 [LCH, B_W, im_sRGB2mono @ im_Lab2sRGB @ im_LCh2Lab @ im_clip2f], 394 [LCH, XYZ, im_Lab2XYZ @ im_LCh2Lab @ im_clip2f], 395 [LCH, YXY, im_XYZ2Yxy @ im_Lab2sRGB @ im_LCh2Lab @ im_clip2f], 396 [LCH, LAB, im_LCh2Lab @ im_clip2f], 397 [LCH, LCH, image_set_type LCH], 398 [LCH, UCS, im_LCh2UCS @ im_clip2f], 399 [LCH, RGB, im_Lab2disp @ im_LCh2Lab @ im_clip2f], 400 [LCH, sRGB, im_Lab2sRGB @ im_LCh2Lab @ im_clip2f], 401 [LCH, LABQ, im_Lab2LabQ @ im_LCh2Lab @ im_clip2f], 402 [LCH, LABS, im_LabQ2LabS @ im_Lab2LabQ @ im_LCh2Lab @ im_clip2f], 403 404 [UCS, B_W, im_sRGB2mono @ im_XYZ2sRGB @ im_UCS2XYZ @ im_clip2f], 405 [UCS, XYZ, im_UCS2XYZ @ im_clip2f], 406 [UCS, YXY, im_XYZ2Yxy @ im_Lab2XYZ @ im_UCS2Lab @ im_clip2f], 407 [UCS, LAB, im_UCS2Lab @ im_clip2f], 408 [UCS, LCH, im_UCS2LCh @ im_clip2f], 409 [UCS, UCS, image_set_type UCS], 410 [UCS, RGB, im_Lab2disp @ im_UCS2Lab @ im_clip2f], 411 [UCS, sRGB, im_Lab2sRGB @ im_UCS2Lab @ im_clip2f], 412 [UCS, LABQ, im_Lab2LabQ @ im_UCS2Lab @ im_clip2f], 413 [UCS, LABS, im_LabQ2LabS @ im_Lab2LabQ @ im_UCS2Lab @ im_clip2f], 414 415 [RGB, B_W, im_sRGB2mono @ im_XYZ2sRGB @ im_disp2XYZ @ im_clip], 416 [RGB, XYZ, im_disp2XYZ @ im_clip], 417 [RGB, YXY, im_XYZ2Yxy @ im_disp2XYZ @ im_clip], 418 [RGB, LAB, im_disp2Lab @ im_clip], 419 [RGB, LCH, im_Lab2LCh @ im_disp2Lab @ im_clip], 420 [RGB, UCS, im_Lab2UCS @ im_disp2Lab @ im_clip], 421 [RGB, RGB, image_set_type RGB], 422 [RGB, sRGB, im_XYZ2sRGB @ im_disp2XYZ @ im_clip], 423 [RGB, LABQ, im_Lab2LabQ @ im_disp2Lab @ im_clip], 424 [RGB, LABS, im_LabQ2LabS @ im_Lab2LabQ @ im_disp2Lab @ im_clip], 425 426 [sRGB, B_W, im_sRGB2mono], 427 [sRGB, XYZ, im_sRGB2XYZ @ im_clip], 428 [sRGB, YXY, im_XYZ2Yxy @ im_sRGB2XYZ @ im_clip], 429 [sRGB, LAB, im_sRGB2Lab @ im_clip], 430 [sRGB, LCH, im_Lab2LCh @ im_sRGB2Lab @ im_clip], 431 [sRGB, UCS, im_XYZ2UCS @ im_sRGB2XYZ @ im_clip], 432 [sRGB, RGB, im_XYZ2disp @ im_sRGB2XYZ @ im_clip], 433 [sRGB, sRGB, image_set_type sRGB], 434 [sRGB, LABQ, im_Lab2LabQ @ im_sRGB2Lab @ im_clip], 435 [sRGB, LABS, im_LabQ2LabS @ im_Lab2LabQ @ im_sRGB2Lab @ im_clip], 436 437 [LABQ, B_W, im_sRGB2mono @ im_Lab2sRGB @ im_LabQ2Lab], 438 [LABQ, XYZ, im_Lab2XYZ @ im_LabQ2Lab], 439 [LABQ, YXY, im_XYZ2Yxy @ im_Lab2XYZ @ im_LabQ2Lab], 440 [LABQ, LAB, im_LabQ2Lab], 441 [LABQ, LCH, im_Lab2LCh @ im_LabQ2Lab], 442 [LABQ, UCS, im_Lab2UCS @ im_LabQ2Lab], 443 [LABQ, RGB, im_LabQ2disp], 444 [LABQ, sRGB, im_Lab2sRGB @ im_LabQ2Lab], 445 [LABQ, LABQ, image_set_type LABQ], 446 [LABQ, LABS, im_LabQ2LabS], 447 448 [LABS, B_W, im_sRGB2mono @ im_Lab2sRGB @ im_LabQ2Lab @ 449 im_LabS2LabQ @ im_clip2s], 450 [LABS, XYZ, im_Lab2XYZ @ im_LabQ2Lab @ im_LabS2LabQ @ im_clip2s], 451 [LABS, YXY, im_XYZ2Yxy @ 452 im_Lab2XYZ @ im_LabQ2Lab @ im_LabS2LabQ @ im_clip2s], 453 [LABS, LAB, im_LabS2Lab], 454 [LABS, LCH, im_Lab2LCh @ im_LabQ2Lab @ im_LabS2LabQ @ im_clip2s], 455 [LABS, UCS, im_Lab2UCS @ im_LabQ2Lab @ im_LabS2LabQ @ im_clip2s], 456 [LABS, RGB, im_LabQ2disp @ im_LabS2LabQ @ im_clip2s], 457 [LABS, sRGB, im_XYZ2sRGB @ 458 im_Lab2XYZ @ im_LabQ2Lab @ im_LabS2LabQ @ im_clip2s], 459 [LABS, LABQ, im_LabS2LabQ @ im_clip2s], 460 [LABS, LABS, image_set_type LABS] 461] 462{ 463 /* From Image_type ... repeat here for brevity. Use same ordering as 464 * in Colour menu for consistency. 465 */ 466 B_W = 1; 467 XYZ = 12; 468 YXY = 23; 469 LAB = 13; 470 LCH = 19; 471 UCS = 18; 472 RGB = 17; 473 sRGB = 22; 474 LABQ = 16; 475 LABS = 21; 476} 477 478/* Transform between two colour spaces. 479 */ 480colour_transform from to in 481 = colour_unary _colour_conversion_table?i?2 in, i >= 0 482 = error (_ "unable to convert " ++ Image_type.type_names.get_name from ++ 483 _ " to " ++ Image_type.type_names.get_name to) 484{ 485 match x = x?0 == from && x?1 == to; 486 i = index match _colour_conversion_table; 487} 488 489/* Transform to a colour space, assuming the type field in the input is 490 * correct 491 */ 492colour_transform_to to in = colour_transform (get_type in) to in; 493 494/* Given a list of things, try to make them all the same size. Don't change 495 * the format. Don't touch non-image things. 496 */ 497size_alike l 498 = map enlarge l 499{ 500 max_width = foldr (test_prop has_width get_width) 0 l; 501 max_height = foldr (test_prop has_height get_height) 0 l; 502 503 test_prop has get x best 504 = best, !has x 505 = max_pair best (get x); 506 507 enlarge x 508 = embed 0 0 0 max_width max_height x, has_width x 509 = x; 510} 511 512/* Given a list of things, look for 1 band objects and bump them to to n - 513 * band objects, where n is the maximum number of bands. Don't change the 514 * format. Don't touch non-image things. 515 */ 516bands_alike l 517 = map upband l 518{ 519 max_bands = foldr (test_prop has_bands get_bands) 0 l; 520 521 test_prop has get x best 522 = best, !has x 523 = max_pair best (get x); 524 525 upband x 526 = bandjoin (replicate max_bands x), 527 has_bands x && get_bands x == 1 528 = x; 529} 530