{-# OPTIONS_GHC -optc-D_LARGEFILE_SOURCE #-}
{-# OPTIONS_GHC -optc-D_LARGEFILE64_SOURCE #-}
{-# OPTIONS_GHC -optc-D_THREAD_SAFE #-}
{-# OPTIONS_GHC -optc-D_REENTRANT #-}
{-# OPTIONS_GHC -optc-DBUILD_DIR="build/debug" #-}
{-# OPTIONS_GHC -optc-DGHC_VERSION=90205 #-}
{-# OPTIONS_GHC -optc-D__APPLE__ #-}
{-# LINE 1 "Util/Rect.hsc" #-}
module Util.Rect (
Rect(Rect)
, Point
, x, y, w, h, r, b
, upper_left, lower_left, upper_right, lower_right
, xywh, empty
, place, resize
, distance, intersection, overlaps, touches, point_distance
, contains_point, touches_point
) where
import qualified Util.Pretty as Pretty
import qualified Util.FFI as FFI
import ForeignC
data Rect = Rect { x :: Int, y :: Int, w :: Int, h :: Int }
deriving (Eq, Ord, Show, Read)
type Point = (Int, Int)
instance Pretty.Pretty Rect where
format (Rect x y w h) = Pretty.text "Rect" Pretty.<+> Pretty.format (x, y)
Pretty.<+> Pretty.format (w, h)
r, b :: Rect -> Int
r rect = x rect + w rect
b rect = y rect + h rect
upper_left, lower_left, upper_right, lower_right :: Rect -> Point
upper_left rect = (x rect, y rect)
lower_left rect = (x rect, b rect)
upper_right rect = (r rect, y rect)
lower_right rect = (r rect, b rect)
xywh :: Int -> Int -> Int -> Int -> Rect
xywh = Rect
empty :: Rect
empty = Rect 0 0 0 0
place :: Int -> Int -> Rect -> Rect
place x y rect = xywh x y (w rect) (h rect)
resize :: Int -> Int -> Rect -> Rect
resize w h rect = xywh (x rect) (y rect) w h
distance :: Point -> Rect -> Double
distance (px, py) (Rect x y w h)
| x <= px && px < r && y <= py && py < b = 0
| x <= px && px < r = fromIntegral $
min (abs (y - py)) (abs (b - py))
| y <= py && py < b = fromIntegral $
min (abs (x - px)) (abs (r - px))
| otherwise = dist (x, y) `min` dist (r, y)
`min` dist (r, b) `min` dist (x, b)
where
r = x + w
b = y + h
dist = point_distance (px, py)
intersection :: Rect -> Rect -> Rect
intersection r1 r2 = Rect x_ y_ (max 0 (r_-x_)) (max 0 (b_-y_))
where
x_ = max (x r1) (x r2)
y_ = max (y r1) (y r2)
r_ = min (r r1) (r r2)
b_ = min (b r1) (b r2)
overlaps :: Rect -> Rect -> Bool
overlaps r1 r2 = not $
x r1 >= r r2 || r r1 <= x r2 || y r1 >= b r2 || b r1 <= y r2
touches :: Rect -> Rect -> Bool
touches r1 r2 = not $
x r1 > r r2 || r r1 < x r2 || y r1 > b r2 || b r1 < y r2
point_distance :: Point -> Point -> Double
point_distance (x1, y1) (x2, y2) =
sqrt $ fromIntegral (x2-x1) ** 2 + fromIntegral (y2-y1) ** 2
contains_point :: Rect -> Point -> Bool
contains_point rect (x_, y_) =
x rect <= x_ && x_ < r rect && y rect <= y_ && y_ < b rect
touches_point :: Rect -> Point -> Bool
touches_point rect (x_, y_) =
x rect <= x_ && x_ <= r rect && y rect <= y_ && y_ <= b rect
instance CStorable Rect where
sizeOf _ = (16)
{-# LINE 122 "Util/Rect.hsc" #-}
alignment _ = alignment (0 :: CInt)
poke p (Rect x y w h) = do
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) p (i x)
{-# LINE 125 "Util/Rect.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 4)) p (i y)
{-# LINE 126 "Util/Rect.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 8)) p (i w)
{-# LINE 127 "Util/Rect.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 12)) p (i h)
{-# LINE 128 "Util/Rect.hsc" #-}
where i = FFI.c_int
peek p = do
x <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p :: IO CInt
{-# LINE 131 "Util/Rect.hsc" #-}
y <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) p :: IO CInt
{-# LINE 132 "Util/Rect.hsc" #-}
w <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) p :: IO CInt
{-# LINE 133 "Util/Rect.hsc" #-}
h <- ((\hsc_ptr -> peekByteOff hsc_ptr 12)) p :: IO CInt
{-# LINE 134 "Util/Rect.hsc" #-}
return $ xywh (i x) (i y) (i w) (i h)
where i = fromIntegral
instance CStorable Point where
sizeOf _ = (8)
{-# LINE 139 "Util/Rect.hsc" #-}
alignment _ = alignment (0 :: CInt)
poke p (x, y) = do
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) p (i x)
{-# LINE 142 "Util/Rect.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 4)) p (i y)
{-# LINE 143 "Util/Rect.hsc" #-}
where i = FFI.c_int
peek p = do
x <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p :: IO CInt
{-# LINE 146 "Util/Rect.hsc" #-}
y <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) p :: IO CInt
{-# LINE 147 "Util/Rect.hsc" #-}
return (i x, i y)
where i = fromIntegral