Decide.hs

{-# Language FlexibleContexts #-}
{-# Language RankNTypes #-}

-- decide where to move kaj ktp

module Screen.Decide where

import Terminal.Game
import Lens.Micro.Platform

import Input
import Meeple.Operate
import Screen.Check
import Screen.Primitives

import qualified Line.Draw     as D


-- cogitate = the part of r/c speed inluenced by the player (i.e. not
-- gravity).
cogitate :: HasScreen s => s -> Meeple -> Meeple
cogitate _ m@(MDead _)  = m
cogitate s (MBird b)    = periodicMove s b MBird decideMoveBird stopAll
cogitate s (MDumb d)    = periodicMove s d MDumb decideMoveDumbWalker stopH
cogitate s (MKram k)    = periodicMove s k MKram decideMoveSmartWalker stopH
cogitate _ m@(MLock _)  = m
cogitate _ m@(MNettle _)  = m
cogitate s (MPlayer p)  = dmp s p
cogitate _ m@(MSave _)  = m
cogitate s (MSmart m)   = periodicMove s m MSmart decideMoveSmartWalker stopH
cogitate _ m@(MStar _)  = m
cogitate _ m@(MStone _) = m
cogitate _ m@(MSickle _) = m
cogitate s (MWin w)     = periodicMove s w MWin decideMoveWin stopV
cogitate s (MWitch w)   = periodicMove s w MWitch decideMoveWitch stopAll

periodicMove :: forall s a. (HasScreen s,
                 HasDelayed a,
                 HasMoving a) =>
                s -> a ->        -- input
                (a -> Meeple) -> -- constructor
                (s -> a -> a) -> -- decide mov function
                (s -> a -> a) -> -- wait function
                Meeple
periodicMove s a mc fmov wmov =
        let t = a ^. delay in
        if fetchFrame t
          then mc $ fmov s a & delay %~ tick
          else mc $ wmov s a & delay %~ tick
                      & speed . _2 .~ 0

---------------
-- MOVEMENTS --
---------------

dmp :: HasScreen s => s -> Player -> Meeple
dmp s p | p ^. amSlow = periodicMove s p MPlayer decideMovePlayer stopH
        | otherwise = MPlayer $ decideMovePlayer s p

-- non delayed
decideMovePlayer :: HasScreen s => s -> Player -> Player
decideMovePlayer _ p = p & nuSpeed
    where
          mc = p ^. action
          nuSpeed = case mc of
            AJumpL   -> jumpMod AGoW
            AJumpR   -> jumpMod AGoE
            AJumpX   -> jumpMod ANoAction
            AClimb   -> \lp -> lp & speed . _1 .~ (-1)
                                   & speed . _2 .~ 0
            ADescend -> \lp -> lp & speed . _1 .~ 1
                                   & speed . _2 .~ 0
            AGoW     -> speed . _2 .~ (-1)
            AGoE     -> speed . _2 .~ 1
            ANoAction -> id

          -- what action after jumping? follow horizontal speed
          jumpMod na wp =
                  wp & speed . _1 .~ (-3)
                     & action .~ na


decideMoveBird :: HasScreen s => s -> Bird -> Bird
decideMoveBird _ b =
            -- move randomly
            let (vs, b')  = casualRandom (-1,1) b
                (hs, b'') = casualRandom (-1,1) b'
                (r, c)    = b ^. position          in

            -- don't go too far away from where you spawned
            if ellOut (r+vs, c+hs)
              then b'' & speed .~ (0, 0)
                    -- do not move, pop the seed
              else b'' & speed . _1 .~ vs
                       & speed . _2 .~ hs
    where
          dist :: Coords -> Coords -> Int
          dist pa pb = length (D.bresenham pa pb) - 1

          -- I am outside an ellipse?
          ellOut :: Coords -> Bool
          ellOut cs =
            let -- focals
                cc = b ^. spawnpoint
                md = 10
                f1 = cc & _1 %~ subtract md
                f2 = cc & _1 %~ (+md)

            in dist cs f1 + dist cs f2 > 20

decideMoveWitch :: HasScreen s => s -> Witch -> Witch
decideMoveWitch s w =
       let -- possible random move
           (vsr, w')  = casualRandom (-1,1) w
           (hsr, w'') = casualRandom (-1,1) w' in
        case s ^. player of
          Nothing  -> w & speed .~ (vsr, hsr)
          (Just p) ->

              let -- possible towards player move
                  (pr, pc) = p ^. position
                  (wr, wc) = w ^. position
                  vsp = signum (pr - wr)
                  hsp = signum (pc - wc)

                  sn :: Integer
                  (sn, w''') = casualRandom (1, 10) w''
              in

              if sn > 7 then w''' & speed .~ (vsr, hsr)
                        else w''' & speed .~ (vsp, hsp)




decideMoveDumbWalker :: (HasScreen s, Meepeable m, HasWalker m, HasMoving m, HasStationary m) => s -> m -> m
decideMoveDumbWalker s b =
            let b' = updateDumbWalker s b
                nhs = b' ^. cardinal . to projhs
            in b' & speed . _2 .~ nhs

decideMoveSmartWalker :: (HasScreen s, Meepeable m, HasWalker m, HasMoving m, HasStationary m) => s -> m -> m
decideMoveSmartWalker s m =
            let m' = updateSmartWalker s m
                nhs = m' ^. cardinal . to projhs
            in m' & speed . _2 .~ nhs

decideMoveWin :: HasScreen s => s -> Win -> Win
decideMoveWin _ w =
            let nvs = w ^. floatino . to projvs
            in w & speed . _1 .~ nvs
                 & floatino %~ turnAround

-- decide = update state / update speed (auto)
-- update its state
updateDumbWalker :: (HasScreen s, Meepeable m, HasWalker m, HasStationary m) => s -> m -> m
updateDumbWalker s m =
            let hs  = m ^. cardinal . to projhs
                ucs = m ^. position & _2 +~ hs
                    -- projected state
            in

            if checkSolidMeeps s m ucs
              then m & cardinal %~ turnAround
              else m

-- all smart (don't fallon ledges) walkers
updateSmartWalker :: (HasScreen s, Meepeable m, HasWalker m, HasStationary m) => s -> m -> m
updateSmartWalker s m =
            if checkSolidMeeps s m ucs ||
               not stepVoid
              then m & cardinal %~ turnAround
              else m
    where
         hs  = m ^. cardinal . to projhs
         ucs = m ^. position & _2 +~ hs

         stepVoid :: Bool
         stepVoid = checkGround s m (ucs & _1 +~ 1)


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

-- meeples don't move as fast as player, usually the move once per couple
-- of frames. What do we do when it's not our turn to move? Allow some stuff
-- (gravity, etc.) but not our "sentient" movement.
stopV :: (HasScreen s, HasMoving a) => s -> a -> a
stopV _ m = m & speed . _1 .~ 0

stopH :: (HasScreen s, HasMoving a) => s -> a -> a
stopH _ m = m & speed . _2 .~ 0

stopAll :: (HasScreen s, HasMoving a) => s -> a -> a
stopAll _ m = m & speed .~ (0, 0)


-- projected horizontal speed
projhs :: Cardinal -> Integer
projhs E = 1
projhs W = -1
projhs _ = error "Cardinal not valid hs"

-- projected horizontal speed
projvs :: Cardinal -> Integer
projvs S = 1
projvs N = -1
projvs _ = error "Cardinal not valid vs"