module Dodge.Layout 
    ( module Dodge.Layout
    , module Dodge.Layout.Tree
    )
    where
import Dodge.Data
import Dodge.LevelGen
import Dodge.LevelGen.StaticWalls
import Dodge.LevelGen.Data
import Dodge.Base
import Dodge.RandomHelp
import Dodge.Graph
import Dodge.Layout.Tree
import Dodge.Layout.Tree.Polymorphic (applyToRoot)
import Dodge.Room.Data
import Dodge.Default
import Geometry
import Dodge.Room.Link

import Control.Monad.State
import Control.Lens
import System.Random
import Data.List
import Data.Maybe
import Data.Tree
import Data.Either
import Data.Function
import Data.Graph.Inductive.Graph
import Data.Graph.Inductive.Basic
import Data.Graph.Inductive.PatriciaTree
import Data.Graph.Inductive.NodeMap
import qualified Data.Map as M
import qualified Data.IntMap.Strict as IM

generateFromList :: State StdGen [Room] -> World -> World
generateFromList gr w = updateWallZoning 
    . placeSpots plmnts
    $ w { _walls = wallsFromRooms rs
        }
  where
    plmnts = concatMap _rmPS rs
    rs = evalState gr $ _randGen w

-- | connects a collection (tree) of rooms together
generateFromTree :: State StdGen (Tree Room) -> World -> World
generateFromTree t w = updateWallZoning $ placeSpots plmnts 
   $ w  {_walls         = wallsFromTree tr
        ,_pathGraph     = path
        ,_pathGraph'    = pairGraph
        ,_pathPoints    = foldr insertPoint IM.empty (labNodes path) 
        ,_pathInc       = pinc
        }
  where 
    tr = evalState t $ _randGen w
    plmnts = concatMap _rmPS $ flatten tr
    path = pairsToGraph dist pairGraph
    pairGraph = makePath tr
    insertPoint  pp@(_,(x,y)) = insertInZoneWith (floorHun x) (floorHun y) (++) [pp]
    pinc = M.fromList $ pairsToIncidence pairGraph

updateWallZoning :: World -> World
updateWallZoning w = set wallsZone (IM.foldr wallInZone IM.empty (_walls w)) w
  where
    wallInZone wl | uncurry dist (_wlLine wl) <= 2*zoneSize 
                      = insertIMInZone x y wlid wl
                  | otherwise = flip (foldr (\(a,b) -> insertIMInZone a b wlid wl)) ips
      where (x,y) = zoneOfPoint $ (uncurry pHalf (_wlLine wl))
            wlid  = _wlID wl
            ips = map zoneOfPoint $ uncurry (divideLine (2*zoneSize)) (_wlLine wl)


makePath :: Tree Room -> [(Point2,Point2)]
makePath = concat . map _rmPath . flatten

-- consider nubbing walls after dividing them
wallsFromTree :: Tree Room -> IM.IntMap Wall
wallsFromTree t = 
--    createInnerWalls 
    divideWalls 
    . assignKeys 
    . removeInverseWalls
    . foldr cutWalls [] -- map (map (g . roundPoint2)) 
--    . map (map roundPoint2)
    $ (concatMap _rmPolys $ flatten t)
  where
    assignKeys = IM.fromList . zip [0..] . zipWith f [0..]
    f i (x,y) = defaultWall {_wlLine = (x,y) , _wlID = i}
    g (x,y) = (x-3855,y - 2613)

wallsFromRooms :: [Room] -> IM.IntMap Wall
wallsFromRooms =
--    divideWalls .
    IM.fromList . zip [0..] . zipWith f [0..] . removeInverseWalls 
        . foldr cutWalls [] . concatMap _rmPolys
  where
    f i (x,y) = defaultWall {_wlLine = (x,y) , _wlID = i}

divideWall :: Wall -> [Wall]
divideWall wl
    = let (a,b) = _wlLine wl
          --ps = divideLine (zoneSize * 2) a b
          ps = divideLine (zoneSize * 2) a b
      in  map (\(x,y) -> wl {_wlLine = (x,y)}) $ zip (init ps) (tail ps)

divideWallIn :: Wall -> IM.IntMap Wall -> IM.IntMap Wall
divideWallIn wl wls = 
    let (wl':newWls) = divideWall wl
        k = newKey wls
        newWls' = zipWith (\i w -> w {_wlID = i}) [k..] newWls
    in  foldr (\w -> IM.insert (_wlID w) w) wls (wl':newWls')

divideWalls :: IM.IntMap Wall -> IM.IntMap Wall
divideWalls wls = IM.foldr divideWallIn wls wls

insertInZone :: Int -> Int -> a -> IM.IntMap (IM.IntMap a) -> IM.IntMap (IM.IntMap a)
insertInZone x y obj = IM.insertWith f x $ IM.singleton y obj
    where f _ = IM.insert y obj

shiftRoomTree :: Tree Room -> Tree Room
shiftRoomTree (Node t []) = Node t []
shiftRoomTree (Node t ts) = Node t 
    $ zipWith (\l -> shiftRoomTree . applyToRoot (shiftRoomToLink l)) 
    (_rmLinks t) 
    ts

shiftRoomTreeConstruction :: Tree Room -> [Tree Room]
shiftRoomTreeConstruction (Node t []) = [Node t []]
shiftRoomTreeConstruction (Node t ts) = (Node t [] :) $ concat $
    zipWith (\l -> shiftRoomTreeConstruction . applyToRoot (shiftRoomBy l . f)) 
    (_rmLinks t) 
    ts
  where 
    f r = shiftRoomBy ((0,0) -.- (rotateV (pi-a) p),0) $ shiftRoomBy ((0,0),pi-a)  r
      where 
        (p,a) = last $ _rmLinks r