module Dodge.Layout 
    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.Polymorphic (applyToRoot)
import Dodge.Room.Data
import Dodge.Default.Wall
import Geometry
import Dodge.Room.Link
import qualified IntMapHelp as IM
--import Dodge.Debug.LinkDecoration
import Picture.Data
import Tile

import Control.Monad.State
import Control.Lens
import System.Random
--import Data.List
--import Data.Maybe
import Data.Tree
import Data.Graph.Inductive.Graph (labNodes)
import qualified Data.Map as M

generateLevelFromRoomList :: State StdGen [Room] -> World -> World
generateLevelFromRoomList gr w = updateWallZoning 
    . placeSpots plmnts
--    . addRoomPolyDecorations rs
--    . addRoomLinkDecorations rs
    $ w { _walls = wallsFromRooms rs
        , _floorTiles = floorsFromRooms 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 = concatMap _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}

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}

floorsFromRooms :: [Room] -> [RenderType]
floorsFromRooms = concatMap (concatMap tToRender . _rmFloor)

divideWall :: Wall -> [Wall]
divideWall wl
    = let (a,b) = _wlLine wl
          ps = divideLine (zoneSize * 2) a b
      in  zipWith (\ x y -> wl & wlLine .~ (x,y) ) (init ps) (tail ps)

divideWallIn :: Wall -> IM.IntMap Wall -> IM.IntMap Wall
divideWallIn wl wls = 
    let (wl':newWls) = divideWall wl
        k = IM.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