-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Handling 'Swarm.TUI.Model.Frame' events.
module Swarm.TUI.Controller.EventHandlers.Frame (
  runFrameUI,
  runGameTickUI,

  -- ** Constants
  ticksPerFrameCap,
) where

import Brick
import Control.Lens as Lens
import Control.Monad (unless, void, when)
import Control.Monad.IO.Class (MonadIO (liftIO))
import Data.Bits
import Data.Map qualified as M
import Swarm.Game.Achievement.Attainment (achievement)
import Swarm.Game.Achievement.Definitions
import Swarm.Game.Achievement.Persistence
import Swarm.Game.State
import Swarm.Game.State.Substate
import Swarm.Game.Step (gameTick)
import Swarm.TUI.Controller.UpdateUI
import Swarm.TUI.Controller.Util
import Swarm.TUI.Model
import Swarm.TUI.Model.Achievements (popupAchievement)
import Swarm.TUI.Model.UI.Gameplay
import System.Clock

ticksPerFrameCap :: Int
ticksPerFrameCap :: Int
ticksPerFrameCap = Int
30

-- | Run the game for a single /frame/ (/i.e./ screen redraw), then
--   update the UI.  Depending on how long it is taking to draw each
--   frame, and how many ticks per second we are trying to achieve,
--   this may involve stepping the game any number of ticks (including
--   zero).
runFrameUI :: Bool -> EventM Name AppState ()
runFrameUI :: Bool -> EventM Name AppState ()
runFrameUI Bool
forceRedraw = LensLike' (Zoomed (EventM Name PlayState) ()) AppState PlayState
-> EventM Name PlayState () -> EventM Name AppState ()
forall c.
LensLike' (Zoomed (EventM Name PlayState) c) AppState PlayState
-> EventM Name PlayState c -> EventM Name AppState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom (PlayState -> Focusing (StateT (EventState Name) IO) () PlayState)
-> AppState -> Focusing (StateT (EventState Name) IO) () AppState
LensLike' (Zoomed (EventM Name PlayState) ()) AppState PlayState
Lens' AppState PlayState
playState EventM Name PlayState ()
runFrame EventM Name AppState ()
-> EventM Name AppState () -> EventM Name AppState ()
forall a b.
EventM Name AppState a
-> EventM Name AppState b -> EventM Name AppState b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> EventM Name AppState ()
updateAndRedrawUI Bool
forceRedraw

oneSecond :: Integer
oneSecond :: Integer
oneSecond = Integer
1_000_000_000 -- one second = 10^9 nanoseconds

runFramePlayState :: EventM Name PlayState ()
runFramePlayState :: EventM Name PlayState ()
runFramePlayState = LensLike'
  (Zoomed (EventM Name ScenarioState) ()) PlayState ScenarioState
-> EventM Name ScenarioState () -> EventM Name PlayState ()
forall c.
LensLike'
  (Zoomed (EventM Name ScenarioState) c) PlayState ScenarioState
-> EventM Name ScenarioState c -> EventM Name PlayState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom LensLike'
  (Zoomed (EventM Name ScenarioState) ()) PlayState ScenarioState
Lens' PlayState ScenarioState
scenarioState (EventM Name ScenarioState () -> EventM Name PlayState ())
-> EventM Name ScenarioState () -> EventM Name PlayState ()
forall a b. (a -> b) -> a -> b
$ do
  -- Reset the needsRedraw flag.  While processing the frame and stepping the robots,
  -- the flag will get set to true if anything changes that requires redrawing the
  -- world (e.g. a robot moving or disappearing).
  (GameState -> Identity GameState)
-> ScenarioState -> Identity ScenarioState
Lens' ScenarioState GameState
gameState ((GameState -> Identity GameState)
 -> ScenarioState -> Identity ScenarioState)
-> ((Bool -> Identity Bool) -> GameState -> Identity GameState)
-> (Bool -> Identity Bool)
-> ScenarioState
-> Identity ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool) -> GameState -> Identity GameState
Lens' GameState Bool
needsRedraw ((Bool -> Identity Bool)
 -> ScenarioState -> Identity ScenarioState)
-> Bool -> EventM Name ScenarioState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
False

  -- The logic here is taken from https://gafferongames.com/post/fix_your_timestep/ .

  TimeSpec
curTime <- IO TimeSpec -> EventM Name ScenarioState TimeSpec
forall a. IO a -> EventM Name ScenarioState a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TimeSpec -> EventM Name ScenarioState TimeSpec)
-> IO TimeSpec -> EventM Name ScenarioState TimeSpec
forall a b. (a -> b) -> a -> b
$ Clock -> IO TimeSpec
getTime Clock
Monotonic
  LensLike' (Zoomed (EventM Name UITiming) ()) ScenarioState UITiming
-> EventM Name UITiming () -> EventM Name ScenarioState ()
forall c.
LensLike' (Zoomed (EventM Name UITiming) c) ScenarioState UITiming
-> EventM Name UITiming c -> EventM Name ScenarioState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom ((UIGameplay -> Zoomed (EventM Name UITiming) () UIGameplay)
-> ScenarioState -> Zoomed (EventM Name UITiming) () ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Zoomed (EventM Name UITiming) () UIGameplay)
 -> ScenarioState -> Zoomed (EventM Name UITiming) () ScenarioState)
-> ((UITiming -> Zoomed (EventM Name UITiming) () UITiming)
    -> UIGameplay -> Zoomed (EventM Name UITiming) () UIGameplay)
-> LensLike'
     (Zoomed (EventM Name UITiming) ()) ScenarioState UITiming
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UITiming -> Zoomed (EventM Name UITiming) () UITiming)
-> UIGameplay -> Zoomed (EventM Name UITiming) () UIGameplay
Lens' UIGameplay UITiming
uiTiming) (EventM Name UITiming () -> EventM Name ScenarioState ())
-> EventM Name UITiming () -> EventM Name ScenarioState ()
forall a b. (a -> b) -> a -> b
$ do
    -- Find out how long the previous frame took, by subtracting the
    -- previous time from the current time.
    TimeSpec
prevTime <- Getting TimeSpec UITiming TimeSpec -> EventM Name UITiming TimeSpec
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting TimeSpec UITiming TimeSpec
Lens' UITiming TimeSpec
lastFrameTime
    let frameTime :: TimeSpec
frameTime = TimeSpec -> TimeSpec -> TimeSpec
diffTimeSpec TimeSpec
curTime TimeSpec
prevTime

    -- Remember now as the new previous time.
    (TimeSpec -> Identity TimeSpec) -> UITiming -> Identity UITiming
Lens' UITiming TimeSpec
lastFrameTime ((TimeSpec -> Identity TimeSpec) -> UITiming -> Identity UITiming)
-> TimeSpec -> EventM Name UITiming ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= TimeSpec
curTime

    -- We now have some additional accumulated time to play with.  The
    -- idea is to now "catch up" by doing as many ticks as are supposed
    -- to fit in the accumulated time.  Some accumulated time may be
    -- left over, but it will roll over to the next frame.  This way we
    -- deal smoothly with things like a variable frame rate, the frame
    -- rate not being a nice multiple of the desired ticks per second,
    -- etc.
    (TimeSpec -> Identity TimeSpec) -> UITiming -> Identity UITiming
Lens' UITiming TimeSpec
accumulatedTime ((TimeSpec -> Identity TimeSpec) -> UITiming -> Identity UITiming)
-> TimeSpec -> EventM Name UITiming ()
forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter' s a -> a -> m ()
+= TimeSpec
frameTime

  -- Update TPS/FPS counters every second
  TimeSpec
infoUpdateTime <- Getting TimeSpec ScenarioState TimeSpec
-> EventM Name ScenarioState TimeSpec
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((UIGameplay -> Const TimeSpec UIGameplay)
-> ScenarioState -> Const TimeSpec ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Const TimeSpec UIGameplay)
 -> ScenarioState -> Const TimeSpec ScenarioState)
-> ((TimeSpec -> Const TimeSpec TimeSpec)
    -> UIGameplay -> Const TimeSpec UIGameplay)
-> Getting TimeSpec ScenarioState TimeSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UITiming -> Const TimeSpec UITiming)
-> UIGameplay -> Const TimeSpec UIGameplay
Lens' UIGameplay UITiming
uiTiming ((UITiming -> Const TimeSpec UITiming)
 -> UIGameplay -> Const TimeSpec UIGameplay)
-> Getting TimeSpec UITiming TimeSpec
-> (TimeSpec -> Const TimeSpec TimeSpec)
-> UIGameplay
-> Const TimeSpec UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting TimeSpec UITiming TimeSpec
Lens' UITiming TimeSpec
lastInfoTime)
  let updateTime :: Integer
updateTime = TimeSpec -> Integer
toNanoSecs (TimeSpec -> Integer) -> TimeSpec -> Integer
forall a b. (a -> b) -> a -> b
$ TimeSpec -> TimeSpec -> TimeSpec
diffTimeSpec TimeSpec
curTime TimeSpec
infoUpdateTime
  Bool
-> EventM Name ScenarioState () -> EventM Name ScenarioState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
updateTime Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
oneSecond) (EventM Name ScenarioState () -> EventM Name ScenarioState ())
-> EventM Name ScenarioState () -> EventM Name ScenarioState ()
forall a b. (a -> b) -> a -> b
$ do
    -- Wait for at least one second to have elapsed
    Bool
-> EventM Name ScenarioState () -> EventM Name ScenarioState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TimeSpec
infoUpdateTime TimeSpec -> TimeSpec -> Bool
forall a. Eq a => a -> a -> Bool
/= TimeSpec
0) (EventM Name ScenarioState () -> EventM Name ScenarioState ())
-> EventM Name ScenarioState () -> EventM Name ScenarioState ()
forall a b. (a -> b) -> a -> b
$ do
      LensLike' (Zoomed (EventM Name UITiming) ()) ScenarioState UITiming
-> EventM Name UITiming () -> EventM Name ScenarioState ()
forall c.
LensLike' (Zoomed (EventM Name UITiming) c) ScenarioState UITiming
-> EventM Name UITiming c -> EventM Name ScenarioState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom ((UIGameplay -> Zoomed (EventM Name UITiming) () UIGameplay)
-> ScenarioState -> Zoomed (EventM Name UITiming) () ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Zoomed (EventM Name UITiming) () UIGameplay)
 -> ScenarioState -> Zoomed (EventM Name UITiming) () ScenarioState)
-> ((UITiming -> Zoomed (EventM Name UITiming) () UITiming)
    -> UIGameplay -> Zoomed (EventM Name UITiming) () UIGameplay)
-> LensLike'
     (Zoomed (EventM Name UITiming) ()) ScenarioState UITiming
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UITiming -> Zoomed (EventM Name UITiming) () UITiming)
-> UIGameplay -> Zoomed (EventM Name UITiming) () UIGameplay
Lens' UIGameplay UITiming
uiTiming) (EventM Name UITiming () -> EventM Name ScenarioState ())
-> EventM Name UITiming () -> EventM Name ScenarioState ()
forall a b. (a -> b) -> a -> b
$ do
        -- set how much frame got processed per second
        Int
frames <- Getting Int UITiming Int -> EventM Name UITiming Int
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Int UITiming Int
Lens' UITiming Int
frameCount
        (Double -> Identity Double) -> UITiming -> Identity UITiming
Lens' UITiming Double
uiFPS ((Double -> Identity Double) -> UITiming -> Identity UITiming)
-> Double -> EventM Name UITiming ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
frames Int -> Int -> Int
forall a. Num a => a -> a -> a
* Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
oneSecond) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
updateTime

        -- set how much ticks got processed per frame
        Int
uiTicks <- Getting Int UITiming Int -> EventM Name UITiming Int
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Int UITiming Int
Lens' UITiming Int
tickCount
        (Double -> Identity Double) -> UITiming -> Identity UITiming
Lens' UITiming Double
uiTPF ((Double -> Identity Double) -> UITiming -> Identity UITiming)
-> Double -> EventM Name UITiming ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
uiTicks Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
frames

      -- ensure this frame gets drawn
      (GameState -> Identity GameState)
-> ScenarioState -> Identity ScenarioState
Lens' ScenarioState GameState
gameState ((GameState -> Identity GameState)
 -> ScenarioState -> Identity ScenarioState)
-> ((Bool -> Identity Bool) -> GameState -> Identity GameState)
-> (Bool -> Identity Bool)
-> ScenarioState
-> Identity ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool) -> GameState -> Identity GameState
Lens' GameState Bool
needsRedraw ((Bool -> Identity Bool)
 -> ScenarioState -> Identity ScenarioState)
-> Bool -> EventM Name ScenarioState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True

    LensLike' (Zoomed (EventM Name UITiming) ()) ScenarioState UITiming
-> EventM Name UITiming () -> EventM Name ScenarioState ()
forall c.
LensLike' (Zoomed (EventM Name UITiming) c) ScenarioState UITiming
-> EventM Name UITiming c -> EventM Name ScenarioState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom ((UIGameplay -> Zoomed (EventM Name UITiming) () UIGameplay)
-> ScenarioState -> Zoomed (EventM Name UITiming) () ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Zoomed (EventM Name UITiming) () UIGameplay)
 -> ScenarioState -> Zoomed (EventM Name UITiming) () ScenarioState)
-> ((UITiming -> Zoomed (EventM Name UITiming) () UITiming)
    -> UIGameplay -> Zoomed (EventM Name UITiming) () UIGameplay)
-> LensLike'
     (Zoomed (EventM Name UITiming) ()) ScenarioState UITiming
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UITiming -> Zoomed (EventM Name UITiming) () UITiming)
-> UIGameplay -> Zoomed (EventM Name UITiming) () UIGameplay
Lens' UIGameplay UITiming
uiTiming) (EventM Name UITiming () -> EventM Name ScenarioState ())
-> EventM Name UITiming () -> EventM Name ScenarioState ()
forall a b. (a -> b) -> a -> b
$ do
      -- Reset the counter and wait another seconds for the next update
      (Int -> Identity Int) -> UITiming -> Identity UITiming
Lens' UITiming Int
tickCount ((Int -> Identity Int) -> UITiming -> Identity UITiming)
-> Int -> EventM Name UITiming ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Int
0
      (Int -> Identity Int) -> UITiming -> Identity UITiming
Lens' UITiming Int
frameCount ((Int -> Identity Int) -> UITiming -> Identity UITiming)
-> Int -> EventM Name UITiming ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Int
0
      (TimeSpec -> Identity TimeSpec) -> UITiming -> Identity UITiming
Lens' UITiming TimeSpec
lastInfoTime ((TimeSpec -> Identity TimeSpec) -> UITiming -> Identity UITiming)
-> TimeSpec -> EventM Name UITiming ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= TimeSpec
curTime

  LensLike' (Zoomed (EventM Name UITiming) ()) ScenarioState UITiming
-> EventM Name UITiming () -> EventM Name ScenarioState ()
forall c.
LensLike' (Zoomed (EventM Name UITiming) c) ScenarioState UITiming
-> EventM Name UITiming c -> EventM Name ScenarioState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom ((UIGameplay -> Zoomed (EventM Name UITiming) () UIGameplay)
-> ScenarioState -> Zoomed (EventM Name UITiming) () ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Zoomed (EventM Name UITiming) () UIGameplay)
 -> ScenarioState -> Zoomed (EventM Name UITiming) () ScenarioState)
-> ((UITiming -> Zoomed (EventM Name UITiming) () UITiming)
    -> UIGameplay -> Zoomed (EventM Name UITiming) () UIGameplay)
-> LensLike'
     (Zoomed (EventM Name UITiming) ()) ScenarioState UITiming
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UITiming -> Zoomed (EventM Name UITiming) () UITiming)
-> UIGameplay -> Zoomed (EventM Name UITiming) () UIGameplay
Lens' UIGameplay UITiming
uiTiming) (EventM Name UITiming () -> EventM Name ScenarioState ())
-> EventM Name UITiming () -> EventM Name ScenarioState ()
forall a b. (a -> b) -> a -> b
$ do
    -- Increment the frame count
    (Int -> Identity Int) -> UITiming -> Identity UITiming
Lens' UITiming Int
frameCount ((Int -> Identity Int) -> UITiming -> Identity UITiming)
-> Int -> EventM Name UITiming ()
forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter' s a -> a -> m ()
+= Int
1

    (Int -> Identity Int) -> UITiming -> Identity UITiming
Lens' UITiming Int
frameTickCount ((Int -> Identity Int) -> UITiming -> Identity UITiming)
-> Int -> EventM Name UITiming ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Int
0

-- | Run the game for a single frame, without updating the UI.
runFrame :: EventM Name PlayState ()
runFrame :: EventM Name PlayState ()
runFrame = do
  EventM Name PlayState ()
runFramePlayState

  -- Figure out how many ticks per second we're supposed to do,
  -- and compute the timestep `dt` for a single tick.
  Int
lgTPS <- Getting Int PlayState Int -> EventM Name PlayState Int
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((ScenarioState -> Const Int ScenarioState)
-> PlayState -> Const Int PlayState
Lens' PlayState ScenarioState
scenarioState ((ScenarioState -> Const Int ScenarioState)
 -> PlayState -> Const Int PlayState)
-> ((Int -> Const Int Int)
    -> ScenarioState -> Const Int ScenarioState)
-> Getting Int PlayState Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Const Int UIGameplay)
-> ScenarioState -> Const Int ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Const Int UIGameplay)
 -> ScenarioState -> Const Int ScenarioState)
-> ((Int -> Const Int Int) -> UIGameplay -> Const Int UIGameplay)
-> (Int -> Const Int Int)
-> ScenarioState
-> Const Int ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UITiming -> Const Int UITiming)
-> UIGameplay -> Const Int UIGameplay
Lens' UIGameplay UITiming
uiTiming ((UITiming -> Const Int UITiming)
 -> UIGameplay -> Const Int UIGameplay)
-> Getting Int UITiming Int
-> (Int -> Const Int Int)
-> UIGameplay
-> Const Int UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Int UITiming Int
Lens' UITiming Int
lgTicksPerSecond)
  let dt :: Integer
dt
        | Int
lgTPS Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 = Integer
oneSecond Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` (Integer
1 Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
lgTPS)
        | Bool
otherwise = Integer
oneSecond Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Integer
1 Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int -> Int
forall a. Num a => a -> a
abs Int
lgTPS)

  -- Now do as many ticks as we need to catch up.
  TimeSpec -> EventM Name PlayState ()
runFrameTicks (Integer -> TimeSpec
fromNanoSecs Integer
dt)

-- | Do zero or more ticks, with each tick notionally taking the given
--   timestep, until we have used up all available accumulated time,
--   OR until we have hit the cap on ticks per frame, whichever comes
--   first.
runFrameTicks :: TimeSpec -> EventM Name PlayState ()
runFrameTicks :: TimeSpec -> EventM Name PlayState ()
runFrameTicks TimeSpec
dt = do
  UITiming
timing <- Getting UITiming PlayState UITiming
-> EventM Name PlayState UITiming
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting UITiming PlayState UITiming
 -> EventM Name PlayState UITiming)
-> Getting UITiming PlayState UITiming
-> EventM Name PlayState UITiming
forall a b. (a -> b) -> a -> b
$ (ScenarioState -> Const UITiming ScenarioState)
-> PlayState -> Const UITiming PlayState
Lens' PlayState ScenarioState
scenarioState ((ScenarioState -> Const UITiming ScenarioState)
 -> PlayState -> Const UITiming PlayState)
-> ((UITiming -> Const UITiming UITiming)
    -> ScenarioState -> Const UITiming ScenarioState)
-> Getting UITiming PlayState UITiming
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Const UITiming UIGameplay)
-> ScenarioState -> Const UITiming ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Const UITiming UIGameplay)
 -> ScenarioState -> Const UITiming ScenarioState)
-> ((UITiming -> Const UITiming UITiming)
    -> UIGameplay -> Const UITiming UIGameplay)
-> (UITiming -> Const UITiming UITiming)
-> ScenarioState
-> Const UITiming ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UITiming -> Const UITiming UITiming)
-> UIGameplay -> Const UITiming UIGameplay
Lens' UIGameplay UITiming
uiTiming
  let a :: TimeSpec
a = UITiming
timing UITiming -> Getting TimeSpec UITiming TimeSpec -> TimeSpec
forall s a. s -> Getting a s a -> a
^. Getting TimeSpec UITiming TimeSpec
Lens' UITiming TimeSpec
accumulatedTime
      t :: Int
t = UITiming
timing UITiming -> Getting Int UITiming Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int UITiming Int
Lens' UITiming Int
frameTickCount

  -- Ensure there is still enough time left, and we haven't hit the
  -- tick limit for this frame.
  Bool -> EventM Name PlayState () -> EventM Name PlayState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TimeSpec
a TimeSpec -> TimeSpec -> Bool
forall a. Ord a => a -> a -> Bool
>= TimeSpec
dt Bool -> Bool -> Bool
&& Int
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ticksPerFrameCap) (EventM Name PlayState () -> EventM Name PlayState ())
-> EventM Name PlayState () -> EventM Name PlayState ()
forall a b. (a -> b) -> a -> b
$ do
    -- If so, do a tick, count it, subtract dt from the accumulated time,
    -- and loop!
    EventM Name PlayState ()
runGameTick
    LensLike' (Zoomed (EventM Name UITiming) ()) PlayState UITiming
-> EventM Name UITiming () -> EventM Name PlayState ()
forall c.
LensLike' (Zoomed (EventM Name UITiming) c) PlayState UITiming
-> EventM Name UITiming c -> EventM Name PlayState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom ((ScenarioState -> Zoomed (EventM Name UITiming) () ScenarioState)
-> PlayState -> Zoomed (EventM Name UITiming) () PlayState
Lens' PlayState ScenarioState
scenarioState ((ScenarioState -> Zoomed (EventM Name UITiming) () ScenarioState)
 -> PlayState -> Zoomed (EventM Name UITiming) () PlayState)
-> LensLike'
     (Zoomed (EventM Name UITiming) ()) ScenarioState UITiming
-> LensLike' (Zoomed (EventM Name UITiming) ()) PlayState UITiming
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Zoomed (EventM Name UITiming) () UIGameplay)
-> ScenarioState -> Zoomed (EventM Name UITiming) () ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Zoomed (EventM Name UITiming) () UIGameplay)
 -> ScenarioState -> Zoomed (EventM Name UITiming) () ScenarioState)
-> ((UITiming -> Zoomed (EventM Name UITiming) () UITiming)
    -> UIGameplay -> Zoomed (EventM Name UITiming) () UIGameplay)
-> LensLike'
     (Zoomed (EventM Name UITiming) ()) ScenarioState UITiming
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UITiming -> Zoomed (EventM Name UITiming) () UITiming)
-> UIGameplay -> Zoomed (EventM Name UITiming) () UIGameplay
Lens' UIGameplay UITiming
uiTiming) (EventM Name UITiming () -> EventM Name PlayState ())
-> EventM Name UITiming () -> EventM Name PlayState ()
forall a b. (a -> b) -> a -> b
$ do
      (Int -> Identity Int) -> UITiming -> Identity UITiming
Lens' UITiming Int
tickCount ((Int -> Identity Int) -> UITiming -> Identity UITiming)
-> Int -> EventM Name UITiming ()
forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter' s a -> a -> m ()
+= Int
1
      (Int -> Identity Int) -> UITiming -> Identity UITiming
Lens' UITiming Int
frameTickCount ((Int -> Identity Int) -> UITiming -> Identity UITiming)
-> Int -> EventM Name UITiming ()
forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter' s a -> a -> m ()
+= Int
1
      (TimeSpec -> Identity TimeSpec) -> UITiming -> Identity UITiming
Lens' UITiming TimeSpec
accumulatedTime ((TimeSpec -> Identity TimeSpec) -> UITiming -> Identity UITiming)
-> TimeSpec -> EventM Name UITiming ()
forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter' s a -> a -> m ()
-= TimeSpec
dt
    TimeSpec -> EventM Name PlayState ()
runFrameTicks TimeSpec
dt

-- | Run the game for a single tick, and update the UI.
runGameTickUI :: EventM Name AppState ()
runGameTickUI :: EventM Name AppState ()
runGameTickUI = LensLike' (Zoomed (EventM Name PlayState) ()) AppState PlayState
-> EventM Name PlayState () -> EventM Name AppState ()
forall c.
LensLike' (Zoomed (EventM Name PlayState) c) AppState PlayState
-> EventM Name PlayState c -> EventM Name AppState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom (PlayState -> Focusing (StateT (EventState Name) IO) () PlayState)
-> AppState -> Focusing (StateT (EventState Name) IO) () AppState
LensLike' (Zoomed (EventM Name PlayState) ()) AppState PlayState
Lens' AppState PlayState
playState EventM Name PlayState ()
runGameTick EventM Name AppState ()
-> EventM Name AppState () -> EventM Name AppState ()
forall a b.
EventM Name AppState a
-> EventM Name AppState b -> EventM Name AppState b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EventM Name AppState Bool -> EventM Name AppState ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void EventM Name AppState Bool
updateUI

updateAchievements :: EventM Name PlayState ()
updateAchievements :: EventM Name PlayState ()
updateAchievements = do
  -- Merge the in-game achievements with the master list in UIState
  Map GameplayAchievement Attainment
achievementsFromGame <- Getting
  (Map GameplayAchievement Attainment)
  PlayState
  (Map GameplayAchievement Attainment)
-> EventM Name PlayState (Map GameplayAchievement Attainment)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting
   (Map GameplayAchievement Attainment)
   PlayState
   (Map GameplayAchievement Attainment)
 -> EventM Name PlayState (Map GameplayAchievement Attainment))
-> Getting
     (Map GameplayAchievement Attainment)
     PlayState
     (Map GameplayAchievement Attainment)
-> EventM Name PlayState (Map GameplayAchievement Attainment)
forall a b. (a -> b) -> a -> b
$ (ScenarioState
 -> Const (Map GameplayAchievement Attainment) ScenarioState)
-> PlayState
-> Const (Map GameplayAchievement Attainment) PlayState
Lens' PlayState ScenarioState
scenarioState ((ScenarioState
  -> Const (Map GameplayAchievement Attainment) ScenarioState)
 -> PlayState
 -> Const (Map GameplayAchievement Attainment) PlayState)
-> ((Map GameplayAchievement Attainment
     -> Const
          (Map GameplayAchievement Attainment)
          (Map GameplayAchievement Attainment))
    -> ScenarioState
    -> Const (Map GameplayAchievement Attainment) ScenarioState)
-> Getting
     (Map GameplayAchievement Attainment)
     PlayState
     (Map GameplayAchievement Attainment)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GameState -> Const (Map GameplayAchievement Attainment) GameState)
-> ScenarioState
-> Const (Map GameplayAchievement Attainment) ScenarioState
Lens' ScenarioState GameState
gameState ((GameState
  -> Const (Map GameplayAchievement Attainment) GameState)
 -> ScenarioState
 -> Const (Map GameplayAchievement Attainment) ScenarioState)
-> ((Map GameplayAchievement Attainment
     -> Const
          (Map GameplayAchievement Attainment)
          (Map GameplayAchievement Attainment))
    -> GameState
    -> Const (Map GameplayAchievement Attainment) GameState)
-> (Map GameplayAchievement Attainment
    -> Const
         (Map GameplayAchievement Attainment)
         (Map GameplayAchievement Attainment))
-> ScenarioState
-> Const (Map GameplayAchievement Attainment) ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Discovery -> Const (Map GameplayAchievement Attainment) Discovery)
-> GameState
-> Const (Map GameplayAchievement Attainment) GameState
Lens' GameState Discovery
discovery ((Discovery
  -> Const (Map GameplayAchievement Attainment) Discovery)
 -> GameState
 -> Const (Map GameplayAchievement Attainment) GameState)
-> ((Map GameplayAchievement Attainment
     -> Const
          (Map GameplayAchievement Attainment)
          (Map GameplayAchievement Attainment))
    -> Discovery
    -> Const (Map GameplayAchievement Attainment) Discovery)
-> (Map GameplayAchievement Attainment
    -> Const
         (Map GameplayAchievement Attainment)
         (Map GameplayAchievement Attainment))
-> GameState
-> Const (Map GameplayAchievement Attainment) GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map GameplayAchievement Attainment
 -> Const
      (Map GameplayAchievement Attainment)
      (Map GameplayAchievement Attainment))
-> Discovery
-> Const (Map GameplayAchievement Attainment) Discovery
Lens' Discovery (Map GameplayAchievement Attainment)
gameAchievements
  let wrappedGameAchievements :: Map CategorizedAchievement Attainment
wrappedGameAchievements = (GameplayAchievement -> CategorizedAchievement)
-> Map GameplayAchievement Attainment
-> Map CategorizedAchievement Attainment
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys GameplayAchievement -> CategorizedAchievement
GameplayAchievement Map GameplayAchievement Attainment
achievementsFromGame

  Map CategorizedAchievement Attainment
oldMasterAchievementsList <- Getting
  (Map CategorizedAchievement Attainment)
  PlayState
  (Map CategorizedAchievement Attainment)
-> EventM Name PlayState (Map CategorizedAchievement Attainment)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting
   (Map CategorizedAchievement Attainment)
   PlayState
   (Map CategorizedAchievement Attainment)
 -> EventM Name PlayState (Map CategorizedAchievement Attainment))
-> Getting
     (Map CategorizedAchievement Attainment)
     PlayState
     (Map CategorizedAchievement Attainment)
-> EventM Name PlayState (Map CategorizedAchievement Attainment)
forall a b. (a -> b) -> a -> b
$ (ProgressionState
 -> Const (Map CategorizedAchievement Attainment) ProgressionState)
-> PlayState
-> Const (Map CategorizedAchievement Attainment) PlayState
Lens' PlayState ProgressionState
progression ((ProgressionState
  -> Const (Map CategorizedAchievement Attainment) ProgressionState)
 -> PlayState
 -> Const (Map CategorizedAchievement Attainment) PlayState)
-> ((Map CategorizedAchievement Attainment
     -> Const
          (Map CategorizedAchievement Attainment)
          (Map CategorizedAchievement Attainment))
    -> ProgressionState
    -> Const (Map CategorizedAchievement Attainment) ProgressionState)
-> Getting
     (Map CategorizedAchievement Attainment)
     PlayState
     (Map CategorizedAchievement Attainment)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map CategorizedAchievement Attainment
 -> Const
      (Map CategorizedAchievement Attainment)
      (Map CategorizedAchievement Attainment))
-> ProgressionState
-> Const (Map CategorizedAchievement Attainment) ProgressionState
Lens' ProgressionState (Map CategorizedAchievement Attainment)
attainedAchievements
  (ProgressionState -> Identity ProgressionState)
-> PlayState -> Identity PlayState
Lens' PlayState ProgressionState
progression ((ProgressionState -> Identity ProgressionState)
 -> PlayState -> Identity PlayState)
-> ((Map CategorizedAchievement Attainment
     -> Identity (Map CategorizedAchievement Attainment))
    -> ProgressionState -> Identity ProgressionState)
-> (Map CategorizedAchievement Attainment
    -> Identity (Map CategorizedAchievement Attainment))
-> PlayState
-> Identity PlayState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map CategorizedAchievement Attainment
 -> Identity (Map CategorizedAchievement Attainment))
-> ProgressionState -> Identity ProgressionState
Lens' ProgressionState (Map CategorizedAchievement Attainment)
attainedAchievements ((Map CategorizedAchievement Attainment
  -> Identity (Map CategorizedAchievement Attainment))
 -> PlayState -> Identity PlayState)
-> (Map CategorizedAchievement Attainment
    -> Map CategorizedAchievement Attainment)
-> EventM Name PlayState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Attainment -> Attainment -> Attainment)
-> Map CategorizedAchievement Attainment
-> Map CategorizedAchievement Attainment
-> Map CategorizedAchievement Attainment
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith Attainment -> Attainment -> Attainment
forall a. Semigroup a => a -> a -> a
(<>) Map CategorizedAchievement Attainment
wrappedGameAchievements

  -- Don't save to disk unless there was a change in the attainment list.
  let incrementalAchievements :: Map CategorizedAchievement Attainment
incrementalAchievements = Map CategorizedAchievement Attainment
wrappedGameAchievements Map CategorizedAchievement Attainment
-> Map CategorizedAchievement Attainment
-> Map CategorizedAchievement Attainment
forall k a b. Ord k => Map k a -> Map k b -> Map k a
`M.difference` Map CategorizedAchievement Attainment
oldMasterAchievementsList
  Bool -> EventM Name PlayState () -> EventM Name PlayState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Map CategorizedAchievement Attainment -> Bool
forall a. Map CategorizedAchievement a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map CategorizedAchievement Attainment
incrementalAchievements) (EventM Name PlayState () -> EventM Name PlayState ())
-> EventM Name PlayState () -> EventM Name PlayState ()
forall a b. (a -> b) -> a -> b
$ LensLike'
  (Zoomed (EventM Name ProgressionState) ())
  PlayState
  ProgressionState
-> EventM Name ProgressionState () -> EventM Name PlayState ()
forall c.
LensLike'
  (Zoomed (EventM Name ProgressionState) c)
  PlayState
  ProgressionState
-> EventM Name ProgressionState c -> EventM Name PlayState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom LensLike'
  (Zoomed (EventM Name ProgressionState) ())
  PlayState
  ProgressionState
Lens' PlayState ProgressionState
progression (EventM Name ProgressionState () -> EventM Name PlayState ())
-> EventM Name ProgressionState () -> EventM Name PlayState ()
forall a b. (a -> b) -> a -> b
$ do
    (Attainment -> EventM Name ProgressionState ())
-> Map CategorizedAchievement Attainment
-> EventM Name ProgressionState ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (CategorizedAchievement -> EventM Name ProgressionState ()
forall (m :: * -> *).
MonadState ProgressionState m =>
CategorizedAchievement -> m ()
popupAchievement (CategorizedAchievement -> EventM Name ProgressionState ())
-> (Attainment -> CategorizedAchievement)
-> Attainment
-> EventM Name ProgressionState ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting CategorizedAchievement Attainment CategorizedAchievement
-> Attainment -> CategorizedAchievement
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting CategorizedAchievement Attainment CategorizedAchievement
Lens' Attainment CategorizedAchievement
achievement) Map CategorizedAchievement Attainment
incrementalAchievements

    Map CategorizedAchievement Attainment
newAchievements <- ((Map CategorizedAchievement Attainment
  -> Const
       (Map CategorizedAchievement Attainment)
       (Map CategorizedAchievement Attainment))
 -> ProgressionState
 -> Const (Map CategorizedAchievement Attainment) ProgressionState)
-> EventM
     Name ProgressionState (Map CategorizedAchievement Attainment)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Map CategorizedAchievement Attainment
 -> Const
      (Map CategorizedAchievement Attainment)
      (Map CategorizedAchievement Attainment))
-> ProgressionState
-> Const (Map CategorizedAchievement Attainment) ProgressionState
Lens' ProgressionState (Map CategorizedAchievement Attainment)
attainedAchievements
    IO () -> EventM Name ProgressionState ()
forall a. IO a -> EventM Name ProgressionState a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM Name ProgressionState ())
-> IO () -> EventM Name ProgressionState ()
forall a b. (a -> b) -> a -> b
$ [Attainment] -> IO ()
saveAchievementsInfo ([Attainment] -> IO ()) -> [Attainment] -> IO ()
forall a b. (a -> b) -> a -> b
$ Map CategorizedAchievement Attainment -> [Attainment]
forall k a. Map k a -> [a]
M.elems Map CategorizedAchievement Attainment
newAchievements

-- | Run the game for a single tick (/without/ updating the UI).
--   Every robot is given a certain amount of maximum computation to
--   perform a single world action (like moving, turning, grabbing,
--   etc.).
runGameTick :: EventM Name PlayState ()
runGameTick :: EventM Name PlayState ()
runGameTick = do
  Bool
ticked <- StateC GameState (TimeIOC (LiftC IO)) Bool
-> EventM Name PlayState Bool
forall (m :: * -> *) a.
(MonadState PlayState m, MonadIO m) =>
StateC GameState (TimeIOC (LiftC IO)) a -> m a
zoomGameStateFromPlayState StateC GameState (TimeIOC (LiftC IO)) Bool
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasGameStepState sig m =>
m Bool
gameTick
  Bool -> EventM Name PlayState () -> EventM Name PlayState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
ticked EventM Name PlayState ()
updateAchievements