boundingboxes 0.1.1 → 0.2

raw patch · 4 files changed

+80/−132 lines, 4 filesdep ~linear

Dependency ranges changed: linear

Files

Data/BoundingBox.hs +63/−0
Data/BoundingBox/Dim2.hs +0/−114
boundingboxes.cabal +4/−4
tests/properties.hs +13/−14

+ Data/BoundingBox.hs view

@@ -0,0 +1,63 @@+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.BoundingBox
+-- Copyright   :  (C) 2014 Fumiaki Kinoshita
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>
+-- Stability   :  provisional
+-- Portability :  non-portable
+-- The type and accessors for bounding boxes
+----------------------------------------------------------------------------
+{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable, Rank2Types #-}
+module Data.BoundingBox where
+
+import Control.Lens
+import Data.Foldable
+import Data.Typeable
+import Control.Applicative
+import Data.Foldable as Foldable
+import Data.Traversable as Traversable
+
+-- | The type of bounding box for arbitrary vector @f@.
+data Box f a = Box (f a) (f a) deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Read)
+
+instance Applicative f => Applicative (Box f) where
+    pure a = Box (pure a) (pure a)
+    {-# INLINE pure #-}
+    Box f g <*> Box a b = Box (f <*> a) (g <*> b)
+    {-# INLINE (<*>) #-}
+
+instance Monad f => Monad (Box f) where
+    return a = Box (return a) (return a)
+    {-# INLINE return #-}
+    Box f g >>= k = Box (f >>= \x -> let Box p _ = k x in p) (g >>= \x -> let Box _ q = k x in q)
+
+-- | check whether the point is in the box.
+isInside :: (Applicative f, Foldable f, Ord a) => f a -> Box f a -> Bool
+isInside v (Box p q) = Foldable.and (liftA2 (<=) p v) && Foldable.and (liftA2 (<=) v q)
+
+-- | Returns True if the bounding box is valid.
+isCanonical :: (Applicative f, Foldable f, Ord a) => Box f a -> Bool
+isCanonical (Box p q) = Foldable.and (liftA2 (<=) p q)
+
+-- | Calculate an intersect between two boundingboxes.
+intersect :: (Applicative f, Ord a) => Box f a -> Box f a -> Box f a
+intersect (Box p q) (Box r s) = Box (liftA2 max p r) (liftA2 min q s)
+
+-- | Enumerate the corners.
+corners :: (Applicative f, Traversable f) => Box f a -> [f a]
+corners (Box p q) = Traversable.sequence $ liftA2 (\a b -> [a, b]) p q
+
+sizePos :: (Applicative f, Num a) => f a -> Iso' (Box f a) (f a, f a)
+sizePos k = iso f g where
+    f (Box p q) = (liftA2 (-) q p, (+) <$> liftA2 (*) (fmap (1-) k) p <*> liftA2 (*) k q)
+    g (s, v) = Box ((-) <$> v <*> liftA2 (*) k s) ((+) <$> v <*> liftA2 (*) (fmap (1-) k) s)
+
+-- | The accessor for the position on the given reference. Usually the reference point 
+position :: (Applicative f, Num a) => f a -> Lens' (Box f a) (f a)
+position ref = sizePos ref . _2
+
+-- | The accessor for the size. A given reference point will be a center of resizing.
+size :: (Applicative f, Num a) => f a -> Lens' (Box f a) (f a)
+size ref = sizePos ref . _1

− Data/BoundingBox/Dim2.hs

@@ -1,114 +0,0 @@-{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable, DeriveDataTypeable, Rank2Types #-}
------------------------------------------------------------------------------
--- |
--- Module      :  Data.BoundingBox.Dim2
--- Copyright   :  (C) 2014 Fumiaki Kinoshita
--- License     :  BSD-style (see the file LICENSE)
---
--- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>
--- Stability   :  provisional
--- Portability :  non-portable
--- The type and accessors for 2D bounding boxes
-----------------------------------------------------------------------------
-module Data.BoundingBox.Dim2 (
-    BoundingBox(..)
-    , inBoundingBox
-    , intersect
-    , enclose
-    , _TLBR
-    , _BLTR
-    , _Corners
-    , Reference(..)
-    , sizePos
-    , position
-    , size
-    ) where
-
-import Linear
-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)
-
-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
--- |       |
--- L   C   R
--- |       |
--- BL--B--BR
--- @
-data Reference = TL | T | TR
-               |  L | C | R
-               | BL | B | BR
-    deriving (Show, Eq, Ord, Read, Enum, Bounded)
-
--- |
--- @
--- fst----+
---  |     |
---  +----snd
--- @
-_TLBR :: Iso' (BoundingBox a) (V2 a, V2 a)
-_TLBR = iso (\(BoundingBox x0 y0 x1 y1) -> (V2 x0 y0, V2 x1 y1)) (\(V2 x0 y0, V2 x1 y1) -> BoundingBox x0 y0 x1 y1)
-
--- |
--- @
---  +----snd
---  |     |
--- fst----+
--- @
-_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)
-
-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 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 = sizePos ref . _1

boundingboxes.cabal view

@@ -1,5 +1,5 @@ name:                boundingboxes
-version:             0.1.1
+version:             0.2
 synopsis:            The type for 2D bounding box
 -- description:         
 homepage:            https://github.com/fumieval/boundingboxes
@@ -14,10 +14,10 @@ cabal-version:       >=1.10
 
 library
-  exposed-modules:     Data.BoundingBox.Dim2
+  exposed-modules:     Data.BoundingBox
   -- other-modules:       
   other-extensions:    DeriveFunctor, DeriveFoldable, DeriveTraversable, DeriveDataTypeable, Rank2Types
-  build-depends:       base == 4.*, linear >= 1.0, lens >= 3.8 && < 5
+  build-depends:       base == 4.*, lens >= 3.8 && < 5
   -- hs-source-dirs:      
   default-language:    Haskell2010
 
@@ -34,4 +34,4 @@     , random
     , boundingboxes
   main-is: properties.hs
-  hs-source-dirs: tests+  hs-source-dirs: tests

tests/properties.hs view

@@ -1,5 +1,5 @@-{-# LANGUAGE TemplateHaskell, ViewPatterns #-}
-import Data.BoundingBox.Dim2
+{-# LANGUAGE TemplateHaskell, ViewPatterns, FlexibleInstances #-}
+import Data.BoundingBox
 import Test.QuickCheck
 import Test.Framework.Providers.QuickCheck2
 import Test.Framework.TH
@@ -8,32 +8,31 @@ import Control.Applicative
 import System.Random
 
-instance (Num a, Random a) => Arbitrary (BoundingBox a) where
+instance (Num a, Random a) => Arbitrary (Box V2 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)
+        return (Box (V2 x0 y0) (V2 x1 y1))
 
+newtype Reference = Reference { getReference :: V2 Float } deriving Show
+
 instance Arbitrary Reference where
-    arbitrary = toEnum <$> choose (0, 8)
+    arbitrary = fmap Reference $ V2 <$> oneof [pure 0, pure 0.5, pure 1] <*> oneof [pure 0, pure 0.5, pure 1]
 
 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_resize bb (getReference -> ref) sz = nearZero $ bb ^. position ref - bb' ^. position ref where
+    bb' = bb & size ref .~ getPositive sz :: Box V2 Float
 
-prop_rearrange ref bb pos = nearZero $ bb ^. size C - bb' ^. size C where
-    bb' = bb & position ref .~ pos :: BoundingBox Float
+prop_rearrange (getReference -> ref) bb pos = nearZero $ bb ^. size 0 - bb' ^. size 0 where
+    bb' = bb & position ref .~ pos :: Box V2 Float
 
-prop_construct ref pos (getPositive -> sz) = nearZero (bb ^. size C - sz)
+prop_construct (getReference -> ref) pos (getPositive -> sz) = nearZero (bb ^. size 0 - 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]
+    bb = sizePos ref # (sz, pos) :: Box V2 Float
 
 main = $(defaultMainGenerator)