module WholePixels.Geometry where

import Relude

fitGrid :: (Double, Double) -> Int -> ((Int, Int), Double)
fitGrid (canvas_w, canvas_h) desired_size =
  ((bool swap id (canvas_w > canvas_h) (grid_min, grid_max)), cell_size)
  where
    canvas_max = max canvas_w canvas_h
    canvas_min = min canvas_w canvas_h
    grid_min = desired_size
    grid_max = floor $ fromIntegral desired_size * canvas_max / canvas_min
    cell_size = floorf $ canvas_min / fromIntegral grid_min

roundf :: Double -> Double
roundf = fromIntegral @Int . round

floorf :: Double -> Double
floorf = fromIntegral @Int . floor

divf :: Double -> Int -> Double
divf x y = x / fromIntegral y

angularNeighborhood :: Double -> Double -> Double -> Double
angularNeighborhood center size a = exp (-((a - center) / size) ^ (2 :: Int))

lerp :: Double -> Double -> Double -> Double
lerp a x0 x1 = a * x1 + (1 - a) * x0

data Direction = R | D | L | U
  deriving (Show, Eq, Ord, Enum, Bounded)

data Rect
  = Rect
      { rx, ry, rw, rh :: !Double
      }
  deriving (Show, Eq)

unitRect :: Rect
unitRect = Rect (-1.0) (-1.0) 2.0 2.0

hsplit :: Rect -> [Rect]
hsplit = hsplitMod (/ 2)

hsplitGolden :: Rect -> [Rect]
hsplitGolden = hsplitMod (/ goldenRatio)

hsplitReverseGolden :: Rect -> [Rect]
hsplitReverseGolden = hsplitMod (* (1 - 1 / goldenRatio))

hsplitMod :: (Double -> Double) -> Rect -> [Rect]
hsplitMod modh r =
  [ r {rh = h'}
  , r {rh = rh r - h', ry = ry r + h'}
  ]
  where
    h' = modh $ rh r

vsplit :: Rect -> [Rect]
vsplit = vsplitMod (/ 2)

vsplitGolden :: Rect -> [Rect]
vsplitGolden = vsplitMod (/ goldenRatio)

vsplitReverseGolden :: Rect -> [Rect]
vsplitReverseGolden = vsplitMod (* (1 - 1 / goldenRatio))

vsplitMod :: (Double -> Double) -> Rect -> [Rect]
vsplitMod modw r =
  [ r {rw = w'}
  , r {rw = rw r - w', rx = rx r + w'}
  ]
  where
    w' = modw $ rw r

goldenRatio :: Double
goldenRatio = 1.618

opposite :: Direction -> Direction
opposite = \case
  R -> L
  D -> U
  L -> R
  U -> D

data CellSpec = Y | N

data GridSpec = GridSpec [[CellSpec]]

rectangularGridSpec :: Int -> Int -> GridSpec
rectangularGridSpec colCount rowCount =
  GridSpec (replicate rowCount (replicate colCount Y))

tesselate :: Int -> GridSpec -> GridSpec
tesselate n (GridSpec rows) = GridSpec (concatMap f rows)
  where
    f row = dup (concatMap dup row)
    dup x = replicate n x

calculateCellSize :: (Double, Double) -> GridSpec -> Double
calculateCellSize (w, h) (GridSpec gs) =
  let colCount = case gs of
        (row : _) -> length row
        _ -> 0
      rowCount = length gs
  in min (w / fromIntegral colCount) (h / fromIntegral rowCount)