module Dodge.LevelGen (generateWorldFromSeed) where

import Dodge.Annotation.Data
import Dodge.Layout
import Data.Preload.Render
import Control.Lens
import Control.Monad.State
import Data.Foldable
import qualified Data.Text.IO as TIO
import Dodge.Combine.Graph
import Dodge.Data.GenWorld
import Dodge.Floor
import Dodge.Initialisation
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 "log"
    createDirectoryIfMissing True "graph"
    writeFile "log/attemptedSeeds" ""
    writeFile "log/treeCluster" ""
    writeFile "log/aGeneratedRoomLayout" ""
    generateGraphs
    (roomList, bounds) <- layoutLevelFromSeed 0 i
    postGenerationProcessing rdata
        $! generateLevelFromRoomList roomList initialWorld{_randGen = mkStdGen i}
        & gwWorld . cWorld . cwGen . cwgRoomClipping .~ bounds
        & gwWorld . cWorld . cwGen . cwgSeed .~ i

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

generateGraphs :: IO ()
generateGraphs = TIO.writeFile "graph/itemCombinations.gv" combinationsDotGraph

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
    putStrLnAppend "log/attemptedSeeds" $ "Generating level with seed " ++ show seed
    appendFile "log/attemptedSeeds" "\n"
    let g = mkStdGen seed
    let treecluster = evalState tutRoomTree (LayVars g 0)
    let labts = decomposeSelfTree $ numSelfTree $ combineTree _rmName treecluster
    appendFile "log/treeCluster" ("Seed: " ++ show seed ++ "\n")
    putStrLn "MetaTree clusters:"
    mapM_ (putStrLnAppend "log/treeCluster" . smallDrawTree . fmap showIntsString) labts
    let tc = composeTree treecluster
    let rmtree = inorderNumberTree tc
    appendFile "log/aGeneratedRoomLayout" ("Seed: " ++ show seed ++ "\n")
    putStrLnAppend "log/aGeneratedRoomLayout" "Room layout (compact): "
    putStrLnAppend "log/aGeneratedRoomLayout" $ compactDrawTree $ fmap (show . snd) rmtree
    let nameshow (r, rid) = _rmName r ++ "-" ++ show rid
    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)