gloss-algorithms 1.11.1.1 → 1.12.0.0
raw patch · 6 files changed
+72/−69 lines, 6 filesdep ~basedep ~ghc-primdep ~glosssetup-changednew-uploaderPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base, ghc-prim, gloss
API changes (from Hackage documentation)
Files
- Graphics/Gloss/Algorithms/RayCast.hs +18/−17
- Graphics/Gloss/Data/Extent.hs +15/−15
- Graphics/Gloss/Data/Quad.hs +1/−1
- Graphics/Gloss/Data/QuadTree.hs +22/−22
- Setup.hs +0/−2
- gloss-algorithms.cabal +16/−12
Graphics/Gloss/Algorithms/RayCast.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE PatternGuards, RankNTypes #-}+{-# LANGUAGE PatternGuards #-}+{-# LANGUAGE RankNTypes #-} -- | Various ray casting algorithms. module Graphics.Gloss.Algorithms.RayCast@@ -14,15 +15,15 @@ -- | The quadtree contains cells of unit extent (NetHack style).--- Given a line segement (P1-P2) through the tree, get the cell +-- Given a line segement (P1-P2) through the tree, get the cell -- closest to P1 that intersects the segment, if any. ------ TODO: This currently uses a naive algorithm. It just calls +-- TODO: This currently uses a naive algorithm. It just calls -- `traceSegIntoCellularQuadTree` and sorts the results--- to get the one closest to P1. It'd be better to do a +-- to get the one closest to P1. It'd be better to do a -- proper walk over the tree in the direction of the ray.--- -castSegIntoCellularQuadTree +--+castSegIntoCellularQuadTree :: forall a . Point -- ^ (P1) Starting point of seg. -> Point -- ^ (P2) Final point of seg.@@ -34,10 +35,10 @@ | 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@@ -45,38 +46,38 @@ in compare d1 d2 distance :: Point -> Point -> Float-distance (x1, y1) (x2, y2) +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 +-- Given a line segment (P1-P2) through the tree, return the list of cells -- that intersect the segment.--- -traceSegIntoCellularQuadTree +--+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 ++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 + | 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 ]- + _ -> []
Graphics/Gloss/Data/Extent.hs view
@@ -41,7 +41,7 @@ -- | Construct an extent. -- The north value must be > south, and east > west, else `error`.-makeExtent +makeExtent :: Int -- ^ y max (north) -> Int -- ^ y min (south) -> Int -- ^ x max (east)@@ -51,7 +51,7 @@ makeExtent n s e w | n >= s, e >= w = Extent n s e w- + | otherwise = error "Graphics.Gloss.Geometry.Extent.makeExtent: invalid extent" @@ -94,7 +94,7 @@ s' = fromIntegral s e' = fromIntegral e w' = fromIntegral w- + in x >= w' && x <= e' && y >= s' && y <= n' @@ -108,7 +108,7 @@ -- | Cut one quadrant out of an extent. cutQuadOfExtent :: Quad -> Extent -> Extent-cutQuadOfExtent quad (Extent n s e w) +cutQuadOfExtent quad (Extent n s e w) = let hheight = (n - s) `div` 2 hwidth = (e - w) `div` 2 in case quad of@@ -116,22 +116,22 @@ 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 + = 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 + | isUnitExtent extent = Just []- + | otherwise = do quad <- quadOfCoord extent coord rest <- pathToCoord (cutQuadOfExtent quad extent) coord@@ -149,17 +149,17 @@ -- | / | -- + | -- /--------- / +-- / -- P1 -- @--- +-- 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@@ -169,7 +169,7 @@ | 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@@ -178,7 +178,7 @@ -- must be starting inside extent. | otherwise = Nothing- + where n = fromIntegral n' s = fromIntegral s' e = fromIntegral e'
Graphics/Gloss/Data/Quad.hs view
@@ -3,7 +3,7 @@ ( Quad(..) , allQuads) where- + -- | Represents a Quadrant in the 2D plane. data Quad = NW -- ^ North West
Graphics/Gloss/Data/QuadTree.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE RankNTypes #-} -- | A QuadTree can be used to recursively divide up 2D space into quadrants.--- The smallest division corresponds to an unit `Extent`, so the total depth +-- 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 (..)@@ -27,7 +27,7 @@ -- | 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@@ -67,7 +67,7 @@ -- If the tree does not have an outer node then return the original tree. liftToQuad :: Quad- -> (QuadTree a -> QuadTree a) + -> (QuadTree a -> QuadTree a) -> QuadTree a -> QuadTree a liftToQuad quad f tree@@ -80,15 +80,15 @@ 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- + insertByPath (q:qs) x tree = case tree of TNil -> liftToQuad q (insertByPath qs x) emptyNode@@ -112,7 +112,7 @@ lookupNodeByPath [] tree = Just tree- + lookupNodeByPath (q:qs) tree = case tree of TNil -> Nothing@@ -131,58 +131,58 @@ -- | Lookup a node if a tree given a coordinate which it contains.-lookupByCoord +lookupByCoord :: forall a . Extent -- ^ Extent that covers the whole tree. -> Coord -- ^ Coordinate of the value of interest.- -> QuadTree a + -> QuadTree a -> Maybe a lookupByCoord extent coord tree = do path <- pathToCoord extent coord lookupByPath path tree- - ++ -- | Flatten a QuadTree into a list of its contained values, with coordinates.-flattenQuadTree +flattenQuadTree :: forall a . Extent -- ^ Extent that covers the whole tree.- -> QuadTree a + -> QuadTree a -> [(Coord, a)]- + flattenQuadTree extentInit treeInit = flatten' extentInit treeInit where flatten' extent tree = case tree of TNil -> []- TLeaf x + 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' --- | Flatten a QuadTree into a list of its contained values, with coordinates.+-- | Flatten a QuadTree into a list of its contained values, with extents. flattenQuadTreeWithExtents :: forall a . Extent -- ^ Extent that covers the whole tree.- -> QuadTree a + -> QuadTree a -> [(Extent, a)]- + flattenQuadTreeWithExtents extentInit treeInit = flatten' extentInit treeInit where flatten' extent tree = case tree of TNil -> []- TLeaf x + 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
− Setup.hs
@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain
gloss-algorithms.cabal view
@@ -1,5 +1,5 @@ Name: gloss-algorithms-Version: 1.11.1.1+Version: 1.12.0.0 License: MIT License-file: LICENSE Author: Ben Lippmeier@@ -17,18 +17,24 @@ Data structures and algorithms for working with 2D graphics. source-repository head- type: git- location: https://github.com/benl23x5/gloss+ type: git+ location: https://github.com/benl23x5/gloss +source-repository this+ type: git+ tag: v1.12.0.0+ location: https://github.com/benl23x5/gloss+ Library- Build-Depends: - base >= 4.8 && < 4.10,- ghc-prim >= 0.4 && < 0.6,- containers == 0.5.*,- gloss == 1.11.*+ Build-Depends:+ base >= 4.8 && < 4.12+ , containers == 0.5.*+ , ghc-prim+ , gloss == 1.12.* ghc-options:- -O2 -Wall+ -O2+ -Wall Exposed-modules: Graphics.Gloss.Algorithms.RayCast@@ -36,6 +42,4 @@ Graphics.Gloss.Data.Quad Graphics.Gloss.Data.QuadTree - Extensions:- DeriveDataTypeable- PatternGuards+-- vim: nospell