module Dodge.Room.Path
    ( gridPoints
    , linksAndPath
    , makeGrid
    , createPathGrid
    )
    where
import Dodge.Room.Data
import Dodge.LevelGen.StaticWalls
import Geometry

import Data.Function (on)
import Data.List
import Data.Bifunctor
import Data.Maybe
import qualified Data.Tuple.Extra as Tup
import qualified Control.Foldl as L

createPathGrid :: Room -> Room
createPathGrid rm = rm
    { _rmPath = linksAndPath (_rmLinks rm) filterGrid }
  where
    filterGrid = filter (\p -> pairInPolys (_rmPolys rm) p && testCrossWalls outerWalls p) grid
    grid = fromMaybe [] $ shiftedGrid <$> minx <*> maxx <*> miny <*> maxy
    outerWalls = foldr cutPoly [] $ _rmPolys rm
    outerPoints = map fst outerWalls
    (minx, maxx, miny, maxy) = L.fold theFold outerPoints
    theFold = (,,,)
        <$> L.premap fstV2 L.minimum 
        <*> L.premap fstV2 L.maximum
        <*> L.premap sndV2 L.minimum 
        <*> L.premap sndV2 L.maximum

-- ?TODO? : make this minimumOn
linksAndPath :: [(Point2,Float)] -> [(Point2,Point2)] -> [(Point2,Point2)]
linksAndPath lnks subpth = subpth ++ concatMap linkClosest lnks
  where 
    linkClosest (p,_) = doublePair (p, minimumBy (compare `on` dist p) $ map fst subpth)

testCrossWalls
    :: [(Point2,Point2)]
    -> (Point2,Point2)
    -> Bool
testCrossWalls wls (a,b) = not $ any (isJust . uncurry (intersectSegSeg a b)) wls

--extra test whether both members of the path edge are in some poly
pairInPolys
    :: [[Point2]]
    -> (Point2,Point2)
    -> Bool
pairInPolys polys (a,b) = any (pointInPolygon a) polys && any (pointInPolygon b) polys

shiftedGrid
    :: Float    -- ^ x min
    -> Float    -- ^ x max
    -> Float    -- ^ y min
    -> Float    -- ^ y max
    -> [(Point2,Point2)]
shiftedGrid xmin xmax ymin ymax = grid
  where
    xd = xmax - xmin
    yd = ymax - ymin
    xsteps = ceiling $ (xd - 40) / 60
    ysteps = ceiling $ (yd - 40) / 60
    shift p = bimap (p +.+) (p +.+)
    grid = map (shift (V2 (xmin + 20) (ymin+20))) $ makeGrid 60 xsteps 60 ysteps

-- creates a rectangular grid starting at (0,0) in the positive orthant
-- needs fixing in degenerate (xstep or ystep == 0) cases
makeGrid 
    :: Float    -- ^ horizontal step size
    -> Int      -- ^ number of horizontal steps
    -> Float    -- ^ vertical step size
    -> Int      -- ^ number of vertical steps
    -> [(Point2,Point2)]
makeGrid x nx y ny 
    = nub 
    . concatMap doublePair 
    . concatMap (\p -> map (Tup.both (p +.+)) $ makeRect x y)
    $ gridPoints x nx y ny

gridPoints :: Float -> Int -> Float -> Int -> [Point2]
gridPoints x nx y ny = [V2 a b | a <- take nx $ scanl (+) 0 $ repeat x
                              , b <- take ny $ scanl (+) 0 $ repeat y
                       ]

makeRect :: Float -> Float -> [(Point2,Point2)]
makeRect x y = map (bimap toV2 toV2) [((0,0),(x,0))
               ,((0,0),(0,y))
               ,((x,y),(x,0))
               ,((x,y),(0,y))
               ]