compat/7.10/_predicate.def

/* is_colour_space str: is a string one of nip's colour space names
 */
is_colour_space str = Image_type.colour_spaces.present 0 str;

/* is_colour_type n: is a number one of VIPS's colour spaces
 */
is_colour_type n = Image_type.colour_spaces.present 1 n;

/* is_number: is a real or a complex number.
 */
is_number a = is_real a || is_complex a;

/* is_int: is an integer
 */
is_int a = is_real a && a == (int) a;

/* is_uint: is an unsigned integer
 */
is_uint a = is_int a && a >= 0;

/* is_pint: is a positive integer
 */
is_pint a = is_int a && a > 0;

/* is_preal: is a positive real
 */
is_preal a = is_real a && a > 0;

/* is_ureal: is an unsigned real
 */
is_ureal a = is_real a && a >= 0;

/* is_letter c: true of character c is an ASCII letter
 *
 * is_letter :: char -> bool
 */
is_letter c = ('a' <= c && c <= 'z') || ('A' <= c && c <= 'Z');

/* is_digit c: true if character c is an ASCII digit
 *
 * is_digit :: char->bool
 */
is_digit x = '0' <= x && x <= '9';

/* A whitespace character.
 *
 * is_space :: char->bool
 */
is_space = member " \n\t";

/* is_listof p s: true if finite list with p true for every element.
 */
is_listof p l = is_list l && land (map p l);

/* is_string s: true if finite list of char.
 */
is_string s = is_listof is_char s;

/* is_real_list l: is l a list of real numbers ... test each element,
 * so no infinite lists pls.
 */
is_real_list l = is_listof is_real l;

/* is_string_list l: is l a finite list of finite strings.
 */
is_string_list l = is_listof is_string l;

/* is_rectangular l: is l a rectangular data structure
 */
is_rectangular l
	= true, !is_list l
	= true, land (map is_obj l)
	= true, land (map is_list l) &&
		land (map (not @ is_obj) l) &&
		land (map is_rectangular l) &&
		len l > 0 &&
		land (map (equal (hd lengths)) (tl lengths))
	= false
{
	// treat strings as a base type, not [char]
	is_obj x = !is_list x || is_string x;
	lengths = map len l;
}

/* is_matrix l: is l a list of lists of real numbers, all the same length
 */
is_matrix l = is_listof is_real_list l && is_rectangular l;

/* is_square_matrix l: is l a matrix with width == height
 */
is_square_matrix l
      = true, l == []
      = is_matrix l && len l == len (hd l);

/* is_oddmatrix l: is l a matrix with odd-length sides
 */
is_oddmatrix l
      = true, l == []
      = is_matrix l && (len l) % 2 == 1 && (len (l?0)) % 2 == 1;

/* is_odd_square_matrix l: is l a square_matrix with odd-length sides
 */
is_odd_square_matrix l = is_square_matrix l && (len l) % 2 == 1;

/* Is an item in a column of a table?
 */
is_incolumn n table x = member (map (extract n) table) x;

/* Is HGuide or VGuide.
 */
is_HGuide x = is_instanceof "HGuide" x;

is_VGuide x = is_instanceof "VGuide" x;

is_Guide x = is_HGuide x || is_VGuide x;

is_Mark x = is_instanceof "Mark" x;

is_Group x = is_instanceof "Group" x;

is_Image x = is_instanceof "Image" x;

is_Region x = is_instanceof "Region" x;

is_Real x = is_instanceof "Real" x;

is_Matrix x = is_instanceof "Matrix_base" x;

is_Vector x = is_instanceof "Vector" x;

is_Colour x = is_instanceof "Colour" x;

is_Arrow x = is_instanceof "Arrow" x;

is_Bool x = is_instanceof "Bool" x;

is_Slider x = is_instanceof "Scale" x;

is_Rect x = is_instanceof "Rect" x;

is_Number x = is_instanceof "Number" x;

is_Expression x = is_instanceof "Expression" x;

is_String x = is_instanceof "String" x;

/* A list of the form [[1,2],[3,4],[5,6]...]
 */
is_xy_list l
	= is_list l && land (map xy l)
{
	xy l = is_real_list l && len l == 2;
}

/* Does an object have a sensible VIPS type?
 */
has_type x = is_image x || is_Image x || is_Arrow x || is_Colour x;

/* Try to get a VIPS image type from an object.
 */
get_type x
	= get_type_im x, is_image x
	= get_type_im x.value, is_Image x
	= get_type_im x.image.value, is_Arrow x
	= Image_type.colour_spaces.lookup 0 1 x.colour_space, is_Colour x
	// slightly odd ... but our display is always 0-255, so it makes sense for
	// a plain number to be in the same range
	= Image_type.sRGB, is_real x
	= error ("get_type: unable to get type from " ++ print x)
{
	// get the type from a VIPS image ... but only if it makes sense with
	// the rest of the image

	// we often have Type set wrong, hence the ugly guessing :-(
	get_type_im im
		= Image_type.LABQ, coding == Image_coding.LABPACK
		= Image_type.B_W, bands == 1
		= type, bands == 3 && is_colorimetric
		= Image_type.sRGB, bands == 3 && !is_colorimetric
		= Image_type.MULTIBAND, bands != 3 && !is_colorimetric
		= type
	{
		type = im_header_int "Type" im;
		coding = im_header_int "Coding" im;
		bands = im_header_int "Bands" im;

		// 3-band colorimetric types we allow ... the things which the
		// Colour/Convert To menu can make, excluding mono.
		ok_types = [
			Image_type.sRGB,
			Image_type.LAB,
			Image_type.LABQ,
			Image_type.LABS,
			Image_type.LCH,
			Image_type.XYZ,
			Image_type.YXY,
			Image_type.UCS
		];
		is_colorimetric = member ok_types type;
	}
}

has_format x = has_member "format" x || is_Arrow x || is_image x;

get_format x
	= x.format, has_member "format" x
	= x.image.format, is_Arrow x
	= im_header_int "BandFmt" x, is_image x
	= error ("get_format: unable to get format from " ++ print x);

has_bits x = has_member "bits" x || is_Arrow x || is_image x;

get_bits x
	= x.bits, has_member "bits" x
	= x.image.bits, is_Arrow x
	= im_header_int "Bbits" x, is_image x
	= error ("get_bits: unable to get bits from " ++ print x);

has_bands x = is_image x || has_member "bands" x || is_Arrow x;

get_bands x
	= x.bands, has_member "bands" x
	= x.image.bands, is_Arrow x
	= im_header_int "Bands" x, is_image x
	= 1, is_real x
	= len x, is_real_list x
	= error ("get_bands: unable to get bands from " ++ print x);

has_coding x = has_member "coding" x || is_Arrow x || is_image x;

get_coding x
	= x.coding, has_member "coding" x
	= x.image.coding, is_Arrow x
	= im_header_int "Coding" x, is_image x
	= Image_coding.NOCODING, is_real x
	= error ("get_coding: unable to get coding from " ++ print x);

has_xres x = has_member "xres" x || is_Arrow x || is_image x;

get_xres x
	= x.xres, has_member "xres" x
	= x.image.xres, is_Arrow x
	= im_header_int "Xres" x, is_image x
	= error ("get_xres: unable to get xres from " ++ print x);

has_yres x = has_member "yres" x || is_Arrow x || is_image x;

get_yres x
	= x.yres, has_member "yres" x
	= x.image.yres, is_Arrow x
	= im_header_int "Yres" x, is_image x
	= error ("get_yres: unable to get yres from " ++ print x);

has_xoffset x = has_member "xoffset" x || is_Arrow x || is_image x;

get_xoffset x
	= x.xoffset, has_member "xoffset" x
	= x.image.xoffset, is_Arrow x
	= im_header_int "Xoffset" x, is_image x
	= error ("get_xoffset: unable to get xoffset from " ++ print x);

has_yoffset x = has_member "yoffset" x || is_Arrow x || is_image x;

get_yoffset x
	= x.yoffset, has_member "yoffset" x
	= x.image.yoffset, is_Arrow x
	= im_header_int "Yoffset" x, is_image x
	= error ("get_yoffset: unable to get yoffset from " ++ print x);

has_value = has_member "value";

get_value x = x.value;

has_image x = is_image x || is_Image x || is_Arrow x;

get_image x
	= x.value, is_Image x
	= x.image.value, is_Arrow x
	= x, is_image x
	= error ("get_image: unable to get image from " ++ print x);

has_number x = is_number x || is_Real x;

get_number x
	= x.value, is_Real x
	= x, is_number x
	= error ("get_number: unable to get number from " ++ print x);

has_real x = is_real x || is_Real x;

get_real x
	= x.value, is_Real x
	= x, is_real x
	= error ("get_real: unable to get real from " ++ print x);

has_width x = has_member "width" x || is_image x;

get_width x
	= x.width, has_member "width" x
	= im_header_int "Xsize" x, is_image x
	= error ("get_width: unable to get width from " ++ print x);

has_height x = has_member "height" x || is_image x;

get_height x
	= x.height, has_member "height" x
	= im_header_int "Ysize" x, is_image x
	= error ("get_height: unable to get height from " ++ print x);

has_left x = has_member "left" x;

get_left x
	= x.left, has_member "left" x
	= error ("get_left: unable to get left from " ++ print x);

has_top x = has_member "top" x;

get_top x
	= x.top, has_member "top" x
	= error ("get_top: unable to get top from " ++ print x);

// like has/get member,but first in a lst of objects
has_member_list has objects
	= filter has objects != [];

// get a member from the first of a list of objects to have it
get_member_list has get objects
	= hd members, members != []
	= error "unable to get property"
{
	members = map get (filter has objects);
}

is_hist x
	= has_image x && (h == 1 || w == 1 || t == Image_type.HISTOGRAM)
{
	im = get_image x;
	w = get_width im;
	h = get_height im;
	t = get_type im;
}