-- GENERATED by C->Haskell Compiler, version 0.28.1 Switcheroo, 1 April 2016 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "src/NanoVG/Internal/Color.chs" #-}
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)
{-# LINE 12 "src/NanoVG/Internal/Color.chs" #-}


-- | rgba
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

-- | Returns a color value from red, green, blue values. Alpha will be set to 255 (1.0f).
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'')

{-# LINE 36 "src/NanoVG/Internal/Color.chs" #-}


-- | Returns a color value from red, green, blue values. Alpha will be set to 1.0f.
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'')

{-# LINE 40 "src/NanoVG/Internal/Color.chs" #-}


-- | Returns a color value from red, green, blue and alpha values.
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'')

{-# LINE 44 "src/NanoVG/Internal/Color.chs" #-}


-- | Returns a color value from red, green, blue and alpha values.
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'')

{-# LINE 48 "src/NanoVG/Internal/Color.chs" #-}


-- | Linearly interpolates from color c0 to c1, and returns resulting color value.
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'')

{-# LINE 52 "src/NanoVG/Internal/Color.chs" #-}


-- | Sets transparency of a color value.
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'')

{-# LINE 56 "src/NanoVG/Internal/Color.chs" #-}


-- | Sets transparency of a color value.
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'')

{-# LINE 60 "src/NanoVG/Internal/Color.chs" #-}


-- | Returns color value specified by hue, saturation and lightness.
-- HSL values are all in range [0..1], alpha will be set to 255.
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'')

{-# LINE 65 "src/NanoVG/Internal/Color.chs" #-}


-- | Returns color value specified by hue, saturation and lightness and alpha.
-- HSL values are all in range [0..1], alpha in range [0..255]
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'')

{-# LINE 70 "src/NanoVG/Internal/Color.chs" #-}



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 ()))))))