Operate.hs

module Meeple.Operate ( module M, module Meeple.Operate ) where

import Meeple.Primitives as M

import Lens.Micro.Platform
import Terminal.Game

import qualified Data.Char     as C
import qualified Line.Draw     as D


casualRandom :: (Random a, HasCasual c) => (a, a) -> c -> (a, c)
casualRandom bs c = let g       = c ^. seed
                        (i, g') = getRandom bs g in
                    (i, c & seed .~ g')


-- bool: long lock ani?
updateLockAni :: Bool -> Meeple -> Meeple
updateLockAni b (MLock l) =
            let i  = l ^. currNumeral
                a' | i >= 0    = lockAni i
                   | otherwise = creaStaticAnimation (cell '?')
                l' = l & draw .~ a'
            in

            if b then MLock l'
                 else MLock (l' & draw %~ lapse)
    where
          lockAni 0  =
                    creaAnimation
                      [(1, cell '\\'),
                       (1, cell '-'),
                       (1, cell '/')]
          lockAni wi = let n = 1
                           c = C.intToDigit . fromIntegral $ wi in
                    creaAnimation
                      [(n, cell '\\'),
                       (n, cell '-'),
                       (n, cell '/'),
                       (n, cell c)]
updateLockAni _ m       = m

isDead :: Meeple -> Bool
isDead (MDead _) = True
isDead _         = False

isPlayer :: Meeple -> Bool
isPlayer (MPlayer _) = True
isPlayer _           = False

-- if you have moved, unset new property
oldPlayer :: Player -> Player
oldPlayer p
        | not (p ^. isNew)     = p
        | p ^. speed == (0, 0) = p
        | otherwise            = p & isNew .~ False


hasSteps :: Meeple -> Bool
hasSteps (MDead _)   = False
hasSteps (MBird b)   = (not . null) (b ^. steps)
hasSteps (MDumb d)   = (not . null) (d ^. steps)
hasSteps (MKram k)   = (not . null) (k ^. steps)
hasSteps (MLock _)   = False
hasSteps (MNettle _) = False
hasSteps (MPlayer p) = (not . null) (p ^. steps)
hasSteps (MSave _)   = False
hasSteps (MSmart s)  = (not . null) (s ^. steps)
hasSteps (MSickle s) = (not . null) (s ^. steps)
hasSteps (MStar _)   = False
hasSteps (MStone s)  = (not . null) (s ^. steps)
hasSteps (MWin w)    = (not . null) (w ^. steps)
hasSteps (MWitch b)   = (not . null) (b ^. steps)

dropStep :: Meeple -> Meeple
dropStep m@(MDead _)   = m
dropStep m@(MBird _)   = m & steps %~ tail
dropStep m@(MDumb _)   = m & steps %~ tail
dropStep m@(MKram _)   = m & steps %~ tail
dropStep m@(MLock _)   = m
dropStep m@(MNettle _) = m
dropStep m@(MPlayer _) = m & steps %~ tail
dropStep m@(MSave _)   = m
dropStep m@(MSmart _)  = m & steps %~ tail
dropStep m@(MSickle _) = m & steps %~ tail
dropStep m@(MStar _)   = m
dropStep m@(MStone _)  = m & steps %~ tail
dropStep m@(MWin _)    = m & steps %~ tail
dropStep m@(MWitch _)   = m & steps %~ tail

safePrevPos :: Meeple -> Coords
safePrevPos (MDead _)     = error "safePrevPos"
safePrevPos m@(MBird _)   = m ^. prevPos
safePrevPos m@(MDumb _)   = m ^. prevPos
safePrevPos m@(MKram _)   = m ^. prevPos
safePrevPos m@(MLock _)   = m ^. position
safePrevPos m@(MNettle _) = m ^. position
safePrevPos m@(MPlayer _) = m ^. prevPos
safePrevPos m@(MSave _)   = m ^. position
safePrevPos m@(MSickle _) = m ^. prevPos
safePrevPos m@(MStar _)   = m ^. position
safePrevPos m@(MSmart _)  = m ^. prevPos
safePrevPos m@(MStone _)  = m ^. prevPos
safePrevPos m@(MWin _)    = m ^. prevPos
safePrevPos m@(MWitch _)   = m ^. prevPos

-- this generates the projectile and decides whether it is gonna be
-- spawned or aborted
genProj :: Meeple -> Meeple
genProj (MBird b) = let cs = b ^. position
                        b' = b & ready ?~ MRStone cs
                    in MBird $ spawnOrNot (1, 8) b'
genProj (MKram k) = let cs = k ^. position
                        -- (sh, k') = casualRandom (-1, 1) k
                        -- non un bel effetto grafico
                        k' = k & ready ?~ MRSickle cs (-1, 0)
                    in MKram $ spawnOrNot (1, 5) k'
genProj m@MDead {}         = m
genProj m@MPlayer {}         = m
genProj m@MStar {}         = m
genProj m@MLock {}         = m
genProj m@MNettle {}         = m
genProj m@MSickle {}         = m
genProj m@MStone {}         = m
genProj m@MDumb {}         = m
genProj m@MSmart {}         = m
genProj m@MWin {}         = m
genProj m@MWitch {}         = m
genProj m@MSave {}         = m

-- let the generated meeplelive or else
spawnOrNot :: (HasGenerator g, HasCasual g) => (Integer, Integer) -> g -> g
spawnOrNot (t, n) g =
            let (i, g') = casualRandom (1, n) g
            in if i <= t then g'                    -- let it live
                         else g' & ready .~ Nothing -- cull it


-------------
-- OPERATE --
-------------

generateSteps :: Meeple -> Meeple
generateSteps m = let ss = D.bresenham (0, 0) (m ^. speed)
                      mf (a, b) (c, d) = (a-c, b-d)
                  in m & steps .~ zipWith mf (tail ss) ss

-- touch animation
touchSave :: Save -> Save
touchSave s = s & draw .~ ani
    where
          ani = creaAnimation
                  [(2, cell '@' # color Blue Vivid),
                   (3, cell '+' # color Yellow Vivid # bold),
                   (3, cell '@' # color Blue Vivid),
                   (3, cell '+' # color Yellow Vivid # bold),
                   (3, cell '@' # color Blue Vivid)]


-- inquire --

-- similar folks don't hit each other
isSimilar :: Meeple -> Meeple -> Bool
isSimilar ma mb = meepleCategory ma == meepleCategory mb

isStingy :: Nettle -> Bool
isStingy n = (n ^. draw . to fetchFrame . to paperPlane) == "A\n"

------------------
-- CONSTRUCTORS --
------------------

-- ASCII Chars:
--   !"#$%&'()*+,-./
--   0123456789
--   :;<=>?@
--   ABCDEFGHIJKLMNOPQRSTUVWXYZ
--   [\]^_`
--   abcdefghijklmnopqrstuvwxyz
--   {|}

creaRef :: MeepRef -> [Meeple]
creaRef (MRStone cs)     = [s (-1), s 0, s 1]
    where
          s :: Integer -> Meeple
          s mh = MStone $ defaultStone (cs & _1 %~ (+1)
                                           & _2  %~(+mh))
creaRef (MRSickle cs sp) = [MSickle $ defaultSickle
                                        (cs & _1 %~ subtract 1)
                                        sp]