packages feed

boundingboxes 0.1 → 0.1.1

raw patch · 3 files changed

+110/−43 lines, 3 filesdep +QuickCheckdep +boundingboxesdep +randomdep ~basedep ~lensdep ~linear

Dependencies added: QuickCheck, boundingboxes, random, test-framework, test-framework-quickcheck2, test-framework-th

Dependency ranges changed: base, lens, linear

Files

Data/BoundingBox/Dim2.hs view
@@ -12,9 +12,14 @@ ----------------------------------------------------------------------------
 module Data.BoundingBox.Dim2 (
     BoundingBox(..)
+    , inBoundingBox
+    , intersect
+    , enclose
     , _TLBR
     , _BLTR
+    , _Corners
     , Reference(..)
+    , sizePos
     , position
     , size
     ) where
@@ -23,9 +28,33 @@ import Control.Lens
 import Data.Foldable
 import Data.Typeable
+import Control.Applicative
 
-data BoundingBox a = BoundingBox a a a a deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Read, Typeable)
+data BoundingBox a = BoundingBox !a !a !a !a deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Read, Typeable)
 
+instance Applicative BoundingBox where
+    pure a = BoundingBox a a a a
+    BoundingBox f0 g0 f1 g1 <*> BoundingBox x0 y0 x1 y1 = BoundingBox (f0 x0) (g0 y0) (f1 x1) (g1 y1)
+
+-- | Determine whether the given point is in the 'BoundingBox'.
+inBoundingBox :: Ord a => V2 a -> BoundingBox a -> Bool
+inBoundingBox (V2 x y) (BoundingBox x0 y0 x1 y1) = x0 <= x && x <= x1 && y0 <= y && y <= y1
+
+-- | Intersection between two boundingboxes.
+intersect :: Ord a => BoundingBox a -> BoundingBox a -> Maybe (BoundingBox a)
+intersect (BoundingBox x0 y0 x1 y1) (BoundingBox x2 y2 x3 y3)
+    | x4 > x5 = Nothing
+    | y4 > y5 = Nothing
+    | otherwise = Just $ BoundingBox x4 y4 x5 y5
+    where
+        x4 = max x0 x2
+        y4 = max y0 y2
+        x5 = min x1 x3
+        y5 = min y1 y3
+
+enclose :: (Num a, Ord a) => V2 a -> BoundingBox a -> BoundingBox a
+enclose (V2 x y) (BoundingBox x0 y0 x1 y1) = BoundingBox (min x x0) (min y y0) (max x x1) (max y y1)
+
 -- | The type of reference points.
 -- @
 -- TL--T--TR
@@ -37,7 +66,7 @@ data Reference = TL | T | TR
                |  L | C | R
                | BL | B | BR
-    deriving (Show, Eq, Ord, Read)
+    deriving (Show, Eq, Ord, Read, Enum, Bounded)
 
 -- |
 -- @
@@ -57,45 +86,29 @@ _BLTR :: Iso' (BoundingBox a) (V2 a, V2 a)
 _BLTR = iso (\(BoundingBox x0 y0 x1 y1) -> (V2 x0 y1, V2 x1 y0)) (\(V2 x0 y1, V2 x1 y0) -> BoundingBox x0 y0 x1 y1)
 
-position :: Fractional a => Reference -> Lens' (BoundingBox a) (V2 a)
-position ref f (BoundingBox x0 y0 x1 y1) = f (V2 x0 y0 + offset)
-    <&> \v -> let V2 x y = v - offset in BoundingBox x y (x + w) (y + h) where
-    w = x1 - x0
-    h = y1 - y0
-    offset = case ref of
+sizePos :: Fractional a => Reference -> Iso' (BoundingBox a) (V2 a, V2 a)
+sizePos ref = iso f g where
+    f (BoundingBox x0 y0 x1 y1) = (V2 (x1 - x0) (y1 - y0), V2 x0 y0 * (1 - k) + V2 x1 y1 * k)
+    g (s@(V2 w h), p) = BoundingBox x0 y0 x1 y1 where
+        V2 x0 y0 = p - k * s
+        V2 x1 y1 = p + (1 - k) * s
+    k = case ref of
         TL -> V2 0 0
-        T -> V2 (w / 2) 0
-        TR -> V2 w 0
-        L -> V2 0 (h / 2)
-        C -> V2 (w / 2) (h / 2)
-        R -> V2 w (h / 2)
-        BL -> V2 0 h
-        B -> V2 (w / 2) h
-        BR -> V2 w h
+        T -> V2 0.5 0
+        TR -> V2 1 0
+        L -> V2 0 0.5
+        C -> V2 0.5 0.5
+        R -> V2 1 0.5
+        BL -> V2 0 1
+        B -> V2 0.5 1
+        BR -> V2 1 1
 
+_Corners :: Traversal' (BoundingBox a) (V2 a)
+_Corners f (BoundingBox x0 y0 x1 y1) = go <$> f (V2 x0 y0) <*> f (V2 x1 y0) <*> f (V2 x1 y1) <*> f (V2 x0 y1) where
+    go (V2 x0' _) (V2 _ y1') (V2 x2' _) (V2 _ y3') = BoundingBox x0' y1' x2' y3'
+
+position :: Fractional a => Reference -> Lens' (BoundingBox a) (V2 a)
+position ref = sizePos ref . _2
+
 size :: Fractional a => Reference -> Lens' (BoundingBox a) (V2 a)
-size ref f (BoundingBox x0 y0 x1 y1) = f (V2 w h)
-    <&> \(V2 w' h') -> BoundingBox (x0 - p * (w' - w)) (y0 - q * (h' - h)) (x1 + (1 - p) * (w' - w)) (y1 + (1 - q) * (h' - h))
-    where
-        w = x1 - x0
-        h = y1 - y0
-        p = case ref of
-            TL -> 0
-            T -> 0.5
-            TR -> 1
-            L -> 0
-            C -> 0.5
-            R -> 1
-            BL -> 0
-            B -> 0.5
-            BR -> 1
-        q = case ref of
-            TL -> 0
-            L -> 0.5
-            BL -> 1
-            T -> 0
-            C -> 0.5
-            B -> 1
-            TR -> 0
-            R -> 0.5
-            BR -> 1+size ref = sizePos ref . _1
boundingboxes.cabal view
@@ -1,5 +1,5 @@ name:                boundingboxes
-version:             0.1
+version:             0.1.1
 synopsis:            The type for 2D bounding box
 -- description:         
 homepage:            https://github.com/fumieval/boundingboxes
@@ -19,4 +19,19 @@   other-extensions:    DeriveFunctor, DeriveFoldable, DeriveTraversable, DeriveDataTypeable, Rank2Types
   build-depends:       base == 4.*, linear >= 1.0, lens >= 3.8 && < 5
   -- hs-source-dirs:      
-  default-language:    Haskell2010+  default-language:    Haskell2010
+
+test-suite properties
+  type: exitcode-stdio-1.0
+  default-language:    Haskell2010
+  build-depends: base
+    , linear
+    , lens
+    , QuickCheck >=2.4
+    , test-framework-th >= 0.2
+    , test-framework
+    , test-framework-quickcheck2 >= 0.2
+    , random
+    , boundingboxes
+  main-is: properties.hs
+  hs-source-dirs: tests
+ tests/properties.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE TemplateHaskell, ViewPatterns #-}
+import Data.BoundingBox.Dim2
+import Test.QuickCheck
+import Test.Framework.Providers.QuickCheck2
+import Test.Framework.TH
+import Control.Lens
+import Linear
+import Control.Applicative
+import System.Random
+
+instance (Num a, Random a) => Arbitrary (BoundingBox a) where
+    arbitrary = sized $ \n -> let k = fromIntegral n in do
+        x0 <- choose (-k, 0)
+        y0 <- choose (-k, 0)
+        x1 <- choose (0, k)
+        y1 <- choose (0, k)
+        return (BoundingBox x0 y0 x1 y1)
+
+instance Arbitrary Reference where
+    arbitrary = toEnum <$> choose (0, 8)
+
+instance Arbitrary a => Arbitrary (V2 a) where
+    arbitrary = V2 <$> arbitrary <*> arbitrary
+
+prop_resize bb ref sz = nearZero $ bb ^. position ref - bb' ^. position ref where
+    bb' = bb & size ref .~ getPositive sz :: BoundingBox Float
+
+prop_rearrange ref bb pos = nearZero $ bb ^. size C - bb' ^. size C where
+    bb' = bb & position ref .~ pos :: BoundingBox Float
+
+prop_construct ref pos (getPositive -> sz) = nearZero (bb ^. size C - sz)
+    .&&. nearZero (bb ^. position ref - pos) where
+    
+    bb = sizePos ref # (sz, pos) :: BoundingBox Float
+
+prop_enclosure xs = and [inBoundingBox p (foldr enclose (pure 0) ps) | p <- ps] where
+    ps = map (uncurry V2) xs :: [V2 Float]
+
+main = $(defaultMainGenerator)