diff --git a/scenegraph.cabal b/scenegraph.cabal --- a/scenegraph.cabal +++ b/scenegraph.cabal @@ -1,5 +1,5 @@ name: scenegraph -version: 0.2.0.0 +version: 0.2.0.1 cabal-version: >= 1.10 build-type: Simple author: Mark Wassell diff --git a/test/Graphics/SceneGraph/BasicSpec.hs b/test/Graphics/SceneGraph/BasicSpec.hs --- a/test/Graphics/SceneGraph/BasicSpec.hs +++ b/test/Graphics/SceneGraph/BasicSpec.hs @@ -4,30 +4,97 @@ {-# OPTIONS_GHC -Wno-type-defaults #-} module Graphics.SceneGraph.BasicSpec where -import Test.Hspec (Spec, describe, it, shouldBe, - shouldSatisfy) +import Test.Hspec (Expectation, Spec, describe, + it, shouldBe, shouldSatisfy) import Test.Hspec.QuickCheck (prop) import Test.QuickCheck (Arbitrary (arbitrary)) +import Control.Lens ((^.)) import Graphics.SceneGraph.Basic -import Graphics.SceneGraph.BoundingBox -import Linear (V3 (..)) +import Graphics.SceneGraph.BoundingBox (bounds, boxSize) +import Linear (R1 (..), R2 (..), R3 (..), + V3 (..), V4 (..), (!*)) +import qualified Linear as L instance Arbitrary a => Arbitrary (V3 a) where arbitrary = V3 <$> arbitrary <*> arbitrary <*> arbitrary +class Roundable a where + roundV :: a -> a +instance Roundable Float where + roundV = (/ 100.0) . fromIntegral . round . (* 100) + +instance Roundable a => Roundable (V3 a) where + roundV = fmap roundV + +infix 1 `shouldBeApproximately` + +shouldBeApproximately :: (Eq a, Show a, Roundable a) => a -> a -> Expectation +shouldBeApproximately a b = roundV a `shouldBe` roundV b + + +origin :: V4 Float +origin = L.point $ pure 0 + + spec :: Spec spec = do - describe "union" $ do - prop "should be idempotent" $ \(box :: Box Float) -> - union box box `shouldBe` box + describe "translate" $ do + prop "should move a point linearly" $ \p -> do + testScene <- osg $ do + translate p camera + let camNode = findCamera testScene 0 + getTransformTo testScene camNode !* origin `shouldBe` L.point p - it "should yield a superset of the two input boxes" $ do - let a = (V3 (-2) (-2) (-2), V3 2 2 2) - b = (V3 (-1) (-1) (-1), V3 3 3 3) - union a b `shouldBe` (V3 (-2) (-2) (-2), V3 3 3 3) + + describe "rotateX" $ do + prop "should not modify the X coordinate" $ \p theta -> do + testScene <- osg $ do + rotateX theta (translate p camera) + let camNode = findCamera testScene 0 + (getTransformTo testScene camNode !* origin) ^. _x + `shouldBeApproximately` p ^. _x + + it "should turn a Y unit vector into a Z unit vector" $ do + testScene <- osg $ do + rotateX 90 (translate (V3 0 1 0) camera) + let camNode = findCamera testScene 0 + (getTransformTo testScene camNode !* origin) ^. _xyz + `shouldBeApproximately` V3 0 0 1 + + + describe "rotateY" $ do + prop "should not modify the Y coordinate" $ \p theta -> do + testScene <- osg $ do + rotateY theta (translate p camera) + let camNode = findCamera testScene 0 + (getTransformTo testScene camNode !* origin) ^. _y + `shouldBeApproximately` p ^. _y + + it "should turn an X unit vector into a Z unit vector" $ do + testScene <- osg $ do + rotateY 90 (translate (V3 1 0 0) camera) + let camNode = findCamera testScene 0 + (getTransformTo testScene camNode !* origin) ^. _xyz + `shouldBeApproximately` V3 0 0 (-1) + + + describe "rotateZ" $ do + prop "should not modify the Z coordinate" $ \p theta -> do + testScene <- osg $ do + rotateZ theta (translate p camera) + let camNode = findCamera testScene 0 + (getTransformTo testScene camNode !* origin) ^. _z + `shouldBeApproximately` p ^. _z + + it "should turn an X unit vector into a Y unit vector" $ do + testScene <- osg $ do + rotateZ 90 (translate (V3 1 0 0) camera) + let camNode = findCamera testScene 0 + (getTransformTo testScene camNode !* origin) ^. _xyz + `shouldBeApproximately` V3 0 1 0 describe "bounds" $ do diff --git a/test/Graphics/SceneGraph/BoundingBoxSpec.hs b/test/Graphics/SceneGraph/BoundingBoxSpec.hs --- a/test/Graphics/SceneGraph/BoundingBoxSpec.hs +++ b/test/Graphics/SceneGraph/BoundingBoxSpec.hs @@ -4,36 +4,21 @@ {-# OPTIONS_GHC -Wno-type-defaults #-} module Graphics.SceneGraph.BoundingBoxSpec where -import Test.Hspec (Expectation, Spec, describe, - it, shouldBe, shouldSatisfy) + +import Test.Hspec (Spec, describe, it, shouldBe, + shouldSatisfy) import Test.Hspec.QuickCheck (prop) import Test.QuickCheck (Arbitrary (arbitrary)) -import Control.Lens ((^.)) import Graphics.SceneGraph.Basic import Graphics.SceneGraph.BoundingBox -import Linear (R1 (..), R2 (..), R3 (..), - V3 (..), V4 (..), (!*)) -import qualified Linear as L -import Linear.Vector ((^*)) +import Linear (V3 (..)) instance Arbitrary a => Arbitrary (V3 a) where arbitrary = V3 <$> arbitrary <*> arbitrary <*> arbitrary -infix 1 `shouldBeApproximately` -shouldBeApproximately :: V3 Float -> V3 Float -> Expectation -shouldBeApproximately a b = roundV a `shouldBe` roundV b - where - roundV :: V3 Float -> V3 Float - roundV v = fmap ((/ 100.0) . fromIntegral . round) (v ^* 100) - - -origin :: V4 Float -origin = L.point $ pure 0 - - spec :: Spec spec = do describe "union" $ do @@ -44,62 +29,6 @@ let a = (V3 (-2) (-2) (-2), V3 2 2 2) b = (V3 (-1) (-1) (-1), V3 3 3 3) union a b `shouldBe` (V3 (-2) (-2) (-2), V3 3 3 3) - - - describe "translate" $ do - prop "should move a point linearly" $ \p -> do - testScene <- osg $ do - translate p camera - let camNode = findCamera testScene 0 - getTransformTo testScene camNode !* origin `shouldBe` L.point p - - - describe "rotateX" $ do - prop "should not modify the X coordinate" $ \p theta -> do - testScene <- osg $ do - rotateX theta (translate p camera) - let camNode = findCamera testScene 0 - (getTransformTo testScene camNode !* origin) ^. _x - `shouldBe` p ^. _x - - it "should turn a Y unit vector into a Z unit vector" $ do - testScene <- osg $ do - rotateX 90 (translate (V3 0 1 0) camera) - let camNode = findCamera testScene 0 - (getTransformTo testScene camNode !* origin) ^. _xyz - `shouldBeApproximately` V3 0 0 1 - - - describe "rotateY" $ do - prop "should not modify the Y coordinate" $ \p theta -> do - testScene <- osg $ do - rotateY theta (translate p camera) - let camNode = findCamera testScene 0 - (getTransformTo testScene camNode !* origin) ^. _y - `shouldBe` p ^. _y - - it "should turn an X unit vector into a Z unit vector" $ do - testScene <- osg $ do - rotateY 90 (translate (V3 1 0 0) camera) - let camNode = findCamera testScene 0 - (getTransformTo testScene camNode !* origin) ^. _xyz - `shouldBeApproximately` V3 0 0 (-1) - - - describe "rotateZ" $ do - prop "should not modify the Z coordinate" $ \p theta -> do - testScene <- osg $ do - rotateZ theta (translate p camera) - let camNode = findCamera testScene 0 - (getTransformTo testScene camNode !* origin) ^. _z - `shouldBe` p ^. _z - - it "should turn an X unit vector into a Y unit vector" $ do - testScene <- osg $ do - rotateZ 90 (translate (V3 1 0 0) camera) - let camNode = findCamera testScene 0 - (getTransformTo testScene camNode !* origin) ^. _xyz - `shouldBeApproximately` V3 0 1 0 describe "bounds" $ do