venzone-1.0.0.0: src/Screen.hs

{-# Language ScopedTypeVariables #-}

module Screen ( module Screen,
                module Screen.Primitives,
                module Screen.ProcessKeys,
                module Screen.Check
              )
        where

import Input
import Meeple.Operate
import Room
import Plant
import Screen.Check
import Screen.Decide
import Screen.Move
import Screen.Primitives
import Screen.ProcessKeys

import Lens.Micro.Platform
import Terminal.Game

import qualified Data.List  as L


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

screenLogic :: (Show s, HasScreen s) => Input -> s -> s
screenLogic k s
                -- key processing
        | isMovKey k  = s & player %~ fmap (processMovKeys k s)
        | isMenuKey k = playerDie s
                -- logic
        | otherwise   =
                  L.foldl' (flip ($)) s
                        [ -- I decide where to move
                          mappedScreen cogitate,

                          -- II actually move (and collision)
                          moveCollideGeneral,

                          -- III spawn phase (for projectile-launching
                          -- enemies
                          spawnProjectiles,

                          -- IV clean-up (reset + mark deads)
                          cleanUp
                        ]
    where
          mappedScreen :: HasScreen s => (s -> Meeple -> Meeple) -> s -> s
          mappedScreen f sw = sw & meeples . each %~ f sw

cleanUp :: HasScreen s => s -> s
cleanUp s = s & room . plant   %~ tickPlant
              & meeples . each %~ (resetClimb s .
                                   (\m -> m & draw %~ tick) .
                                   oobDead .
                                   uselessLock .
                                   oldMPlayer)
    where
          oobDead :: Meeple -> Meeple
          oobDead m@(MDead _) = m
          oobDead m           =
                let (tr, tc) = s ^. room . to boundaries
                    (mr, mc) = m ^. position
                in
                if mr < -5 || mc < -10 ||
                   mr > (tr + 5) || mc > (tc + 5)
                   then MDead None
                   else m

          uselessLock :: Meeple -> Meeple
          uselessLock m@(MLock l)
                | l ^. currNumeral <= 0 &&
                  l ^. draw . to isExpired = MDead None
                | otherwise             = m
          uselessLock m                 = m

          oldMPlayer :: Meeple -> Meeple
          oldMPlayer (MPlayer p) = MPlayer $ oldPlayer p
          oldMPlayer m           = m

resetClimb :: HasScreen s => s -> Meeple -> Meeple
resetClimb _ m@(MDead _) = m
resetClimb s m | amOutOfBounds s m  = m
               | not (canClimb s m) = noClimb m
               | otherwise          = m
    where
          noClimb (MPlayer p) = MPlayer $ p & isClimbing .~ False
          noClimb mw          = mw

spawnProjectiles :: HasScreen s => s -> s
spawnProjectiles s =
            let s' = s & meeples . each %~ genProj
                sp :: [Meeple]
                sp = concat $ s ^.. meeples . each . to fetchProj . _Just
            in s' & meeples %~ (++ sp)
    where
          fetchProj :: Meeple -> Maybe [Meeple]
          fetchProj (MBird b) = creaRef <$> b ^. ready
          fetchProj (MKram k) = creaRef <$> k ^. ready
          fetchProj MDead {} = Nothing
          fetchProj MDumb {} = Nothing
          fetchProj MLock {} = Nothing
          fetchProj MNettle {} = Nothing
          fetchProj MPlayer {} = Nothing
          fetchProj MSave {} = Nothing
          fetchProj MSmart {} = Nothing
          fetchProj MSickle {} = Nothing
          fetchProj MStar {} = Nothing
          fetchProj MStone {} = Nothing
          fetchProj MWin {} = Nothing
          fetchProj MWitch {} = Nothing


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

drawScreen :: HasScreen s => s -> Plane
drawScreen s =          blankPlane 80 24 &
               (r, c) % mergePlanes (drawRoom (s ^. room)) pcs
    where
          (r, c) = let (aw, ah) = planeSize actionPlane
                   in (div (24-ah) 2 + 1,
                       div (80-aw) 2 + 1)

          actionPlane = mergePlanes (drawRoom (s ^. room)) pcs

          meepOrd :: [Meeple]
          meepOrd = let ms = (s ^.. meeples . each . filtered (not . isDead))
                    in L.sort ms

          pcs :: [(Coords, Plane)]
          pcs = map f meepOrd

          f :: Meeple -> (Coords, Plane)
          f m = (m ^. position, m ^. draw . to fetchFrame)