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 NanoVG.Internal.Context
import NanoVG.Internal.FFIHelpers
import NanoVG.Internal.Types
data ImageFlags = ImageGenerateMipmaps
| ImageRepeatx
| ImageRepeaty
| ImageFlipy
| ImagePremultiplied
deriving (Show,Read,Eq,Ord)
instance Enum ImageFlags where
succ ImageGenerateMipmaps = ImageRepeatx
succ ImageRepeatx = ImageRepeaty
succ ImageRepeaty = ImageFlipy
succ ImageFlipy = ImagePremultiplied
succ ImagePremultiplied = error "ImageFlags.succ: ImagePremultiplied has no successor"
pred ImageRepeatx = ImageGenerateMipmaps
pred ImageRepeaty = ImageRepeatx
pred ImageFlipy = ImageRepeaty
pred ImagePremultiplied = ImageFlipy
pred ImageGenerateMipmaps = error "ImageFlags.pred: ImageGenerateMipmaps has no predecessor"
enumFromTo from 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 ImagePremultiplied
fromEnum ImageGenerateMipmaps = 1
fromEnum ImageRepeatx = 2
fromEnum ImageRepeaty = 4
fromEnum ImageFlipy = 8
fromEnum ImagePremultiplied = 16
toEnum 1 = ImageGenerateMipmaps
toEnum 2 = ImageRepeatx
toEnum 4 = ImageRepeaty
toEnum 8 = ImageFlipy
toEnum 16 = ImagePremultiplied
toEnum unmatched = error ("ImageFlags.toEnum: Cannot match " ++ show unmatched)
safeImage :: CInt -> Maybe Image
safeImage i
| i < 0 = Nothing
| otherwise = Just (Image i)
createImage :: (Context) -> (FileName) -> (CInt) -> IO ((Maybe Image))
createImage a1 a2 a3 =
let {a1' = id a1} in
(withCString.unwrapFileName) a2 $ \a2' ->
let {a3' = fromIntegral a3} in
createImage'_ a1' a2' a3' >>= \res ->
let {res' = safeImage res} in
return (res')
createImageMem :: (Context) -> (ImageFlags) -> (ByteString) -> IO ((Maybe Image))
createImageMem a1 a2 a3 =
let {a1' = id a1} in
let {a2' = (fromIntegral . fromEnum) a2} in
useAsCStringLen' a3 $ \(a3'1, a3'2) ->
createImageMem'_ a1' a2' a3'1 a3'2 >>= \res ->
let {res' = safeImage res} in
return (res')
createImageRGBA :: (Context) -> (CInt) -> (CInt) -> (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' = (fromIntegral . fromEnum) a4} in
useAsPtr a5 $ \a5' ->
createImageRGBA'_ a1' a2' a3' a4' a5' >>= \res ->
let {res' = safeImage res} in
return (res')
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 ()
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'')
deleteImage :: (Context) -> (Image) -> IO ()
deleteImage a1 a2 =
let {a1' = id a1} in
let {a2' = imageHandle a2} in
deleteImage'_ a1' a2' >>
return ()
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 ())))