{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RankNTypes #-}
-- | deals with placement of objects within the world
-- after they have had their coordinates set by the layout
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 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 $ randomCompass $ generateLevelFromRoomList roomList 
         initialWorld{_randGen=mkStdGen i}

randomCompass :: World -> World
randomCompass w = w & cameraRot .~ (takeOne [0,0.5*pi,pi,1.5*pi] & evalState $ _randGen w)

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)
