{-# LINE 1 "src/NanoVG/Internal/Image.chs" #-}
module NanoVG.Internal.Image where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp
import Foreign.C.Types
import Data.ByteString hiding (null)
import Foreign.Marshal.Alloc
import Foreign.Storable
import qualified Data.Set as S
import NanoVG.Internal.Context
import NanoVG.Internal.FFIHelpers
import NanoVG.Internal.Types
{-# LINE 16 "src/NanoVG/Internal/Image.chs" #-}
data ImageFlags = ImageGenerateMipmaps
| ImageRepeatx
| ImageRepeaty
| ImageFlipy
| ImagePremultiplied
| ImageNearest
deriving (Show,Read,Eq,Ord)
instance Enum ImageFlags where
succ :: ImageFlags -> ImageFlags
succ ImageFlags
ImageGenerateMipmaps = ImageFlags
ImageRepeatx
succ ImageFlags
ImageRepeatx = ImageFlags
ImageRepeaty
succ ImageRepeaty = ImageFlipy
succ ImageFlags
ImageFlipy = ImageFlags
ImagePremultiplied
succ ImageFlags
ImagePremultiplied = ImageFlags
ImageNearest
succ ImageNearest = error String
"ImageFlags.succ: ImageNearest has no successor"
pred ImageRepeatx = ImageGenerateMipmaps
pred ImageRepeaty = ImageRepeatx
pred ImageFlipy = ImageRepeaty
pred ImagePremultiplied = ImageFlipy
pred ImageNearest = ImagePremultiplied
pred ImageGenerateMipmaps = error "ImageFlags.pred: ImageGenerateMipmaps has no predecessor"
enumFromTo :: ImageFlags -> ImageFlags -> [ImageFlags]
enumFromTo ImageFlags
from ImageFlags
to = go from
where
end = fromEnum to
go v = case compare (fromEnum v) end of
LT -> v : go (succ v)
EQ -> [v]
GT -> []
enumFrom from = enumFromTo from ImageNearest
fromEnum ImageGenerateMipmaps = 1
fromEnum ImageRepeatx = 2
fromEnum ImageRepeaty = 4
fromEnum ImageFlipy = 8
fromEnum ImagePremultiplied = 16
fromEnum ImageNearest = 32
toEnum :: Int -> ImageFlags
toEnum Int
1 = ImageFlags
ImageGenerateMipmaps
toEnum Int
2 = ImageFlags
ImageRepeatx
toEnum Int
4 = ImageFlags
ImageRepeaty
toEnum Int
8 = ImageFlags
ImageFlipy
toEnum Int
16 = ImageFlags
ImagePremultiplied
toEnum Int
32 = ImageFlags
ImageNearest
toEnum Int
unmatched = String -> ImageFlags
forall a. HasCallStack => String -> a
error (String
"ImageFlags.toEnum: Cannot match " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
unmatched)
{-# LINE 20 "src/NanoVG/Internal/Image.chs" #-}
safeImage :: CInt -> Maybe Image
safeImage i
| i < 0 = Nothing
| otherwise = Just (Image i)
createImage :: (Context) -> (FileName) -> (S.Set ImageFlags) -> IO ((Maybe Image))
createImage a1 a2 a3 =
let {a1' = id a1} in
(withCString.unwrapFileName) a2 $ \a2' ->
let {a3' = bitMask a3} in
createImage'_ a1' a2' a3' >>= \res ->
let {res' = safeImage res} in
return (res')
{-# LINE 29 "src/NanoVG/Internal/Image.chs" #-}
createImageMem :: (Context) -> (S.Set ImageFlags) -> (ByteString) -> IO ((Maybe Image))
createImageMem a1 a2 a3 =
let {a1' = id a1} in
let {a2' = bitMask a2} in
useAsCStringLen' a3 $ \(a3'1, a3'2) ->
createImageMem'_ a1' a2' a3'1 a3'2 >>= \res ->
let {res' = safeImage res} in
return (res')
{-# LINE 33 "src/NanoVG/Internal/Image.chs" #-}
createImageRGBA :: (Context) -> (CInt) -> (CInt) -> (S.Set ImageFlags) -> (ByteString) -> IO ((Maybe Image))
createImageRGBA a1 a2 a3 a4 a5 =
let {a1' = id a1} in
let {a2' = fromIntegral a2} in
let {a3' = fromIntegral a3} in
let {a4' = bitMask a4} in
useAsPtr a5 $ \a5' ->
createImageRGBA'_ a1' a2' a3' a4' a5' >>= \res ->
let {res' = safeImage res} in
return (res')
{-# LINE 37 "src/NanoVG/Internal/Image.chs" #-}
updateImage :: (Context) -> (Image) -> (ByteString) -> IO ()
updateImage a1 a2 a3 =
let {a1' = id a1} in
let {a2' = imageHandle a2} in
useAsPtr a3 $ \a3' ->
updateImage'_ a1' a2' a3' >>
return ()
{-# LINE 41 "src/NanoVG/Internal/Image.chs" #-}
imageSize :: (Context) -> (Image) -> IO ((CInt), (CInt))
imageSize a1 a2 =
let {a1' = id a1} in
let {a2' = imageHandle a2} in
alloca $ \a3' ->
alloca $ \a4' ->
imageSize'_ a1' a2' a3' a4' >>
peek a3'>>= \a3'' ->
peek a4'>>= \a4'' ->
return (a3'', a4'')
{-# LINE 45 "src/NanoVG/Internal/Image.chs" #-}
deleteImage :: (Context) -> (Image) -> IO ()
deleteImage a1 a2 =
let {a1' = id a1} in
let {a2' = imageHandle a2} in
deleteImage'_ a1' a2' >>
return ()
{-# LINE 49 "src/NanoVG/Internal/Image.chs" #-}
foreign import ccall unsafe "NanoVG/Internal/Image.chs.h nvgCreateImage"
createImage'_ :: ((Context) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))
foreign import ccall unsafe "NanoVG/Internal/Image.chs.h nvgCreateImageMem"
createImageMem'_ :: ((Context) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CUChar) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))))
foreign import ccall unsafe "NanoVG/Internal/Image.chs.h nvgCreateImageRGBA"
createImageRGBA'_ :: ((Context) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CUChar) -> (IO C2HSImp.CInt))))))
foreign import ccall unsafe "NanoVG/Internal/Image.chs.h nvgUpdateImage"
updateImage'_ :: ((Context) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CUChar) -> (IO ()))))
foreign import ccall unsafe "NanoVG/Internal/Image.chs.h nvgImageSize"
imageSize'_ :: ((Context) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO ())))))
foreign import ccall unsafe "NanoVG/Internal/Image.chs.h nvgDeleteImage"
deleteImage'_ :: ((Context) -> (C2HSImp.CInt -> (IO ())))