module Graphics.FieldTrip.Transform2
(
Transform2
, translate2, rotate2, scale2, uscale2
, tweakMatrix2, tweakError2
, toT3
) where
import Data.Monoid
import Graphics.Rendering.OpenGL.GL.CoordTrans
import Data.VectorSpace (AdditiveGroup)
import Graphics.FieldTrip.Vector2
import Graphics.FieldTrip.Vector3
import Graphics.FieldTrip.Transform
import Graphics.FieldTrip.Transform3
import Graphics.FieldTrip.Render (ErrorBound)
newtype Transform2 s = T2 { toT3 :: Transform3 s }
instance (Fractional s, AdditiveGroup s) => Invertible (Transform2 s) where
inverse (T2 xf3) = T2 (inverse xf3)
translate2 :: Num s => Vector2 s -> Transform2 s
translate2 (Vector2 dx dy) = T2 (translate3 (Vector3 dx dy 0))
rotate2 :: Num s => s -> Transform2 s
rotate2 theta = T2 (rotate3 theta zVector3)
scale2 :: Num s => s -> s -> Transform2 s
scale2 sx sy = T2 (scale3 sx sy 1)
uscale2 :: Num s => s -> Transform2 s
uscale2 s = scale2 s s
instance Monoid (Transform2 s) where
mempty = T2 mempty
T2 o `mappend` T2 i = T2 (o `mappend` i)
tweakMatrix2 :: (Floating s, MatrixComponent s) => Transform2 s -> IO ()
tweakMatrix2 = tweakMatrix3 . toT3
tweakError2 :: (Real s, Fractional s) => Transform2 s -> ErrorBound -> ErrorBound
tweakError2 = tweakError3 . toT3