gloss-algorithms 1.9.2.1 → 1.9.3.1

raw patch · 5 files changed

+252/−252 lines, 5 filesdep ~basedep ~ghc-primdep ~glossPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base, ghc-prim, gloss

API changes (from Hackage documentation)

Files

• Graphics/Gloss/Algorithms/RayCast.hs +41/−41
• Graphics/Gloss/Data/Extent.hs +92/−92
• Graphics/Gloss/Data/Quad.hs +8/−8
• Graphics/Gloss/Data/QuadTree.hs +107/−107
• gloss-algorithms.cabal +4/−4

@@ -2,8 +2,8 @@  -- | Various ray casting algorithms. module Graphics.Gloss.Algorithms.RayCast-	( castSegIntoCellularQuadTree-	, traceSegIntoCellularQuadTree)+        ( castSegIntoCellularQuadTree+        , traceSegIntoCellularQuadTree) where import Graphics.Gloss.Data.Picture import Graphics.Gloss.Data.Quad@@ -23,60 +23,60 @@ --         proper walk over the tree in the direction of the ray. --          castSegIntoCellularQuadTree -	:: forall a-	.  Point 			-- ^ (P1) Starting point of seg.-	-> Point 			-- ^ (P2) Final point of seg.-	-> Extent 			-- ^ Extent convering the whole tree.-	-> QuadTree a 			-- ^ The tree.-	-> Maybe (Point, Extent, a)	-- ^ Intersection point, extent of cell, value of cell (if any).+        :: forall a+        .  Point                        -- ^ (P1) Starting point of seg.+        -> Point                        -- ^ (P2) Final point of seg.+        -> Extent                       -- ^ Extent convering the whole tree.+        -> QuadTree a                   -- ^ The tree.+        -> Maybe (Point, Extent, a)     -- ^ Intersection point, extent of cell, value of cell (if any).  castSegIntoCellularQuadTree p1 p2 extent tree-	| cells@(_:_)	<- traceSegIntoCellularQuadTree p1 p2 extent tree-	, c : _		<- sortBy ((compareDistanceTo p1) `on` (\(a, _, _) -> a) ) cells-	= Just c-	-	| otherwise-	= Nothing-	+        | cells@(_:_)   <- traceSegIntoCellularQuadTree p1 p2 extent tree+        , c : _         <- sortBy ((compareDistanceTo p1) `on` (\(a, _, _) -> a) ) cells+        = Just c+        +        | otherwise+        = Nothing+         compareDistanceTo :: Point -> Point -> Point -> Ordering compareDistanceTo p0 p1 p2- = let	d1	= distance p0 p1-	d2	= distance p0 p2-   in	compare d1 d2+ = let  d1      = distance p0 p1+        d2      = distance p0 p2+   in   compare d1 d2  distance :: Point -> Point -> Float-distance (x1, y1) (x2, y2)	- = let	xd	= x2 - x1-	yd	= y2 - y1-   in	sqrt (xd * xd + yd * yd)+distance (x1, y1) (x2, y2)      + = let  xd      = x2 - x1+        yd      = y2 - y1+   in   sqrt (xd * xd + yd * yd)   -- | The quadtree contains cells of unit extent (NetHack style). --   Given a line segment (P1-P2) through the tree, return the list of cells  --   that intersect the segment. --  -traceSegIntoCellularQuadTree 	-	:: forall a-	.  Point 			-- ^ (P1) Starting point of seg.-	-> Point 			-- ^ (P2) Final point of seg.-	-> Extent 			-- ^ Extent covering the whole tree.-	-> QuadTree a 			-- ^ The tree.-	-> [(Point, Extent, a)]		-- ^ Intersection point, extent of cell, value of cell.-	+traceSegIntoCellularQuadTree    +        :: forall a+        .  Point                        -- ^ (P1) Starting point of seg.+        -> Point                        -- ^ (P2) Final point of seg.+        -> Extent                       -- ^ Extent covering the whole tree.+        -> QuadTree a                   -- ^ The tree.+        -> [(Point, Extent, a)]         -- ^ Intersection point, extent of cell, value of cell.+         traceSegIntoCellularQuadTree p1 p2 extent tree   = case tree of-	TNil	-> []-	TLeaf a-	 -> case intersectSegExtent p1 p2 extent of-		Just pos	-> [(pos, extent, a)]-		Nothing		-> []-					-	TNode nw ne sw se-	 | touchesSegExtent p1 p2 extent -	 -> concat+        TNil    -> []+        TLeaf a+         -> case intersectSegExtent p1 p2 extent of+                Just pos        -> [(pos, extent, a)]+                Nothing         -> []+                                        +        TNode nw ne sw se+         | touchesSegExtent p1 p2 extent +         -> concat              [ traceSegIntoCellularQuadTree p1 p2 (cutQuadOfExtent NW extent) nw              , traceSegIntoCellularQuadTree p1 p2 (cutQuadOfExtent NE extent) ne              , traceSegIntoCellularQuadTree p1 p2 (cutQuadOfExtent SW extent) sw              , traceSegIntoCellularQuadTree p1 p2 (cutQuadOfExtent SE extent) se ]-	-	_ -> []+        +        _ -> []

@@ -4,21 +4,21 @@ --   Using `Int`s (instead of `Float`s) for the bounds means we can safely --   compare extents for equality. module Graphics.Gloss.Data.Extent-	( Extent-	, Coord-	, makeExtent-	, takeExtent-	, squareExtent-	, sizeOfExtent-	, isUnitExtent-	, coordInExtent-	, pointInExtent-	, centerCoordOfExtent-	, cutQuadOfExtent-	, quadOfCoord-	, pathToCoord-	, intersectSegExtent-	, touchesSegExtent)+        ( Extent+        , Coord+        , makeExtent+        , takeExtent+        , squareExtent+        , sizeOfExtent+        , isUnitExtent+        , coordInExtent+        , pointInExtent+        , centerCoordOfExtent+        , cutQuadOfExtent+        , quadOfCoord+        , pathToCoord+        , intersectSegExtent+        , touchesSegExtent) where import Graphics.Gloss.Data.Point import Graphics.Gloss.Data.Quad@@ -30,112 +30,112 @@ --   We keep the type abstract to ensure that invalid extents cannot be --   constructed. data Extent-	= Extent Int Int Int Int-	deriving (Eq, Show)+        = Extent Int Int Int Int+        deriving (Eq, Show)   -- | An integral coordinate. type Coord-	= (Int, Int)+        = (Int, Int)   -- | Construct an extent.---	The north value must be > south, and east > west, else `error`.+--      The north value must be > south, and east > west, else `error`. makeExtent -	:: Int 	-- ^ y max (north)-	-> Int 	-- ^ y min (south)-	-> Int 	-- ^ x max (east)-	-> Int 	-- ^ x min (west)-	-> Extent+        :: Int  -- ^ y max (north)+        -> Int  -- ^ y min (south)+        -> Int  -- ^ x max (east)+        -> Int  -- ^ x min (west)+        -> Extent  makeExtent n s e w-	| n >= s, e >= w-	= Extent n s e w-	-	| otherwise-	= error "Graphics.Gloss.Geometry.Extent.makeExtent: invalid extent"+        | n >= s, e >= w+        = Extent n s e w+        +        | otherwise+        = error "Graphics.Gloss.Geometry.Extent.makeExtent: invalid extent"   -- | Take the NSEW components of an extent. takeExtent :: Extent -> (Int, Int, Int, Int) takeExtent (Extent n s e w)-	= (n, s, e, w)+        = (n, s, e, w)   -- | A square extent of a given size. squareExtent :: Int -> Extent squareExtent i-	= Extent i 0 i 0+        = Extent i 0 i 0   -- | Get the width and height of an extent. sizeOfExtent :: Extent -> (Int, Int) sizeOfExtent (Extent n s e w)-	= (e - w, n - s)+        = (e - w, n - s)   -- | Check if an extent is a square with a width and height of 1. isUnitExtent :: Extent -> Bool isUnitExtent extent-	= sizeOfExtent extent == (1, 1)+        = sizeOfExtent extent == (1, 1)   -- | Check whether a coordinate lies inside an extent. coordInExtent :: Extent -> Coord -> Bool coordInExtent (Extent n s e w) (x, y)-	=  x >= w && x < e-	&& y >= s && y < n+        =  x >= w && x < e+        && y >= s && y < n   -- | Check whether a point lies inside an extent. pointInExtent :: Extent -> Point -> Bool pointInExtent (Extent n s e w) (x, y)- = let	n'	= fromIntegral n-	s'	= fromIntegral s-	e'	= fromIntegral e-	w'	= fromIntegral w-	-   in	x >= w' && x <= e'+ = let  n'      = fromIntegral n+        s'      = fromIntegral s+        e'      = fromIntegral e+        w'      = fromIntegral w+        +   in   x >= w' && x <= e'      && y >= s' && y <= n'   -- | Get the coordinate that lies at the center of an extent. centerCoordOfExtent :: Extent -> (Int, Int) centerCoordOfExtent (Extent n s e w)- = 	( w + (e - w) `div` 2-	, s + (n - s) `div` 2)+ =      ( w + (e - w) `div` 2+        , s + (n - s) `div` 2)   -- | Cut one quadrant out of an extent. cutQuadOfExtent :: Quad -> Extent -> Extent cutQuadOfExtent quad (Extent n s e w)  - = let	hheight	= (n - s) `div` 2-	hwidth	= (e - w) `div` 2-   in	case quad of-	  	NW -> Extent n (s + hheight)  (e - hwidth) w-		NE -> Extent n (s + hheight)  e (w + hwidth)-		SW -> Extent (n - hheight) s  (e - hwidth) w-		SE -> Extent (n - hheight) s  e (w + hwidth)-	-	+ = let  hheight = (n - s) `div` 2+        hwidth  = (e - w) `div` 2+   in   case quad of+                NW -> Extent n (s + hheight)  (e - hwidth) w+                NE -> Extent n (s + hheight)  e (w + hwidth)+                SW -> Extent (n - hheight) s  (e - hwidth) w+                SE -> Extent (n - hheight) s  e (w + hwidth)+        +         -- | Get the quadrant that this coordinate lies in, if any. quadOfCoord :: Extent -> Coord -> Maybe Quad quadOfCoord extent coord- 	= listToMaybe -	$ filter (\q -> coordInExtent (cutQuadOfExtent q extent) coord)-	$ allQuads+        = listToMaybe +        $ filter (\q -> coordInExtent (cutQuadOfExtent q extent) coord)+        $ allQuads -	+         -- | Constuct a path to a particular coordinate in an extent. pathToCoord :: Extent -> Coord -> Maybe [Quad] pathToCoord extent coord-	| isUnitExtent extent	-	= Just []-	-	| otherwise-	= do	quad	<- quadOfCoord extent coord-		rest	<- pathToCoord (cutQuadOfExtent quad extent) coord-		return	$ quad : rest+        | isUnitExtent extent   +        = Just []+        +        | otherwise+        = do    quad    <- quadOfCoord extent coord+                rest    <- pathToCoord (cutQuadOfExtent quad extent) coord+                return  $ quad : rest   -- | If a line segment (P1-P2) intersects the outer edge of an extent then@@ -155,41 +155,41 @@ --  intersectSegExtent :: Point -> Point -> Extent -> Maybe Point intersectSegExtent p1@(x1, y1) p2 (Extent n' s' e' w')-	-- starts below extent-	| y1 < s-	, Just pos	<- intersectSegHorzSeg p1 p2 s w e-	= Just pos-	-	-- starts above extent-	| y1 > n-	, Just pos	<- intersectSegHorzSeg p1 p2 n w e-	= Just pos+        -- starts below extent+        | y1 < s+        , Just pos      <- intersectSegHorzSeg p1 p2 s w e+        = Just pos+        +        -- starts above extent+        | y1 > n+        , Just pos      <- intersectSegHorzSeg p1 p2 n w e+        = Just pos -	-- starts left of extent-	| x1 < w-	, Just pos	<- intersectSegVertSeg p1 p2 w s n-	= Just pos-	-	-- starts right of extent-	| x1 > e-	, Just pos	<- intersectSegVertSeg p1 p2 e s n-	= Just pos+        -- starts left of extent+        | x1 < w+        , Just pos      <- intersectSegVertSeg p1 p2 w s n+        = Just pos+        +        -- starts right of extent+        | x1 > e+        , Just pos      <- intersectSegVertSeg p1 p2 e s n+        = Just pos -	-- must be starting inside extent.-	| otherwise-	= Nothing-	-	where	n	= fromIntegral n'-		s	= fromIntegral s'-		e	= fromIntegral e'-		w	= fromIntegral w'+        -- must be starting inside extent.+        | otherwise+        = Nothing+        +        where   n       = fromIntegral n'+                s       = fromIntegral s'+                e       = fromIntegral e'+                w       = fromIntegral w'   -- | Check whether a line segment's endpoints are inside an extent, or if it --   intersects with the boundary. touchesSegExtent :: Point -> Point -> Extent -> Bool touchesSegExtent p1 p2 extent-	=   pointInExtent extent p1-       	 || pointInExtent extent p2-	 || isJust (intersectSegExtent p1 p2 extent)+        =   pointInExtent extent p1+         || pointInExtent extent p2+         || isJust (intersectSegExtent p1 p2 extent) 

@@ -1,16 +1,16 @@  module Graphics.Gloss.Data.Quad-	( Quad(..)-	, allQuads)+        ( Quad(..)+        , allQuads) where-	+         -- | Represents a Quadrant in the 2D plane. data Quad-	= NW 	-- ^ North West-	| NE 	-- ^ North East-	| SW 	-- ^ South West-	| SE	-- ^ South East-	deriving (Show, Eq, Enum)+        = NW    -- ^ North West+        | NE    -- ^ North East+        | SW    -- ^ South West+        | SE    -- ^ South East+        deriving (Show, Eq, Enum)  -- | A list of all quadrants. Same as @[NW .. SE]@. allQuads :: [Quad]

@@ -4,34 +4,34 @@ --   The smallest division corresponds to an unit `Extent`, so the total depth  --   of the tree will depend on what sized `Extent` you start with. module Graphics.Gloss.Data.QuadTree-	( QuadTree (..)-	, emptyTree-	, emptyNode-	, takeQuadOfTree-	, liftToQuad-	, insertByPath-	, insertByCoord-	, lookupNodeByPath-	, lookupByPath-	, lookupByCoord-	, flattenQuadTree-	, flattenQuadTreeWithExtents)+        ( QuadTree (..)+        , emptyTree+        , emptyNode+        , takeQuadOfTree+        , liftToQuad+        , insertByPath+        , insertByCoord+        , lookupNodeByPath+        , lookupByPath+        , lookupByCoord+        , flattenQuadTree+        , flattenQuadTreeWithExtents) where import Graphics.Gloss.Data.Quad import Graphics.Gloss.Data.Extent  -- | The quad tree structure. data QuadTree a-	-- | An empty node.-	= TNil+        -- | An empty node.+        = TNil -	-- | A leaf containint some value.-	| TLeaf a-	-	-- | A node with four children.-	| TNode (QuadTree a) (QuadTree a) 	-- NW NE-		(QuadTree a) (QuadTree a)	-- SW SE-	deriving Show+        -- | A leaf containint some value.+        | TLeaf a+        +        -- | A node with four children.+        | TNode (QuadTree a) (QuadTree a)       -- NW NE+                (QuadTree a) (QuadTree a)       -- SW SE+        deriving Show   -- | A `TNil` tree.@@ -47,145 +47,145 @@ -- | Get a quadrant from a node. --   If the tree does not have an outer node then `Nothing`. takeQuadOfTree-	:: Quad-	-> QuadTree a-	-> Maybe (QuadTree a)+        :: Quad+        -> QuadTree a+        -> Maybe (QuadTree a)  takeQuadOfTree quad tree  = case tree of-	TNil		-> Nothing-	TLeaf{}		-> Nothing-	TNode nw ne sw se-	 -> case quad of-		NW	-> Just nw-		NE	-> Just ne-		SW	-> Just sw-		SE	-> Just se+        TNil            -> Nothing+        TLeaf{}         -> Nothing+        TNode nw ne sw se+         -> case quad of+                NW      -> Just nw+                NE      -> Just ne+                SW      -> Just sw+                SE      -> Just se   -- | Apply a function to a quadrant of a node. --   If the tree does not have an outer node then return the original tree. liftToQuad-	:: Quad-	-> (QuadTree a -> QuadTree a) -	-> QuadTree a  -> QuadTree a+        :: Quad+        -> (QuadTree a -> QuadTree a) +        -> QuadTree a  -> QuadTree a  liftToQuad quad f tree  = case tree of-	TNil		-> tree-	TLeaf{}		-> tree-	TNode nw ne sw se-	 -> case quad of-		NW	-> TNode (f nw) ne sw se-		NE	-> TNode nw (f ne) sw se-		SW	-> TNode nw ne (f sw) se-		SE	-> TNode nw ne sw (f se)-		 -		+        TNil            -> tree+        TLeaf{}         -> tree+        TNode nw ne sw se+         -> case quad of+                NW      -> TNode (f nw) ne sw se+                NE      -> TNode nw (f ne) sw se+                SW      -> TNode nw ne (f sw) se+                SE      -> TNode nw ne sw (f se)+                 +                 -- | Insert a value into the tree at the position given by a path. --   If the path intersects an existing `TLeaf` then return the original tree. insertByPath :: [Quad] -> a -> QuadTree a -> QuadTree a-	+         insertByPath [] x _-	= TLeaf x-	+        = TLeaf x+         insertByPath (q:qs) x tree  = case tree of-	TNil	-> liftToQuad q (insertByPath qs x) emptyNode-	TLeaf{}	-> tree-	TNode{}	-> liftToQuad q (insertByPath qs x) tree+        TNil    -> liftToQuad q (insertByPath qs x) emptyNode+        TLeaf{} -> tree+        TNode{} -> liftToQuad q (insertByPath qs x) tree   -- | Insert a value into the node containing this coordinate. --   The node is created at maximum depth, corresponding to an unit `Extent`. insertByCoord :: Extent -> Coord -> a -> QuadTree a -> Maybe (QuadTree a) insertByCoord extent coord x tree- = do	path	<- pathToCoord extent coord-	return	$  insertByPath path x tree+ = do   path    <- pathToCoord extent coord+        return  $  insertByPath path x tree   -- | Lookup a node based on a path to it. lookupNodeByPath-	:: [Quad]-	-> QuadTree a-	-> Maybe (QuadTree a)+        :: [Quad]+        -> QuadTree a+        -> Maybe (QuadTree a)  lookupNodeByPath [] tree-	= Just tree-	+        = Just tree+         lookupNodeByPath (q:qs) tree  = case tree of-	TNil	-> Nothing-	TLeaf{}	-> Nothing-	TNode{}-	 -> let Just quad	= takeQuadOfTree q tree-	    in  lookupNodeByPath qs quad+        TNil    -> Nothing+        TLeaf{} -> Nothing+        TNode{}+         -> let Just quad       = takeQuadOfTree q tree+            in  lookupNodeByPath qs quad   -- | Lookup an element based given a path to it. lookupByPath :: [Quad] -> QuadTree a -> Maybe a lookupByPath path tree  = case lookupNodeByPath path tree of-	Just (TLeaf x)	-> Just x-	_		-> Nothing+        Just (TLeaf x)  -> Just x+        _               -> Nothing   -- | Lookup a node if a tree given a coordinate which it contains. lookupByCoord -	:: forall a-	.  Extent 	-- ^ Extent that covers the whole tree.-	-> Coord 	-- ^ Coordinate of the value of interest.-	-> QuadTree a -	-> Maybe a+        :: forall a+        .  Extent       -- ^ Extent that covers the whole tree.+        -> Coord        -- ^ Coordinate of the value of interest.+        -> QuadTree a +        -> Maybe a lookupByCoord extent coord tree- = do	path	<- pathToCoord extent coord-	lookupByPath path tree-	-	+ = do   path    <- pathToCoord extent coord+        lookupByPath path tree+        +         -- | Flatten a QuadTree into a list of its contained values, with coordinates. flattenQuadTree -	:: forall a-	.  Extent 	-- ^ Extent that covers the whole tree.-	-> QuadTree a -	-> [(Coord, a)]-	+        :: forall a+        .  Extent       -- ^ Extent that covers the whole tree.+        -> QuadTree a +        -> [(Coord, a)]+         flattenQuadTree extentInit treeInit  = flatten' extentInit treeInit- where	flatten' extent tree- 	 = case tree of-		TNil	-> []-		TLeaf x	-		 -> let (_, s, _, w) = takeExtent extent-		    in  [((w, s), x)]+ where  flatten' extent tree+         = case tree of+                TNil    -> []+                TLeaf x +                 -> let (_, s, _, w) = takeExtent extent+                    in  [((w, s), x)] -		TNode{}	-> concat $ map (flattenQuad extent tree) allQuads-			-	flattenQuad extent tree quad- 	 = let	extent'		= cutQuadOfExtent quad extent-		Just tree'	= takeQuadOfTree quad tree-   	   in	flatten' extent' tree'+                TNode{} -> concat $ map (flattenQuad extent tree) allQuads+                        +        flattenQuad extent tree quad+         = let  extent'         = cutQuadOfExtent quad extent+                Just tree'      = takeQuadOfTree quad tree+           in   flatten' extent' tree'   -- | Flatten a QuadTree into a list of its contained values, with coordinates. flattenQuadTreeWithExtents-	:: forall a-	.  Extent 	-- ^ Extent that covers the whole tree.-	-> QuadTree a -	-> [(Extent, a)]-	+        :: forall a+        .  Extent       -- ^ Extent that covers the whole tree.+        -> QuadTree a +        -> [(Extent, a)]+         flattenQuadTreeWithExtents extentInit treeInit  = flatten' extentInit treeInit- where	flatten' extent tree- 	 = case tree of-		TNil	-> []-		TLeaf x	-		 -> [(extent, x)]+ where  flatten' extent tree+         = case tree of+                TNil    -> []+                TLeaf x +                 -> [(extent, x)] -		TNode{}	-> concat $ map (flattenQuad extent tree) allQuads-			-	flattenQuad extent tree quad- 	 = let	extent'		= cutQuadOfExtent quad extent-		Just tree'	= takeQuadOfTree quad tree-   	   in	flatten' extent' tree'+                TNode{} -> concat $ map (flattenQuad extent tree) allQuads+                        +        flattenQuad extent tree quad+         = let  extent'         = cutQuadOfExtent quad extent+                Just tree'      = takeQuadOfTree quad tree+           in   flatten' extent' tree'  

@@ -1,5 +1,5 @@ Name:                gloss-algorithms-Version:             1.9.2.1+Version:             1.9.3.1 License:             MIT License-file:        LICENSE Author:              Ben Lippmeier@@ -22,10 +22,10 @@  Library   Build-Depends: -        base       == 4.7.*,-        ghc-prim   == 0.3.*,+        base       == 4.8.*,+        ghc-prim   == 0.4.*,         containers == 0.5.*,-        gloss      == 1.9.2.*+        gloss      == 1.9.3.*    ghc-options:         -O2 -Wall