QuadTree

module QuadTree where

data Point = Point { getX :: Double, getY :: Double } deriving (Show)

data QTree
    = Leaf (Point, Point)
    | QS (Maybe Point) QTree QTree QTree QTree (Point, Point)
    deriving (Show)

-- ---------
-- | 3 | 2 |
-- ---------
-- | 0 | 1 |
-- ---------

dlc :: QTree -> Point
dlc (Leaf (p, _)) = p
dlc (QS _ _ _ _ _ (p, _)) = p

urc :: QTree -> Point
urc (Leaf (_, p)) = p
urc (QS _ _ _ _ _ (_, p)) = p

mid :: Point -> Point -> Point
mid p1 p2 = Point ((getX p1 + getX p2) / 2) ((getY p2 + getY p1) / 2)

getCorners :: Int -> Point -> Point -> Point -> (Point, Point)
getCorners 0 d m _ = (d, m)
getCorners 1 d m u = (Point (getX m) (getY d), Point (getX u) (getY m))
getCorners 2 _ m u = (m, u)
getCorners 3 d m u = (Point (getX d) (getY m), Point (getX m) (getY u))

contains :: Point -> Point -> Point -> Bool
contains p c1 c2 = (getX p >= getX c1) && (getY p >= getY c1) &&
                   (getX p < getX c2) && (getY p < getY c2)

insertQT :: Point -> QTree -> QTree
insertQT p t
    | contains p d u = addPoint p t
    | otherwise = t
    where
        d = dlc t
        u = urc t
        m = mid d u
        addPoint p (Leaf corners) =
            QS (Just p)
            (Leaf $ getCorners 0 d m u)
            (Leaf $ getCorners 1 d m u)
            (Leaf $ getCorners 2 d m u)
            (Leaf $ getCorners 3 d m u)
            corners
        addPoint p (QS Nothing ld rd ru lu crn) =
            QS Nothing
            (insertQT p ld)
            (insertQT p rd)
            (insertQT p ru)
            (insertQT p lu)
            crn
        addPoint p (QS (Just pnt) ld rd ru lu crn) =
            addPoint p $ addPoint pnt (QS Nothing ld rd ru lu crn)

p1 = Point (-100.0) (-100.0)
p2 = Point 100.0 100.0
qt1 = Leaf (p1, p2)