sdl2-image-2.1.0.0/example/0000755000000000000000000000000014120463234013414 5ustar0000000000000000sdl2-image-2.1.0.0/src/0000755000000000000000000000000014120100701012533 5ustar0000000000000000sdl2-image-2.1.0.0/src/SDL/0000755000000000000000000000000014120462732013174 5ustar0000000000000000sdl2-image-2.1.0.0/src/SDL/Raw/0000755000000000000000000000000014120462543013725 5ustar0000000000000000sdl2-image-2.1.0.0/src/SDL/Image.hs0000644000000000000000000002106114120462732014552 0ustar0000000000000000{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} -- | -- -- Module : SDL.Image -- Copyright : (c) 2015 Siniša Biđin, 2021 Daniel Firth -- License : MIT -- Maintainer : sinisa@bidin.eu, dan.firth@homotopic.tech -- Stability : experimental -- -- Bindings to the @SDL2_image@ library. These should allow you to load various -- types of images as @SDL@ 'Surface's, as well as detect image formats. -- -- You can safely assume that any monadic function listed here is capable of -- throwing an 'SDLException' in case it encounters an error. module SDL.Image ( -- * Loading images -- -- | Use the following functions to read any @PNG@, @JPG@, @TIF@, @GIF@, -- @WEBP@, @CUR@, @ICO@, @BMP@, @PNM@, @XPM@, @XCF@, @PCX@ and @XV@ formatted -- data. -- -- If you have @TGA@-formatted data, you might wish to use the functions from -- the <#tga following section> instead. load, decode, loadTexture, decodeTexture, -- * Loading TGA images -- -- | #tga# Since @TGA@ images don't contain a specific unique signature, the -- following functions might succeed even when given files not formatted as -- @TGA@ images. -- -- Only use these functions if you're certain the inputs are @TGA@-formatted, -- otherwise they'll throw an exception. loadTGA, decodeTGA, loadTextureTGA, decodeTextureTGA, -- * Format detection formattedAs, format, Format (..), -- * Other initialize, InitFlag (..), version, quit, ) where import Control.Exception (bracket, throwIO) import Control.Monad.IO.Class (MonadIO, liftIO) import Data.Bits ((.|.)) import Data.ByteString (ByteString) import Data.ByteString.Unsafe (unsafeUseAsCStringLen) import Data.List (find) import Data.Text (pack) import Foreign.C.String (withCString) import Foreign.C.Types (CInt) import Foreign.Ptr (Ptr, castPtr) import Foreign.Storable (peek) import GHC.Generics (Generic) import SDL (Renderer, SDLException (..), Surface (..), Texture) import qualified SDL import SDL.Internal.Exception (throwIfNull, throwIf_) import qualified SDL.Raw import SDL.Raw.Filesystem (rwFromConstMem, rwFromFile) import qualified SDL.Raw.Image import SDL.Raw.Types (RWops) import System.IO.Unsafe (unsafePerformIO) -- | Initializes @SDL2_image@ by loading support for the chosen image formats. -- Explicit initialization is optional. -- -- You should call this function if you prefer to load image support yourself, -- at a time when your process isn't as busy. Otherwise, image support will be -- loaded dynamically when you attempt to load a @JPG@, @PNG@, @TIF@ or -- @WEBP@-formatted file. -- -- You may call this function multiple times. initialize :: (Foldable f, MonadIO m) => f InitFlag -> m () initialize flags = do let cint = foldl (\a b -> a .|. flagToCInt b) 0 flags throwIf_ (\result -> cint /= 0 && cint /= result) "SDL.Image.initialize" "IMG_Init" (SDL.Raw.Image.init cint) -- | Flags intended to be fed to 'initialize'. -- -- Each designates early loading of support for a particular image format. data InitFlag = -- | Load support for reading @JPG@ files. InitJPG | -- | Same, but for @PNG@ files. InitPNG | -- | @TIF@ files. InitTIF | -- | @WEBP@ files. InitWEBP deriving stock (Eq, Enum, Ord, Bounded, Generic, Read, Show) flagToCInt :: InitFlag -> CInt flagToCInt = \case InitJPG -> SDL.Raw.Image.IMG_INIT_JPG InitPNG -> SDL.Raw.Image.IMG_INIT_PNG InitTIF -> SDL.Raw.Image.IMG_INIT_TIF InitWEBP -> SDL.Raw.Image.IMG_INIT_WEBP -- | A helper for unmanaged 'Surface's, since it is not exposed by SDL itself. unmanaged :: Ptr SDL.Raw.Surface -> Surface unmanaged p = Surface p Nothing -- | Loads any given file of a supported image type as a 'Surface', including -- @TGA@ if the filename ends with @\".tga\"@. -- -- If you have @TGA@ files that don't have names ending with @\".tga\"@, use -- 'loadTGA' instead. load :: MonadIO m => FilePath -> m Surface load path = fmap unmanaged . throwIfNull "SDL.Image.load" "IMG_Load" . liftIO $ withCString path SDL.Raw.Image.load -- | Same as 'load', but returning a 'Texture' instead. -- -- For @TGA@ files not ending in ".tga", use 'loadTextureTGA' instead. loadTexture :: MonadIO m => Renderer -> FilePath -> m Texture loadTexture r path = liftIO . bracket (load path) SDL.freeSurface $ SDL.createTextureFromSurface r -- | Reads an image from a 'ByteString'. -- -- This will work for all supported image types, __except TGA__. If you need to -- decode a @TGA@ 'ByteString', use 'decodeTGA' instead. decode :: MonadIO m => ByteString -> m Surface decode bytes = liftIO . unsafeUseAsCStringLen bytes $ \(cstr, len) -> do rw <- rwFromConstMem (castPtr cstr) (fromIntegral len) fmap unmanaged . throwIfNull "SDL.Image.decode" "IMG_Load_RW" $ SDL.Raw.Image.load_RW rw 0 -- | Same as 'decode', but returning a 'Texture' instead. -- -- If you need to decode a @TGA@ 'ByteString', use 'decodeTextureTGA' instead. decodeTexture :: MonadIO m => Renderer -> ByteString -> m Texture decodeTexture r bytes = liftIO . bracket (decode bytes) SDL.freeSurface $ SDL.createTextureFromSurface r -- | If your @TGA@ files aren't in a filename ending with @\".tga\"@, you can -- load them using this function. loadTGA :: MonadIO m => FilePath -> m Surface loadTGA path = fmap unmanaged . throwIfNull "SDL.Image.loadTGA" "IMG_LoadTGA_RW" . liftIO $ do rw <- withCString "rb" $ withCString path . flip rwFromFile SDL.Raw.Image.loadTGA_RW rw -- | Same as 'loadTGA', only returning a 'Texture' instead. loadTextureTGA :: MonadIO m => Renderer -> FilePath -> m Texture loadTextureTGA r path = liftIO . bracket (loadTGA path) SDL.freeSurface $ SDL.createTextureFromSurface r -- | Reads a @TGA@ image from a 'ByteString'. -- -- Assumes the input is a @TGA@-formatted image. decodeTGA :: MonadIO m => ByteString -> m Surface decodeTGA bytes = liftIO . unsafeUseAsCStringLen bytes $ \(cstr, len) -> do rw <- rwFromConstMem (castPtr cstr) (fromIntegral len) fmap unmanaged . throwIfNull "SDL.Image.decodeTGA" "IMG_LoadTGA_RW" $ SDL.Raw.Image.loadTGA_RW rw -- | Same as 'decodeTGA', but returns a 'Texture' instead. decodeTextureTGA :: MonadIO m => Renderer -> ByteString -> m Texture decodeTextureTGA r bytes = liftIO . bracket (decodeTGA bytes) SDL.freeSurface $ SDL.createTextureFromSurface r -- | Tests whether a 'ByteString' contains an image of a given format. formattedAs :: Format -> ByteString -> Bool formattedAs f bytes = unsafePerformIO . unsafeUseAsCStringLen bytes $ \(cstr, len) -> do rw <- rwFromConstMem (castPtr cstr) (fromIntegral len) formatPredicate f rw >>= \case 1 -> return True 0 -> return False e -> do let err = "Expected 1 or 0, got " `mappend` pack (show e) `mappend` "." let fun = "IMG_is" `mappend` pack (show f) throwIO $ SDLCallFailed "SDL.Image.formattedAs" fun err -- | Tries to detect the image format by attempting 'formattedAs' with each -- possible 'Format'. -- -- If you're trying to test for a specific format, use a specific 'formattedAs' -- directly instead. format :: ByteString -> Maybe Format format bytes = fst <$> find snd attempts where attempts = map (\f -> (f, formattedAs f bytes)) [minBound ..] -- | Each of the supported image formats. data Format = CUR | ICO | BMP | PNM | XPM | XCF | PCX | GIF | LBM | XV | JPG | PNG | TIF | WEBP deriving stock (Eq, Enum, Ord, Bounded, Generic, Read, Show) -- Given an image format, return its raw predicate function. formatPredicate :: MonadIO m => Format -> Ptr RWops -> m CInt formatPredicate = \case CUR -> SDL.Raw.Image.isCUR ICO -> SDL.Raw.Image.isICO BMP -> SDL.Raw.Image.isBMP PNM -> SDL.Raw.Image.isPNM XPM -> SDL.Raw.Image.isXPM XCF -> SDL.Raw.Image.isXCF PCX -> SDL.Raw.Image.isPCX GIF -> SDL.Raw.Image.isGIF LBM -> SDL.Raw.Image.isLBM XV -> SDL.Raw.Image.isXV JPG -> SDL.Raw.Image.isJPG PNG -> SDL.Raw.Image.isPNG TIF -> SDL.Raw.Image.isTIF WEBP -> SDL.Raw.Image.isWEBP -- | Gets the major, minor, patch versions of the linked @SDL2_image@ library. version :: (Integral a, MonadIO m) => m (a, a, a) version = liftIO $ do SDL.Raw.Version major minor patch <- peek =<< SDL.Raw.Image.getVersion return (fromIntegral major, fromIntegral minor, fromIntegral patch) -- | Cleans up any loaded image libraries, freeing memory. You only need to -- call this function once. quit :: MonadIO m => m () quit = SDL.Raw.Image.quit sdl2-image-2.1.0.0/src/SDL/Raw/Helper.hs0000644000000000000000000000626314120462046015505 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE TemplateHaskell #-} -- | -- -- Module : SDL.Raw.Helper -- Copyright : (c) 2015 Siniša Biđin, 2021 Daniel Firth -- License : MIT -- Maintainer : sinisa@bidin.eu, dan.firth@homotopic.tech -- Stability : experimental -- -- Exposes a way to automatically generate a foreign import alongside its lifted, -- inlined MonadIO variant. Use this to simplify the package's SDL.Raw.* modules. module SDL.Raw.Helper (liftF) where import Control.Monad (replicateM) import Control.Monad.IO.Class (MonadIO, liftIO) import Language.Haskell.TH ( Body (NormalB), Callconv (CCall), Clause (Clause), Dec (ForeignD, FunD, PragmaD, SigD), Exp (AppE, VarE), Foreign (ImportF), Inline (Inline), Name, Pat (VarP), Phases (AllPhases), Pragma (InlineP), Q, RuleMatch (FunLike), Safety (Safe), TyVarBndr (PlainTV), Type (AppT, ArrowT, ConT, ForallT, SigT, VarT), mkName, newName, #if MIN_VERSION_template_haskell(2,17,0) Specificity(SpecifiedSpec) #endif ) -- | Given a name @fname@, a name of a C function @cname@ and the desired -- Haskell type @ftype@, this function generates: -- -- * A foreign import of @cname@, named as @fname'@. -- * An always-inline MonadIO version of @fname'@, named @fname@. liftF :: String -> String -> Q Type -> Q [Dec] liftF fname cname ftype = do let f' = mkName $ fname ++ "'" -- Direct binding. let f = mkName fname -- Lifted. t' <- ftype -- Type of direct binding. -- The generated function accepts n arguments. args <- replicateM (countArgs t') $ newName "x" -- If the function has no arguments, then we just liftIO it directly. -- However, this fails to typecheck without an explicit type signature. -- Therefore, we include one. TODO: Can we get rid of this? sigd <- case args of [] -> ((: []) . SigD f) `fmap` liftType t' _ -> return [] return $ concat [ [ ForeignD $ ImportF CCall Safe cname f' t', PragmaD $ InlineP f Inline FunLike AllPhases ], sigd, [ FunD f [ Clause (map VarP args) (NormalB $ 'liftIO `applyTo` [f' `applyTo` map VarE args]) [] ] ] ] -- | How many arguments does a function of a given type take? countArgs :: Type -> Int countArgs = count 0 where count :: Num p => p -> Type -> p count !n = \case (AppT (AppT ArrowT _) t) -> count (n + 1) t (ForallT _ _ t) -> count n t (SigT t _) -> count n t _ -> n -- | An expression where f is applied to n arguments. applyTo :: Name -> [Exp] -> Exp applyTo f [] = VarE f applyTo f es = loop (tail es) . AppE (VarE f) $ head es where loop :: Foldable t => t Exp -> Exp -> Exp loop as e = foldl AppE e as -- | Fuzzily speaking, converts a given IO type into a MonadIO m one. liftType :: Type -> Q Type liftType = \case AppT _ t -> do m <- newName "m" return $ ForallT #if MIN_VERSION_template_haskell(2,17,0) [PlainTV m SpecifiedSpec] #else [PlainTV m] #endif [AppT (ConT ''MonadIO) $ VarT m] (AppT (VarT m) t) t -> return t sdl2-image-2.1.0.0/src/SDL/Raw/Image.hsc0000644000000000000000000001031114120462543015442 0ustar0000000000000000{-| Module : SDL.Raw.Image Copyright : (c) 2015 Siniša Biđin, 2021 Daniel Firth License : MIT Maintainer : sinisa@bidin.eu, dan.firth@homotopic.tech Stability : experimental Raw bindings to the @SDL2_image@ library. No error-handling is done here. For more information about specific function behaviour, see the @SDL2_image@ documentation. -} {-# OPTIONS_GHC -fno-warn-missing-signatures #-} {-# OPTIONS_GHC -fno-warn-missing-exported-signatures #-} {-# OPTIONS_GHC -fno-warn-missing-import-lists #-} {-# OPTIONS_GHC -fno-warn-missing-local-signatures #-} {-# OPTIONS_GHC -fno-warn-missing-pattern-synonym-signatures #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE TemplateHaskell #-} module SDL.Raw.Image ( -- * Loading images Free , load , load_RW , Format , loadTyped_RW , loadCUR_RW , loadICO_RW , loadBMP_RW , loadPNM_RW , loadXPM_RW , loadXCF_RW , loadPCX_RW , loadGIF_RW , loadJPG_RW , loadTIF_RW , loadPNG_RW , loadTGA_RW , loadLBM_RW , loadXV_RW , loadWEBP_RW -- * Testing for formats , isCUR , isICO , isBMP , isPNM , isXPM , isXCF , isPCX , isGIF , isJPG , isTIF , isPNG , isLBM , isXV , isWEBP -- * Other , InitFlags , pattern IMG_INIT_JPG , pattern IMG_INIT_PNG , pattern IMG_INIT_TIF , pattern IMG_INIT_WEBP , init , getVersion , quit ) where #include "SDL_image.h" import Foreign.C.String (CString) import Foreign.C.Types (CInt(..)) import Foreign.Ptr (Ptr) import Prelude hiding (init) import SDL.Raw.Types (Version, Surface, RWops) import SDL.Raw.Helper (liftF) liftF "getVersion" "IMG_Linked_Version" [t|IO (Ptr Version)|] type InitFlags = CInt pattern IMG_INIT_JPG = #{const IMG_INIT_JPG} pattern IMG_INIT_PNG = #{const IMG_INIT_PNG} pattern IMG_INIT_TIF = #{const IMG_INIT_TIF} pattern IMG_INIT_WEBP = #{const IMG_INIT_WEBP} liftF "init" "IMG_Init" [t|InitFlags -> IO InitFlags|] liftF "quit" "IMG_Quit" [t|IO ()|] liftF "load" "IMG_Load" [t|CString -> IO (Ptr Surface)|] -- | Should the 'Ptr' 'RWops' be freed after an operation? 1 for yes, 0 for no. type Free = CInt liftF "load_RW" "IMG_Load_RW" [t|Ptr RWops -> Free -> IO (Ptr Surface)|] -- | A case-insensitive desired format, e.g. @\"jpg\"@ or @\"PNG\"@. type Format = CString liftF "loadTyped_RW" "IMG_LoadTyped_RW" [t|Ptr RWops -> Free -> Format -> IO (Ptr Surface)|] liftF "loadCUR_RW" "IMG_LoadCUR_RW" [t|Ptr RWops -> IO (Ptr Surface)|] liftF "loadICO_RW" "IMG_LoadICO_RW" [t|Ptr RWops -> IO (Ptr Surface)|] liftF "loadBMP_RW" "IMG_LoadBMP_RW" [t|Ptr RWops -> IO (Ptr Surface)|] liftF "loadPNM_RW" "IMG_LoadPNM_RW" [t|Ptr RWops -> IO (Ptr Surface)|] liftF "loadXPM_RW" "IMG_LoadXPM_RW" [t|Ptr RWops -> IO (Ptr Surface)|] liftF "loadXCF_RW" "IMG_LoadXCF_RW" [t|Ptr RWops -> IO (Ptr Surface)|] liftF "loadPCX_RW" "IMG_LoadPCX_RW" [t|Ptr RWops -> IO (Ptr Surface)|] liftF "loadGIF_RW" "IMG_LoadGIF_RW" [t|Ptr RWops -> IO (Ptr Surface)|] liftF "loadJPG_RW" "IMG_LoadJPG_RW" [t|Ptr RWops -> IO (Ptr Surface)|] liftF "loadTIF_RW" "IMG_LoadTIF_RW" [t|Ptr RWops -> IO (Ptr Surface)|] liftF "loadPNG_RW" "IMG_LoadPNG_RW" [t|Ptr RWops -> IO (Ptr Surface)|] liftF "loadTGA_RW" "IMG_LoadTGA_RW" [t|Ptr RWops -> IO (Ptr Surface)|] liftF "loadLBM_RW" "IMG_LoadLBM_RW" [t|Ptr RWops -> IO (Ptr Surface)|] liftF "loadXV_RW" "IMG_LoadXV_RW" [t|Ptr RWops -> IO (Ptr Surface)|] liftF "loadWEBP_RW" "IMG_LoadWEBP_RW" [t|Ptr RWops -> IO (Ptr Surface)|] liftF "isCUR" "IMG_isCUR" [t|Ptr RWops -> IO CInt|] liftF "isICO" "IMG_isICO" [t|Ptr RWops -> IO CInt|] liftF "isBMP" "IMG_isBMP" [t|Ptr RWops -> IO CInt|] liftF "isPNM" "IMG_isPNM" [t|Ptr RWops -> IO CInt|] liftF "isXPM" "IMG_isXPM" [t|Ptr RWops -> IO CInt|] liftF "isXCF" "IMG_isXCF" [t|Ptr RWops -> IO CInt|] liftF "isPCX" "IMG_isPCX" [t|Ptr RWops -> IO CInt|] liftF "isGIF" "IMG_isGIF" [t|Ptr RWops -> IO CInt|] liftF "isJPG" "IMG_isJPG" [t|Ptr RWops -> IO CInt|] liftF "isTIF" "IMG_isTIF" [t|Ptr RWops -> IO CInt|] liftF "isPNG" "IMG_isPNG" [t|Ptr RWops -> IO CInt|] liftF "isLBM" "IMG_isLBM" [t|Ptr RWops -> IO CInt|] liftF "isXV" "IMG_isXV" [t|Ptr RWops -> IO CInt|] liftF "isWEBP" "IMG_isWEBP" [t|Ptr RWops -> IO CInt|] sdl2-image-2.1.0.0/example/Main.hs0000644000000000000000000000303314120463234014633 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} import Control.Concurrent (threadDelay) import Control.Monad (forM_) import Data.Text (Text) import Data.Text.IO (putStrLn) import qualified SDL import qualified SDL.Image import System.Environment (getArgs) import System.Exit (exitFailure) import Prelude hiding (putStrLn) -- A sequence of example actions to be perfomed and displayed. examples :: [(Text, SDL.Window -> FilePath -> IO ())] examples = [ ( "Loading as surface, blitting", \window path -> do image <- SDL.Image.load path screen <- SDL.getWindowSurface window _ <- SDL.surfaceBlit image Nothing screen Nothing SDL.updateWindowSurface window SDL.freeSurface image ), ( "Loading as texture, rendering", \window path -> do r <- SDL.createRenderer window (-1) SDL.defaultRenderer texture <- SDL.Image.loadTexture r path SDL.clear r SDL.copy r texture Nothing Nothing SDL.present r SDL.destroyTexture texture ) ] main :: IO () main = do SDL.initialize [SDL.InitVideo] getArgs >>= \case [] -> do putStrLn "Usage: cabal run path/to/image.(png|jpg|...)" exitFailure (path : _) -> -- Run each of the examples within a newly-created window. forM_ examples $ \(name, action) -> do putStrLn name window <- SDL.createWindow name SDL.defaultWindow SDL.showWindow window action window path threadDelay 1000000 SDL.destroyWindow window SDL.quit sdl2-image-2.1.0.0/README.md0000644000000000000000000000130014120463164013234 0ustar0000000000000000# sdl2-image [![Hackage](https://img.shields.io/hackage/v/sdl2-image.svg)](https://hackage.haskell.org/package/sdl2-image) [![GitLab](https://gitlab.homotopic.tech/haskell/sdl2-image/badges/master/pipeline.svg)](https://gitlab.homotopic.tech/haskell/sdl2-image) Haskell bindings to SDL2_image. Provides both raw and high level bindings. The [original SDL2_image documentation](http://www.libsdl.org/projects/SDL_image/docs/SDL_image.html) can also help, as the bindings are close to a direct mapping. ##### Example A small example executable is included with the library. It loads and displays a given image. You can find it in the `example` directory. ```bash stack exec -- sdl2-image-example ``` sdl2-image-2.1.0.0/ChangeLog.md0000644000000000000000000000010414120463357014133 0ustar0000000000000000# Changelog for sdl2-image ## v2.1.0.0 * Compatibility with GHC-9 sdl2-image-2.1.0.0/LICENSE0000644000000000000000000000206514120463703012772 0ustar0000000000000000Copyright (c) 2015 Siniša Biđin, 2021 Daniel Firth Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. sdl2-image-2.1.0.0/sdl2-image.cabal0000644000000000000000000000406214120463204014670 0ustar0000000000000000cabal-version: 1.12 -- This file has been generated from package.yaml by hpack version 0.34.4. -- -- see: https://github.com/sol/hpack name: sdl2-image version: 2.1.0.0 synopsis: Haskell bindings to SDL2_image category: Graphics, Foreign, Image bug-reports: https://gitlab.homotopic.tech/haskell/sdl2-image/issues author: Cai Lei, Siniša Biđin, Daniel Firth maintainer: Siniša Biđin , Daniel Firth copyright: 2014 Cal Lei, 2015 Siniša Biđin, 2021 Daniel Firth license: MIT license-file: LICENSE build-type: Simple extra-source-files: README.md ChangeLog.md source-repository head type: git location: https://gitlab.homotopic.tech/haskell/sdl2-image library exposed-modules: SDL.Image SDL.Raw.Helper SDL.Raw.Image other-modules: Paths_sdl2_image hs-source-dirs: src ghc-options: -Weverything -Wno-all-missed-specialisations -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-prepositive-qualified-module -Wno-missing-import-lists -Wno-safe -Wno-unsafe extra-libraries: SDL2_image pkgconfig-depends: sdl2 >= 2.0.3 , SDL2_image >= 1.0.1 build-depends: base >=4.9 && <5 , bytestring >=0.10.4.0 , sdl2 >=2.0.0 , template-haskell >=2.10 , text >=1.1.0.0 default-language: Haskell2010 autogen-modules: Paths_sdl2_image executable sdl2-image-example main-is: Main.hs other-modules: Paths_sdl2_image hs-source-dirs: example ghc-options: -Weverything -Wno-all-missed-specialisations -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-prepositive-qualified-module -Wno-missing-import-lists -Wno-safe -Wno-unsafe -threaded -rtsopts -with-rtsopts=-N extra-libraries: SDL2_image pkgconfig-depends: sdl2 >= 2.0.3 , SDL2_image >= 1.0.1 build-depends: base >=4.9 && <5 , sdl2 >=2.0.0 , sdl2-image , text >=1.1.0.0 default-language: Haskell2010