{-# LANGUAGE PatternGuards #-}
module Graphics.Gloss.Data.Extent
( 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
import Graphics.Gloss.Geometry.Line
import Data.Maybe
data Extent
= Extent Int Int Int Int
deriving (Eq, Show)
type Coord
= (Int, Int)
makeExtent
:: Int
-> Int
-> Int
-> Int
-> Extent
makeExtent n s e w
| n >= s, e >= w
= Extent n s e w
| otherwise
= error "Graphics.Gloss.Geometry.Extent.makeExtent: invalid extent"
takeExtent :: Extent -> (Int, Int, Int, Int)
takeExtent (Extent n s e w)
= (n, s, e, w)
squareExtent :: Int -> Extent
squareExtent i
= Extent i 0 i 0
sizeOfExtent :: Extent -> (Int, Int)
sizeOfExtent (Extent n s e w)
= (e - w, n - s)
isUnitExtent :: Extent -> Bool
isUnitExtent extent
= sizeOfExtent extent == (1, 1)
coordInExtent :: Extent -> Coord -> Bool
coordInExtent (Extent n s e w) (x, y)
= x >= w && x < e
&& y >= s && y < n
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'
&& y >= s' && y <= n'
centerCoordOfExtent :: Extent -> (Int, Int)
centerCoordOfExtent (Extent n s e w)
= ( w + (e - w) `div` 2
, s + (n - s) `div` 2)
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)
quadOfCoord :: Extent -> Coord -> Maybe Quad
quadOfCoord extent coord
= listToMaybe
$ filter (\q -> coordInExtent (cutQuadOfExtent q extent) coord)
$ allQuads
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
intersectSegExtent :: Point -> Point -> Extent -> Maybe Point
intersectSegExtent p1@(x1, y1) p2 (Extent n' s' e' w')
| y1 < s
, Just pos <- intersectSegHorzSeg p1 p2 s w e
= Just pos
| y1 > n
, Just pos <- intersectSegHorzSeg p1 p2 n w e
= Just pos
| x1 < w
, Just pos <- intersectSegVertSeg p1 p2 w s n
= Just pos
| x1 > e
, Just pos <- intersectSegVertSeg p1 p2 e s n
= Just pos
| otherwise
= Nothing
where n = fromIntegral n'
s = fromIntegral s'
e = fromIntegral e'
w = fromIntegral w'
touchesSegExtent :: Point -> Point -> Extent -> Bool
touchesSegExtent p1 p2 extent
= pointInExtent extent p1
|| pointInExtent extent p2
|| isJust (intersectSegExtent p1 p2 extent)