{-# Language TemplateHaskell #-}

module Story where

import Meeple.Operate
import Input
import Plant
import Room
import Screen

import Terminal.Game
import Lens.Micro.Platform

import qualified Data.List as L
import qualified Data.Set  as S


-- SWinning = win animation
data Status = SRunning | SWon Animation | SQuit
        deriving (Eq, Show)

type Name = String
data Story = Story { -- read
                     _name  :: Name,
                     _size  :: Coords,
                     _rooms :: [Room],

                      -- state
                     _storyScreen :: Screen,
                     _spawnRoom   :: Room,

                     -- playerstate
                     _stars     :: Integer,
                     _collected :: S.Set (Name, Coords),
                         -- collected stars
                     _status    :: Status
                   }
           deriving (Eq, Show)
makeLenses ''Story
instance HasScreen Story where screen = storyScreen


defaultStory :: Story
defaultStory = buildStory "no-name" (1,1) "<no-init-title>" [defaultRoom]

-- constructor + sanity check
buildStory :: Name -> Coords -> Title -> [Room] -> Story
buildStory n c st rs
        | null rs   = -- check we have at least one screen
                      ef "no screen found"
        | otherwise =

            -- spawn at the initial coordinates
            -- (it will check spawn in room one exists)
            let s = spawn r S.empty in

            -- check sizes of screen
            case checkRoomSize c rs of
              [] -> let lst = Story n c rs s r 0 S.empty SRunning
                    in -- todo [refactor] starify and fetchNeighburs
                       --      should be generalised, maybe inside spawn
                       lst & id %~ starifyScreen False
                           & id %~ fetchNeighbours
              es -> error (mismErr c es)
    where
          ef s = error $ "buildStory: " ++ s ++
                         " in Story \"" ++ n ++ "\"!"

          -- non posso usare fetchroom perché non ho ancora
          -- costruito Story
          r = case filter (^. title . to (== st)) rs of
                (x:_) -> x
                _     -> ef $ "no starting room" ++ show st

---------------
-- FUNCTIONS --
---------------

fetchRoom :: Story -> Title -> Room
fetchRoom s t = fetchRoomSafe s t ^. non e
    where
          e = error $ "Cannot find room named " ++ show t ++ "!"

fetchRoomSafe :: Story -> Title -> Maybe Room
fetchRoomSafe s t =
                case filter f (s ^. rooms) of
                  (r:_) -> Just r
                  []    -> Nothing
    where
          f r = r ^. title . to (== t)

-- fetch neighbour of current room
fetchNeighbours :: Story -> Story
fetchNeighbours s =
            let op = s ^. room . plant
                ps = s ^. size
            in s & neighbourPlant .~ gluePlants ps op ns
    where
          ns :: [(Cardinal, Plant)]
          ns = map f (s ^. room . exits)

          f :: Exit -> (Cardinal, Plant)
          f (Exit c t) = (c, fr s t ^. plant)

          fr :: Story -> Title -> Room
          fr ws t = fetchRoomSafe ws t ^. non defaultRoom

-----------
-- LOGIC --
-----------

storyLogic :: Story -> Input -> Story
storyLogic s KExit = s & status .~ SQuit
storyLogic s _ | isWinning s = s & status %~ tickWinning
storyLogic s e     = (buryDeads . deadCheck . saveCheck . oobCheck) s &
                        storyScreen %~ screenLogic e

isWinning :: Story -> Bool
isWinning s = case s ^. status of
                SWon {} -> True
                _       -> False

tickWinning :: Status -> Status
tickWinning (SWon a) = SWon $ tick a
tickWinning s        = s

isWinOver :: Story -> Bool
isWinOver s = case s ^. status of
                SWon a -> isExpired a
                _      -> False


-- todo [refactor] hack
saveCheck :: Story -> Story
saveCheck s = case s ^. mplayer of
                Nothing -> s
                Just _  ->
                    if s ^. player ^?! _Just . amSaving
                      then s & spawnRoom .~ (s ^. screen . room)
                             & player . mapped . amSaving .~ False
                      else s

-- todo [refactor] refactor starify e in generale spawn
deadCheck :: Story -> Story
deadCheck s | playerDead s = s & storyScreen .~ spawn (s ^. spawnRoom)
                                                      (s ^. collected)
                               & id %~ starifyScreen False
                               & id %~ fetchNeighbours
            | otherwise    = s

oobCheck :: Story -> Story
oobCheck s | playerDead s = s
           | pr < 1       = changeRoom N
           | pr > mr      = changeRoom S
           | pc < 1       = changeRoom W
           | pc > mc      = changeRoom E
           | otherwise    = s
    where
          (pr, pc) = s ^. player .
                          non (error "oobCheck - no player") .
                          position
          (mr, mc) = s ^. size

          changeRoom :: Cardinal -> Story
          changeRoom c =
                let r = s ^. screen . room
                    p = s ^. screen . player .
                             non (error "changeRoom - no Player")
                    sps = s ^. collected                          in
                case cardinalTitle r c of
                  Nothing -> playerDie s
                  Just t  -> s & storyScreen .~ enter p sps (fetchRoom s t)
                               & id %~ starifyScreen False
                               & id %~ fetchNeighbours
                               -- xxx [refactor] really abstract this

-- from Dead elements we will get score info and such
-- (or cleanDeads)
buryDeads :: Story -> Story
buryDeads s = s & meeples .~ rs
                & id      %~ processDead dm
    where
          (dm, rs) = s ^. meeples . to (L.partition isDead)
            -- todo [refactor] anche qui, dovrei swrapparli e poi
            --      passarli a processdead

-- meeple
processDead :: [Meeple] -> Story -> Story
processDead ms s = foldl f s ms
    where
          f :: Story -> Meeple -> Story
          f ws (MDead x) = g ws x
          f _ _          = error "processDeads passed a non dead"

          -- che succede se raccolgo una stella?
          g :: Story -> Message -> Story
          g ws None     = ws
          g ws (PlusStar cs) = consumeStar True cs ws
          g ws (NeutralStar cs) = consumeStar False cs ws
          g ws Won        = ws & status .~ SWon winAni

winAni :: Animation
winAni = creaAnimation [(26, box ' ' 80 24)]


-- add a star: True = the player collected it
consumeStar :: Bool -> Coords -> Story -> Story
consumeStar b cs s  =
            if b
              then s & stars +~ 1
                     & collected %~ S.insert (rname, cs)
                     & id %~ starifyScreen True
              else s & collected %~ S.insert (rname, cs)
    where
          rname = s ^. screen . room . title

-- apply the relevant Screen changes, given a story state (i.e., locks
-- to open if we collected enough stars).
-- Bool: long lock animation?
starifyScreen :: Bool -> Story -> Story
starifyScreen b s = s & screen . meeples . each %~ f
    where
          -- xxx [refactor] anche qui vorrei un "is xyz" map
          f :: Meeple -> Meeple
          f (MLock l) = let on = l ^. origNumeral
                            ps = s ^. stars
                            lo = MLock $ l & currNumeral .~ (on - ps)
                        in updateLockAni b lo
          f m         = m


----------
-- DRAW --
----------

drawStory :: Story -> Plane
drawStory s | isWinning s = let (SWon a) = s ^. status in fetchFrame a
            | otherwise   =  drawScreen $ s ^. storyScreen


-----------------
-- SPAWN/ENTER --
-----------------

-- spawns inside a room. Set is "stars not to create, because already
-- taken".
spawn :: Room -> S.Set (Name, Coords) -> Screen
spawn r tcs = case findSpawn r of
                Just cs -> let p = defaultPlayer cs
                           in thaw r tcs p
                Nothing -> error $
                             "respawn: no spawn-point found in room \"" ++
                              r ^. title ++ "\"!"


enter :: Player -> S.Set (Title, Coords) -> Room -> Screen
enter p tcs r = ts
    where
          -- since every room has the same dimensions
          -- mandatory coords
          (mr, mc) = boundaries r

          -- 'mirror' the overflown coordinate
          (pr, pc) = p ^. position

          -- north/south exit
          nr | pr > mr   = pr - mr
             | pr < 1    = mr - pr
             | otherwise = pr

          -- west/east exit
          nc | pc > mc   = pc - mc
             | pc < 1    = mc - pc
             | otherwise = pc

          p' = p & position .~ (nr, nc)

          ts = thaw r tcs p'

thaw :: Room -> S.Set (Title, Coords) -> Player -> Screen
thaw r tcs p = defaultScreen
                        & room .~ r
                        & meeples .~ (r ^. frozenMeeples)
                        & meeples %~ filter notColl
                        & meeples %~ (MPlayer p :)
        where
              tcs' = S.filter ((== r ^. title) . fst) tcs
              css   = S.toList (S.map snd tcs')

              notColl (MStar s) = notElem (s ^. position) css
              notColl _         = True


-----------------
-- ANCILLARIES --
-----------------

-- checks if screens are sane (mandatory size)
-- returns ill ones
checkRoomSize :: Coords -> [Room] -> [(Title, Coords)]
checkRoomSize ms rs = rs ^.. (each . filtered ff . to bf)
    where
          -- filter function
          ff r =  r ^. to boundaries . to (/=ms)

          -- return function
          bf :: Room -> (Title, Coords)
          bf r = (r ^. title, r ^. to boundaries)

-- for mismatch errors
mismErr :: Coords -> [(Title, Coords)] -> String
mismErr cs es =
        "Found rooms of mismatched dimensions!\n" ++
        "Expected dimension: " ++ dim2str cs ++ "\n" ++
        "--\n" ++ unlines (map romErr es)
    where
          dim2str (wr, wc) = show wr ++ " rows, " ++ show wc ++ " cols."

          romErr (t, wcs) = t ++ ": " ++ dim2str wcs