module Dodge.LevelGen (generateWorldFromSeed) where

import Control.Lens
import Control.Monad.State
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)
    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)