{-# LANGUAGE TupleSections #-}
{- | Annotating tree structures with desired properties for rooms.  -}
module Dodge.Annotation 
    ( module Dodge.Annotation.Data
    , module Dodge.Annotation
    ) where
import Dodge.RandomHelp
import Dodge.Tree
import Dodge.Room
import Dodge.Annotation.Data
--import LensHelp

import Data.Tree
import Control.Monad.State
import System.Random
--import Control.Lens
import Data.Maybe

addLock :: Int -> Tree [Annotation] -> State StdGen (Tree [Annotation])
addLock i t = do
    (beforeLock, afterLock) <- splitTrunk t
    newBefore <- applyToRandomNode (Key i :) beforeLock
    return $ addToTrunk newBefore [Node [Lock i] afterLock]
{- | Add one corridor between each parent-child link of a tree of annotations.  -}
padWithCorridors :: Tree [Annotation] -> Tree [Annotation]
padWithCorridors = padWithAno [Corridor]

padWithAno :: [Annotation] -> Tree [Annotation] -> Tree [Annotation]
padWithAno ano (Node x xs) = Node ano [Node x (map (padWithAno ano) xs)]

padSucWithCorridors :: Tree [Annotation] -> Tree [Annotation]
padSucWithCorridors (Node x xs) = Node x (map padWithCorridors xs)

padSucWithDoors :: Tree [Annotation] -> Tree [Annotation]
padSucWithDoors (Node x xs) = Node x (map (padWithAno [SpecificRoom thetree]) xs)
  where
    thetree = do
        thecor <- shuffleLinks corridor
        takeOne
            [ (return (UseAll door),TreeSubLabelling "door" Nothing)
            , (treeFromPost [PassDown door, PassDown thecor] (UseAll door)
                ,TreeSubLabelling "twoDoors" Nothing)
            ]

{- Add one to three corridors between each parent-child link of a tree of annotations.  -}
randomPadCorridors :: Tree [Annotation] -> State StdGen (Tree [Annotation])
randomPadCorridors  (Node x xs) = do
    n <- state $ randomR (1, 3)
    xs' <- mapM randomPadCorridors xs
    return $ treeFromTrunk (replicate n [Corridor]) (Node x xs')
{- | Add a corridor to a random out-link of a room.  -}
roomThenCorridor :: RandomGen g => Room -> State g (SubCompTree Room)
roomThenCorridor theRoom = fmap 
    (\r -> Node (PassDown theRoom) [(pure . UseAll) r]) 
    (shuffleLinks corridor)

{- | Create a random room tree structure from a list of annotations.  -}
anoToRoomTree :: [Annotation] -> State StdGen (LabSubCompTree Room)
anoToRoomTree anos = case anos of
    [AnoApplyInt i f] -> f i
--    [AnoApplyInt' i f str] -> f i <&> (,TreeSubLabelling str Nothing)
    (SpecificRoom rt:_) -> rt
    [PassthroughLockKeyLists i ls ks] -> do
        (functionlockroom,randomitemidentity) <- takeOne ls
        lr' <- functionlockroom i
        ii <- randomitemidentity
        let lr = fst lr'
        keyroom' <- fromJust $ lookup ii ks
        let keyroom = fst keyroom'
        return (overwriteLabel 0 UseNone lr [keyroom]
            ,TreeSubLabelling ("PassthroughLockKeyLists-"++show ii) 
                (Just $ treeFromPost [snd lr'] (snd keyroom'))
                )
    _ -> (,TreeSubLabelling "no label" Nothing) <$> anoToRoomTree' anos

{- | Create a random room tree structure from a list of annotations.  -}
anoToRoomTree' :: [Annotation] -> State StdGen (SubCompTree Room)
anoToRoomTree' anos = case anos of
    [ChainAnos ass] -> do
        rms <- mapM anoToRoomTree' ass
        return $ chainUses rms
    [OrAno as] -> do
        a <- takeOne as
        anoToRoomTree' a
    [Corridor] -> pure . UseAll <$> shuffleLinks corridor
    (BossAno cr : _) -> do
        br <- bossRoom cr
        branchRectWith . pure . fmap PassDown $ treeFromPost [corridor,corridor] br
    (TreasureAno crs loot : _) -> branchRectWith . fmap (pure . PassDown) $ lootRoom crs loot
    _ -> do
        w <- state $ randomR (100,400)
        h <- state $ randomR (200,400)
        fmap (pure . UseAll) . shuffleLinks $ roomRectAutoLinks w h