content: {-# LANGUAGE ConstraintKinds       #-}
  {-# LANGUAGE FlexibleContexts      #-}
  {-# LANGUAGE TypeFamilies          #-}
  
  
  module Diagrams.Test.Transform where
  
  import           Test.Tasty
  import           Test.Tasty.QuickCheck
  import           Diagrams.Prelude
  import           Diagrams.Direction
  import Instances
  
  tests :: TestTree
  tests = testGroup "Transform" [
  
          testProperty "rotating a vector by a number then its additive inverse will yield the original vector" $
            \θ a -> rotate ((θ * (-1)) @@ deg) (rotate ((θ :: Double) @@ deg) (a ::  V2 Double)) =~ a
          , testProperty "under rotated allows scaling along an angle" $
            \θ f a -> under (rotated ((θ :: Double) @@ deg)) (scaleX (f :: Double)) (a ::  V2 Double) =~ (rotate (negated (θ @@ deg)) . (scaleX f) . rotate (θ @@ deg)) a
          , testProperty "a rotation of 0 does nothing" $
            \a -> rotate (0 @@ deg) (a ::  V2 Double) =~ a
          , testProperty "adding 360 degrees to a turn does nothing" $
            \c a -> rotate (((c :: Double) + 360) @@ deg) (a ::  V2 Double) =~ rotate (c @@ deg) a
          , testProperty "over rotated allows scaling along x of a rotated shape" $
            \θ f a -> over (rotated ((θ :: Double) @@ deg)) (scaleX (f :: Double)) (a ::  V2 Double) =~ (rotate (θ @@ deg) . (scaleX f) . rotate (negated (θ @@ deg))) a
          , testProperty "scaleX" $
            \f a b -> (scaleX (f :: Double)) (V2 (a ::  Double) b) =~ V2 (a * f) b
          , testProperty "scaleY" $
            \f a b -> (scaleY (f :: Double)) (V2 (a ::  Double) b) =~ V2 a  (f * b)
          , testProperty "reflectX" $
            \a b -> reflectX (V2 (a ::  Double) b) =~ V2 (a * (-1))  b
          , testProperty "reflectY" $
            \a b -> reflectY (V2 (a ::  Double) b) =~ V2 a  ((-1) * b)
          , testProperty "reflectXY" $
            \a b -> reflectXY (V2 (a ::  Double) b) =~ V2 b a
          , testProperty "translate" $
            \a b c d -> translateX (a :: Double) (translateY b (P (V2 c d ))) =~ P (V2 (a + c) (b + d))
          , testProperty "shear" $
            \a b c d -> shearX (a :: Double) (shearY b (V2 c d)) =~ V2 ((c*b + d) * a + c) (c*b + d)
          , testProperty "(1,0) rotateTo some dir will return normalised dir" $
            \(NonZero a) b -> rotateTo  (dir (V2 (a :: Double) b)) (V2 1 0) =~ signorm (V2 a b)
          , testProperty "rotates" $
            \a c -> rotate ((a :: Double)@@ deg) (c :: V2 Double)   =~ rotate'' ((a :: Double)@@ deg) (c :: V2 Double) && rotate ((a :: Double)@@ deg) (c :: V2 Double)   =~ rotate' ((a :: Double)@@ deg) (c :: V2 Double)
          , testProperty "reflectAbout works for a vector" $
            \a b c d e f -> reflectAbout (P (V2 (a :: Double) b)) (dir (V2 c d)) (V2 e f) =~  over (rotated (atan2A' d c)) reflectY (V2 e f)
          , testProperty "reflectAbout works for a point" $
            \a b c d e f -> reflectAbout (P (V2 (a :: Double) b)) (dir (V2 c d)) (P (V2 e f)) =~ translate (V2 a b)  ((over (rotated (atan2A' d c)) reflectY) ((translate (V2 (-a) (-b)) )  (P (V2 e f))))
  
  
          ]
  
  --the original " '' " and a secondary " ' " rotate function for testing
  
  rotation'' :: Floating n => Angle n -> T2 n
  rotation'' theta = fromLinear r (linv r)
            where
              r               = rot theta <-> rot (negated theta)
              rot th (V2 x y) = V2 (cosA th * x - sinA th * y)
                                   (sinA th * x + cosA th * y)
  
  rotate'' :: (InSpace V2 n t, Transformable t, Floating n) => Angle n -> t -> t
  rotate'' = transform . rotation''
  
  rotation' :: Floating n => Angle n -> T2 n
  rotation' theta = fromLinear r (linv r)
              where
              r               = rot theta <-> rot (negated theta)
              rot th (V2 x y) = V2 (c * x - s * y)
                                   (s * x + c * y)
                                    where
                                      c = cosA th
                                      s = sinA th
  
  rotate' :: (InSpace V2 n t, Transformable t, Floating n) => Angle n -> t -> t
  rotate'  = transform . rotation'
  