module Dodge.LevelGen (generateWorldFromSeed) where

import Control.Lens
--import Control.Monad.State
import Control.Monad.Trans.State.Lazy
import Data.Foldable
import Data.Preload.Render
import Dodge.Data.GenWorld
import Dodge.Floor
import Dodge.Initialisation
import Dodge.Layout
import Dodge.Tree
import Geometry.ConvexPoly
import qualified IntMapHelp as IM
import System.Directory
import System.Random

generateWorldFromSeed :: RenderData -> Int -> IO World
generateWorldFromSeed rdata i = do
    createDirectoryIfMissing True "generated/log"
    writeFile "generated/log/attemptedSeeds" ""
    writeFile "generated/log/treeCluster" ""
    writeFile "generated/log/aGeneratedRoomLayout" ""
    (roomList, bounds) <- layoutLevelFromSeed 0 i
    postGenerationProcessing rdata
        $! generateLevelFromRoomList roomList
        $ initialWorld{_randGen = mkStdGen i}
            & cWorld . cwGen . cwgRoomClipping .~ bounds
            & cWorld . cwGen . cwgSeed .~ i

postGenerationProcessing :: RenderData -> GenWorld -> IO World
postGenerationProcessing _ gw = do
    let w = _gwWorld gw & cWorld . cwTiles .~ (tilesFromRooms . IM.elems $ _genRooms gw)
--    print $ gw ^. genInts
    return $ foldl' assignPushDoors w (w ^. cWorld . lWorld . doors)

assignPushDoors :: World -> Door -> World
assignPushDoors w dr = case dr ^?! drPushedBy of
    PushedBy i -> w & cWorld . lWorld . doors . ix i . drPushes ?~ _drID dr
    _ -> w

layoutLevelFromSeed :: Int -> Int -> IO (IM.IntMap Room, [ConvexPoly])
layoutLevelFromSeed i seed = do
    let i' = i + 1
    createDirectoryIfMissing True "generated/log"
    putStrLnAppend "generated/log/attemptedSeeds" $
        "Generating level with seed " ++ show seed
    appendFile "generated/log/attemptedSeeds" "\n"
    let g = mkStdGen seed
    let treecluster = evalState tutRoomTree (LayVars g 0)
    --    let treecluster = evalState initialRoomTree (LayVars g 0)
    let labts = decomposeSelfTree $ numSelfTree $ combineTree _rmName treecluster
    appendFile "generated/log/treeCluster" ("Seed: " ++ show seed ++ "\n")
    putStrLn "MetaTree clusters:"
    mapM_
        (putStrLnAppend "generated/log/treeCluster" . smallDrawTree . fmap showIntsString)
        labts
    let tc = composeTree treecluster
    let rmtree = inorderNumberTree tc
    appendFile "generated/log/aGeneratedRoomLayout" ("Seed: " ++ show seed ++ "\n")
    putStrLnAppend "generated/log/aGeneratedRoomLayout" "Room layout (compact): "
    putStrLnAppend "generated/log/aGeneratedRoomLayout" 
        $ compactDrawTree $ fmap (show . snd) rmtree
    let nameshow (r, rid) = _rmName r ++ "-" ++ show rid
    putStrLnAppend "generated/log/aGeneratedRoomLayout" "Layout with room names:"
    putStrLnAppend "generated/log/aGeneratedRoomLayout" 
        $ smallDrawTree $ fmap nameshow rmtree
    mrs <- positionRoomsFromTree rmtree
    case mrs of
        Just (PosRooms bounds rs) -> do
            putStrLnAppend "generated/log/attemptedSeeds" $
                "After " ++ show i'
                    ++ " attempt(s), Successful generation of level with seed "
                    ++ show seed
            putStrLnAppend "generated/log/attemptedSeeds" 
                $ show (Prelude.length rs) ++ " rooms in total"
            return (IM.fromList $ map reversePair rs, bounds)
        Nothing -> do
            putStrLnAppend "generated/log/attemptedSeeds" 
                $ "Level generation with seed " ++ show seed ++ " failed: "
            let (seed', _) = random g
            layoutLevelFromSeed i' seed'

putStrLnAppend :: FilePath -> String -> IO ()
putStrLnAppend fp str = appendFile fp (str ++ "\n") >> putStrLn str

reversePair :: (a, b) -> (b, a)
reversePair (a, b) = (b, a)

compactDrawTree :: Tree String -> String
compactDrawTree = unlines . compactDraw

smallDrawTree :: Tree String -> String
smallDrawTree = unlines . compactDraw'

compactDraw :: Tree String -> [String]
compactDraw (Node x [Node y ts]) = compactDraw (Node (x ++ "," ++ y) ts)
compactDraw (Node x ts0) = lines x ++ drawSubTrees ts0
  where
    drawSubTrees [] = []
    drawSubTrees [t] =
        "|" : compactDraw t
    drawSubTrees (t : ts) =
        "|" : shift "+- " "|  " (compactDraw t) ++ drawSubTrees ts
    shift first other = zipWith (++) (first : repeat other)

compactDraw' :: Tree String -> [String]
compactDraw' (Node x [Node y ts]) = lines x ++ ["|"] ++ compactDraw' (Node y ts)
compactDraw' (Node x ts0) = lines x ++ drawSubTrees ts0
  where
    drawSubTrees [] = []
    drawSubTrees [t] =
        "|" : compactDraw' t
    drawSubTrees (t : ts) =
        "|" : shift "+- " "|  " (compactDraw' t) ++ drawSubTrees ts
    shift first other = zipWith (++) (first : repeat other)