module NanoVG.Internal.Color where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp
import qualified System.IO.Unsafe as C2HSImp
import Control.Applicative (pure)
import Foreign.C.Types
import Foreign.Marshal.Alloc
import Foreign.Ptr
import Foreign.Marshal.Utils
import Foreign.Storable
type ColorPtr = C2HSImp.Ptr (Color)
data Color = Color !CFloat !CFloat !CFloat !CFloat deriving (Show,Read,Eq,Ord)
instance Storable Color where
sizeOf _ = sizeOf (0 :: CFloat) * 4
alignment _ = alignment (0 :: CFloat)
peek p =
do let p' = castPtr p :: Ptr CFloat
r <- peek p'
g <- peekElemOff p' 1
b <- peekElemOff p' 2
a <- peekElemOff p' 3
pure (Color r g b a)
poke p (Color r g b a) =
do let p' = castPtr p :: Ptr CFloat
poke p' r
pokeElemOff p' 1 g
pokeElemOff p' 2 b
pokeElemOff p' 3 a
rgb :: (CUChar) -> (CUChar) -> (CUChar) -> (Color)
rgb a1 a2 a3 =
C2HSImp.unsafePerformIO $
let {a1' = id a1} in
let {a2' = id a2} in
let {a3' = id a3} in
alloca $ \a4' ->
rgb'_ a1' a2' a3' a4' >>
peek a4'>>= \a4'' ->
return (a4'')
rgbf :: (CFloat) -> (CFloat) -> (CFloat) -> (Color)
rgbf a1 a2 a3 =
C2HSImp.unsafePerformIO $
let {a1' = realToFrac a1} in
let {a2' = realToFrac a2} in
let {a3' = realToFrac a3} in
alloca $ \a4' ->
rgbf'_ a1' a2' a3' a4' >>
peek a4'>>= \a4'' ->
return (a4'')
rgba :: (CUChar) -> (CUChar) -> (CUChar) -> (CUChar) -> (Color)
rgba a1 a2 a3 a4 =
C2HSImp.unsafePerformIO $
let {a1' = id a1} in
let {a2' = id a2} in
let {a3' = id a3} in
let {a4' = id a4} in
alloca $ \a5' ->
rgba'_ a1' a2' a3' a4' a5' >>
peek a5'>>= \a5'' ->
return (a5'')
rgbaf :: (CFloat) -> (CFloat) -> (CFloat) -> (CFloat) -> (Color)
rgbaf a1 a2 a3 a4 =
C2HSImp.unsafePerformIO $
let {a1' = realToFrac a1} in
let {a2' = realToFrac a2} in
let {a3' = realToFrac a3} in
let {a4' = realToFrac a4} in
alloca $ \a5' ->
rgbaf'_ a1' a2' a3' a4' a5' >>
peek a5'>>= \a5'' ->
return (a5'')
lerpRGBA :: (Color) -> (Color) -> (CFloat) -> (Color)
lerpRGBA a1 a2 a3 =
C2HSImp.unsafePerformIO $
with a1 $ \a1' ->
with a2 $ \a2' ->
let {a3' = realToFrac a3} in
alloca $ \a4' ->
lerpRGBA'_ a1' a2' a3' a4' >>
peek a4'>>= \a4'' ->
return (a4'')
transRGBA :: (Color) -> (CUChar) -> (Color)
transRGBA a1 a2 =
C2HSImp.unsafePerformIO $
with a1 $ \a1' ->
let {a2' = id a2} in
alloca $ \a3' ->
transRGBA'_ a1' a2' a3' >>
peek a3'>>= \a3'' ->
return (a3'')
transRGBAf :: (Color) -> (CFloat) -> (Color)
transRGBAf a1 a2 =
C2HSImp.unsafePerformIO $
with a1 $ \a1' ->
let {a2' = realToFrac a2} in
alloca $ \a3' ->
transRGBAf'_ a1' a2' a3' >>
peek a3'>>= \a3'' ->
return (a3'')
hsl :: (CFloat) -> (CFloat) -> (CFloat) -> (Color)
hsl a1 a2 a3 =
C2HSImp.unsafePerformIO $
let {a1' = realToFrac a1} in
let {a2' = realToFrac a2} in
let {a3' = realToFrac a3} in
alloca $ \a4' ->
hsl'_ a1' a2' a3' a4' >>
peek a4'>>= \a4'' ->
return (a4'')
hsla :: (CFloat) -> (CFloat) -> (CFloat) -> (CUChar) -> (Color)
hsla a1 a2 a3 a4 =
C2HSImp.unsafePerformIO $
let {a1' = realToFrac a1} in
let {a2' = realToFrac a2} in
let {a3' = realToFrac a3} in
let {a4' = id a4} in
alloca $ \a5' ->
hsla'_ a1' a2' a3' a4' a5' >>
peek a5'>>= \a5'' ->
return (a5'')
foreign import ccall unsafe "NanoVG/Internal/Color.chs.h nvgRGB_"
rgb'_ :: (C2HSImp.CUChar -> (C2HSImp.CUChar -> (C2HSImp.CUChar -> ((ColorPtr) -> (IO ())))))
foreign import ccall unsafe "NanoVG/Internal/Color.chs.h nvgRGBf_"
rgbf'_ :: (C2HSImp.CFloat -> (C2HSImp.CFloat -> (C2HSImp.CFloat -> ((ColorPtr) -> (IO ())))))
foreign import ccall unsafe "NanoVG/Internal/Color.chs.h nvgRGBA_"
rgba'_ :: (C2HSImp.CUChar -> (C2HSImp.CUChar -> (C2HSImp.CUChar -> (C2HSImp.CUChar -> ((ColorPtr) -> (IO ()))))))
foreign import ccall unsafe "NanoVG/Internal/Color.chs.h nvgRGBAf_"
rgbaf'_ :: (C2HSImp.CFloat -> (C2HSImp.CFloat -> (C2HSImp.CFloat -> (C2HSImp.CFloat -> ((ColorPtr) -> (IO ()))))))
foreign import ccall unsafe "NanoVG/Internal/Color.chs.h nvgLerpRGBA_"
lerpRGBA'_ :: ((ColorPtr) -> ((ColorPtr) -> (C2HSImp.CFloat -> ((ColorPtr) -> (IO ())))))
foreign import ccall unsafe "NanoVG/Internal/Color.chs.h nvgTransRGBA_"
transRGBA'_ :: ((ColorPtr) -> (C2HSImp.CUChar -> ((ColorPtr) -> (IO ()))))
foreign import ccall unsafe "NanoVG/Internal/Color.chs.h nvgTransRGBAf_"
transRGBAf'_ :: ((ColorPtr) -> (C2HSImp.CFloat -> ((ColorPtr) -> (IO ()))))
foreign import ccall unsafe "NanoVG/Internal/Color.chs.h nvgHSL_"
hsl'_ :: (C2HSImp.CFloat -> (C2HSImp.CFloat -> (C2HSImp.CFloat -> ((ColorPtr) -> (IO ())))))
foreign import ccall unsafe "NanoVG/Internal/Color.chs.h nvgHSLA_"
hsla'_ :: (C2HSImp.CFloat -> (C2HSImp.CFloat -> (C2HSImp.CFloat -> (C2HSImp.CUChar -> ((ColorPtr) -> (IO ()))))))