
/* Try to make a Matrix ... works for Vector/Image/Real, plus image/real
 */
to_matrix x
    = to_matrix x.expr, is_Expression x
    = x, is_Matrix x
    = tom x
{
    to_matrix_op = Operator "to_matrix" tom Operator_type.COMPOUND false;

    tom x
        = oo_unary_function to_matrix_op x, is_class x
        = Matrix (itom x), is_image x
        = Matrix [[x]], is_real x
        = Matrix [x], is_real_list x
        = Matrix x, is_matrix x
        = error (_ "bad arguments to " ++ "to_matrix");

    itom i
        = (vips_matrix_from_image ((double) i)).value, is_image i
        = error (_ "not image");
}

/* Try to make a Vector ... works for Vector/Image/Real, plus image/real
 */
to_vector x
    = to_vector x.expr, is_Expression x
    = x, is_Vector x
    = tov x
{
    to_vector_op = Operator "to_vector" tov Operator_type.COMPOUND false;

    tov x
        = oo_unary_function to_vector_op x, is_class x
        = Vector (itov x), is_image x
        = Vector [x], is_real x
        = Vector x, is_real_list x
        = Vector x?0, is_matrix x && len x == 1
        = Vector (transpose x)?0, is_matrix x && len x?0 == 1
        = error (_ "bad arguments to " ++ "to_vector");

    itov i
        = v, is_image i
        = error (_ "not image")
    {
        m = vips_matrix_from_image ((double) i);
        v
            = m.value?0, m.height == 1
            = (transpose m.value)?0, m.width == 1
            = error (_ "image is not 1xN or Nx1");
    }
}

/* Try to make an Image ... works for Vector/Matrix/Real, plus image/real
 * Special case for Colour ... pull out the colour_space and set Type in the
 * image.
 */
to_image x
    = to_image x.expr, is_Expression x
    = Image x.value, is_Plot x
    = x, is_Image x
    = Image (set_header $interpretation
             (Interpretation.get_value x.colour_space)
             (mtoi [x.value])),
        is_Colour x
    = toi x
{
    to_image_op = Operator "to_image" toi Operator_type.COMPOUND false;

    toi x
        = oo_unary_function to_image_op x, is_class x
        = Image x, is_image x
        = Image (mtoi [[x]]), is_real x
        = Image (mtoi [x]), is_real_list x
        = Image (mtoi x), is_matrix x
        = error (_ "bad arguments to " ++ "to_image");

    // [[real]] -> image
    mtoi m
        = (make_colour @ make_image) m
    {
        width = len m?0;
        height = len m;

        make_image = vips_image_from_matrix @ Matrix;

        // width 3 becomes sRGB
        make_colour im
            = copy [$interpretation => Interpretation.sRGB] (joinup im),
                width == 3
            = im
        {
            joinup i
                = b1 ++ b2 ++ b3
            {
                b1 = crop 0 0 1 height i;
                b2 = crop 1 0 1 height i;
                b3 = crop 2 0 1 height i;
            }
        }
    }
}

// like to_image, but we do 1x1 pixel + x, then embed it up
// always make an unwrapped image for speed ... this gets used by ifthenelse
// and stuff like that
// format can be NULL, meaning set format from x
to_image_size width height bands format x
    = x, is_image x
    = x.value, is_Image x
    = set_header $interpretation (get_interpretation x) image
{
    format_option
        = [$format => format], format != NULL
        = [];

    image = image_new ([
        $bands => bands,
        $pixel => x
      ] ++ format_option) width height;
}

/* Try to make a Colour.
 */
to_colour x
    = to_colour x.expr, is_Expression x
    = x, is_Colour x
    = to_colour (crop x.left x.top 1 1 x.image), is_Mark x
    = toc x
{
    to_colour_op = Operator "to_colour" toc Operator_type.COMPOUND false;

    toc x
        = oo_unary_function to_colour_op x, is_class x
        = Colour (colour_space (get_interpretation x''))
            (map mean (bandsplit (get_image x''))),
            has_image x
        = Colour "sRGB" [x, x, x], is_real x    // since Colour can't do mono
        = Colour "sRGB" x, is_real_list x && is_list_len 3 x
        = mtoc3 x, is_matrix x && (is_list_len 3 x?0 || is_list_len 1 x?0)
        = error (_ "bad arguments to " ++ "to_colour")
    {
        x'
            = x,
                Interpretation_3ary.has_value (get_interpretation x)
            = colourspace [] Interpretation.sRGB x;
        x''
            = extract_bands 0 3 x', get_bands x' > 3
            = x';

        // matrix to colour ... average the rows
        mtoc3 x
            = Colour "sRGB" value
        {
            sums = map sum (transpose x);
            avgs = map (converse divide (len x)) sums;
            value
                = avgs, len avgs == 3
                = [avgs?0, avgs?0, avgs?0];
        }
    }

    colour_space interp
        = Interpretation_3ary.get_key interp,
            Interpretation_3ary.has_value interp
        = error (_ "unable to make Colour from " ++
            Interpretation.get_name interp ++ _ " image");
}

/* Try to make a real (not a Real!).
 */
to_real x
    = to_real x.expr, is_Expression x
    = tor x
{
    to_real_op = Operator "to_real" tor Operator_type.COMPOUND false;

    tor x
        = oo_unary_function to_real_op x, is_class x
        = x, is_real x
        = abs x, is_complex x
        = 1, is_bool x && x
        = 0, is_bool x && !x
        = error (_ "bad arguments to " ++ "to_real");
}

to_int x = (int) (to_real x);

/* Try to make an enum value. These can be strings (eg. $lab) or reals (eg.
 * Interpretation.LAB).
 */
to_enum x
    = to_enum x.expr, is_Expression x
    = toe x
{
    to_enum_op = Operator "to_enum" toe Operator_type.COMPOUND false;

    toe x
        = oo_unary_function to_enum_op x, is_class x
        = x, is_real x
        = abs x, is_complex x
        = 1, is_bool x && x
        = 0, is_bool x && !x
        = map (to_kebab @ to_lower) x, is_string x
        = error (_ "bad arguments to " ++ "to_enum");

    // map eg b_w to b-w
    to_kebab c
        = '-', c == '_'
        = c;

    // to lowercase ... all libvips enum names are lowercase only
    to_lower c
        = (int) c - (int) 'A' + (int) 'a', c >= 'A' && c <= 'Z'
        = c;
}

to_bool x
    = x, is_bool x
    = oo_unary_function to_bool_op x, is_class x
    = to_int x != 0
{
    to_bool_op = Operator "to_bool" to_bool Operator_type.COMPOUND false;
}

/* Try to make a list ... ungroup, basically. We remove the innermost layer of
 * Groups.
 */
to_list x
    = x.value, is_Group x && !contains_Group x.value
    = Group (map to_list x.value), is_Group x
    = x;

/* Try to make a group. The outermost list objects become Group()'d.
 */
to_group x
    = Group x, is_list x
    = Group (map to_group x.value), is_Group x
    = x;

/* Macbeth chart patch names.
 */
macbeth_names = [
	"Dark skin",
	"Light skin",
	"Blue sky",
	"Foliage",
	"Blue flower",
	"Bluish green",
	"Orange",
	"Purplish blue",
	"Moderate red",
	"Purple",
	"Yellow green",
	"Orange yellow",
	"Blue",
	"Green",
	"Red",
	"Yellow",
	"Magenta",
	"Cyan",
	"White (density 0.05)",
	"Neutral 8 (density 0.23)",
	"Neutral 6.5 (density 0.44)",
	"Neutral 5 (density 0.70)",
	"Neutral 3.5 (density 1.05)",
	"Black (density 1.50)"
];

Whitepoint = class Enum {
    D93 = Vector [89.7400, 100, 130.7700];
    D75 = Vector [94.9682, 100, 122.5710];
    D65 = Vector [95.0470, 100, 108.8827];
    D55 = Vector [95.6831, 100, 92.0871];
    D50 = Vector [96.4250, 100, 82.4680];
    A = Vector [109.8503, 100, 35.5849];        // 2856K
    B = Vector [99.0720, 100, 85.2230];         // 4874K
    C = Vector [98.0700, 100, 118.2300];        // 6774K
    E = Vector [100, 100, 100];                 // ill. free
    D3250 = Vector [105.6590, 100, 45.8501];

    _description = [
        [A, _"CIE A (2850K)"],
        [B, _"CIE B (4874K)"],
        [C, _"CIE C (6774K)"],
        [E, _"CIE E (illuminant free)"]
    ];
};

/* matrix to convert D65 XYZ to D50 XYZ ... direct conversion, found by
 * measuring a macbeth chart in D50 and D65 and doing a LMS to get a matrix
 */
D652D50_direct = Matrix
    [[ 1.13529, -0.0604663, -0.0606321 ],
     [ 0.0975399, 0.935024, -0.0256156 ],
     [ -0.0336428, 0.0414702, 0.994135 ]];

D502D65_direct = D652D50_direct ** -1;

/* Convert normalised XYZ to Bradford RGB.
 */
XYZ2RGBbrad = Matrix
    [[0.8951,  0.2664, -0.1614],
     [-0.7502,  1.7135,  0.0367],
     [0.0389, -0.0685,  1.0296]];

/* Convert bradford RGB to normalised XYZ.
 */
RGBbrad2XYZ = XYZ2RGBbrad ** -1;

/* Convert D50 XYZ to D65 using the bradford chromatic adaptation approx.
 */
D502D65brad xyz
    = xyz'''
{
    xyz' = xyz / Whitepoint.D50;

    rgb = recomb XYZ2RGBbrad xyz';

    // move white in bradford RGB
    rgb' = rgb / Vector [0.94, 1.02, 1.33];

    xyz'' = recomb RGBbrad2XYZ rgb';

    // back to D65
    xyz''' = xyz'' * Whitepoint.D65;
}

/* Convert D65 XYZ to D50 using the bradford approx.
 */
D652D50brad xyz
    = xyz'''
{
    xyz' = xyz / Whitepoint.D65;

    rgb = recomb XYZ2RGBbrad xyz';

    // move white in bradford RGB
    rgb' = rgb * Vector [0.94, 1.02, 1.33];

    xyz'' = recomb RGBbrad2XYZ rgb';

    xyz''' = xyz'' * Whitepoint.D50;
}

/* Parse a positive integer.
 */
parse_pint l
    = foldl acc 0 l
{
    acc sofar ch = sofar * 10 + parse_c ch;

    /* Turn a char digit to a number.
     */
    parse_c ch
        = error (_ "not a digit"), !is_digit ch
        = (int) ch - (int) '0';
}

/* Parse an integer, with an optional sign character.
 */
parse_int l
    = error (_ "badly formed number"), !is_list_len 2 parts
    = sign * n
{
    parts = splitpl [member "+-", is_digit] l;

    n = parse_pint parts?1;
    sign
        = 1, parts?0 == [] || parts?0 == "+"
        = -1;
}

/* Parse a float.
 *  [+-]?[0-9]*([.][0-9]*)?(e[0-9]+)?
 */
parse_float l
    = err, !is_list_len 4 parts
    = sign * (abs ipart + fpart) * 10 ** exp
{
    err = error (_ "badly formed number");

    parts = splitpl [
        member "+-0123456789",
        member ".0123456789",
        member "eE",
        member "+-0123456789"
    ] l;

    ipart = parse_int parts?0;
    sign
        = 1, ipart >= 0
        = -1;
    fpart
        = 0, parts?1 == [];
        = err, parts?1?0 != '.'
        = parse_pint (tl parts?1) / 10 ** (len parts?1 - 1);
    exp
        = 0, parts?2 == [] && parts?3 == []
        = err, parts?2 == []
        = parse_int parts?3;

}

/* Parse a time in "hh:mm:ss" into seconds.
 */
parse_time l
    = error (_ "badly formed time"), !is_list_len 5 parts
    = s + 60 * m + 60 * 60 * h
{
    parts = splitpl [is_digit, equal ':', is_digit, equal ':', is_digit] l;
    h = parse_int parts?0;
    m = parse_int parts?2;
    s = parse_int parts?4;
}

/* Form a pathname.
 *  form_path ["home", "john"] == "home/john"
 *  form_path ["/", "home", "john"] == "/home/john"
 *  form_path ["c:", "home", "john"] == "c:/home/john"
 */
form_path l
    = "/" ++ joinsep "/" (tl l), len l > 0 && l?0 == "/"
    = joinsep "/" l;

/* Parse a pathname.
 *  parse_path "/home/john" == ["/", "home", "john"]
 *  parse_path "///home//////john" == ["/", "home", "john"]
 *  parse_path "home/john" == ["home", "john"]
 *  parse_path "c:\\home\\john" == ["c:", "home", "john"]
 */
parse_path str
    = ["/"] ++ components, is_absolute
    = components
{
    components = split (member "/\\") str;

    // does str have a leading '/'? this is an absolute path
    is_absolute = len str > 0 && str?0 == '/';
}

/* Return $PATH, reformatted as [["comp1", "comp2"], ["comp1", "comp2"] ..]
 */
system_search_path
    = [vipsbin] ++
        map parse_path (split (equal path_sep) (expand "$PATH"))
{
    /* On some platforms we ship vips with a few extra progs. Search
     * $VIPSHOME/bin first.
     */
    vipsbin = parse_path (expand "$VIPSHOME") ++ ["bin"];

    path_sep
        = ':', expand "$SEP" == "/"
        = ';';
}

/* Search $PATH for the first occurence of name, or "".
 */
search_for name
    = hits?0, hits != []
    = ""
{
    exe_name = name ++ expand "$EXEEXT";
    paths = map (\p form_path (p ++ [exe_name])) system_search_path;
    hits = dropwhile (equal []) (map search paths);
}

/* Search $PATH for the first occurence of name, error on failure.
 */
search_for_error name
    = path, path != ""
    = error (exe_name ++ " not found on your search path. " ++
        "Check you have installed the program and it is on your PATH.")
{
    exe_name = name ++ expand "$EXEEXT";
    path = search_for name;
}

