```module Sifflet.Data.Geometry
(Position(..),
positionDelta, positionDistance,
positionDistanceSquared, positionCloseEnough,
Circle(..), pointInCircle,
Size(..),
BBox(..),
bbX, bbY, bbWidth, bbSetWidth, bbHeight, bbPosition, bbSize,
bbToRect, bbFromRect, bbCenter, bbLeft, bbXCenter, bbRight,
bbTop, bbYCenter, bbBottom,
bbMerge, bbMergeList, pointInBB,
Widen(widen),
Translate(..)
)

where

import Data.Tree as T
import Graphics.UI.Gtk(Rectangle(Rectangle))

-- A Position may be interpreted either absolutely, as a point (x, y);
-- or relatively, as an offset (dx, dy)

data Position = Position {posX :: Double, posY :: Double} -- x, y

positionDelta :: Position -> Position -> (Double, Double)
positionDelta (Position x1 y1) (Position x2 y2) = (x2 - x1, y2 - y1)

positionDistance :: Position -> Position -> Double
positionDistance p1 p2 = sqrt (positionDistanceSquared p1 p2)

positionDistanceSquared :: Position -> Position -> Double
positionDistanceSquared (Position x1 y1) (Position x2 y2) =
(x1 - x2) ** 2 + (y1 - y2) ** 2

positionCloseEnough :: Position -> Position -> Double -> Bool
-- Essentially asks if p1 and p2 are nearly intersecting,
-- i.e., if p1 is within a circle with center p2 and the given radius
positionDistanceSquared p1 p2 <= radius ** 2

data Circle = Circle {circleCenter :: Position,

pointInCircle :: Position -> Circle -> Bool
pointInCircle point (Circle center radius) =

data Size = Size {sizeW :: Double, sizeH :: Double}    -- width, height

-- | BBox x y width height; (x, y) is the top left corner

data BBox = BBox Double Double Double Double

-- | BBox accessors and utilities

bbX, bbY, bbWidth, bbHeight :: BBox -> Double
bbX (BBox x _y _w _h) = x

bbY (BBox _x y _w _h) = y
bbWidth (BBox _x _y w _h) = w
bbHeight (BBox _x _y _w h) = h

bbPosition :: BBox -> Position
bbPosition (BBox x y _w _h) = Position x y

bbSize :: BBox -> Size
bbSize (BBox _x _y w h) = Size w h

bbCenter :: BBox -> Position
bbCenter (BBox x y w h) = Position (x + w / 2) (y + h / 2)

bbSetWidth :: BBox -> Double -> BBox
bbSetWidth (BBox x y _w h) nwidth = BBox x y nwidth h

bbLeft, bbXCenter, bbRight :: BBox -> Double
bbLeft = bbX
bbXCenter (BBox x _y w _h) = x + w / 2
bbRight (BBox x _y w _h) = x + w

bbTop, bbYCenter, bbBottom :: BBox -> Double
bbTop = bbY
bbYCenter (BBox _x y _w h) = y + h / 2
bbBottom (BBox _x y _w h) = y + h

bbToRect :: BBox -> Rectangle
bbToRect (BBox x y w h) =
Rectangle (round x) (round y) (round w) (round h)

bbFromRect :: Rectangle -> BBox
bbFromRect (Rectangle x y w h) =
BBox (fromIntegral x) (fromIntegral y)
(fromIntegral w) (fromIntegral h)

-- | Form a new BBox which encloses two bboxes
bbMerge :: BBox -> BBox -> BBox
bbMerge bb1 bb2 =
let f1 ! f2 = f1 (f2 bb1) (f2 bb2)
bottom = max ! bbBottom -- i.e.,  max (bbBottom bb1) (bbBottom bb2)
top = min ! bbTop
left = min ! bbLeft
right = max ! bbRight
in BBox left top (right - left) (bottom - top)

bbMergeList :: [BBox] -> BBox
bbMergeList [] = error "bbMergeList: empty list"
bbMergeList (b:bs) = foldl bbMerge b bs

-- Test whether a point (e.g., from mouse click) is within a
-- bounding box
pointInBB :: Position -> BBox -> Bool
pointInBB (Position x y) (BBox x1 y1 w h) =
x >= x1 &&
x <= x1 + w &&
y >= y1 &&
y <= y1 + h

class Widen a where
-- | Make an object have at least a specified minimum width;
-- does nothing if it's already at least that wide
widen :: a -> Double -> a

instance Widen BBox where
widen bb@(BBox x y w h) minWidth =
if w >= minWidth
then bb
else BBox x y minWidth h

-- | A Translate is a thing that can be repositioned by
-- delta x and delta y

class Translate a where
translate :: Double -- ^ delta X
-> Double -- ^ delta Y
-> a -- ^ thing in old position
-> a -- ^ thing in new position

instance (Translate e) => Translate [e] where
translate dx dy = map (translate dx dy)

instance (Translate e) => Translate (Tree e) where
translate dx dy t =
T.Node (translate dx dy (rootLabel t))
(translate dx dy (subForest t))

instance Translate BBox where
translate dx dy (BBox x y w h) = BBox (x + dx) (y + dy) w h

instance Translate Position where
translate dx dy (Position x y) = Position (x + dx) (y + dy)

instance Translate Circle where
translate dx dy (Circle center radius) =
Circle (translate dx dy center) radius

```