module SFML.Graphics.Transform
(
Transform
, m00, m10, m20
, m01, m11, m21
, m02, m12, m22
, createTransform
, idTransform
, translation
, rotation
, rotationWithCenter
, scaling
, scalingWithCenter
, inverse
, fastInverse
, transformPoint
, transformDir
, transformRect
)
where
import SFML.Graphics.Rect
import SFML.Graphics.Types
import SFML.System.Vector2
import Control.Applicative ((<$>), (<*>))
import Data.List (foldl')
import Foreign.C.Types
import Foreign.Storable
sizeFloat = (4)
data Transform = Transform
{ m00 :: Float, m10 :: Float, m20 :: Float
, m01 :: Float, m11 :: Float, m21 :: Float
, m02 :: Float, m12 :: Float, m22 :: Float
}
instance Storable Transform where
sizeOf _ = 9 * sizeFloat
alignment _ = alignment (undefined :: CFloat)
peek ptr = Transform
<$> fmap realToFrac (peekByteOff ptr 0 :: IO CFloat)
<*> fmap realToFrac (peekByteOff ptr sizeFloat :: IO CFloat)
<*> fmap realToFrac (peekByteOff ptr $ 2*sizeFloat :: IO CFloat)
<*> fmap realToFrac (peekByteOff ptr $ 3*sizeFloat :: IO CFloat)
<*> fmap realToFrac (peekByteOff ptr $ 4*sizeFloat :: IO CFloat)
<*> fmap realToFrac (peekByteOff ptr $ 5*sizeFloat :: IO CFloat)
<*> fmap realToFrac (peekByteOff ptr $ 6*sizeFloat :: IO CFloat)
<*> fmap realToFrac (peekByteOff ptr $ 7*sizeFloat :: IO CFloat)
<*> fmap realToFrac (peekByteOff ptr $ 8*sizeFloat :: IO CFloat)
poke ptr (Transform m00 m01 m02 m10 m11 m12 m20 m21 m22) = do
pokeByteOff ptr 0 (realToFrac m00 :: CFloat)
pokeByteOff ptr sizeFloat (realToFrac m01 :: CFloat)
pokeByteOff ptr (2*sizeFloat) (realToFrac m02 :: CFloat)
pokeByteOff ptr (3*sizeFloat) (realToFrac m10 :: CFloat)
pokeByteOff ptr (4*sizeFloat) (realToFrac m11 :: CFloat)
pokeByteOff ptr (5*sizeFloat) (realToFrac m12 :: CFloat)
pokeByteOff ptr (6*sizeFloat) (realToFrac m20 :: CFloat)
pokeByteOff ptr (7*sizeFloat) (realToFrac m21 :: CFloat)
pokeByteOff ptr (8*sizeFloat) (realToFrac m22 :: CFloat)
instance Num Transform where
(Transform a00 a01 a02 a03 a04 a05 a06 a07 a08)
+ (Transform b00 b01 b02 b03 b04 b05 b06 b07 b08)
= Transform (a00 + b00) (a01 + b01) (a02 + b02)
(a03 + b03) (a04 + b04) (a05 + b05)
(a06 + b06) (a07 + b07) (a08 + b08)
(Transform a00 a01 a02 a03 a04 a05 a06 a07 a08)
(Transform b00 b01 b02 b03 b04 b05 b06 b07 b08)
= Transform (a00 b00) (a01 b01) (a02 b02)
(a03 b03) (a04 b04) (a05 b05)
(a06 b06) (a07 b07) (a08 b08)
(Transform a00 a10 a20 a01 a11 a21 a02 a12 a22)
* (Transform b00 b10 b20 b01 b11 b21 b02 b12 b22)
= Transform (a00 * b00 + a10 * b01 + a20 * b02)
(a00 * b10 + a10 * b11 + a20 * b12)
(a00 * b20 + a10 * b21 + a20 * b22)
(a01 * b00 + a11 * b01 + a21 * b02)
(a01 * b10 + a11 * b11 + a21 * b12)
(a01 * b20 + a11 * b21 + a21 * b22)
(a02 * b00 + a12 * b01 + a22 * b02)
(a02 * b10 + a12 * b11 + a22 * b12)
(a02 * b20 + a12 * b21 + a22 * b22)
abs (Transform a00 a01 a02 a03 a04 a05 a06 a07 a08) =
(Transform (abs a00) (abs a01) (abs a02) (abs a03)
(abs a04) (abs a05) (abs a06) (abs a07) (abs a08))
signum (Transform a00 a01 a02 a03 a04 a05 a06 a07 a08) =
(Transform (signum a00) (signum a01) (signum a02) (signum a03)
(signum a04) (signum a05) (signum a06) (signum a07) (signum a08))
fromInteger i = Transform i' i' i' i' i' i' i' i' i' where i' = fromInteger i
createTransform
:: Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Transform
createTransform = Transform
idTransform :: Transform
idTransform = Transform 1 0 0 0 1 0 0 0 1
translation
:: Float
-> Float
-> Transform
translation x y = Transform
1 0 x
0 1 y
0 0 1
rotation
:: Float
-> Transform
rotation deg =
let rad = deg * pi / 180
sa = sin rad
ca = cos rad
in Transform
ca (sa) 0
sa ca 0
0 0 1
rotationWithCenter
:: Float
-> Float
-> Float
-> Transform
rotationWithCenter deg x y =
let rad = deg * pi / 180
ca = cos rad
sa = sin rad
in Transform
ca (sa) (x * (1 ca) + y * sa)
sa ca (y * (1 ca) x * sa)
0 0 1
scaling
:: Float
-> Float
-> Transform
scaling x y = Transform
x 0 0
0 y 0
0 0 1
scalingWithCenter
:: Float
-> Float
-> Float
-> Float
-> Transform
scalingWithCenter sx sy cx cy = Transform
sx 0 (cx * (1 sx))
0 sy (cy * (1 sy))
0 0 1
determinant :: Transform -> Float
determinant (Transform m00 m10 m20 m01 m11 m21 m02 m12 m22)
= m00 * (m11 * m22 m12 * m21)
+ m01 * (m12 * m20 m10 * m22)
+ m02 * (m10 * m21 m11 * m20)
inverse :: Transform -> Transform
inverse t@(Transform m00 m10 m20 m01 m11 m21 m02 m12 m22) =
let det = determinant t
det_inv = 1 / det
t00 = m11 * m22 m12 * m21
t01 = m10 * m22 + m12 * m20
t02 = m10 * m21 m11 * m20
t10 = m01 * m22 + m02 * m21
t11 = m00 * m22 m02 * m20
t12 = m00 * m21 + m01 * m20
t20 = m01 * m12 m02 * m11
t21 = m00 * m12 + m02 * m10
t22 = m00 * m11 m01 * m10
in
if determinant t /= 0 then Transform
(t00*det_inv) (t01*det_inv) (t02*det_inv)
(t10*det_inv) (t11*det_inv) (t12*det_inv)
(t20*det_inv) (t21*det_inv) (t22*det_inv)
else
idTransform
fastInverse :: Transform -> Transform
fastInverse mat =
let rx = m00 mat
ry = m01 mat
fx = m10 mat
fy = m11 mat
tx = (m20 mat)
ty = (m21 mat)
in Transform
rx ry (tx*rx + ty*ry)
fx fy (tx*fx + ty*fy)
0 0 1
transformPoint :: Transform -> Vec2f -> Vec2f
transformPoint (Transform m00 m10 m20 m01 m11 m21 _ _ _) (Vec2f x y) = Vec2f x' y'
where
x' = m00 * x + m10 * y + m20
y' = m01 * x + m11 * y + m21
transformDir :: Transform -> Vec2f -> Vec2f
transformDir (Transform m00 m10 _ m01 m11 _ _ _ _) (Vec2f x y) = Vec2f x' y'
where
x' = m00 * x + m10 * y
y' = m01 * x + m11 * y
transformRect :: Transform -> FloatRect -> FloatRect
transformRect transf (FloatRect l t w h) = FloatRect l' t' w' h'
where
p0@(Vec2f p0x p0y) = transformPoint transf (Vec2f l $ t)
p1@(Vec2f p1x p1y) = transformPoint transf (Vec2f l $ t + h)
p2@(Vec2f p2x p2y) = transformPoint transf (Vec2f (l + w) t)
p3@(Vec2f p3x p3y) = transformPoint transf (Vec2f (l + w) (t + h))
left = p0x;
top = p0y;
right = p0x;
bottom = p0y;
l' = min p3x $ min p2x $ min p1x p0x
t' = min p3y $ min p2y $ min p1y p0y
r' = max p3x $ max p2x $ max p1x p0x
b' = max p3y $ max p2y $ max p1y p0y
w' = r' l'
h' = b' t'