{-# LANGUAGE CPP #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -------------------------------------------------------------------- -- | -- Module : Data/Array/Repa/IO/DevIL/Base.hsc -- Copyright : (c) Don Stewart 2011, Luke Palmer 2010. -- -- License : BSD3 -- -- Maintainer: Don Stewart -- Stability : provisional -- -- Raw FFI bindings to DevIL. -- module Image.DevIL.Base ( -- * Types ILImage , ILError , ILUInt, ILSizei, ILBoolean, ILEnum, ILInt, ILUByte, ImageName(..), -- * Functions ilInit, -- * Values il_type_unknown, il_bmp , il_cut , il_doom , il_doom_flat , il_ico , il_jpg , il_jfif , il_ilbm , il_pcd , il_pcx , il_pic , il_png , il_pnm , il_sgi , il_tga , il_tif , il_chead , il_raw , il_mdl , il_wal , il_lif , il_mng , il_jng , il_gif , il_dds , il_dcx , il_psd , il_exif , il_psp , il_pix , il_pxr , il_xpm , il_hdr , il_icns , il_jp2 , il_exr , il_wdp , il_vtf , il_wbmp , il_sun , il_iff , il_tpl , il_fits , il_dicom , il_iwi , il_blp , il_ftx , il_rot , il_texture , il_dpx , il_utx , il_mp3 , il_no_error , il_invalid_enum , il_out_of_memory , il_format_not_supported , il_internal_error , il_invalid_value , il_illegal_operation , il_illegal_file_value , il_invalid_file_header , il_invalid_param , il_could_not_open_file , il_invalid_extension , il_file_already_exists , il_out_format_same , il_stack_overflow , il_stack_underflow , il_invalid_conversion , il_bad_dimensions , il_file_read_error , il_file_write_error , il_lib_gif_error , il_lib_jpeg_error , il_lib_png_error , il_lib_tiff_error , il_lib_mng_error , il_lib_jp2_error , il_lib_exr_error , il_unknown_error ) where import Foreign import Foreign.Ptr import Foreign.C.Types import Foreign.C.String #include "IL/il.h" -- Documentation from: -- -- You must initialize DevIL, or it will most certainly crash. You need to -- initialize each library (il, ilu, and ilut) separately. You do not need -- to initialize libraries you are not using, but keep in mind that the -- higher level libraries are dependent on the lower ones. -- Design: an /unforgeable/ token (ala the mersenne-random package): ------------------------------------------------------------------------ -- Bindings -- Initialization -- | Initialize DevIL. Must be done prior to other calls. ilInit :: IO () ilInit = c_ilInit foreign import ccall "ilInit" c_ilInit :: IO () foreign import ccall "ilOriginFunc" c_ilOriginFunc :: ILenum -> IO ILboolean foreign import ccall "ilEnable" c_ilEnableC :: ILenum -> IO ILboolean -- Names type ILUInt = #type ILuint type ILSizei = #type ILsizei type ILBoolean = #type ILboolean type ILEnum = #type ILenum type ILInt = #type ILint type ILUByte = #type ILubyte -- | Image names are DevIL’s way of keeping track of images it is currently containing. newtype ImageName = ImageName { fromImageName :: ILUInt } ------------------------------------------------------------------------ -- Enumeration types -- | Image types type ILImage = CInt -- Image types #{enum ILImage, , il_type_unknown = IL_TYPE_UNKNOWN , il_bmp = IL_BMP , il_cut = IL_CUT , il_doom = IL_DOOM , il_doom_flat = IL_DOOM_FLAT , il_ico = IL_ICO , il_jpg = IL_JPG , il_jfif = IL_JFIF , il_ilbm = IL_ILBM , il_pcd = IL_PCD , il_pcx = IL_PCX , il_pic = IL_PIC , il_png = IL_PNG , il_pnm = IL_PNM , il_sgi = IL_SGI , il_tga = IL_TGA , il_tif = IL_TIF , il_chead = IL_CHEAD , il_raw = IL_RAW , il_mdl = IL_MDL , il_wal = IL_WAL , il_lif = IL_LIF , il_mng = IL_MNG , il_jng = IL_JNG , il_gif = IL_GIF , il_dds = IL_DDS , il_dcx = IL_DCX , il_psd = IL_PSD , il_exif = IL_EXIF , il_psp = IL_PSP , il_pix = IL_PIX , il_pxr = IL_PXR , il_xpm = IL_XPM , il_hdr = IL_HDR , il_icns = IL_ICNS , il_jp2 = IL_JP2 , il_exr = IL_EXR , il_wdp = IL_WDP , il_vtf = IL_VTF , il_wbmp = IL_WBMP , il_sun = IL_SUN , il_iff = IL_IFF , il_tpl = IL_TPL , il_fits = IL_FITS , il_dicom = IL_DICOM , il_iwi = IL_IWI , il_blp = IL_BLP , il_ftx = IL_FTX , il_rot = IL_ROT , il_texture = IL_TEXTURE , il_dpx = IL_DPX , il_utx = IL_UTX , il_mp3 = IL_MP3 , il_jasc_pal = IL_JASC_PAL } -- | Error Types type ILError = CInt #{enum ILError, , il_no_error = IL_NO_ERROR , il_invalid_enum = IL_INVALID_ENUM , il_out_of_memory = IL_OUT_OF_MEMORY , il_format_not_supported = IL_FORMAT_NOT_SUPPORTED , il_internal_error = IL_INTERNAL_ERROR , il_invalid_value = IL_INVALID_VALUE , il_illegal_operation = IL_ILLEGAL_OPERATION , il_illegal_file_value = IL_ILLEGAL_FILE_VALUE , il_invalid_file_header = IL_INVALID_FILE_HEADER , il_invalid_param = IL_INVALID_PARAM , il_could_not_open_file = IL_COULD_NOT_OPEN_FILE , il_invalid_extension = IL_INVALID_EXTENSION , il_file_already_exists = IL_FILE_ALREADY_EXISTS , il_out_format_same = IL_OUT_FORMAT_SAME , il_stack_overflow = IL_STACK_OVERFLOW , il_stack_underflow = IL_STACK_UNDERFLOW , il_invalid_conversion = IL_INVALID_CONVERSION , il_bad_dimensions = IL_BAD_DIMENSIONS , il_file_read_error = IL_FILE_READ_ERROR , il_file_write_error = IL_FILE_WRITE_ERROR , il_lib_gif_error = IL_LIB_GIF_ERROR , il_lib_jpeg_error = IL_LIB_JPEG_ERROR , il_lib_png_error = IL_LIB_PNG_ERROR , il_lib_tiff_error = IL_LIB_TIFF_ERROR , il_lib_mng_error = IL_LIB_MNG_ERROR , il_lib_jp2_error = IL_LIB_JP2_ERROR , il_lib_exr_error = IL_LIB_EXR_ERROR , il_unknown_error = IL_UNKNOWN_ERROR }