Transform.hs

{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE OverloadedStrings #-}

module Spec.Transform (tests) where

import Geomancy
import Hedgehog
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.Hedgehog (testPropertyNamed)

import Linear (M44, V3(..))

import Geomancy.Mat4 qualified
import Geomancy.Quaternion qualified
import Geomancy.Transform ((!.))
import Geomancy.Transform qualified as Transform

import Support.Ball (Ball, balls, consistent, enclosed)
import Support.Fixtures
  (intrinsicComposed, intrinsicComposedRef, quarterTurn, rotationsMatch, trs, trsRef, xPos, yNeg, yPos, zPos)
import Support.Linear (toV3)
import Support.Reference.Mat4 qualified as Ref.Mat4
import Support.Reference.Quaternion qualified as Ref.Quaternion
import Support.Reference.Transform qualified as Ref.Transform

tests :: TestTree
tests = testGroup "Transform"
  [ testPropertyNamed "det" "prop_transform_det" prop_transform_det
  , testPropertyNamed "rotateX" "prop_transform_rotateX" prop_transform_rotateX
  , testPropertyNamed "rotateY" "prop_transform_rotateY" prop_transform_rotateY
  , testPropertyNamed "rotateZ" "prop_transform_rotateZ" prop_transform_rotateZ
  , testPropertyNamed "node" "prop_transform_node" prop_transform_node
  , testPropertyNamed "order" "prop_transform_order" prop_transform_order
  ]

prop_transform_det :: Property
prop_transform_det = withTests 1 $ property do
  1     === Geomancy.Mat4.det Geomancy.Mat4.identity
  1     === Geomancy.Mat4.det (Transform.rotateY (pi/6))  -- area-preserving
  1     === Geomancy.Mat4.det (Transform.translate 1 2 3) -- area-preserving too
  0     === Geomancy.Mat4.det (Transform.scaleX 0)        -- space collapse, no inverse
  -1    === Geomancy.Mat4.det (Transform.scaleZ (-1))     -- flips the space
  8     === Geomancy.Mat4.det (Transform.scale 2)         -- stretches a little
  (1/8) === Geomancy.Mat4.det (Transform.scale (1/2))     -- stretches backwards

prop_transform_rotateX :: Property
prop_transform_rotateX = withTests 1 $ property do
  rotationMatches xPos Transform.rotateX Ref.Transform.rotateX zPos yNeg

prop_transform_rotateY :: Property
prop_transform_rotateY = withTests 1 $ property do
  rotationMatches yPos Transform.rotateY Ref.Transform.rotateY zPos xPos

prop_transform_rotateZ :: Property
prop_transform_rotateZ = withTests 1 $ property do
  rotationMatches zPos Transform.rotateZ Ref.Transform.rotateZ xPos yPos

rotationMatches
  :: Vec3
  -> (Float -> Transform)
  -> (Ball Float -> M44 (Ball Float))
  -> Vec3
  -> Vec3
  -> PropertyT IO ()
rotationMatches axis rotate rotateRef input expected = do
  rotationsMatch toV3
    (rotate quarterTurn !.)
    (rotateRef quarterTurn Ref.Transform.!.)
    [(input, expected)]
  rotationsMatch toV3
    (Transform.rotateQ (Geomancy.Quaternion.axisAngle axis quarterTurn) !.)
    (Ref.Transform.rotateQ (Ref.Quaternion.axisAngle (balls (toV3 axis)) quarterTurn) Ref.Transform.!.)
    [(input, expected)]

prop_transform_node :: Property
prop_transform_node = withTests 1 $ property do
  let
    r = intrinsicComposed 0 0 (pi/7)
    dps = Transform.node (vec3 2 3 5) r 11
    node = trs (vec3 2 3 5) r 11
    v = vec3 0 0 1
    rBall = intrinsicComposedRef 0 0 (pi/7)
    dpsBall = Ref.Transform.node (V3 2 3 5) rBall 11
    nodeBall = trsRef (V3 2 3 5) rBall 11
    viaDpsBall = dpsBall Ref.Transform.!. V3 0 0 1
    viaNodeBall = nodeBall Ref.Transform.!. V3 0 0 1
  replicate 3 Nothing === enclosed viaDpsBall (toV3 (dps !. v))
  replicate 3 Nothing === enclosed viaNodeBall (toV3 (node !. v))
  replicate 3 Nothing === consistent viaDpsBall viaNodeBall

prop_transform_order :: Property
prop_transform_order = withTests 1 $ property do
  let
    parent = Transform.node (vec3 4 5 6) (intrinsicComposed 0 0 (pi/6)) 2
    local = Transform.node (vec3 7 8 9) (intrinsicComposed 0 (pi/6) 0) (1/3)
    precomp = parent <> local !. vec3 0 0 1
    nocomp = parent !. local !. vec3 0 0 1
    parentBall = Ref.Transform.node (V3 4 5 6) (intrinsicComposedRef 0 0 (pi/6)) 2
    localBall = Ref.Transform.node (V3 7 8 9) (intrinsicComposedRef 0 (pi/6) 0) (1/3)
    precompBall = Ref.Mat4.compose parentBall localBall Ref.Transform.!. V3 0 0 1
    nocompBall = parentBall Ref.Transform.!. localBall Ref.Transform.!. V3 0 0 1
  replicate 3 Nothing === enclosed precompBall (toV3 precomp)
  replicate 3 Nothing === enclosed nocompBall (toV3 nocomp)
  replicate 3 Nothing === consistent precompBall nocompBall