{-# 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'