{-# OPTIONS_GHC -Wno-unused-imports #-}
{- | The tree of rooms that make up a level. -}
module Dodge.Floor
    ( layoutLevelFromSeed
    ) where
import Geometry.Data
import Dodge.Data
import Dodge.Creature.State.Data
import Dodge.Room
import Dodge.Placement.Instance.Button
import Dodge.Layout.Tree.Polymorphic
import Dodge.Layout.Tree.Either
import Dodge.Annotation
import Dodge.Layout.Tree.Shift
import Dodge.Creature
import Dodge.LevelGen.Data
import Dodge.LevelGen.Switch
import Dodge.Item.Weapon.Launcher
import Dodge.PlacementSpot
import Dodge.RoomPos
import Dodge.Room.RunPast
import MonadHelp
import Data.Tree
import Color
import Dodge.Wire

import Control.Lens
import Control.Monad.State
import Control.Monad.Loops
import System.Random
import Data.Sequence hiding (zipWith)
import Data.Maybe
import qualified Data.IntMap.Strict as IM


initialAnoTree :: RandomGen g => Tree [Annotation g]
initialAnoTree = padSucWithCorridors $ treeFromTrunk 
    [[AnoApplyInt 0 startRoom]
    , [AnoApplyInt 1 lasSensorTurretTest]
--    ,[ChainAnos 
--        [[SetLabel 0 $ return $ roomRectAutoLinks 200 200 
--            & rmExtPmnt ?~ triggerSwitchSPicLight (drawSwitchWire red red)
--                (anyLnkInPS 5 & psLnkRoomEff .~ (putWireStart 0 . extractRoomPos) )
--            & rmLinkEff .~ [putWireEnd 0]
--         ]
--        ,[UseLabel 0 $ return switchDoorRoom]
--        ]
--     ]
--    ,[SpecificRoom $ return $ connectRoom lasTunnel ]
--    ,[SpecificRoom $ fmap connectRoom slowDoorRoom ]
--    ,[Corridor]
--    ,[Corridor]
--    ,[SpecificRoom $ fmap connectRoom roomCCrits]
--    ,[AirlockAno]
--    ,[Corridor]
------    ,[SpecificRoom roomCCrits]
------    ,[Corridor]
------    ,[SpecificRoom . pure . pure . Right $ roomGlassOctogon 400 
------        & rmPS %~ ([sPS (V2 0 50) 0 $ PutCrit armourChaseCrit 
------                    ,sPS (V2 50 25) 0 $ PutCrit armourChaseCrit 
------                    ,sPS (V2 50 0) 0 $ PutCrit armourChaseCrit 
------                    ]++)
------     ]
------    --,[SpecificRoom . pure . pure . Right $ roomGlassOctogon 400 
------    --    & rmPS %~ ([swarmPS 0 (x,y) 0 swarmCrit | x <- [-20,-19.5.. 20] , y <- [200,202] ]++)
------    -- ]
------    ,[SpecificRoom . pure . pure . Right $ roomGlassOctogon 400 
------        & rmPS %~ ([sPS (V2 0 50) 0 $ PutCrit pistolCrit ]++)
------     ]
------    ,[Corridor]
----    --,[SpecificRoom $ pure . Right <$> twinSlowDoorChasers]
-----    ,[SpecificRoom $ pure $ (pure . Right) (twinSlowDoorRoom 80 200 40)]
-----    ,[DoorAno]
-----    ,[SpecificRoom $ pure . Right <$> centerVaultExplosiveExit]
-----    ,[SpecificRoom blockedCorridor]
-----    ,[OrAno [[DoorAno]
-----            ,[Corridor]
-----            ,[DoorNumAno 0,AirlockAno]] 
-----            ]
-----    ,[FirstWeapon]
-----    ,[CorridorDebug]
-----    ,[SpecificRoom $ fmap (pure . Right) randomFourCornerRoom]
--    ,[OrAno 
--        [[SpecificRoom $ branchRectWith $ fmap (fmap Left) armouredChasers]
--        ,[BossAno $ addArmour launcherCrit & crHP +~ 800
--            & crState . crDropsOnDeath .~ DropSpecific [0] ]
--        ]
--     ]
----    ,[SpecificRoom $ fmap (pure . Right) armouredCorridor]
--    ,[Corridor]
--    ,[TreasureAno [addArmour autoCrit,addArmour autoCrit] [launcher]]
    ] 
    $ treeFromPost [[Corridor,SpecificRoom $ fmap (pure . Right) randomFourCornerRoom]] 
                                [EndRoom]

{- | A test level tree. -}
initialRoomTree :: RandomGen g => State g (Tree Room)
initialRoomTree = do
    expandTreeBy id <$> mapM anoToRoomTree initialAnoTree

layoutLevelFromSeed :: Int -> Int -> IO [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 <- positionRooms 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)
            return rs
        Nothing -> do
            putStr $ "Level generation with seed " ++ show seed ++ " failed: "
            let (seed',_) = random g
            layoutLevelFromSeed i' seed'

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)