{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TemplateHaskell #-}

module Shape.Description.AABB where

import Shape.Description

import Control.Lens
import Data.Semigroup
import Linear
import Linear.Affine

data AABB a = AABB
  { _aabbCenter :: Point V2 a
  , _aabbSize :: V2 a
  } deriving (Eq, Show, Functor)

makeAABBFromShape
  :: (Ord a, Integral a)
  => Shape a -> AABB a
makeAABBFromShape (ManyShape [a]) = makeAABBFromShape a
makeAABBFromShape (ManyShape (a:as)) =
  foldr (<>) (makeAABBFromShape a) (map makeAABBFromShape as)
makeAABBFromShape (Circle cen r) = AABB cen (pure r)
makeAABBFromShape (Rectangle cen sz) = AABB cen $ (`div` 2) <$> sz
makeAABBFromShape (Image cen sz _) = AABB cen sz
makeAABBFromShape (WithFillColour _ s) = makeAABBFromShape s
makeAABBFromShape (WithStrokeColour _ s) = makeAABBFromShape s

makeLenses ''AABB

combineAABB
  :: (Num a, Ord a)
  => (a -> a) -> AABB a -> AABB a -> AABB a
combineAABB divFunc a b =
  AABB (P $ V2 cenX cenY) (V2 (maxX - cenX) (maxY - cenY))
  where
    minX =
      min
        (a ^. aabbCenter . _x - a ^. aabbSize . _x)
        (b ^. aabbCenter . _x - b ^. aabbSize . _x)
    minY =
      min
        (a ^. aabbCenter . _y - a ^. aabbSize . _y)
        (b ^. aabbCenter . _y - b ^. aabbSize . _y)
    maxX =
      max
        (a ^. aabbCenter . _x + a ^. aabbSize . _x)
        (b ^. aabbCenter . _x + b ^. aabbSize . _x)
    maxY =
      max
        (a ^. aabbCenter . _y + a ^. aabbSize . _y)
        (b ^. aabbCenter . _y + b ^. aabbSize . _y)
    cenX = divFunc (minX + maxX)
    cenY = divFunc (minY + maxY)

instance (Integral a, Ord a) =>
         Semigroup (AABB a) where
  (<>) = combineAABB (`div` 2)

pointInsideAABB
  :: (Ord a, Num a, R2 f)
  => AABB a -> f a -> Bool
pointInsideAABB (AABB cen sz) p =
  (p ^. _x >= cen ^. _x - sz ^. _x) &&
  (p ^. _x <= cen ^. _x + sz ^. _x) &&
  (p ^. _y >= cen ^. _y - sz ^. _y) &&
  (p ^. _y <= cen ^. _y + sz ^. _y)

cornerPoints
  :: Num a
  => AABB a -> [V2 a]
cornerPoints (AABB cen sz) =
  V2 <$> [cen ^. _x - sz ^. _x, cen ^. _x + sz ^. _x] <*>
  [cen ^. _y - sz ^. _y, cen ^. _y + sz ^. _y]

aabbOverlap
  :: (Ord a, Num a)
  => AABB a -> AABB a -> Bool
aabbOverlap a = any (pointInsideAABB a) . cornerPoints
