-- GENERATED by C->Haskell Compiler, version 0.28.8 Switcheroo, 25 November 2017 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "src/NanoVG/Internal/Transformation.chs" #-}
{-# LANGUAGE ScopedTypeVariables #-}
module NanoVG.Internal.Transformation 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.Marshal.Utils
import Foreign.Ptr
import Foreign.Storable
import NanoVG.Internal.Context
import NanoVG.Internal.FixedVector




{-# LINE 15 "src/NanoVG/Internal/Transformation.chs" #-}


-- | Affine matrix
--
-- > [sx kx tx]
-- > [ky sy ty]
-- > [ 0  0  1]
newtype Transformation = Transformation (M23 CFloat) deriving (Int -> Transformation -> ShowS
[Transformation] -> ShowS
Transformation -> String
(Int -> Transformation -> ShowS)
-> (Transformation -> String)
-> ([Transformation] -> ShowS)
-> Show Transformation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Transformation] -> ShowS
$cshowList :: [Transformation] -> ShowS
show :: Transformation -> String
$cshow :: Transformation -> String
showsPrec :: Int -> Transformation -> ShowS
$cshowsPrec :: Int -> Transformation -> ShowS
Show,ReadPrec [Transformation]
ReadPrec Transformation
Int -> ReadS Transformation
ReadS [Transformation]
(Int -> ReadS Transformation)
-> ReadS [Transformation]
-> ReadPrec Transformation
-> ReadPrec [Transformation]
-> Read Transformation
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Transformation]
$creadListPrec :: ReadPrec [Transformation]
readPrec :: ReadPrec Transformation
$creadPrec :: ReadPrec Transformation
readList :: ReadS [Transformation]
$creadList :: ReadS [Transformation]
readsPrec :: Int -> ReadS Transformation
$creadsPrec :: Int -> ReadS Transformation
Read,Transformation -> Transformation -> Bool
(Transformation -> Transformation -> Bool)
-> (Transformation -> Transformation -> Bool) -> Eq Transformation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Transformation -> Transformation -> Bool
$c/= :: Transformation -> Transformation -> Bool
== :: Transformation -> Transformation -> Bool
$c== :: Transformation -> Transformation -> Bool
Eq,Eq Transformation
Eq Transformation
-> (Transformation -> Transformation -> Ordering)
-> (Transformation -> Transformation -> Bool)
-> (Transformation -> Transformation -> Bool)
-> (Transformation -> Transformation -> Bool)
-> (Transformation -> Transformation -> Bool)
-> (Transformation -> Transformation -> Transformation)
-> (Transformation -> Transformation -> Transformation)
-> Ord Transformation
Transformation -> Transformation -> Bool
Transformation -> Transformation -> Ordering
Transformation -> Transformation -> Transformation
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Transformation -> Transformation -> Transformation
$cmin :: Transformation -> Transformation -> Transformation
max :: Transformation -> Transformation -> Transformation
$cmax :: Transformation -> Transformation -> Transformation
>= :: Transformation -> Transformation -> Bool
$c>= :: Transformation -> Transformation -> Bool
> :: Transformation -> Transformation -> Bool
$c> :: Transformation -> Transformation -> Bool
<= :: Transformation -> Transformation -> Bool
$c<= :: Transformation -> Transformation -> Bool
< :: Transformation -> Transformation -> Bool
$c< :: Transformation -> Transformation -> Bool
compare :: Transformation -> Transformation -> Ordering
$ccompare :: Transformation -> Transformation -> Ordering
$cp1Ord :: Eq Transformation
Ord)

instance Storable Transformation where
  sizeOf :: Transformation -> Int
sizeOf Transformation
_ = CFloat -> Int
forall a. Storable a => a -> Int
sizeOf (CFloat
0 :: CFloat) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
6
  alignment :: Transformation -> Int
alignment Transformation
_ = CFloat -> Int
forall a. Storable a => a -> Int
alignment (CFloat
0 :: CFloat)
  peek :: Ptr Transformation -> IO Transformation
peek Ptr Transformation
p =
    do let p' :: Ptr CFloat
p' = Ptr Transformation -> Ptr CFloat
forall a b. Ptr a -> Ptr b
castPtr Ptr Transformation
p :: Ptr CFloat
       CFloat
a <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
p'
       CFloat
b <- Ptr CFloat -> Int -> IO CFloat
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr CFloat
p' Int
1
       CFloat
c <- Ptr CFloat -> Int -> IO CFloat
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr CFloat
p' Int
2
       CFloat
d <- Ptr CFloat -> Int -> IO CFloat
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr CFloat
p' Int
3
       CFloat
e <- Ptr CFloat -> Int -> IO CFloat
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr CFloat
p' Int
4
       CFloat
f <- Ptr CFloat -> Int -> IO CFloat
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr CFloat
p' Int
5
       Transformation -> IO Transformation
forall (f :: * -> *) a. Applicative f => a -> f a
pure (M23 CFloat -> Transformation
Transformation
               (V3 CFloat -> V3 CFloat -> M23 CFloat
forall a. a -> a -> V2 a
V2 (CFloat -> CFloat -> CFloat -> V3 CFloat
forall a. a -> a -> a -> V3 a
V3 CFloat
a CFloat
c CFloat
e)
                   (CFloat -> CFloat -> CFloat -> V3 CFloat
forall a. a -> a -> a -> V3 a
V3 CFloat
b CFloat
d CFloat
f)))
  poke :: Ptr Transformation -> Transformation -> IO ()
poke Ptr Transformation
p (Transformation (V2 (V3 CFloat
a CFloat
c CFloat
e) (V3 CFloat
b CFloat
d CFloat
f))) =
    do let p' :: Ptr CFloat
p' = Ptr Transformation -> Ptr CFloat
forall a b. Ptr a -> Ptr b
castPtr Ptr Transformation
p :: Ptr CFloat
       Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CFloat
p' CFloat
a
       Ptr CFloat -> Int -> CFloat -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr CFloat
p' Int
1 CFloat
b
       Ptr CFloat -> Int -> CFloat -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr CFloat
p' Int
2 CFloat
c
       Ptr CFloat -> Int -> CFloat -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr CFloat
p' Int
3 CFloat
d
       Ptr CFloat -> Int -> CFloat -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr CFloat
p' Int
4 CFloat
e
       Ptr CFloat -> Int -> CFloat -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr CFloat
p' Int
5 CFloat
f

-- | Resets current transform to a identity matrix.
resetTransform :: (Context) -> IO ()
resetTransform :: Context -> IO ()
resetTransform Context
a1 =
  let {a1' :: Context
a1' = Context -> Context
forall a. a -> a
id Context
a1} in 
  Context -> IO ()
resetTransform'_ Context
a1' IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
  () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

{-# LINE 49 "src/NanoVG/Internal/Transformation.chs" #-}


-- | Premultiplies current coordinate system by specified matrix.
-- The parameters are interpreted as matrix as follows:
--
-- > [a c e]
-- > [b d f]
-- > [0 0 1]
transform :: (Context) -> (CFloat) -> (CFloat) -> (CFloat) -> (CFloat) -> (CFloat) -> (CFloat) -> IO ()
transform :: Context
-> CFloat
-> CFloat
-> CFloat
-> CFloat
-> CFloat
-> CFloat
-> IO ()
transform Context
a1 CFloat
a2 CFloat
a3 CFloat
a4 CFloat
a5 CFloat
a6 CFloat
a7 =
  let {a1' :: Context
a1' = Context -> Context
forall a. a -> a
id Context
a1} in 
  let {a2' :: CFloat
a2' = CFloat -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
a2} in 
  let {a3' :: CFloat
a3' = CFloat -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
a3} in 
  let {a4' = realToFrac a4} in 
  let {a5' = realToFrac a5} in 
  let {a6' = realToFrac a6} in 
  let {a7' = realToFrac a7} in 
  transform'_ a1' a2' a3' a4' a5' a6' a7' >>
  return ()

{-# LINE 58 "src/NanoVG/Internal/Transformation.chs" #-}


-- | Translates current coordinate system.
translate :: (Context) -> (CFloat) -> (CFloat) -> IO ()
translate a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = realToFrac a2} in 
  let {a3' = realToFrac a3} in 
  translate'_ a1' a2' a3' >>
  return ()

{-# LINE 62 "src/NanoVG/Internal/Transformation.chs" #-}


-- | Rotates current coordinate system. Angle is specified in radians.
rotate :: (Context) -> (CFloat) -> IO ()
rotate a1 a2 =
  let {a1' = id a1} in 
  let {a2' = realToFrac a2} in 
  rotate'_ a1' a2' >>
  return ()

{-# LINE 66 "src/NanoVG/Internal/Transformation.chs" #-}


-- | Skews the current coordinate system along X axis. Angle is specified in radians.
skewX :: (Context) -> (CFloat) -> IO ()
skewX a1 a2 =
  let {a1' = id a1} in 
  let {a2' = realToFrac a2} in 
  skewX'_ a1' a2' >>
  return ()

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


-- | Skews the current coordinate system along Y axis. Angle is specified in radians.
skewY :: (Context) -> (CFloat) -> IO ()
skewY a1 a2 =
  let {a1' = id a1} in 
  let {a2' = realToFrac a2} in 
  skewY'_ a1' a2' >>
  return ()

{-# LINE 74 "src/NanoVG/Internal/Transformation.chs" #-}


-- | Scales the current coordinate system.
scale :: (Context) -> (CFloat) -> (CFloat) -> IO ()
scale a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = realToFrac a2} in 
  let {a3' = realToFrac a3} in 
  scale'_ a1' a2' a3' >>
  return ()

{-# LINE 78 "src/NanoVG/Internal/Transformation.chs" #-}


peekTransformation :: Ptr CFloat -> IO Transformation
peekTransformation = peek . castPtr

allocaTransformation :: (Ptr CFloat -> IO b) -> IO b
allocaTransformation f = alloca (\(p :: Ptr Transformation) -> f (castPtr p))

withTransformation :: Transformation -> (Ptr CFloat -> IO b) -> IO b
withTransformation :: Transformation -> (Ptr CFloat -> IO b) -> IO b
withTransformation Transformation
t Ptr CFloat -> IO b
f = Transformation -> (Ptr Transformation -> IO b) -> IO b
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Transformation
t (\Ptr Transformation
p -> Ptr CFloat -> IO b
f (Ptr Transformation -> Ptr CFloat
forall a b. Ptr a -> Ptr b
castPtr Ptr Transformation
p)) 

-- | Returns the current transformation matrix.
currentTransform :: (Context) -> IO ((Transformation))
currentTransform :: Context -> IO Transformation
currentTransform Context
a1 =
  let {a1' :: Context
a1' = Context -> Context
forall a. a -> a
id Context
a1} in 
  (Ptr CFloat -> IO Transformation) -> IO Transformation
forall b. (Ptr CFloat -> IO b) -> IO b
allocaTransformation ((Ptr CFloat -> IO Transformation) -> IO Transformation)
-> (Ptr CFloat -> IO Transformation) -> IO Transformation
forall a b. (a -> b) -> a -> b
$ \Ptr CFloat
a2' -> 
  Context -> Ptr CFloat -> IO ()
currentTransform'_ Context
a1' Ptr CFloat
a2' IO () -> IO Transformation -> IO Transformation
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
  peekTransformation  a2'>>= \a2'' -> 
  return (a2'')

{-# LINE 91 "src/NanoVG/Internal/Transformation.chs" #-}


-- | Sets the transform to identity matrix.
transformIdentity :: IO ((Transformation))
transformIdentity =
  allocaTransformation $ \a1' -> 
  transformIdentity'_ a1' >>
  peekTransformation  a1'>>= \a1'' -> 
  return (a1'')

{-# LINE 95 "src/NanoVG/Internal/Transformation.chs" #-}


-- | Sets the transform to translation matrix matrix.
transformTranslate :: (CFloat) -> (CFloat) -> IO ((Transformation))
transformTranslate a2 a3 =
  allocaTransformation $ \a1' -> 
  let {a2' = realToFrac a2} in 
  let {a3' = realToFrac a3} in 
  transformTranslate'_ a1' a2' a3' >>
  peekTransformation  a1'>>= \a1'' -> 
  return (a1'')

{-# LINE 99 "src/NanoVG/Internal/Transformation.chs" #-}


-- | Sets the transform to scale matrix.
transformScale :: (CFloat) -> (CFloat) -> IO ((Transformation))
transformScale a2 a3 =
  allocaTransformation $ \a1' -> 
  let {a2' = realToFrac a2} in 
  let {a3' = realToFrac a3} in 
  transformScale'_ a1' a2' a3' >>
  peekTransformation  a1'>>= \a1'' -> 
  return (a1'')

{-# LINE 103 "src/NanoVG/Internal/Transformation.chs" #-}


-- | Sets the transform to rotate matrix. Angle is specified in radians.
transformRotate :: (CFloat) -> IO ((Transformation))
transformRotate a2 =
  allocaTransformation $ \a1' -> 
  let {a2' = realToFrac a2} in 
  transformRotate'_ a1' a2' >>
  peekTransformation  a1'>>= \a1'' -> 
  return (a1'')

{-# LINE 107 "src/NanoVG/Internal/Transformation.chs" #-}


-- | Sets the transform to skew-x matrix. Angle is specified in radians.
transformSkewX :: (CFloat) -> IO ((Transformation))
transformSkewX a2 =
  allocaTransformation $ \a1' -> 
  let {a2' = realToFrac a2} in 
  Ptr CFloat -> CFloat -> IO ()
transformSkewX'_ Ptr CFloat
a1' CFloat
a2' IO () -> IO Transformation -> IO Transformation
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
  Ptr CFloat -> IO Transformation
peekTransformation  Ptr CFloat
a1'IO Transformation
-> (Transformation -> IO Transformation) -> IO Transformation
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a1'' -> 
  return (a1'')

{-# LINE 111 "src/NanoVG/Internal/Transformation.chs" #-}


-- | Sets the transform to skew-y matrix. Angle is specified in radians.
transformSkewY :: (CFloat) -> IO ((Transformation))
transformSkewY a2 =
  allocaTransformation $ \a1' -> 
  let {a2' = realToFrac a2} in 
  transformSkewY'_ a1' a2' >>
  peekTransformation  a1'>>= \a1'' -> 
  return (a1'')

{-# LINE 115 "src/NanoVG/Internal/Transformation.chs" #-}


-- | Sets the transform to the result of multiplication of two transforms, of A = A*B.
transformMultiply :: (Transformation) -> (Transformation) -> IO ((Transformation))
transformMultiply a1 a2 =
  withTransformation a1 $ \a1' -> 
  withTransformation a2 $ \a2' -> 
  transformMultiply'_ a1' a2' >>
  peekTransformation  a1'>>= \a1'' -> 
  return (a1'')

{-# LINE 119 "src/NanoVG/Internal/Transformation.chs" #-}


-- | Sets the transform to the result of multiplication of two transforms, of A = B*A.
transformPremultiply :: (Transformation) -> (Transformation) -> IO ((Transformation))
transformPremultiply a1 a2 =
  withTransformation a1 $ \a1' -> 
  withTransformation a2 $ \a2' -> 
  transformPremultiply'_ a1' a2' >>
  peekTransformation  a1'>>= \a1'' -> 
  return (a1'')

{-# LINE 123 "src/NanoVG/Internal/Transformation.chs" #-}


-- | Sets the destination to inverse of specified transform.
-- Returns 1 if the inverse could be calculated, else 0.
transformInverse :: (Transformation) -> IO ((Transformation))
transformInverse a2 =
  allocaTransformation $ \a1' -> 
  withTransformation a2 $ \a2' -> 
  transformInverse'_ a1' a2' >>
  peekTransformation  a1'>>= \a1'' -> 
  return (a1'')

{-# LINE 128 "src/NanoVG/Internal/Transformation.chs" #-}


-- | Transform a point by given transform.
transformPoint :: (Transformation) -> (CFloat) -> (CFloat) -> ((CFloat), (CFloat))
transformPoint a3 a4 a5 =
  C2HSImp.unsafePerformIO $
  alloca $ \a1' -> 
  alloca $ \a2' -> 
  withTransformation a3 $ \a3' -> 
  let {a4' = realToFrac a4} in 
  let {a5' = realToFrac a5} in 
  transformPoint'_ a1' a2' a3' a4' a5' >>
  peek  a1'>>= \a1'' -> 
  peek  a2'>>= \a2'' -> 
  return (a1'', a2'')

{-# LINE 132 "src/NanoVG/Internal/Transformation.chs" #-}


-- | Converts degrees to radians.
degToRad :: (CFloat) -> (CFloat)
degToRad a1 =
  C2HSImp.unsafePerformIO $
  let {a1' = realToFrac a1} in 
  degToRad'_ a1' >>= \res ->
  let {res' = realToFrac res} in
  return (res')

{-# LINE 136 "src/NanoVG/Internal/Transformation.chs" #-}


-- | Converts radians to degrees.
radToDeg :: (CFloat) -> (CFloat)
radToDeg a1 =
  C2HSImp.unsafePerformIO $
  let {a1' = realToFrac a1} in 
  radToDeg'_ a1' >>= \res ->
  let {res' = realToFrac res} in
  return (res')

{-# LINE 140 "src/NanoVG/Internal/Transformation.chs" #-}


foreign import ccall unsafe "NanoVG/Internal/Transformation.chs.h nvgResetTransform"
  resetTransform'_ :: ((Context) -> (IO ()))

foreign import ccall unsafe "NanoVG/Internal/Transformation.chs.h nvgTransform"
  transform'_ :: ((Context) -> (C2HSImp.CFloat -> (C2HSImp.CFloat -> (C2HSImp.CFloat -> (C2HSImp.CFloat -> (C2HSImp.CFloat -> (C2HSImp.CFloat -> (IO ()))))))))

foreign import ccall unsafe "NanoVG/Internal/Transformation.chs.h nvgTranslate"
  translate'_ :: ((Context) -> (C2HSImp.CFloat -> (C2HSImp.CFloat -> (IO ()))))

foreign import ccall unsafe "NanoVG/Internal/Transformation.chs.h nvgRotate"
  rotate'_ :: ((Context) -> (C2HSImp.CFloat -> (IO ())))

foreign import ccall unsafe "NanoVG/Internal/Transformation.chs.h nvgSkewX"
  skewX'_ :: ((Context) -> (C2HSImp.CFloat -> (IO ())))

foreign import ccall unsafe "NanoVG/Internal/Transformation.chs.h nvgSkewY"
  skewY'_ :: ((Context) -> (C2HSImp.CFloat -> (IO ())))

foreign import ccall unsafe "NanoVG/Internal/Transformation.chs.h nvgScale"
  scale'_ :: ((Context) -> (C2HSImp.CFloat -> (C2HSImp.CFloat -> (IO ()))))

foreign import ccall unsafe "NanoVG/Internal/Transformation.chs.h nvgCurrentTransform"
  currentTransform'_ :: ((Context) -> ((C2HSImp.Ptr C2HSImp.CFloat) -> (IO ())))

foreign import ccall unsafe "NanoVG/Internal/Transformation.chs.h nvgTransformIdentity"
  transformIdentity'_ :: ((C2HSImp.Ptr C2HSImp.CFloat) -> (IO ()))

foreign import ccall unsafe "NanoVG/Internal/Transformation.chs.h nvgTransformTranslate"
  transformTranslate'_ :: ((C2HSImp.Ptr C2HSImp.CFloat) -> (C2HSImp.CFloat -> (C2HSImp.CFloat -> (IO ()))))

foreign import ccall unsafe "NanoVG/Internal/Transformation.chs.h nvgTransformScale"
  transformScale'_ :: ((C2HSImp.Ptr C2HSImp.CFloat) -> (C2HSImp.CFloat -> (C2HSImp.CFloat -> (IO ()))))

foreign import ccall unsafe "NanoVG/Internal/Transformation.chs.h nvgTransformRotate"
  transformRotate'_ :: ((C2HSImp.Ptr C2HSImp.CFloat) -> (C2HSImp.CFloat -> (IO ())))

foreign import ccall unsafe "NanoVG/Internal/Transformation.chs.h nvgTransformSkewX"
  transformSkewX'_ :: ((C2HSImp.Ptr C2HSImp.CFloat) -> (C2HSImp.CFloat -> (IO ())))

foreign import ccall unsafe "NanoVG/Internal/Transformation.chs.h nvgTransformSkewY"
  transformSkewY'_ :: ((C2HSImp.Ptr C2HSImp.CFloat) -> (C2HSImp.CFloat -> (IO ())))

foreign import ccall unsafe "NanoVG/Internal/Transformation.chs.h nvgTransformMultiply"
  transformMultiply'_ :: ((C2HSImp.Ptr C2HSImp.CFloat) -> ((C2HSImp.Ptr C2HSImp.CFloat) -> (IO ())))

foreign import ccall unsafe "NanoVG/Internal/Transformation.chs.h nvgTransformPremultiply"
  transformPremultiply'_ :: ((C2HSImp.Ptr C2HSImp.CFloat) -> ((C2HSImp.Ptr C2HSImp.CFloat) -> (IO ())))

foreign import ccall unsafe "NanoVG/Internal/Transformation.chs.h nvgTransformInverse"
  transformInverse'_ :: ((C2HSImp.Ptr C2HSImp.CFloat) -> ((C2HSImp.Ptr C2HSImp.CFloat) -> (IO C2HSImp.CInt)))

foreign import ccall unsafe "NanoVG/Internal/Transformation.chs.h nvgTransformPoint"
  transformPoint'_ :: ((C2HSImp.Ptr C2HSImp.CFloat) -> ((C2HSImp.Ptr C2HSImp.CFloat) -> ((C2HSImp.Ptr C2HSImp.CFloat) -> (C2HSImp.CFloat -> (C2HSImp.CFloat -> (IO ()))))))

foreign import ccall unsafe "NanoVG/Internal/Transformation.chs.h nvgDegToRad"
  degToRad'_ :: (C2HSImp.CFloat -> (IO C2HSImp.CFloat))

foreign import ccall unsafe "NanoVG/Internal/Transformation.chs.h nvgRadToDeg"
  radToDeg'_ :: (C2HSImp.CFloat -> (IO C2HSImp.CFloat))