----------------------------------------------------------------------
-- |
-- Module      :  Transform2
-- Copyright   :  (c) Conal Elliott and Andy J Gill 2008
-- License     :  BSD3
-- 
-- Maintainer  :  conal@conal.net, andygill@ku.edu
-- Stability   :  experimental
-- 
-- 3D transforms
----------------------------------------------------------------------

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)

-- | 3D affine transform
newtype Transform2 s = T2 { toT3 :: Transform3 s }

instance (Fractional s, AdditiveGroup s) => Invertible (Transform2 s) where
  inverse (T2 xf3) = T2 (inverse xf3)

-- | Translation (motion) in 3D
translate2 :: Num s => Vector2 s -> Transform2 s
translate2 (Vector2 dx dy) = T2 (translate3 (Vector3 dx dy 0))

-- | Rotation in 3D, with angle @theta@ in radians.
rotate2 :: Num s => s -> Transform2 s
rotate2 theta = T2 (rotate3 theta zVector3)

-- | Scaling in 3D
scale2 :: Num s => s -> s -> Transform2 s
scale2 sx sy = T2 (scale3 sx sy 1)

-- | Uniform scale in 2D.
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)

-- TODO: optimize mappend

-- instance Transform (Transform2 s) (Point2 s) where
--   xf *% p = ...

-- instance Transform (Transform2 s) (Vector2 s) where
--   xf *% p = ...

-- | Change the matrix state, according to the given transform.
tweakMatrix2 :: (Floating s, MatrixComponent s) => Transform2 s -> IO ()
tweakMatrix2 = tweakMatrix3 . toT3

-- | Change the required upper error bound, to one that applies before
-- transforming.  Hack for now.
tweakError2 :: (Real s, Fractional s) => Transform2 s -> ErrorBound -> ErrorBound
tweakError2 = tweakError3 . toT3