1 2/* is_colour_space str: is a string one of nip's colour space names 3 */ 4is_colour_space str = Image_type.colour_spaces.present 0 str; 5 6/* is_colour_type n: is a number one of VIPS's colour spaces 7 */ 8is_colour_type n = Image_type.colour_spaces.present 1 n; 9 10/* is_number: is a real or a complex number. 11 */ 12is_number a = is_real a || is_complex a; 13 14/* is_int: is an integer 15 */ 16is_int a = is_real a && a == (int) a; 17 18/* is_uint: is an unsigned integer 19 */ 20is_uint a = is_int a && a >= 0; 21 22/* is_pint: is a positive integer 23 */ 24is_pint a = is_int a && a > 0; 25 26/* is_preal: is a positive real 27 */ 28is_preal a = is_real a && a > 0; 29 30/* is_ureal: is an unsigned real 31 */ 32is_ureal a = is_real a && a >= 0; 33 34/* is_letter c: true if character c is an ASCII letter 35 * 36 * is_letter :: char -> bool 37 */ 38is_letter c = ('a' <= c && c <= 'z') || ('A' <= c && c <= 'Z'); 39 40/* is_digit c: true if character c is an ASCII digit 41 * 42 * is_digit :: char->bool 43 */ 44is_digit x = '0' <= x && x <= '9'; 45 46/* A whitespace character. 47 * 48 * is_space :: char->bool 49 */ 50is_space = member " \n\t"; 51 52/* List str starts with section prefix. 53 * 54 * is_prefix "hell" "hello world!" == true 55 * is_prefix :: [*] -> [*] -> bool 56 */ 57is_prefix prefix str = take (len prefix) str == prefix; 58 59/* List str ends with section suffix. 60 * 61 * is_suffix "ld!" "hello world!" == true 62 * is_suffix :: [*] -> [*] -> bool 63 */ 64is_suffix suffix str = take (len suffix) (reverse str) == reverse suffix; 65 66/* List contains seqence. 67 * 68 * is_substr "llo" "hello world!" == true 69 * is_substr :: [*] -> [*] -> bool 70 */ 71is_substr seq str = any (map (is_prefix seq) (iterate tl str)); 72 73/* is_listof p s: true if finite list with p true for every element. 74 */ 75is_listof p l = is_list l && all (map p l); 76 77/* is_string s: true if finite list of char. 78 */ 79is_string s = is_listof is_char s; 80 81/* is_real_list l: is l a list of real numbers ... test each element, 82 * so no infinite lists pls. 83 */ 84is_real_list l = is_listof is_real l; 85 86/* is_string_list l: is l a finite list of finite strings. 87 */ 88is_string_list l = is_listof is_string l; 89 90/* Test list length ... quicker than len x == n for large lists. 91 */ 92is_list_len n x 93 = true, x == [] && n == 0 94 = false, x == [] || n == 0 95 = is_list_len (n - 1) (tl x); 96 97is_list_len_more n x 98 = true, x != [] && n == 0 99 = false, x == [] || n == 0 100 = is_list_len_more (n - 1) (tl x); 101 102is_list_len_more_equal n x 103 = true, n == 0 104 = false, x == [] 105 = is_list_len_more_equal (n - 1) (tl x); 106 107/* is_rectangular l: is l a rectangular data structure 108 */ 109is_rectangular l 110 = true, !is_list l 111 = true, all (map is_obj l) 112 = true, all (map is_list l) && 113 all (map (not @ is_obj) l) && 114 all (map is_rectangular l) && 115 is_list_len_more 0 l && 116 all (map (is_list_len (len (hd l))) (tl l)) 117 = false 118{ 119 // treat strings as a base type, not [char] 120 is_obj x = !is_list x || is_string x; 121} 122 123/* is_matrix l: is l a list of lists of real numbers, all the same length 124 * 125 * [[]] is the empty matrix, [] is the empty list ... disallow [] 126 */ 127is_matrix l = l != [] && is_listof is_real_list l && is_rectangular l; 128 129/* is_square_matrix l: is l a matrix with width == height 130 */ 131is_square_matrix l 132 = true, l == [[]] 133 = is_matrix l && is_list_len (len (hd l)) l; 134 135/* is_oddmatrix l: is l a matrix with odd-length sides 136 */ 137is_oddmatrix l 138 = true, l == [[]] 139 = is_matrix l && len l % 2 == 1 && len l?0 % 2 == 1; 140 141/* is_odd_square_matrix l: is l a square_matrix with odd-length sides 142 */ 143is_odd_square_matrix l = is_square_matrix l && len l % 2 == 1; 144 145/* Is an item in a column of a table? 146 */ 147is_incolumn n table x = member (map (extract n) table) x; 148 149/* Is HGuide or VGuide. 150 */ 151is_HGuide x = is_instanceof "HGuide" x; 152 153is_VGuide x = is_instanceof "VGuide" x; 154 155is_Guide x = is_HGuide x || is_VGuide x; 156 157is_Mark x = is_instanceof "Mark" x; 158 159is_Group x = is_instanceof "Group" x; 160 161is_NULL x = is_instanceof "NULL" x; 162 163is_List x = is_instanceof "List" x; 164 165is_Image x = is_instanceof "Image" x; 166 167is_Plot x = is_instanceof "Plot" x; 168 169is_Region x = is_instanceof "Region" x; 170 171is_Real x = is_instanceof "Real" x; 172 173is_Matrix x = is_instanceof "Matrix_base" x; 174 175is_Vector x = is_instanceof "Vector" x; 176 177is_Colour x = is_instanceof "Colour" x; 178 179is_Arrow x = is_instanceof "Arrow" x; 180 181is_Bool x = is_instanceof "Bool" x; 182 183is_Scale x = is_instanceof "Scale" x; 184 185is_Rect x = is_instanceof "Rect" x; 186 187is_Number x = is_instanceof "Number" x; 188 189is_Expression x = is_instanceof "Expression" x; 190 191is_String x = is_instanceof "String" x; 192 193/* A list of the form [[1,2],[3,4],[5,6]...] 194 */ 195is_xy_list l 196 = is_list l && all (map xy l) 197{ 198 xy l = is_real_list l && is_list_len 2 l; 199} 200 201// does a nested list structure contain a Group object? 202contains_Group l 203 = true, is_list l && any (map is_Group l) 204 = any (map contains_Group l), is_list l 205 = false; 206 207/* Does an object have a sensible VIPS type? 208 */ 209has_type x = is_image x || is_Image x || is_Arrow x || is_Colour x; 210 211/* Try to get a VIPS image type from an object. 212 */ 213get_type x 214 = get_type_im x, is_image x 215 = get_type_im x.value, is_Image x 216 = get_type_im x.image.value, is_Arrow x 217 = Image_type.colour_spaces.lookup 0 1 x.colour_space, is_Colour x 218 // slightly odd ... but our display is always 0-255, so it makes sense for 219 // a plain number to be in the same range 220 = Image_type.sRGB, is_real x 221 = oo_unary_function get_type_op x, is_class x 222 = error (_ "bad arguments to " ++ "get_type") 223{ 224 get_type_op = Operator "get_type" get_type 225 Operator_type.COMPOUND false; 226 227 // get the type from a VIPS image ... but only if it makes sense with 228 // the rest of the image 229 230 // we often have Type set wrong, hence the ugly guessing :-( 231 // can have alpha, hence we let bands be one more than you might think 232 233 get_type_im im 234 = Image_type.LABQ, coding == Image_coding.LABPACK 235 = Image_type.GREY16, type == Image_type.GREY16 && is_bands 1 236 = Image_type.HISTOGRAM, type == Image_type.HISTOGRAM && 237 (width == 1 || height == 1) 238 = Image_type.B_W, is_bands 1 239 = Image_type.CMYK, type == Image_type.CMYK && is_bands 4 240 = type, is_colorimetric && is_bands 3 241 = Image_type.sRGB, !is_colorimetric && is_bands 3 242 = Image_type.MULTIBAND, !is_colorimetric && !is_bands 3 243 = type 244 { 245 type = get_header "Type" im; 246 coding = get_header "Coding" im; 247 bands = get_header "Bands" im; 248 width = get_header "Xsize" im; 249 height = get_header "Ysize" im; 250 251 // 3-band colorimetric types we allow ... the things which the 252 // Colour/Convert To menu can make, excluding mono. 253 ok_types = [ 254 Image_type.sRGB, 255 Image_type.RGB16, 256 Image_type.LAB, 257 Image_type.LABQ, 258 Image_type.LABS, 259 Image_type.LCH, 260 Image_type.XYZ, 261 Image_type.YXY, 262 Image_type.UCS 263 ]; 264 is_colorimetric = member ok_types type; 265 266 // is bands n, with an optional alpha (ie. can be n + 1 too) 267 is_bands n = bands == n || bands == n + 1; 268 } 269} 270 271has_format x = has_member "format" x || is_Arrow x || is_image x; 272 273get_format x 274 = x.format, has_member "format" x 275 = x.image.format, is_Arrow x 276 = get_header "BandFmt" x, is_image x 277 = oo_unary_function get_format_op x, is_class x 278 = error (_ "bad arguments to " ++ "get_format") 279{ 280 get_format_op = Operator "get_format" get_format 281 Operator_type.COMPOUND false; 282} 283 284has_bits x = has_member "bits" x || is_Arrow x || is_image x; 285 286get_bits x 287 = x.bits, has_member "bits" x 288 = x.image.bits, is_Arrow x 289 = get_header "Bbits" x, is_image x 290 = oo_unary_function get_bits_op x, is_class x 291 = error (_ "bad arguments to " ++ "get_bits") 292{ 293 get_bits_op = Operator "get_bits" get_format 294 Operator_type.COMPOUND false; 295} 296 297has_bands x = is_image x || has_member "bands" x || is_Arrow x; 298 299get_bands x 300 = x.bands, has_member "bands" x 301 = x.image.bands, is_Arrow x 302 = get_header "Bands" x, is_image x 303 = 1, is_real x 304 = len x, is_real_list x 305 = oo_unary_function get_bands_op x, is_class x 306 = error (_ "bad arguments to " ++ "get_bands") 307{ 308 get_bands_op = Operator "get_bands" get_bands 309 Operator_type.COMPOUND false; 310} 311 312has_coding x = has_member "coding" x || is_Arrow x || is_image x; 313 314get_coding x 315 = x.coding, has_member "coding" x 316 = x.image.coding, is_Arrow x 317 = get_header "Coding" x, is_image x 318 = Image_coding.NOCODING, is_real x 319 = oo_unary_function get_coding_op x, is_class x 320 = error (_ "bad arguments to " ++ "get_coding") 321{ 322 get_coding_op = Operator "get_coding" get_coding 323 Operator_type.COMPOUND false; 324} 325 326has_xres x = has_member "xres" x || is_Arrow x || is_image x; 327 328get_xres x 329 = x.xres, has_member "xres" x 330 = x.image.xres, is_Arrow x 331 = get_header "Xres" x, is_image x 332 = oo_unary_function get_xres_op x, is_class x 333 = error (_ "bad arguments to " ++ "get_xres") 334{ 335 get_xres_op = Operator "get_xres" get_xres 336 Operator_type.COMPOUND false; 337} 338 339has_yres x = has_member "yres" x || is_Arrow x || is_image x; 340 341get_yres x 342 = x.yres, has_member "yres" x 343 = x.image.yres, is_Arrow x 344 = get_header "Yres" x, is_image x 345 = oo_unary_function get_yres_op x, is_class x 346 = error (_ "bad arguments to " ++ "get_yres") 347{ 348 get_yres_op = Operator "get_yres" get_yres 349 Operator_type.COMPOUND false; 350} 351 352has_xoffset x = has_member "xoffset" x || is_Arrow x || is_image x; 353 354get_xoffset x 355 = x.xoffset, has_member "xoffset" x 356 = x.image.xoffset, is_Arrow x 357 = get_header "Xoffset" x, is_image x 358 = oo_unary_function get_xoffset_op x, is_class x 359 = error (_ "bad arguments to " ++ "get_xoffset") 360{ 361 get_xoffset_op = Operator "get_xoffset" get_xoffset 362 Operator_type.COMPOUND false; 363} 364 365has_yoffset x = has_member "yoffset" x || is_Arrow x || is_image x; 366 367get_yoffset x 368 = x.yoffset, has_member "yoffset" x 369 = x.image.yoffset, is_Arrow x 370 = get_header "Yoffset" x, is_image x 371 = oo_unary_function get_yoffset_op x, is_class x 372 = error (_ "bad arguments to " ++ "get_yoffset") 373{ 374 get_yoffset_op = Operator "get_yoffset" get_yoffset 375 Operator_type.COMPOUND false; 376} 377 378has_value = has_member "value"; 379 380get_value x = x.value; 381 382has_image x = is_image x || is_Image x || is_Arrow x; 383 384get_image x 385 = x.value, is_Image x 386 = x.image.value, is_Arrow x 387 = x, is_image x 388 = oo_unary_function get_image_op x, is_class x 389 = error (_ "bad arguments to " ++ "get_image") 390{ 391 get_image_op = Operator "get_image" get_image 392 Operator_type.COMPOUND false; 393} 394 395has_number x = is_number x || is_Real x; 396 397get_number x 398 = x.value, is_Real x 399 = x, is_number x 400 = oo_unary_function get_number_op x, is_class x 401 = error (_ "bad arguments to " ++ "get_number") 402{ 403 get_number_op = Operator "get_number" get_number 404 Operator_type.COMPOUND false; 405} 406 407has_real x = is_real x || is_Real x; 408 409get_real x 410 = x.value, is_Real x 411 = x, is_real x 412 = oo_unary_function get_real_op x, is_class x 413 = error (_ "bad arguments to " ++ "get_real") 414{ 415 get_real_op = Operator "get_real" get_real 416 Operator_type.COMPOUND false; 417} 418 419has_width x = has_member "width" x || is_image x; 420 421get_width x 422 = x.width, has_member "width" x 423 = get_header "Xsize" x, is_image x 424 = oo_unary_function get_width_op x, is_class x 425 = error (_ "bad arguments to " ++ "get_width") 426{ 427 get_width_op = Operator "get_width" get_width 428 Operator_type.COMPOUND false; 429} 430 431has_height x = has_member "height" x || is_image x; 432 433get_height x 434 = x.height, has_member "height" x 435 = get_header "Ysize" x, is_image x 436 = oo_unary_function get_height_op x, is_class x 437 = error (_ "bad arguments to " ++ "get_height") 438{ 439 get_height_op = Operator "get_height" get_height 440 Operator_type.COMPOUND false; 441} 442 443has_left x = has_member "left" x; 444 445get_left x 446 = x.left, has_member "left" x 447 = oo_unary_function get_left_op x, is_class x 448 = error (_ "bad arguments to " ++ "get_left") 449{ 450 get_left_op = Operator "get_left" get_left 451 Operator_type.COMPOUND false; 452} 453 454has_top x = has_member "top" x; 455 456get_top x 457 = x.top, has_member "top" x 458 = oo_unary_function get_top_op x, is_class x 459 = error (_ "bad arguments to " ++ "get_top") 460{ 461 get_top_op = Operator "get_top" get_top 462 Operator_type.COMPOUND false; 463} 464 465// like has/get member, but first in a lst of objects 466has_member_list has objects 467 = filter has objects != []; 468 469// need one with the args swapped 470get_member = converse dot; 471 472// get a member from the first of a list of objects to have it 473get_member_list has get objects 474 = hd members, members != [] 475 = error "unable to get property" 476{ 477 members = map get (filter has objects); 478} 479 480is_hist x 481 = has_image x && (h == 1 || w == 1 || t == Image_type.HISTOGRAM) 482{ 483 im = get_image x; 484 w = get_width im; 485 h = get_height im; 486 t = get_type im; 487} 488 489get_header field x 490 = oo_unary_function get_header_op x, is_class x 491 = get_header_image x, is_image x 492 = error (_ "bad arguments to " ++ "get_header") 493{ 494 get_header_op = Operator "get_header" (get_header field) 495 Operator_type.COMPOUND false; 496 get_header_image im 497 = im_header_int field im, type == itype 498 = im_header_double field im, type == dtype 499 = im_header_string field im, type == stype1 || type == stype2 500 = error (_ "image has no field " ++ field), type == 0 501 = error (_ "unknown type for field " ++ field) 502 { 503 type = im_header_get_typeof field im; 504 505 itype = name2gtype "gint"; 506 dtype = name2gtype "gdouble"; 507 stype1 = name2gtype "VipsRefString"; 508 stype2 = name2gtype "gchararray"; 509 } 510} 511 512get_header_type field x 513 = oo_unary_function get_header_type_op x, is_class x 514 = im_header_get_typeof field x, is_image x 515 = error (_ "bad arguments to " ++ "get_header_type") 516{ 517 get_header_type_op = Operator "get_header_type" (get_header_type field) 518 Operator_type.COMPOUND false; 519} 520 521set_header field value x 522 = oo_unary_function set_header_op x, is_class x 523 = im_copy_set_meta x field value, is_image x 524 = error (_ "bad arguments to " ++ "set_header") 525{ 526 set_header_op = Operator "set_header" (set_header field value) 527 Operator_type.COMPOUND false; 528} 529