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


{-# LINE 1 "./GI/Cairo/Render/Matrix.chs" #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  GI.Cairo.Render.Matrix
-- Copyright   :  (c) Paolo Martini 2005
-- License     :  BSD-style (see cairo/COPYRIGHT)
--
-- Maintainer  :  p.martini@neuralnoise.com
-- Stability   :  experimental
-- Portability :  portable
--
-- Matrix math
-----------------------------------------------------------------------------



module GI.Cairo.Render.Matrix (
    Matrix(Matrix)
  , MatrixPtr
  , identity
  , translate
  , scale
  , rotate
  , transformDistance
  , transformPoint
  , scalarMultiply
  , adjoint
  , invert
  ) where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp
import qualified Foreign.Storable as C2HSImp



import Foreign hiding (rotate)
import Foreign.C

-- | Representation of a 2-D affine transformation.
--
--  The Matrix type represents a 2x2 transformation matrix along with a
--  translation vector. @Matrix a1 a2 b1 b2 c1 c2@ describes the
--  transformation of a point with coordinates x,y that is defined by
--
--  >   / x' \  =  / a1 b1 \  / x \  + / c1 \
--  >   \ y' /     \ a2 b2 /  \ y /    \ c2 /
--
--  or
--
--  >   x' =  a1 * x + b1 * y + c1
--  >   y' =  a2 * x + b2 * y + c2

data Matrix = Matrix { Matrix -> Double
xx :: !Double, Matrix -> Double
yx :: !Double,
                       Matrix -> Double
xy :: !Double, Matrix -> Double
yy :: !Double,
                       x0 :: !Double, Matrix -> Double
y0 :: !Double }
  deriving (Show, Matrix -> Matrix -> Bool
(Matrix -> Matrix -> Bool)
-> (Matrix -> Matrix -> Bool) -> Eq Matrix
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Matrix -> Matrix -> Bool
== :: Matrix -> Matrix -> Bool
$c/= :: Matrix -> Matrix -> Bool
/= :: Matrix -> Matrix -> Bool
Eq)

type MatrixPtr = C2HSImp.Ptr (Matrix)
{-# LINE 52 "./GI/Cairo/Render/Matrix.chs" #-}


instance Storable Matrix where
  sizeOf _ = 48
{-# LINE 55 "./GI/Cairo/Render/Matrix.chs" #-}

  alignment _ = alignment (undefined :: CDouble)
  peek p = do
    xx <- (\ptr -> do {C2HSImp.peekByteOff ptr 0 :: IO C2HSImp.CDouble}) p
    yx <- (\ptr -> do {C2HSImp.peekByteOff ptr 8 :: IO C2HSImp.CDouble}) p
    xy <- (\ptr -> do {C2HSImp.peekByteOff ptr 16 :: IO C2HSImp.CDouble}) p
    yy <- (\ptr -> do {C2HSImp.peekByteOff ptr 24 :: IO C2HSImp.CDouble}) p
    x0 <- (\ptr -> do {C2HSImp.peekByteOff ptr 32 :: IO C2HSImp.CDouble}) p
    y0 <- (\ptr -> do {C2HSImp.peekByteOff ptr 40 :: IO C2HSImp.CDouble}) p
    return $ Matrix (realToFrac xx) (realToFrac yx)
                    (realToFrac xy) (realToFrac yy)
                    (realToFrac x0) (realToFrac y0)

  poke :: Ptr Matrix -> Matrix -> IO ()
poke Ptr Matrix
p (Matrix Double
xx Double
yx Double
xy Double
yy Double
x0 Double
y0) = do
    (\Ptr Matrix
ptr CDouble
val -> do {Ptr Matrix -> Int -> CDouble -> IO ()
forall b. Ptr b -> Int -> CDouble -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
C2HSImp.pokeByteOff Ptr Matrix
ptr Int
0 (CDouble
val :: C2HSImp.CDouble)}) Ptr Matrix
p (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
xx)
    (\Ptr Matrix
ptr CDouble
val -> do {Ptr Matrix -> Int -> CDouble -> IO ()
forall b. Ptr b -> Int -> CDouble -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
C2HSImp.pokeByteOff Ptr Matrix
ptr Int
8 (CDouble
val :: C2HSImp.CDouble)}) Ptr Matrix
p (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
yx)
    (\Ptr Matrix
ptr CDouble
val -> do {Ptr Matrix -> Int -> CDouble -> IO ()
forall b. Ptr b -> Int -> CDouble -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
C2HSImp.pokeByteOff Ptr Matrix
ptr Int
16 (CDouble
val :: C2HSImp.CDouble)}) Ptr Matrix
p (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
xy)
    (\Ptr Matrix
ptr CDouble
val -> do {Ptr Matrix -> Int -> CDouble -> IO ()
forall b. Ptr b -> Int -> CDouble -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
C2HSImp.pokeByteOff Ptr Matrix
ptr Int
24 (CDouble
val :: C2HSImp.CDouble)}) Ptr Matrix
p (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
yy)
    (\Ptr Matrix
ptr CDouble
val -> do {Ptr Matrix -> Int -> CDouble -> IO ()
forall b. Ptr b -> Int -> CDouble -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
C2HSImp.pokeByteOff Ptr Matrix
ptr Int
32 (CDouble
val :: C2HSImp.CDouble)}) Ptr Matrix
p (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
x0)
    (\Ptr Matrix
ptr CDouble
val -> do {Ptr Matrix -> Int -> CDouble -> IO ()
forall b. Ptr b -> Int -> CDouble -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
C2HSImp.pokeByteOff Ptr Matrix
ptr Int
40 (CDouble
val :: C2HSImp.CDouble)}) Ptr Matrix
p (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
y0)
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

instance Num Matrix where
  * :: Matrix -> Matrix -> Matrix
(*) (Matrix Double
xx Double
yx Double
xy Double
yy Double
x0 Double
y0) (Matrix Double
xx' Double
yx' Double
xy' Double
yy' Double
x0' Double
y0') =
    Double -> Double -> Double -> Double -> Double -> Double -> Matrix
Matrix (Double
xx Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
xx' Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
yx Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
xy')
           (Double
xx Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
yx' Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
yx Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
yy')
           (Double
xy Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
xx' Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
yy Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
xy')
           (Double
xy Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
yx' Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
yy Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
yy')
           (Double
x0 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
xx' Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
y0 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
xy' Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
x0')
           (Double
x0 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
yx' Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
y0 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
yy' Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
y0')

  + :: Matrix -> Matrix -> Matrix
(+) = (Double -> Double -> Double) -> Matrix -> Matrix -> Matrix
pointwise2 Double -> Double -> Double
forall a. Num a => a -> a -> a
(+)
  (-) = (Double -> Double -> Double) -> Matrix -> Matrix -> Matrix
pointwise2 (-)

  negate :: Matrix -> Matrix
negate = (Double -> Double) -> Matrix -> Matrix
pointwise Double -> Double
forall a. Num a => a -> a
negate
  abs :: Matrix -> Matrix
abs    = (Double -> Double) -> Matrix -> Matrix
pointwise Double -> Double
forall a. Num a => a -> a
abs
  signum :: Matrix -> Matrix
signum = (Double -> Double) -> Matrix -> Matrix
pointwise Double -> Double
forall a. Num a => a -> a
signum

  -- this definition of fromInteger means that 2*m = scale 2 m
  -- and it means 1 = identity
  fromInteger :: Integer -> Matrix
fromInteger Integer
n = Double -> Double -> Double -> Double -> Double -> Double -> Matrix
Matrix (Integer -> Double
forall a. Num a => Integer -> a
fromInteger Integer
n) Double
0 Double
0 (Integer -> Double
forall a. Num a => Integer -> a
fromInteger Integer
n) Double
0 Double
0

{-# INLINE pointwise #-}
pointwise :: (Double -> Double) -> Matrix -> Matrix
pointwise Double -> Double
f (Matrix Double
xx Double
yx Double
xy Double
yy Double
x0 Double
y0) =
  Double -> Double -> Double -> Double -> Double -> Double -> Matrix
Matrix (Double -> Double
f Double
xx) (Double -> Double
f Double
yx) (Double -> Double
f Double
xy) (Double -> Double
f Double
yy) (Double -> Double
f Double
x0) (Double -> Double
f Double
y0)

{-# INLINE pointwise2 #-}
pointwise2 :: (Double -> Double -> Double) -> Matrix -> Matrix -> Matrix
pointwise2 Double -> Double -> Double
f (Matrix Double
xx Double
yx Double
xy Double
yy Double
x0 Double
y0) (Matrix Double
xx' Double
yx' Double
xy' Double
yy' Double
x0' Double
y0') =
  Double -> Double -> Double -> Double -> Double -> Double -> Matrix
Matrix (Double -> Double -> Double
f Double
xx Double
xx') (Double -> Double -> Double
f Double
yx Double
yx') (Double -> Double -> Double
f Double
xy Double
xy') (Double -> Double -> Double
f Double
yy Double
yy') (Double -> Double -> Double
f Double
x0 Double
x0') (Double -> Double -> Double
f Double
y0 Double
y0')

identity :: Matrix
identity :: Matrix
identity = Double -> Double -> Double -> Double -> Double -> Double -> Matrix
Matrix Double
1 Double
0 Double
0 Double
1 Double
0 Double
0

translate :: Double -> Double -> Matrix -> Matrix
translate :: Double -> Double -> Matrix -> Matrix
translate Double
tx Double
ty Matrix
m = Matrix
m Matrix -> Matrix -> Matrix
forall a. Num a => a -> a -> a
* (Double -> Double -> Double -> Double -> Double -> Double -> Matrix
Matrix Double
1 Double
0 Double
0 Double
1 Double
tx Double
ty)

scale :: Double -> Double -> Matrix -> Matrix
scale :: Double -> Double -> Matrix -> Matrix
scale Double
sx Double
sy Matrix
m = Matrix
m Matrix -> Matrix -> Matrix
forall a. Num a => a -> a -> a
* (Double -> Double -> Double -> Double -> Double -> Double -> Matrix
Matrix Double
sx Double
0 Double
0 Double
sy Double
0 Double
0)

rotate :: Double -> Matrix -> Matrix
rotate :: Double -> Matrix -> Matrix
rotate Double
r Matrix
m = Matrix
m Matrix -> Matrix -> Matrix
forall a. Num a => a -> a -> a
* (Double -> Double -> Double -> Double -> Double -> Double -> Matrix
Matrix Double
c Double
s (-Double
s) Double
c Double
0 Double
0)
  where s :: Double
s = Double -> Double
forall a. Floating a => a -> a
sin Double
r
        c :: Double
c = Double -> Double
forall a. Floating a => a -> a
cos Double
r

transformDistance :: Matrix -> (Double,Double) -> (Double,Double)
transformDistance :: Matrix -> (Double, Double) -> (Double, Double)
transformDistance (Matrix Double
xx Double
yx Double
xy Double
yy Double
_ Double
_) (Double
dx,Double
dy) =
  Double
newX Double -> (Double, Double) -> (Double, Double)
forall a b. a -> b -> b
`seq` Double
newY Double -> (Double, Double) -> (Double, Double)
forall a b. a -> b -> b
`seq` (Double
newX,Double
newY)
  where newX :: Double
newX = Double
xx Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
dx Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
xy Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
dy
        newY :: Double
newY = Double
yx Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
dx Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
yy Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
dy

transformPoint :: Matrix -> (Double,Double) -> (Double,Double)
transformPoint :: Matrix -> (Double, Double) -> (Double, Double)
transformPoint (Matrix Double
xx Double
yx Double
xy Double
yy Double
x0 Double
y0) (Double
dx,Double
dy) =
  Double
newX Double -> (Double, Double) -> (Double, Double)
forall a b. a -> b -> b
`seq` Double
newY Double -> (Double, Double) -> (Double, Double)
forall a b. a -> b -> b
`seq` (Double
newX,Double
newY)
  where newX :: Double
newX = Double
xx Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
dx Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
xy Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
dy Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
x0
        newY :: Double
newY = Double
yx Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
dx Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
yy Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
dy Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
y0

scalarMultiply :: Double -> Matrix -> Matrix
scalarMultiply :: Double -> Matrix -> Matrix
scalarMultiply Double
scalar = (Double -> Double) -> Matrix -> Matrix
pointwise (Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
scalar)

adjoint :: Matrix -> Matrix
adjoint :: Matrix -> Matrix
adjoint (Matrix Double
a Double
b Double
c Double
d Double
tx Double
ty) =
  Double -> Double -> Double -> Double -> Double -> Double -> Matrix
Matrix Double
d (-Double
b) (-Double
c) Double
a (Double
cDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
ty Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
dDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
tx) (Double
bDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
tx Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
aDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
ty)

invert :: Matrix -> Matrix
invert :: Matrix -> Matrix
invert m :: Matrix
m@(Matrix Double
xx Double
yx Double
xy Double
yy Double
_ Double
_) = Double -> Matrix -> Matrix
scalarMultiply (Double -> Double
forall a. Fractional a => a -> a
recip Double
det) (Matrix -> Matrix) -> Matrix -> Matrix
forall a b. (a -> b) -> a -> b
$ Matrix -> Matrix
adjoint Matrix
m
  where det :: Double
det = Double
xxDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
yy Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
yxDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
xy