miset_slice_scaling_flag and TODO.

miset_slice_scaling_flag and TODO.

{-# LANGUAGE ForeignFunctionInterface #-}

module Data.Minc.Raw.Base where

import Data.Minc.Utils
import Data.Minc.Types

import Foreign hiding (unsafePerformIO)
import Foreign.C
import System.IO.Unsafe (unsafePerformIO)
import Control.Monad (liftM)

#include <minc2.h>

-- VOLUME FUNCTIONS

-- extern int micreate_volume(const char *filename, int number_of_dimensions,
--                            midimhandle_t dimensions[],
--                            mitype_t volume_type,
--                            miclass_t volume_class,
--                            mivolumeprops_t create_props,
--                            mihandle_t *volume);
{#fun micreate_volume{ `String', `Int',
                       allocaDims- `[Ptr ()]' peekDims*,
                       toCInt `MincMiType',
                       toCInt `MincMiClass',
                       id `Ptr ()',
                       alloca- `Ptr ()' peek* } -> `Int' #}

-- extern int micreate_volume_image(mihandle_t volume);
{#fun micreate_volume_image{ id `Ptr ()' } -> `Int' #}

-- FIXME How do we make a mivolumeprops_t?

toCInt :: Enum a => a -> CInt
toCInt = toEnum . fromEnum

toCUInt :: Enum a => a -> CUInt
toCUInt = toEnum . fromEnum

toCULLong :: Enum a => a -> CULLong
toCULLong = toEnum . fromEnum

-- toCULongLong :: Enum a => a -> CULongLong
-- toCULongLong = toEnum . fromEnum

-- extern int miget_volume_dimension_count(mihandle_t volume, midimclass_t dimclass, midimattr_t attr, int *number_of_dimensions);
{#fun miget_volume_dimension_count{ id `Ptr ()', toCInt `MincDimClass', toCUInt `MincDimAttribute', alloca- `Int' peekIntConv* } -> `Int' #}

-- extern int miget_volume_voxel_count(mihandle_t volume, int *number_of_voxels);
{#fun miget_volume_voxel_count{ id `Ptr ()', alloca- `Int' peekIntConv* } -> `Int' #}

-- extern int miopen_volume(const char *filename, int mode, mihandle_t *volume);
{#fun miopen_volume{ `String', `Int', alloca- `Ptr ()' peek* } -> `Int' #}

-- extern int miclose_volume(mihandle_t volume);
{#fun miclose_volume{ id `Ptr ()' } -> `Int' #}

-- extern int miget_slice_scaling_flag(mihandle_t volume, miboolean_t *slice_scaling_flag);
-- FIXME Might be nicer to use a Bool marshalling thing instead of a CInt (miboolean_t is just int).
{#fun miget_slice_scaling_flag{ id `Ptr ()', alloca- `CInt' peek* } -> `Int' #}

-- extern int miset_slice_scaling_flag(mihandle_t volume, miboolean_t slice_scaling_flag);
{#fun miset_slice_scaling_flag{ id `Ptr ()', `CInt' } -> `Int' #}

-- extern int miget_volume_dimensions(mihandle_t volume, midimclass_t dimclass, midimattr_t attr,
--                                    miorder_t order, int array_length,
--                                    midimhandle_t dimensions[]);
{#fun miget_volume_dimensions{ id `Ptr ()', toCInt `MincDimClass', toCUInt `MincDimAttribute',
                               toCInt `MincDimOrder', toCInt `Int', allocaDims- `[Ptr ()]' peekDims* } -> `Int' #}

-- int miget_dimension_sizes(const midimhandle_t dimensions[], misize_t array_length,
--                                 misize_t sizes[]);
{#fun miget_dimension_sizes{ withArray* `[Ptr ()]', toCULLong `Int', allocaDimSizes- `[Int]' peekDimSizes* } -> `Int' #}

-- int miget_dimension_separations(const midimhandle_t dimensions[],
--                                 mivoxel_order_t voxel_order,
--                                 misize_t array_length,
--                                 double separations[]);
{#fun miget_dimension_separations{ withArray* `[Ptr ()]', toCInt `MincVoxelOrder', toCULLong `Int',
                                   allocaSeparations- `[CDouble]' peekSeparations* } -> `Int' #}

-- int miget_dimension_starts(const midimhandle_t dimensions[], mivoxel_order_t voxel_order,
--                            misize_t array_length, double starts[]);
{#fun miget_dimension_starts{ withArray* `[Ptr ()]', toCInt `MincVoxelOrder', toCULLong `Int',
                              allocaStarts- `[CDouble]' peekStarts* } -> `Int' #}

-- int miget_dimension_name(midimhandle_t dimension, char **name_ptr);
{#fun miget_dimension_name{ id `Ptr ()', alloca- `CString' peek*} -> `Int' #}

-- withArrayInts :: Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArrayInts x = withArray (map toCULLong x)

-- int miget_real_value_hyperslab(mihandle_t volume,
--                                mitype_t buffer_data_type,
--                                const misize_t start[],
--                                const misize_t count[],
--                                void *buffer);
{#fun miget_real_value_hyperslab{ id `Ptr ()',
                                  toCInt `MincType',
                                  withArrayInts* `[Int]',
                                  withArrayInts* `[Int]',
                                  id `Ptr ()' } -> `Int' #}

-- int miget_data_type(mihandle_t vol, mitype_t *volume_data_type);
{#fun miget_data_type{ id `Ptr ()', alloca- `MincType' peekMincType* } -> `Int' #}

-- int miget_hyperslab_size(mitype_t volume_data_type,
--                          int n_dimensions,
--                          const hsize_t count[],
--                          misize_t *size_ptr);
{#fun miget_hyperslab_size{ toCInt `MincType',
                            toCInt `Int',
                            withArrayInts* `[Int]',
                            alloca- `CULLong' peekIntConv* } -> `Int' #}

{-

TODO

int miget_slice_dimension_count(mihandle_t volume, midimclass_t dimclass,
                                midimattr_t attr, int *number_of_dimensions);

/** Create a volume property list.  The new list will be returned in the
 * \a props parameter.    When the program is finished
 * using the property list it should call  mifree_volume_props() to free the
 * memory associated with the list.
 * \param props A pointer to the returned volume properties handle.
 * \ingroup mi2VPrp
 */
int minew_volume_props(mivolumeprops_t *props);

/** Destroy a volume property list.
 * \param props The volume property list to delete.
 * \ingroup mi2VPrp
 */
int mifree_volume_props(mivolumeprops_t props);

/** Get a copy of the volume property list.  When the program is finished
 * using the property list it should call  mifree_volume_props() to free the
 * memory associated with the list.
 * \param volume A volume handle
 * \param props A pointer to the returned volume properties handle.
 * \ingroup mi2VPrp
 */
int miget_volume_props(mihandle_t vol, mivolumeprops_t *props);

/** Set multi-resolution properties.  The \a enable_flag determines
 * whether or not thumbnail images will be calculated at all.  The \a
 * depth parameter determines the lowest-resolution image that will be
 * available.  The full resolution image is considered to be image #0,
 * the half resolution image is image #1, the quarter-resolution image
 * is #2, etc. Therefore a \a depth value of 2 implies both the half
 * and quarter resolution thumbnails will be calculated and stored in
 * the file.
 * \param props A volume property list handle
 * \param enable_flag TRUE if multiresolution support should be enabled in
 * this file.
 * \param depth The maximum depth of multiresolution data
 * to support.
 * \ingroup mi2VPrp
 */
int miset_props_multi_resolution(mivolumeprops_t props, miboolean_t enable_flag,
                                        int depth);

/** Get multi-resolution properties.  Returns the value of the \a enable_flag
 * and \a depth parameters.
 * \param props A volume property list handle
 * \param enable_flag Pointer to a boolean which will be set to TRUE if
 * multiresolution has been enabled.
 * \param depth Pointer to a integer which will contain the maximum resolution
 * depth enabled if multiresolution is enabled.
 * \ingroup mi2VPrp
 */
int miget_props_multi_resolution(mivolumeprops_t props, miboolean_t *enable_flag,
                                        int *depth);

/** Select a different resolution from a multi-resolution image.
 * \ingroup mi2VPrp
 */
int miselect_resolution(mihandle_t volume, int depth);

/** Compute or recompute all resolution groups.
 *
 * \ingroup mi2VPrp
 */
int miflush_from_resolution(mihandle_t volume, int depth);

/** Set compression type for a volume property list
 * Note that enabling compression will automatically
 * enable blocking with default parameters.
 * \param props A volume properties list
 * \param compression_type The type of compression to use (MI_COMPRESS_NONE
 * or MI_COMPRESS_ZLIB)
 * \ingroup mi2VPrp
 */
int miset_props_compression_type(mivolumeprops_t props, micompression_t compression_type);

/** Get compression type for a volume property list
 * \param props A volume property list handle
 * \param compression_type A pointer to a variable to which the current
 * compression type will be assigned.
 * \ingroup mi2VPrp
 */
int miget_props_compression_type(mivolumeprops_t props, micompression_t *compression_type);

/** Set zlib compression properties for a volume list.  The \a zlib_level
 * parameter may range from 1 to 9, where higher numbers request that the
 * library attempt to use more memory (and possibly processing power) to
 * achieve the highest possible compression ratio.
 *
 * \param props A volume property list handle
 * \param zlib_level An integer specifying the desired compression level.
 * \ingroup mi2VPrp
 */
int miset_props_zlib_compression(mivolumeprops_t props, int zlib_level);

/** Get zlib compression properties from a volume property list.
 * \param props A volume property list handle
 * \param zlib_level Pointer to an integer variable that will receive the
 * current compression level.
 * \ingroup mi2VPrp
 */
int miget_props_zlib_compression(mivolumeprops_t props, int *zlib_level);

/** Set blocking structure properties for the volume
 * \param props A volume property list handle
 * \param edge_count
 * \param edge_lengths
 * \ingroup mi2VPrp
 */
int miset_props_blocking(mivolumeprops_t props, int edge_count, const int *edge_lengths);

/** Get blocking structure properties for the volume
 * \param props The properties structure from which to get the information
 * \param edge_count Returns the number of edges (dimensions) in a block
 * \param edge_lengths The lengths of the edges
 * \param max_lengths The number of elements of the edge_lengths array
 * \ingroup mi2VPrp
 */
int miget_props_blocking(mivolumeprops_t props, int *edge_count, int *edge_lengths,
                                int max_lengths);

/** Set properties for uniform/nonuniform record dimension
 * \ingroup mi2VPrp
 */
int miset_props_record(mivolumeprops_t props, misize_t record_length, char *record_name);

/** Set the template volume flag
 * \ingroup mi2VPrp
 */
int miset_props_template(mivolumeprops_t props, int template_flag);

/** \defgroup mi2Slice SLICE/VOLUME SCALE FUNCTIONS */
/**
 * This function sets \a slice_max to the maximum real value of
 * voxels in the slice containing the coordinates \a start_positions.
 * The \a array_length may be less than or equal to the number of dimensions
 * in the volume, extra coordinates will be ignored.  Specifying too few
 * coordinates will trigger an error.
 * Coordinates must always be specified in raw file order.
 * \ingroup mi2Slice
 */
int miget_slice_max(mihandle_t volume,
                           const misize_t start_positions[],
                           size_t array_length, double *slice_max);

/**
 * This function sets minimum real value of
 * values in the slice containing the coordinates \a start_positions.
 * The \a array_length may be less than or equal to the number of dimensions
 * in the volume, extra coordinates will be ignored.  Specifying too few
 * coordinates will trigger an error.
 * Coordinates must always be specified in raw file order.
 * \ingroup mi2Slice
 */
int miset_slice_max(mihandle_t volume,
                           const misize_t start_positions[],
                           size_t array_length, double slice_max);

/**
 * This function sets \a slice_min to the minimum real value of
 * voxels in the slice containing the coordinates \a start_positions.
 * The \a array_length may be less than or equal to the number of dimensions
 * in the volume, extra coordinates will be ignored.  Specifying too few
 * coordinates will trigger an error.
 * Coordinates must always be specified in raw file order.
 * \ingroup mi2Slice
 */
int miget_slice_min(mihandle_t volume,
                           const misize_t start_positions[],
                           size_t array_length, double *slice_min);

/**
 * This function sets minimum real value of
 * values in the slice containing the coordinates \a start_positions.
 * The \a array_length may be less than or equal to the number of dimensions
 * in the volume, extra coordinates will be ignored.  Specifying too few
 * coordinates will trigger an error.
 * Coordinates must always be specified in raw file order.
 * \ingroup mi2Slice
 */
int miset_slice_min(mihandle_t volume,
                           const misize_t start_positions[],
                           size_t array_length, double slice_min);

/**
 * This function gets both the minimum and
 * maximum real value of voxels in the slice containing the coordinates
 * \a start_positions.  The \a array_length may be less than or equal to
 * the number of dimensions in the volume, extra coordinates will be
 * ignored.  Specifying too few coordinates will trigger an error.
 * Coordinates must always be specified in raw file order.
 * \ingroup mi2Slice
 */
int miget_slice_range(mihandle_t volume,
                             const misize_t start_positions[],
                             size_t array_length, double *slice_max,
                             double *slice_min);

/**
 * This function the minimum and maximum real value of voxels in the
 * slice containing the coordinates \a start_positions.  The \a
 * array_length may be less than or equal to the number of dimensions in
 * the volume, extra coordinates will be ignored.  Specifying too few
 * coordinates will trigger an error.  Coordinates must always be
 * specified in raw file order.
 * \ingroup mi2Slice
 */
int miset_slice_range(mihandle_t volume,
                             const misize_t start_positions[],
                             size_t array_length, double slice_max,
                             double slice_min);

/**
 * This function returns the maximum real value of
 * voxels in the entire \a volume.  If per-slice scaling is enabled, this
 * function will return an error.
 * \ingroup mi2Slice
 */
int miget_volume_max(mihandle_t volume, double *slice_max);

/**
 * This function sets the maximum real value of
 * voxels in the entire \a volume.  If per-slice scaling is enabled, this
 * function will return an error.
 * \ingroup mi2Slice
 */
int miset_volume_max(mihandle_t volume, double slice_max);

/**
 * This function returns the minimum real value of
 * voxels in the entire \a volume.  If per-slice scaling is enabled, this
 * function will return an error.
 * \ingroup mi2Slice
 */
int miget_volume_min(mihandle_t volume, double *slice_min);

/**
 * This function sets the minimum real value of
 * voxels in the entire \a volume.  If per-slice scaling is enabled, this
 * function will return an error.
 * \ingroup mi2Slice
 */
int miset_volume_min(mihandle_t volume, double slice_min);

/**
 * This function retrieves the maximum and minimum real values of
 * voxels in the entire \a volume.  If per-slice scaling is enabled, this
 * function will return an error.
 * \ingroup mi2Slice
 */
int miget_volume_range(mihandle_t volume, double *volume_max,
                              double *volume_min);

/**
 * This function sets the maximum and minimum real values of
 * voxels in the entire \a volume.  If per-slice scaling is enabled, this
 * function will return an error.
 * \ingroup mi2Slice
 */
int miset_volume_range(mihandle_t volume, double volume_max,
                              double volume_min);

/** \defgroup mi2Hyper HYPERSLAB FUNCTIONS */

/** Calculates and returns the number of bytes required to store the
 * hyperslab specified by the \a n_dimensions and the
 * \a count parameters, using hdf type id
 * \ingroup mi2Hyper
 */
void miget_hyperslab_size_hdf(hid_t hdf_type_id, int n_dimensions,
                                const hsize_t count[],
                                misize_t *size_ptr);

/** Reads the real values in the volume from the interval min through
 *  max, mapped to the maximum representable range for the requested
 *  data type. Float types is mapped to 0.0 1.0
 * \ingroup mi2Hyper
 */
int miget_hyperslab_normalized(mihandle_t volume,
                                      mitype_t buffer_data_type,
                                      const misize_t start[],
                                      const misize_t count[],
                                      double min,
                                      double max,
                                      void *buffer);

/** Writes the real values in the volume from the interval min through
 *  max, mapped to the maximum representable range for the requested
 *  data type. Float types is mapped to 0.0 1.0
 * \ingroup mi2Hyper
 */
int miset_hyperslab_normalized(mihandle_t volume,
                                      mitype_t buffer_data_type,
                                      const misize_t start[],
                                      const misize_t count[],
                                      double min,
                                      double max,
                                      void *buffer);

/** Get a hyperslab from the file,
 * converting voxel values into real values
 * \ingroup mi2Hyper
 */
int miget_hyperslab_with_icv(mihandle_t volume,
                                    mitype_t buffer_data_type,
                                    const misize_t start[],
                                    const misize_t count[],
                                    void *buffer);

/** Write a hyperslab to the file, converting real values into voxel values
 * \ingroup mi2Hyper
 */
int miset_hyperslab_with_icv(mihandle_t volume,
                                    mitype_t buffer_data_type,
                                    const misize_t start[],
                                    const misize_t count[],
                                    void *buffer);

/** Write a hyperslab to the file from the preallocated buffer,
 *  converting from the stored "voxel" data range to the desired
 * "real" (float or double) data range, same as miset_hyperslab_with_icv
 * \ingroup mi2Hyper
 */
int miset_real_value_hyperslab(mihandle_t volume,
                                      mitype_t buffer_data_type,
                                      const misize_t start[],
                                      const misize_t count[],
                                      void *buffer);

/** Read a hyperslab from the file into the preallocated buffer,
 * with no range conversions or normalization.  Type conversions will
 * be performed if necessary.
 * \ingroup mi2Hyper
 */
int miget_voxel_value_hyperslab(mihandle_t volume,
                                       mitype_t buffer_data_type,
                                       const misize_t start[],
                                       const misize_t count[],
                                       void *buffer);

/** Write a hyperslab to the file from the preallocated buffer,
 * with no range conversions or normalization.  Type conversions will
 * be performed if necessary.
 * \ingroup mi2Hyper
 */
int miset_voxel_value_hyperslab(mihandle_t volume,
                                       mitype_t buffer_data_type,
                                       const misize_t start[],
                                       const misize_t count[],
                                       void *buffer);

/** \defgroup mi2Cvt CONVERT FUNCTIONS */

/** Convert values between real (scaled) values and voxel (unscaled)
 * values.  The voxel value is the unscaled value, and corresponds to the
 * value actually stored in the file, whereas the "real" value is the
 * value at the given location after scaling has been applied.
 *
 * The \a coords parameter specifies the location at which the
 * conversion is performed.  This is needed because MINC supports
 * per-slice scaling, therefore a conversion performed at one location
 * may differ from that performed at another location.
 *
 * \param volume A volume handle
 * \param coords The position for which to perform the conversion.
 * \param ncoords The length of the \a coords array.
 * \param real_value The original real value, to be converted to voxel.
 * \param voxel_value_ptr A pointer to the converted voxel value.
 * \ingroup mi2Cvt
 */
int miconvert_real_to_voxel(mihandle_t volume,
                                   const misize_t coords[],
                                   size_t ncoords,
                                   double real_value,
                                   double *voxel_value_ptr);

/** Convert values between real (scaled) values and voxel (unscaled)
 * values.  The voxel value is the unscaled value, and corresponds to the
 * value actually stored in the file, whereas the "real" value is the
 * value at the given location after scaling has been applied.
 *
 * The \a coords parameter specifies the location at which the
 * conversion is performed.  This is needed because MINC supports
 * per-slice scaling, therefore a conversion performed at one location
 * may differ from that performed at another location.
 *
 * \param volume A volume handle
 * \param coords The position for which to perform the conversion.
 * \param ncoords The length of the \a coords array.
 * \param voxel_value The original voxel value, to be converted to real.
 * \param real_value_ptr A pointer to the converted real value.
 * \ingroup mi2Cvt
 */
int miconvert_voxel_to_real(mihandle_t volume,
                                   const misize_t coords[],
                                   int ncoords,
                                   double voxel_value,
                                   double *real_value_ptr);

/** Converts an N-dimensional spatial position in voxel coordinates into a
 * 3-dimensional spatial position in world coordinates.
 *
 * The returned world coordinate vector is in a standardized order, with
 * the X position first (at index 0), followed by the Y and Z coordinates.
 * The voxel coordinate vector is in the native order appropriate to the
 * file.
 *
 * \ingroup mi2Cvt
 */
int miconvert_voxel_to_world(mihandle_t volume,
                                    const double voxel[],
                                    double world[]);

/** Converts a 3-dimensional spatial position in world coordinates into a
 * N-dimensional spatial position in voxel coordinates.
 *
 * The input world coordinate vector is in a standardized order, with
 * the X position first (at index 0), followed by the Y and Z coordinates.
 * The voxel coordinate vector is in the native order appropriate to the
 * file.
 *
 * \ingroup mi2Cvt
 */
int miconvert_world_to_voxel(mihandle_t volume,
                                    const double world[],
                                    double voxel[]);

/** This function retrieves the real values of a position in the
 *  MINC volume.  The "real" value is the value at the given location
 *  after scaling has been applied.
 *
 * \param volume A volume handle
 * \param coords The voxel position to retrieve
 * \param ndims The number of values in the \a coords array
 * \param value_ptr Pointer to a double variable to hold the returned value.
 *
 * \ingroup mi2Cvt
 */
int miget_real_value(mihandle_t volume,
                            const misize_t coords[],
                            int ndims,
                            double *value_ptr);

/** This function sets the  real value of a position in the MINC
 *  volume. The "real" value is the value at the given location
 *  after scaling has been applied.
 *
 * \param volume A volume handle
 * \param coords The voxel position to retrieve
 * \param ndims The number of values in the \a coords array
 * \param value The value to save at this location.
 *
 * \ingroup mi2Cvt
 */
int miset_real_value(mihandle_t volume,
                            const misize_t coords[],
                            int ndims,
                            double value);

/** This function retrieves the voxel values of a position in the
 * MINC volume. The voxel value is the unscaled value, and corresponds
 * to the value actually stored in the file.
 *
 * \ingroup mi2Cvt
 */
int miget_voxel_value(mihandle_t volume,
                             const misize_t coords[],
                             int ndims,
                             double *voxel_ptr);

/** This function sets the voxel value of a position in the MINC
 * volume.  The voxel value is the unscaled value, and corresponds to the
 * value actually stored in the file.
 *
 * \ingroup mi2Cvt
 */
int miset_voxel_value(mihandle_t volume,
                             const misize_t coords[],
                             int ndims,
                             double voxel);

/** Get the absolute minimum and maximum values of a volume.
 *
 * \ingroup mi2Cvt
 */
int miget_volume_real_range(mihandle_t volume, double real_range[2]);

/**
 * This function sets the world coordinates of the point (0,0,0) in voxel
 * coordinates.  This changes the constant offset of the two coordinate
 * systems.
 *
 * \ingroup mi2Cvt
 */
int miset_world_origin(mihandle_t volume, double origin[MI2_3D]);

/* VALID functions */
/** This function gets the maximum valid value specific to the data
 *  type of the \a volume parameter.
 * \retval MI_ERROR on failure
 * \retval MI_NOERROR on success
 */
int miget_volume_valid_max(mihandle_t volume, double *valid_max);

/** This function sets the maximum valid value specific to the data
 *  type of the \a volume parameter.
 * \retval MI_ERROR on failure
 * \retval MI_NOERROR on success
 */
int miset_volume_valid_max(mihandle_t volume, double valid_max);

/** This function gets the minimum valid value specific to the data
 *  type of the \a volume parameter.
 * \retval MI_ERROR on failure
 * \retval MI_NOERROR on success
 */
int miget_volume_valid_min(mihandle_t volume, double *valid_min);

/** This function sets the minimum valid value specific to the data
 *  type of the \a volume parameter.
 * \retval MI_ERROR on failure
 * \retval MI_NOERROR on success
 */
int miset_volume_valid_min(mihandle_t volume, double valid_min);

/** This function gets the minimum and maximum valid value specific to the
 * data type of the \a volume parameter.
 * \retval MI_ERROR on failure
 * \retval MI_NOERROR on success
 */
int miget_volume_valid_range(mihandle_t volume, double *valid_max, double *valid_min);

/** This function sets the minimum and maximum valid value specific to the
 * data type of the \a volume parameter.
 * \retval MI_ERROR on failure
 * \retval MI_NOERROR on success
 */
int miset_volume_valid_range(mihandle_t volume, double valid_max, double valid_min);

/** \defgroup mi2Rec RECORD functions */
/** This method gets the name of the record dimension
 * TODO: set record name??
 * \ingroup mi2Rec
 */
int miget_record_name(mihandle_t volume, char **name);

/** This method gets the length (i.e., number of fields in the case of
 * uniform records and number of bytes for non_uniform ones) of the
 * record.
 * \ingroup mi2Rec
 */
int miget_record_length(mihandle_t volume, int *length);

/** This method returns the field name for the given field index.  Memory
 * for returned string is allocated on the heap and should be released using
 * mifree_name().
 * \ingroup mi2Rec
 */
int miget_record_field_name(mihandle_t volume, int index, char **name);

/** This method sets a field name for the volume record. The volume
 * must be of class "MI_CLASS_UNIFORM_RECORD".  The size of record
 * type will be increased if necessary to accomodate the new field.
 * \ingroup mi2Rec
 */
int miset_record_field_name(mihandle_t volume, int index,
                                   const char *name);

/** \ingroup mi2Label LABEL functions */

/**
 * This function associates a label name with an integer value for the given
 * volume. Functions which read and write voxel values will read/write
 * in integer values, and must call miget_label_name() to discover the
 * descriptive text string which corresponds to the integer value.
 * \ingroup mi2Label
 */
int midefine_label(mihandle_t volume, int value, const char *name);

/**
 * For a labelled volume, this function retrieves the text name
 * associated with a given integer value.
 *
 * The name pointer returned must be freed by calling mifree_name().
 * \ingroup mi2Label
*/
int miget_label_name(mihandle_t volume, int value, char **name);

/**
 * This function is the inverse of miget_label_name(). It is called to determine
 * what integer value, if any, corresponds to the given text string.
 * \ingroup mi2Label
*/
int miget_label_value(mihandle_t volume, const char *name, int *value);

/**
 * This function returns the number of defined labels, if any, or zero.
 * \ingroup mi2Label
*/
int miget_number_of_defined_labels(mihandle_t volume, int *number_of_labels);

/**
 * This function returns the label value associated with an index (0,1,...)
 * \ingroup mi2Label
*/
int miget_label_value_by_index(mihandle_t volume, int idx, int *value);

#ifdef __cplusplus
}
#endif /* __cplusplus defined */

-}

{-# LANGUAGE ForeignFunctionInterface #-}

module Data.Minc.Raw.Base where

import Data.Minc.Utils
import Data.Minc.Types

import Foreign hiding (unsafePerformIO)
import Foreign.C
import System.IO.Unsafe (unsafePerformIO)
import Control.Monad (liftM)

#include <minc2.h>

-- VOLUME FUNCTIONS

-- extern int micreate_volume(const char *filename, int number_of_dimensions,
--                            midimhandle_t dimensions[],
--                            mitype_t volume_type,
--                            miclass_t volume_class,
--                            mivolumeprops_t create_props,
--                            mihandle_t *volume);
{#fun micreate_volume{ `String', `Int',
                       allocaDims- `[Ptr ()]' peekDims*,
                       toCInt `MincMiType',
                       toCInt `MincMiClass',
                       id `Ptr ()',
                       alloca- `Ptr ()' peek* } -> `Int' #}

-- extern int micreate_volume_image(mihandle_t volume);
{#fun micreate_volume_image{ id `Ptr ()' } -> `Int' #}

-- FIXME How do we make a mivolumeprops_t?

toCInt :: Enum a => a -> CInt
toCInt = toEnum . fromEnum

toCUInt :: Enum a => a -> CUInt
toCUInt = toEnum . fromEnum

toCULLong :: Enum a => a -> CULLong
toCULLong = toEnum . fromEnum

-- toCULongLong :: Enum a => a -> CULongLong
-- toCULongLong = toEnum . fromEnum

-- extern int miget_volume_dimension_count(mihandle_t volume, midimclass_t dimclass, midimattr_t attr, int *number_of_dimensions);
{#fun miget_volume_dimension_count{ id `Ptr ()', toCInt `MincDimClass', toCUInt `MincDimAttribute', alloca- `Int' peekIntConv* } -> `Int' #}

-- extern int miget_volume_voxel_count(mihandle_t volume, int *number_of_voxels);
{#fun miget_volume_voxel_count{ id `Ptr ()', alloca- `Int' peekIntConv* } -> `Int' #}

-- extern int miopen_volume(const char *filename, int mode, mihandle_t *volume);
{#fun miopen_volume{ `String', `Int', alloca- `Ptr ()' peek* } -> `Int' #}

-- extern int miclose_volume(mihandle_t volume);
{#fun miclose_volume{ id `Ptr ()' } -> `Int' #}

-- extern int miget_slice_scaling_flag(mihandle_t volume, miboolean_t *slice_scaling_flag);
-- FIXME Might be nicer to use a Bool marshalling thing instead of a CInt (miboolean_t is just int).
{#fun miget_slice_scaling_flag{ id `Ptr ()', alloca- `CInt' peek* } -> `Int' #}

{-
extern int miset_slice_scaling_flag(mihandle_t volume,
				    miboolean_t slice_scaling_flag);
-}

-- extern int miget_volume_dimensions(mihandle_t volume, midimclass_t dimclass, midimattr_t attr,
--                                    miorder_t order, int array_length,
--                                    midimhandle_t dimensions[]);
{#fun miget_volume_dimensions{ id `Ptr ()', toCInt `MincDimClass', toCUInt `MincDimAttribute',
                               toCInt `MincDimOrder', toCInt `Int', allocaDims- `[Ptr ()]' peekDims* } -> `Int' #}

-- int miget_dimension_sizes(const midimhandle_t dimensions[], misize_t array_length,
--                                 misize_t sizes[]);
{#fun miget_dimension_sizes{ withArray* `[Ptr ()]', toCULLong `Int', allocaDimSizes- `[Int]' peekDimSizes* } -> `Int' #}

-- int miget_dimension_separations(const midimhandle_t dimensions[],
--                                 mivoxel_order_t voxel_order,
--                                 misize_t array_length,
--                                 double separations[]);
{#fun miget_dimension_separations{ withArray* `[Ptr ()]', toCInt `MincVoxelOrder', toCULLong `Int',
                                   allocaSeparations- `[CDouble]' peekSeparations* } -> `Int' #}

-- int miget_dimension_starts(const midimhandle_t dimensions[], mivoxel_order_t voxel_order,
--                            misize_t array_length, double starts[]);
{#fun miget_dimension_starts{ withArray* `[Ptr ()]', toCInt `MincVoxelOrder', toCULLong `Int',
                              allocaStarts- `[CDouble]' peekStarts* } -> `Int' #}

-- int miget_dimension_name(midimhandle_t dimension, char **name_ptr);
{#fun miget_dimension_name{ id `Ptr ()', alloca- `CString' peek*} -> `Int' #}

-- withArrayInts :: Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArrayInts x = withArray (map toCULLong x)

-- int miget_real_value_hyperslab(mihandle_t volume,
--                                mitype_t buffer_data_type,
--                                const misize_t start[],
--                                const misize_t count[],
--                                void *buffer);
{#fun miget_real_value_hyperslab{ id `Ptr ()',
                                  toCInt `MincType',
                                  withArrayInts* `[Int]',
                                  withArrayInts* `[Int]',
                                  id `Ptr ()' } -> `Int' #}

-- int miget_data_type(mihandle_t vol, mitype_t *volume_data_type);
{#fun miget_data_type{ id `Ptr ()', alloca- `MincType' peekMincType* } -> `Int' #}

-- int miget_hyperslab_size(mitype_t volume_data_type,
--                          int n_dimensions,
--                          const hsize_t count[],
--                          misize_t *size_ptr);
{#fun miget_hyperslab_size{ toCInt `MincType',
                            toCInt `Int',
                            withArrayInts* `[Int]',
                            alloca- `CULLong' peekIntConv* } -> `Int' #}


Remove spurious ',' which upset haddock

Remove spurious ',' which upset haddock

darcs-hash:20060128104532-b4c10-4fc9f6552a84dd7420d8adacd8488eb3c20cc8d3.gz

-----------------------------------------------------------------------------
-- |
-- Module      :  Graphics.Rendering.Cairo.Types
-- Copyright   :  (c) Paolo Martini 2005
-- License     :  BSD-style (see cairo/COPYRIGHT)
--
-- Maintainer  :  p.martini@neuralnoise.com
-- Stability   :  experimental
-- Portability :  portable
--
-- Haskell bindings to the cairo types.
-----------------------------------------------------------------------------

-- #hide
module Graphics.Rendering.Cairo.Types (
    Matrix(Matrix), MatrixPtr
  , Cairo(Cairo), unCairo
  , Surface(Surface), withSurface, mkSurface, manageSurface
  , Pattern(Pattern), unPattern
  , Status(..)
  , Operator(..)
  , Antialias(..)
  , FillRule(..)
  , LineCap(..)
  , LineJoin(..)
  , ScaledFont(..), unScaledFont
  , FontFace(..), unFontFace
  , Glyph, unGlyph
  , TextExtentsPtr
  , TextExtents(..)
  , FontExtentsPtr
  , FontExtents(..)
  , FontSlant(..)
  , FontWeight(..)
  , SubpixelOrder(..)
  , HintStyle(..)
  , HintMetrics(..)
  , FontOptions(..), withFontOptions, mkFontOptions
  , Path(..), unPath
  , Content(..)
  , Format(..)
  , Extend(..)
  , Filter(..)

  , cIntConv
  , cFloatConv
  , cFromBool
  , cToBool
  , cToEnum
  , cFromEnum
  , peekFloatConv
  , withFloatConv

  ) where

{#import Graphics.Rendering.Cairo.Matrix#}

import Foreign hiding (rotate)
import CForeign

import Monad (liftM)

{#context lib="cairo" prefix="cairo"#}

-- not visible
{#pointer *cairo_t as Cairo newtype#}
unCairo (Cairo x) = x

-- | The medium to draw on.
{#pointer *surface_t as Surface foreign newtype#}
withSurface (Surface x) = withForeignPtr x

mkSurface :: Ptr Surface -> IO Surface
mkSurface surfacePtr = do
  surfaceForeignPtr <- newForeignPtr_ surfacePtr
  return (Surface surfaceForeignPtr)

manageSurface :: Surface -> IO ()
manageSurface (Surface surfaceForeignPtr) = do
  addForeignPtrFinalizer surfaceDestroy surfaceForeignPtr

foreign import ccall unsafe "&cairo_surface_destroy"
  surfaceDestroy :: FinalizerPtr Surface

-- | Patterns can be simple solid colors, various kinds of gradients or
-- bitmaps. The current pattern for a 'Render' context is used by the 'stroke',
-- 'fill' and paint operations. These operations composite the current pattern
-- with the target surface using the currently selected 'Operator'.
--
{#pointer *pattern_t as Pattern newtype#}
unPattern (Pattern x) = x

-- | Cairo status.
--
-- * 'Status' is used to indicate errors that can occur when using
--   Cairo. In some cases it is returned directly by functions. When using
--   'Graphics.Rendering.Cairo.Render', the last error, if any, is stored
--   in the monad and can be retrieved with 'Graphics.Rendering.Cairo.status'.
--
{#enum status_t as Status {underscoreToCase} deriving(Eq)#}

-- | Composition operator for all drawing operations.
--
{#enum operator_t as Operator {underscoreToCase}#}

-- | Specifies the type of antialiasing to do when rendering text or shapes
--
-- ['AntialiasDefault']  Use the default antialiasing for the subsystem
-- and target device.
--
-- ['AntialiasNone']  Use a bilevel alpha mask.
--
-- ['AntialiasGray']  Perform single-color antialiasing (using shades of
-- gray for black text on a white background, for example).
--
-- ['AntialiasSubpixel']  Perform antialiasing by taking advantage of
-- the order of subpixel elements on devices such as LCD panels.
--
{#enum antialias_t as Antialias {underscoreToCase}#}

-- | Specify how paths are filled.
--
-- * For both fill rules, whether or not a point is included in the fill is
--   determined by taking a ray from that point to infinity and looking at
--   intersections with the path. The ray can be in any direction, as long
--   as it doesn't pass through the end point of a segment or have a tricky
--   intersection such as intersecting tangent to the path. (Note that
--   filling is not actually implemented in this way. This is just a
--   description of the rule that is applied.)
--
-- ['FillRuleWinding']  If the path crosses the ray from left-to-right,
--   counts +1. If the path crosses the ray from right to left, counts -1.
--   (Left and right are determined from the perspective of looking along
--   the ray from the starting point.) If the total count is non-zero, the
--   point will be filled.
--
-- ['FillRuleEvenOdd']  Counts the total number of intersections,
--   without regard to the orientation of the contour. If the total number
--   of intersections is odd, the point will be filled.
--
{#enum fill_rule_t as FillRule {underscoreToCase}#}

-- | Specify line endings.
--
-- ['LineCapButt'] Start(stop) the line exactly at the start(end) point.
--
-- ['LineCapRound'] Use a round ending, the center of the circle is the
--   end point.
--
-- ['LineCapSquare'] Use squared ending, the center of the square is the
--   end point
--
{#enum line_cap_t as LineCap {underscoreToCase}#}

-- | Specify how lines join.
--
{#enum line_join_t as LineJoin {underscoreToCase}#}

{#pointer *scaled_font_t as ScaledFont newtype#}
unScaledFont (ScaledFont x) = x

{#pointer *font_face_t as FontFace newtype#}
unFontFace (FontFace x) = x

{#pointer *glyph_t as Glyph newtype#}
unGlyph (Glyph x) = x

{#pointer *text_extents_t as TextExtentsPtr -> TextExtents#}

-- | Specify the extents of a text.
data TextExtents = TextExtents {
    textExtentsXbearing :: Double
  , textExtentsYbearing :: Double
  , textExtentsWidth    :: Double
  , textExtentsHeight   :: Double
  , textExtentsXadvance :: Double
  , textExtentsYadvance :: Double
  }

instance Storable TextExtents where
  sizeOf _ = {#sizeof text_extents_t#}
  alignment _ = alignment (undefined :: CDouble)
  peek p = do
    x_bearing <- {#get text_extents_t->x_bearing#} p
    y_bearing <- {#get text_extents_t->y_bearing#} p
    width     <- {#get text_extents_t->width#}     p
    height    <- {#get text_extents_t->height#}    p
    x_advance <- {#get text_extents_t->x_advance#} p
    y_advance <- {#get text_extents_t->y_advance#} p
    return $ TextExtents (cFloatConv x_bearing) (cFloatConv y_bearing)
                         (cFloatConv width)     (cFloatConv height)
                         (cFloatConv x_advance) (cFloatConv y_advance)
  poke p (TextExtents x_bearing y_bearing width height x_advance y_advance) = do
    {#set text_extents_t->x_bearing#} p (cFloatConv x_bearing)
    {#set text_extents_t->y_bearing#} p (cFloatConv y_bearing)
    {#set text_extents_t->width#}     p (cFloatConv width)
    {#set text_extents_t->height#}    p (cFloatConv height)
    {#set text_extents_t->x_advance#} p (cFloatConv x_advance)
    {#set text_extents_t->y_advance#} p (cFloatConv y_advance)
    return ()

{#pointer *font_extents_t as FontExtentsPtr -> FontExtents#}

-- | Result of querying the font extents.
data FontExtents = FontExtents {
    fontExtentsAscent      :: Double
  , fontExtentsDescent     :: Double
  , fontExtentsHeight      :: Double
  , fontExtentsMaxXadvance :: Double
  , fontExtentsMaxYadvance :: Double
  }

instance Storable FontExtents where
  sizeOf _ = {#sizeof font_extents_t#}
  alignment _ = alignment (undefined :: CDouble)
  peek p = do
    ascent        <- {#get font_extents_t->ascent#}        p
    descent       <- {#get font_extents_t->descent#}       p
    height        <- {#get font_extents_t->height#}        p
    max_x_advance <- {#get font_extents_t->max_x_advance#} p
    max_y_advance <- {#get font_extents_t->max_y_advance#} p
    return $ FontExtents (cFloatConv ascent) (cFloatConv descent) (cFloatConv height)
                         (cFloatConv max_x_advance) (cFloatConv max_y_advance)
  poke p (FontExtents ascent descent height max_x_advance max_y_advance) = do
    {#set font_extents_t->ascent#}        p (cFloatConv ascent)
    {#set font_extents_t->descent#}       p (cFloatConv descent)
    {#set font_extents_t->height#}        p (cFloatConv height)
    {#set font_extents_t->max_x_advance#} p (cFloatConv max_x_advance)
    {#set font_extents_t->max_y_advance#} p (cFloatConv max_y_advance)
    return ()

-- | Specify font slant.
{#enum font_slant_t as FontSlant {underscoreToCase}#}

-- | Specify font weight.
{#enum font_weight_t as FontWeight {underscoreToCase}#}

-- | The subpixel order specifies the order of color elements within each pixel
-- on the display device when rendering with an antialiasing mode of
-- 'AntialiasSubpixel'.
--
-- ['SubpixelOrderDefault'] Use the default subpixel order for for the
--                          target device
--
-- ['SubpixelOrderRgb']     Subpixel elements are arranged horizontally
--                          with red at the left
--
-- ['SubpixelOrderBgr']     Subpixel elements are arranged horizontally
--                          with blue at the left
--
-- ['SubpixelOrderVrgb']    Subpixel elements are arranged vertically
--                          with red at the top
--
-- ['SubpixelOrderVbgr']    Subpixel elements are arranged vertically
--                          with blue at the top
--
{#enum subpixel_order_t as SubpixelOrder {underscoreToCase}#}

-- | Specifies the type of hinting to do on font outlines.
--
-- Hinting is the process of fitting outlines to the pixel grid in order to
-- improve the appearance of the result. Since hinting outlines involves
-- distorting them, it also reduces the faithfulness to the original outline
-- shapes. Not all of the outline hinting styles are supported by all font
-- backends.
--
-- ['HintStyleDefault']  Use the default hint style for for font backend and
--                       target device
--
-- ['HintStyleNone']     Do not hint outlines
--
-- ['HintStyleSlight']   Hint outlines slightly to improve contrast while
--                       retaining good fidelity to the original shapes.
--
-- ['HintStyleMedium']   Hint outlines with medium strength giving a compromise
--                       between fidelity to the original shapes and contrast
--
-- ['HintStyleFull']     Hint outlines to maximize contrast
--
{#enum hint_style_t as HintStyle {underscoreToCase}#}

-- | Specifies whether to hint font metrics.
--
-- Hinting font metrics means quantizing them so that they are integer values
-- in device space. Doing this improves the consistency of letter and line
-- spacing, however it also means that text will be laid out differently at
-- different zoom factors.
--
-- ['HintMetricsDefault']  Hint metrics in the default manner for the font
--                         backend and target device
--
-- ['HintMetricsOff']      Do not hint font metrics
--
-- ['HintMetricsOn']       Hint font metrics
--
--
{#enum hint_metrics_t as HintMetrics {underscoreToCase}#}

-- | Specifies how to render text.
{#pointer *font_options_t as FontOptions foreign newtype#}

withFontOptions (FontOptions fptr) = withForeignPtr fptr

mkFontOptions :: Ptr FontOptions -> IO FontOptions
mkFontOptions fontOptionsPtr = do
  fontOptionsForeignPtr <- newForeignPtr fontOptionsDestroy fontOptionsPtr
  return (FontOptions fontOptionsForeignPtr)

foreign import ccall unsafe "&cairo_font_options_destroy"
  fontOptionsDestroy :: FinalizerPtr FontOptions

-- XXX: pathToList :: Path -> [PathData]
--
-- http://cairographics.org/manual/bindings-path.html
--
-- {#enum path_data_type_t as PathDataType {underscoreToCase}#}
--
-- type Point = (Double, Double)
-- data PathData = PathMoveTo Point
--               | PathLineTo Point
--               | PathCurveTo Point Point Point
--               | PathClose

-- | A Cairo path.
--
-- * A path is a sequence of drawing operations that are accumulated until
--   'Graphics.Rendering.Cairo.stroke' is called. Using a path is particularly
--   useful when drawing lines with special join styles and
--   'Graphics.Rendering.Cairo.closePath'.
--
{#pointer *path_t as Path newtype#}
unPath (Path x) = x

{#enum content_t as Content {underscoreToCase}#}

data Format = FormatARGB32
            | FormatRGB24
            | FormatA8
            | FormatA1
            deriving (Enum)

-- | FIXME: We should find out about this.
{#enum extend_t as Extend {underscoreToCase}#}

-- | Specify how filtering is done.
{#enum filter_t as Filter {underscoreToCase}#}

-- Marshalling functions

cIntConv :: (Integral a, Integral b) => a -> b
cIntConv  = fromIntegral

cFloatConv :: (RealFloat a, RealFloat b) => a -> b
cFloatConv  = realToFrac

cFromBool :: Num a => Bool -> a
cFromBool  = fromBool

cToBool :: Num a => a -> Bool
cToBool  = toBool

cToEnum :: (Integral i, Enum e) => i -> e
cToEnum  = toEnum . cIntConv

cFromEnum :: (Enum e, Integral i) => e -> i
cFromEnum  = cIntConv . fromEnum

peekFloatConv :: (Storable a, RealFloat a, RealFloat b) =>  Ptr a -> IO b
peekFloatConv  = liftM cFloatConv . peek

withFloatConv :: (Storable b, RealFloat a, RealFloat b) => a -> (Ptr b -> IO c) -> IO c
withFloatConv  = with . cFloatConv

withArrayFloatConv :: (Storable b, RealFloat a, RealFloat b) => [a] -> (Ptr b -> IO b1) -> IO b1
withArrayFloatConv = withArray . map (cFloatConv)

-----------------------------------------------------------------------------
-- |
-- Module      :  Graphics.Rendering.Cairo.Types
-- Copyright   :  (c) Paolo Martini 2005
-- License     :  BSD-style (see cairo/COPYRIGHT)
--
-- Maintainer  :  p.martini@neuralnoise.com
-- Stability   :  experimental
-- Portability :  portable
--
-- Haskell bindings to the cairo types.
-----------------------------------------------------------------------------

-- #hide
module Graphics.Rendering.Cairo.Types (
    Matrix(Matrix), MatrixPtr
  , Cairo(Cairo), unCairo
  , Surface(Surface), withSurface, mkSurface, manageSurface,
  , Pattern(Pattern), unPattern
  , Status(..)
  , Operator(..)
  , Antialias(..)
  , FillRule(..)
  , LineCap(..)
  , LineJoin(..)
  , ScaledFont(..), unScaledFont
  , FontFace(..), unFontFace
  , Glyph, unGlyph
  , TextExtentsPtr
  , TextExtents(..)
  , FontExtentsPtr
  , FontExtents(..)
  , FontSlant(..)
  , FontWeight(..)
  , SubpixelOrder(..)
  , HintStyle(..)
  , HintMetrics(..)
  , FontOptions(..), withFontOptions, mkFontOptions
  , Path(..), unPath
  , Content(..)
  , Format(..)
  , Extend(..)
  , Filter(..)

  , cIntConv
  , cFloatConv
  , cFromBool
  , cToBool
  , cToEnum
  , cFromEnum
  , peekFloatConv
  , withFloatConv

  ) where

{#import Graphics.Rendering.Cairo.Matrix#}

import Foreign hiding (rotate)
import CForeign

import Monad (liftM)

{#context lib="cairo" prefix="cairo"#}

-- not visible
{#pointer *cairo_t as Cairo newtype#}
unCairo (Cairo x) = x

-- | The medium to draw on.
{#pointer *surface_t as Surface foreign newtype#}
withSurface (Surface x) = withForeignPtr x

mkSurface :: Ptr Surface -> IO Surface
mkSurface surfacePtr = do
  surfaceForeignPtr <- newForeignPtr_ surfacePtr
  return (Surface surfaceForeignPtr)

manageSurface :: Surface -> IO ()
manageSurface (Surface surfaceForeignPtr) = do
  addForeignPtrFinalizer surfaceDestroy surfaceForeignPtr

foreign import ccall unsafe "&cairo_surface_destroy"
  surfaceDestroy :: FinalizerPtr Surface

-- | Patterns can be simple solid colors, various kinds of gradients or
-- bitmaps. The current pattern for a 'Render' context is used by the 'stroke',
-- 'fill' and paint operations. These operations composite the current pattern
-- with the target surface using the currently selected 'Operator'.
--
{#pointer *pattern_t as Pattern newtype#}
unPattern (Pattern x) = x

-- | Cairo status.
--
-- * 'Status' is used to indicate errors that can occur when using
--   Cairo. In some cases it is returned directly by functions. When using
--   'Graphics.Rendering.Cairo.Render', the last error, if any, is stored
--   in the monad and can be retrieved with 'Graphics.Rendering.Cairo.status'.
--
{#enum status_t as Status {underscoreToCase} deriving(Eq)#}

-- | Composition operator for all drawing operations.
--
{#enum operator_t as Operator {underscoreToCase}#}

-- | Specifies the type of antialiasing to do when rendering text or shapes
--
-- ['AntialiasDefault']  Use the default antialiasing for the subsystem
-- and target device.
--
-- ['AntialiasNone']  Use a bilevel alpha mask.
--
-- ['AntialiasGray']  Perform single-color antialiasing (using shades of
-- gray for black text on a white background, for example).
--
-- ['AntialiasSubpixel']  Perform antialiasing by taking advantage of
-- the order of subpixel elements on devices such as LCD panels.
--
{#enum antialias_t as Antialias {underscoreToCase}#}

-- | Specify how paths are filled.
--
-- * For both fill rules, whether or not a point is included in the fill is
--   determined by taking a ray from that point to infinity and looking at
--   intersections with the path. The ray can be in any direction, as long
--   as it doesn't pass through the end point of a segment or have a tricky
--   intersection such as intersecting tangent to the path. (Note that
--   filling is not actually implemented in this way. This is just a
--   description of the rule that is applied.)
--
-- ['FillRuleWinding']  If the path crosses the ray from left-to-right,
--   counts +1. If the path crosses the ray from right to left, counts -1.
--   (Left and right are determined from the perspective of looking along
--   the ray from the starting point.) If the total count is non-zero, the
--   point will be filled.
--
-- ['FillRuleEvenOdd']  Counts the total number of intersections,
--   without regard to the orientation of the contour. If the total number
--   of intersections is odd, the point will be filled.
--
{#enum fill_rule_t as FillRule {underscoreToCase}#}

-- | Specify line endings.
--
-- ['LineCapButt'] Start(stop) the line exactly at the start(end) point.
--
-- ['LineCapRound'] Use a round ending, the center of the circle is the
--   end point.
--
-- ['LineCapSquare'] Use squared ending, the center of the square is the
--   end point
--
{#enum line_cap_t as LineCap {underscoreToCase}#}

-- | Specify how lines join.
--
{#enum line_join_t as LineJoin {underscoreToCase}#}

{#pointer *scaled_font_t as ScaledFont newtype#}
unScaledFont (ScaledFont x) = x

{#pointer *font_face_t as FontFace newtype#}
unFontFace (FontFace x) = x

{#pointer *glyph_t as Glyph newtype#}
unGlyph (Glyph x) = x

{#pointer *text_extents_t as TextExtentsPtr -> TextExtents#}

-- | Specify the extents of a text.
data TextExtents = TextExtents {
    textExtentsXbearing :: Double
  , textExtentsYbearing :: Double
  , textExtentsWidth    :: Double
  , textExtentsHeight   :: Double
  , textExtentsXadvance :: Double
  , textExtentsYadvance :: Double
  }

instance Storable TextExtents where
  sizeOf _ = {#sizeof text_extents_t#}
  alignment _ = alignment (undefined :: CDouble)
  peek p = do
    x_bearing <- {#get text_extents_t->x_bearing#} p
    y_bearing <- {#get text_extents_t->y_bearing#} p
    width     <- {#get text_extents_t->width#}     p
    height    <- {#get text_extents_t->height#}    p
    x_advance <- {#get text_extents_t->x_advance#} p
    y_advance <- {#get text_extents_t->y_advance#} p
    return $ TextExtents (cFloatConv x_bearing) (cFloatConv y_bearing)
                         (cFloatConv width)     (cFloatConv height)
                         (cFloatConv x_advance) (cFloatConv y_advance)
  poke p (TextExtents x_bearing y_bearing width height x_advance y_advance) = do
    {#set text_extents_t->x_bearing#} p (cFloatConv x_bearing)
    {#set text_extents_t->y_bearing#} p (cFloatConv y_bearing)
    {#set text_extents_t->width#}     p (cFloatConv width)
    {#set text_extents_t->height#}    p (cFloatConv height)
    {#set text_extents_t->x_advance#} p (cFloatConv x_advance)
    {#set text_extents_t->y_advance#} p (cFloatConv y_advance)
    return ()

{#pointer *font_extents_t as FontExtentsPtr -> FontExtents#}

-- | Result of querying the font extents.
data FontExtents = FontExtents {
    fontExtentsAscent      :: Double
  , fontExtentsDescent     :: Double
  , fontExtentsHeight      :: Double
  , fontExtentsMaxXadvance :: Double
  , fontExtentsMaxYadvance :: Double
  }

instance Storable FontExtents where
  sizeOf _ = {#sizeof font_extents_t#}
  alignment _ = alignment (undefined :: CDouble)
  peek p = do
    ascent        <- {#get font_extents_t->ascent#}        p
    descent       <- {#get font_extents_t->descent#}       p
    height        <- {#get font_extents_t->height#}        p
    max_x_advance <- {#get font_extents_t->max_x_advance#} p
    max_y_advance <- {#get font_extents_t->max_y_advance#} p
    return $ FontExtents (cFloatConv ascent) (cFloatConv descent) (cFloatConv height)
                         (cFloatConv max_x_advance) (cFloatConv max_y_advance)
  poke p (FontExtents ascent descent height max_x_advance max_y_advance) = do
    {#set font_extents_t->ascent#}        p (cFloatConv ascent)
    {#set font_extents_t->descent#}       p (cFloatConv descent)
    {#set font_extents_t->height#}        p (cFloatConv height)
    {#set font_extents_t->max_x_advance#} p (cFloatConv max_x_advance)
    {#set font_extents_t->max_y_advance#} p (cFloatConv max_y_advance)
    return ()

-- | Specify font slant.
{#enum font_slant_t as FontSlant {underscoreToCase}#}

-- | Specify font weight.
{#enum font_weight_t as FontWeight {underscoreToCase}#}

-- | The subpixel order specifies the order of color elements within each pixel
-- on the display device when rendering with an antialiasing mode of
-- 'AntialiasSubpixel'.
--
-- ['SubpixelOrderDefault'] Use the default subpixel order for for the
--                          target device
--
-- ['SubpixelOrderRgb']     Subpixel elements are arranged horizontally
--                          with red at the left
--
-- ['SubpixelOrderBgr']     Subpixel elements are arranged horizontally
--                          with blue at the left
--
-- ['SubpixelOrderVrgb']    Subpixel elements are arranged vertically
--                          with red at the top
--
-- ['SubpixelOrderVbgr']    Subpixel elements are arranged vertically
--                          with blue at the top
--
{#enum subpixel_order_t as SubpixelOrder {underscoreToCase}#}

-- | Specifies the type of hinting to do on font outlines.
--
-- Hinting is the process of fitting outlines to the pixel grid in order to
-- improve the appearance of the result. Since hinting outlines involves
-- distorting them, it also reduces the faithfulness to the original outline
-- shapes. Not all of the outline hinting styles are supported by all font
-- backends.
--
-- ['HintStyleDefault']  Use the default hint style for for font backend and
--                       target device
--
-- ['HintStyleNone']     Do not hint outlines
--
-- ['HintStyleSlight']   Hint outlines slightly to improve contrast while
--                       retaining good fidelity to the original shapes.
--
-- ['HintStyleMedium']   Hint outlines with medium strength giving a compromise
--                       between fidelity to the original shapes and contrast
--
-- ['HintStyleFull']     Hint outlines to maximize contrast
--
{#enum hint_style_t as HintStyle {underscoreToCase}#}

-- | Specifies whether to hint font metrics.
--
-- Hinting font metrics means quantizing them so that they are integer values
-- in device space. Doing this improves the consistency of letter and line
-- spacing, however it also means that text will be laid out differently at
-- different zoom factors.
--
-- ['HintMetricsDefault']  Hint metrics in the default manner for the font
--                         backend and target device
--
-- ['HintMetricsOff']      Do not hint font metrics
--
-- ['HintMetricsOn']       Hint font metrics
--
--
{#enum hint_metrics_t as HintMetrics {underscoreToCase}#}

-- | Specifies how to render text.
{#pointer *font_options_t as FontOptions foreign newtype#}

withFontOptions (FontOptions fptr) = withForeignPtr fptr

mkFontOptions :: Ptr FontOptions -> IO FontOptions
mkFontOptions fontOptionsPtr = do
  fontOptionsForeignPtr <- newForeignPtr fontOptionsDestroy fontOptionsPtr
  return (FontOptions fontOptionsForeignPtr)

foreign import ccall unsafe "&cairo_font_options_destroy"
  fontOptionsDestroy :: FinalizerPtr FontOptions

-- XXX: pathToList :: Path -> [PathData]
--
-- http://cairographics.org/manual/bindings-path.html
--
-- {#enum path_data_type_t as PathDataType {underscoreToCase}#}
--
-- type Point = (Double, Double)
-- data PathData = PathMoveTo Point
--               | PathLineTo Point
--               | PathCurveTo Point Point Point
--               | PathClose

-- | A Cairo path.
--
-- * A path is a sequence of drawing operations that are accumulated until
--   'Graphics.Rendering.Cairo.stroke' is called. Using a path is particularly
--   useful when drawing lines with special join styles and
--   'Graphics.Rendering.Cairo.closePath'.
--
{#pointer *path_t as Path newtype#}
unPath (Path x) = x

{#enum content_t as Content {underscoreToCase}#}

data Format = FormatARGB32
            | FormatRGB24
            | FormatA8
            | FormatA1
            deriving (Enum)

-- | FIXME: We should find out about this.
{#enum extend_t as Extend {underscoreToCase}#}

-- | Specify how filtering is done.
{#enum filter_t as Filter {underscoreToCase}#}

-- Marshalling functions

cIntConv :: (Integral a, Integral b) => a -> b
cIntConv  = fromIntegral

cFloatConv :: (RealFloat a, RealFloat b) => a -> b
cFloatConv  = realToFrac

cFromBool :: Num a => Bool -> a
cFromBool  = fromBool

cToBool :: Num a => a -> Bool
cToBool  = toBool

cToEnum :: (Integral i, Enum e) => i -> e
cToEnum  = toEnum . cIntConv

cFromEnum :: (Enum e, Integral i) => e -> i
cFromEnum  = cIntConv . fromEnum

peekFloatConv :: (Storable a, RealFloat a, RealFloat b) =>  Ptr a -> IO b
peekFloatConv  = liftM cFloatConv . peek

withFloatConv :: (Storable b, RealFloat a, RealFloat b) => a -> (Ptr b -> IO c) -> IO c
withFloatConv  = with . cFloatConv

withArrayFloatConv :: (Storable b, RealFloat a, RealFloat b) => [a] -> (Ptr b -> IO b1) -> IO b1
withArrayFloatConv = withArray . map (cFloatConv)