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

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

generateWorldFromSeed :: Int -> IO World
generateWorldFromSeed i = do
    roomList <- layoutLevelFromSeed 0 i
    return $ _gWorld $ generateLevelFromRoomList roomList 
         initialWorld{_randGen=mkStdGen i}

layoutLevelFromSeed :: Int -> Int -> IO (IM.IntMap Room)
layoutLevelFromSeed i seed = do
    let i' = i + 1
    putStrLn $ "Generating level with seed " ++ show seed
    let g = mkStdGen seed
    let rmtree = inorderNumberTree $ evalState initialRoomTree g
    putStrLn "Abstract layout: "
    putStrLn $ compactDrawTree $ fmap (show . snd) rmtree
    mrs <- positionRoomsFromTree rmtree
    case mrs of
        Just rs -> do
            putStrLn $ "After " ++ show i' 
                ++ " attempt(s), Successful generation of level with seed " 
                ++ show seed
            --return (fmap setLastLinkToUsed rs)
            putStrLn $ show (Prelude.length rs) ++ " rooms in total"
            return . IM.fromList $ map reversePair rs
        Nothing -> do
            putStr $ "Level generation with seed " ++ show seed ++ " failed: "
            let (seed',_) = random g
            layoutLevelFromSeed i' seed'

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

compactDrawTree :: Tree String -> String
compactDrawTree = 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)