{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RankNTypes #-}
module Dodge.LevelGen where
import Dodge.Data
import Dodge.Floor
import Dodge.Save
import Dodge.Layout
import Dodge.Initialisation
--import Dodge.RandomHelp
--import Dodge.LevelGen.Data
import Dodge.Tree
import Geometry.ConvexPoly
--import Dodge.LevelGen.LevelStructure

import System.Directory
import System.Random
import Control.Lens
import Control.Monad.State
import qualified Data.IntMap.Strict as IM

generateWorldFromSeed :: Int -> IO World
generateWorldFromSeed i = do
    createDirectoryIfMissing True "log"
    writeFile "log/attemptedSeeds" ""
    writeFile "log/treeCluster" ""
    writeFile "log/aGeneratedRoomLayout" ""
    (roomList,bounds) <- layoutLevelFromSeed 0 i
    return $ saveLevelStartSlot 
        $ generateLevelFromRoomList roomList initialWorld{_randGen=mkStdGen i}
        & roomClipping .~ bounds

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