{-# LINE 1 "src/Vision/Image/Storage/DevIL/ImageType.hsc" #-}
-- | Defines image types which can be used with the DevIL API.
{-# LINE 2 "src/Vision/Image/Storage/DevIL/ImageType.hsc" #-}
module Vision.Image.Storage.DevIL.ImageType where

import Data.Word


{-# LINE 7 "src/Vision/Image/Storage/DevIL/ImageType.hsc" #-}

class ImageType t where
    -- | Returns the DevIL constant associated with the image type.
    toIlType :: t -> Word32
{-# LINE 11 "src/Vision/Image/Storage/DevIL/ImageType.hsc" #-}

-- | Tries to determine automatically the image type with the header and/or the
-- file extension.
--
-- Raises an 'UnknownFileType' error if the detection failed.
data Autodetect = Autodetect deriving (Eq, Show)

data BLP = BLP deriving (Eq, Show)

data BMP = BMP deriving (Eq, Show)

data CHEAD = CHEAD deriving (Eq, Show)

data CUT = CUT deriving (Eq, Show)

data DCX = DCX deriving (Eq, Show)

-- | DirectDraw Surface (.dds).
data DDS = DDS deriving (Eq, Show)

data DICOM = DICOM deriving (Eq, Show)

-- | Doom texture.
data Doom = Doom deriving (Eq, Show)

-- | Doom flat texture (floor).
data DoomFlat = DoomFlat deriving (Eq, Show)

data DPX = DPX deriving (Eq, Show)

data EXR = EXR deriving (Eq, Show)

data FITS = FITS deriving (Eq, Show)

data FTX = FTX deriving (Eq, Show)

data GIF = GIF deriving (Eq, Show)

data HDR = HDR deriving (Eq, Show)

data ICO = ICO deriving (Eq, Show)

data ICNS = ICNS deriving (Eq, Show)

data IFF = IFF deriving (Eq, Show)

data IWI = IWI deriving (Eq, Show)

-- | Paint Shop Pro (Jasc) palette.
data JASCPAL = JASCPAL deriving (Eq, Show)

-- | JPEG 2000.
data JP2 = JP2 deriving (Eq, Show)

data JPG = JPG deriving (Eq, Show)

-- | Homeworld (.lif).
data LIF = LIF deriving (Eq, Show)

data MDL = MDL deriving (Eq, Show)

data MNG = MNG deriving (Eq, Show)

data MP3 = MP3 deriving (Eq, Show)

data PCD = PCD deriving (Eq, Show)

data PCX = PCX deriving (Eq, Show)

data PIC = PIC deriving (Eq, Show)

data PIX = PIX deriving (Eq, Show)

data PNG = PNG deriving (Eq, Show)

-- | Portable AnyMap (.pbm, .pgm or .ppm).
data PNM = PNM deriving (Eq, Show)

-- | Photoshop Document.
data PSD = PSD deriving (Eq, Show)

-- | Paint Shop Pro image.
data PSP = PSP deriving (Eq, Show)

data PXR = PXR deriving (Eq, Show)

-- | Raw data with a 13-byte header.
data RAW = RAW deriving (Eq, Show)

data ROT = ROT deriving (Eq, Show)

data SGI = SGI deriving (Eq, Show)

data SUN = SUN deriving (Eq, Show)

-- | Medieval II: Total War Texture (.texture) file.
data Texture = Texture deriving (Eq, Show)

data TGA = TGA deriving (Eq, Show)

data TIFF = TIFF deriving (Eq, Show)

data TPL = TPL deriving (Eq, Show)

data UTX = UTX deriving (Eq, Show)

data VTF = VTF deriving (Eq, Show)

data WAL = WAL deriving (Eq, Show)

data WBMP = WBMP deriving (Eq, Show)

data XPM = XPM deriving (Eq, Show)

-- Instances -------------------------------------------------------------------

instance ImageType Autodetect where
    toIlType Autodetect = (0)
{-# LINE 129 "src/Vision/Image/Storage/DevIL/ImageType.hsc" #-}

instance ImageType BLP where
    toIlType BLP = (1100)
{-# LINE 132 "src/Vision/Image/Storage/DevIL/ImageType.hsc" #-}

instance ImageType BMP where
    toIlType BMP = (1056)
{-# LINE 135 "src/Vision/Image/Storage/DevIL/ImageType.hsc" #-}

instance ImageType CHEAD where
    toIlType CHEAD = (1071)
{-# LINE 138 "src/Vision/Image/Storage/DevIL/ImageType.hsc" #-}

instance ImageType CUT where
    toIlType CUT = (1057)
{-# LINE 141 "src/Vision/Image/Storage/DevIL/ImageType.hsc" #-}

instance ImageType DCX where
    toIlType DCX = (1080)
{-# LINE 144 "src/Vision/Image/Storage/DevIL/ImageType.hsc" #-}

instance ImageType DDS where
    toIlType DDS = (1079)
{-# LINE 147 "src/Vision/Image/Storage/DevIL/ImageType.hsc" #-}

instance ImageType DICOM where
    toIlType DICOM = (1098)
{-# LINE 150 "src/Vision/Image/Storage/DevIL/ImageType.hsc" #-}

instance ImageType Doom where
    toIlType Doom = (1058)
{-# LINE 153 "src/Vision/Image/Storage/DevIL/ImageType.hsc" #-}

instance ImageType DoomFlat where
    toIlType DoomFlat = (1059)
{-# LINE 156 "src/Vision/Image/Storage/DevIL/ImageType.hsc" #-}

instance ImageType DPX where
    toIlType DPX = (1104)
{-# LINE 159 "src/Vision/Image/Storage/DevIL/ImageType.hsc" #-}

instance ImageType EXR where
    toIlType EXR = (1090)
{-# LINE 162 "src/Vision/Image/Storage/DevIL/ImageType.hsc" #-}

instance ImageType FITS where
    toIlType FITS = (1097)
{-# LINE 165 "src/Vision/Image/Storage/DevIL/ImageType.hsc" #-}

instance ImageType FTX where
    toIlType FTX = (1101)
{-# LINE 168 "src/Vision/Image/Storage/DevIL/ImageType.hsc" #-}

instance ImageType GIF where
    toIlType GIF = (1078)
{-# LINE 171 "src/Vision/Image/Storage/DevIL/ImageType.hsc" #-}

instance ImageType HDR where
    toIlType HDR = (1087)
{-# LINE 174 "src/Vision/Image/Storage/DevIL/ImageType.hsc" #-}

instance ImageType ICO where
    toIlType ICO = (1060)
{-# LINE 177 "src/Vision/Image/Storage/DevIL/ImageType.hsc" #-}

instance ImageType ICNS where
    toIlType ICNS = (1088)
{-# LINE 180 "src/Vision/Image/Storage/DevIL/ImageType.hsc" #-}

instance ImageType IFF where
    toIlType IFF = (1095)
{-# LINE 183 "src/Vision/Image/Storage/DevIL/ImageType.hsc" #-}

instance ImageType IWI where
    toIlType IWI = (1099)
{-# LINE 186 "src/Vision/Image/Storage/DevIL/ImageType.hsc" #-}

instance ImageType JASCPAL where
    toIlType JASCPAL = (1141)
{-# LINE 189 "src/Vision/Image/Storage/DevIL/ImageType.hsc" #-}

instance ImageType JP2 where
    toIlType JP2 = (1089)
{-# LINE 192 "src/Vision/Image/Storage/DevIL/ImageType.hsc" #-}

instance ImageType JPG where
    toIlType JPG = (1061)
{-# LINE 195 "src/Vision/Image/Storage/DevIL/ImageType.hsc" #-}

instance ImageType LIF where
    toIlType LIF = (1076)
{-# LINE 198 "src/Vision/Image/Storage/DevIL/ImageType.hsc" #-}

instance ImageType MDL where
    toIlType MDL = (1073)
{-# LINE 201 "src/Vision/Image/Storage/DevIL/ImageType.hsc" #-}

instance ImageType MNG where
    toIlType MNG = (1077)
{-# LINE 204 "src/Vision/Image/Storage/DevIL/ImageType.hsc" #-}

instance ImageType MP3 where
    toIlType MP3 = (1106)
{-# LINE 207 "src/Vision/Image/Storage/DevIL/ImageType.hsc" #-}

instance ImageType PCD where
    toIlType PCD = (1063)
{-# LINE 210 "src/Vision/Image/Storage/DevIL/ImageType.hsc" #-}

instance ImageType PCX where
    toIlType PCX = (1064)
{-# LINE 213 "src/Vision/Image/Storage/DevIL/ImageType.hsc" #-}

instance ImageType PIC where
    toIlType PIC = (1065)
{-# LINE 216 "src/Vision/Image/Storage/DevIL/ImageType.hsc" #-}

instance ImageType PIX where
    toIlType PIX = (1084)
{-# LINE 219 "src/Vision/Image/Storage/DevIL/ImageType.hsc" #-}

instance ImageType PNG where
    toIlType PNG = (1066)
{-# LINE 222 "src/Vision/Image/Storage/DevIL/ImageType.hsc" #-}

instance ImageType PNM where
    toIlType PNM = (1067)
{-# LINE 225 "src/Vision/Image/Storage/DevIL/ImageType.hsc" #-}

instance ImageType PSD where
    toIlType PSD = (1081)
{-# LINE 228 "src/Vision/Image/Storage/DevIL/ImageType.hsc" #-}

instance ImageType PSP where
    toIlType PSP = (1083)
{-# LINE 231 "src/Vision/Image/Storage/DevIL/ImageType.hsc" #-}

instance ImageType PXR where
    toIlType PXR = (1085)
{-# LINE 234 "src/Vision/Image/Storage/DevIL/ImageType.hsc" #-}

instance ImageType RAW where
    toIlType RAW = (1072)
{-# LINE 237 "src/Vision/Image/Storage/DevIL/ImageType.hsc" #-}

instance ImageType ROT where
    toIlType ROT = (1102)
{-# LINE 240 "src/Vision/Image/Storage/DevIL/ImageType.hsc" #-}

instance ImageType SGI where
    toIlType SGI = (1068)
{-# LINE 243 "src/Vision/Image/Storage/DevIL/ImageType.hsc" #-}

instance ImageType SUN where
    toIlType SUN = (1094)
{-# LINE 246 "src/Vision/Image/Storage/DevIL/ImageType.hsc" #-}

instance ImageType Texture where
    toIlType Texture = (1103)
{-# LINE 249 "src/Vision/Image/Storage/DevIL/ImageType.hsc" #-}

instance ImageType TGA where
    toIlType TGA = (1069)
{-# LINE 252 "src/Vision/Image/Storage/DevIL/ImageType.hsc" #-}

instance ImageType TIFF where
    toIlType TIFF = (1070)
{-# LINE 255 "src/Vision/Image/Storage/DevIL/ImageType.hsc" #-}

instance ImageType TPL where
    toIlType TPL = (1096)
{-# LINE 258 "src/Vision/Image/Storage/DevIL/ImageType.hsc" #-}

instance ImageType UTX where
    toIlType UTX = (1105)
{-# LINE 261 "src/Vision/Image/Storage/DevIL/ImageType.hsc" #-}

instance ImageType VTF where
    toIlType VTF = (1092)
{-# LINE 264 "src/Vision/Image/Storage/DevIL/ImageType.hsc" #-}

instance ImageType WAL where
    toIlType WAL = (1074)
{-# LINE 267 "src/Vision/Image/Storage/DevIL/ImageType.hsc" #-}

instance ImageType WBMP where
    toIlType WBMP = (1093)
{-# LINE 270 "src/Vision/Image/Storage/DevIL/ImageType.hsc" #-}

instance ImageType XPM where
    toIlType XPM = (1086)
{-# LINE 273 "src/Vision/Image/Storage/DevIL/ImageType.hsc" #-}