module Data.Component.MessageEngine where

import Control.Lens
import Control.Lens.TH.Rules
import Control.Monad.State
import Control.Monad.Catch (MonadMask)
import Data.Aeson hiding ((.=))
import qualified Data.Config.Font as Font
import qualified Data.Text as T
import qualified Data.Vector as V
import Data.Typeable
import MiniLight
import qualified SDL
import qualified SDL.Font
import qualified SDL.Vect as Vect

-- | 'MessageEngine' configuration. If @static@ enabled, only the first page will be rendered.
data Config = Config {
  Config -> Vector Text
messages :: V.Vector T.Text,  -- ^ paged messages
  Config -> Bool
static :: Bool,
  Config -> Config
font :: Font.Config
}

makeLensesWith lensRules_ ''Config

instance FromJSON Config where
  parseJSON :: Value -> Parser Config
parseJSON = String -> (Object -> Parser Config) -> Value -> Parser Config
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "config" ((Object -> Parser Config) -> Value -> Parser Config)
-> (Object -> Parser Config) -> Value -> Parser Config
forall a b. (a -> b) -> a -> b
$ \v :: Object
v -> do
    Vector Text
messages <- Object
v Object -> Text -> Parser (Vector Text)
forall a. FromJSON a => Object -> Text -> Parser a
.: "messages"
    Bool
static <- Object
v Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "static" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
    Config
font <- Object
v Object -> Text -> Parser Config
forall a. FromJSON a => Object -> Text -> Parser a
.: "font"

    Config -> Parser Config
forall (m :: * -> *) a. Monad m => a -> m a
return (Config -> Parser Config) -> Config -> Parser Config
forall a b. (a -> b) -> a -> b
$ Vector Text -> Bool -> Config -> Config
Config Vector Text
messages Bool
static Config
font

data MessageEngine = MessageEngine {
  MessageEngine -> Font
fontData :: SDL.Font.Font,
  MessageEngine -> Int
counter :: Int,
  MessageEngine -> Int
page :: Int,
  MessageEngine -> Int
textCounter :: Int,
  MessageEngine -> Figure
textTexture :: Figure,
  MessageEngine -> Bool
finished :: Bool,
  MessageEngine -> Vector Text
currentMessages :: V.Vector T.Text,
  MessageEngine -> Config
config :: Config
}

makeLensesWith lensRules_ ''MessageEngine

data EngineEvent where
  NextPage :: EngineEvent
  SetMessage
    :: [T.Text]  -- ^ pages messages
    -> EngineEvent
  deriving Typeable

instance EventType EngineEvent where
  getEventType :: EngineEvent -> Text
getEventType NextPage = "next-page"
  getEventType (SetMessage _) = "set-message"

instance ComponentUnit MessageEngine where
  update :: MessageEngine -> LightT env m MessageEngine
update = StateT MessageEngine (LightT env m) ()
-> MessageEngine -> LightT env m MessageEngine
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT (StateT MessageEngine (LightT env m) ()
 -> MessageEngine -> LightT env m MessageEngine)
-> StateT MessageEngine (LightT env m) ()
-> MessageEngine
-> LightT env m MessageEngine
forall a b. (a -> b) -> a -> b
$ do
    Bool
fin <- Getting Bool MessageEngine Bool
-> StateT MessageEngine (LightT env m) Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Bool MessageEngine Bool
Lens' MessageEngine Bool
_finished
    Bool
-> StateT MessageEngine (LightT env m) ()
-> StateT MessageEngine (LightT env m) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
fin (StateT MessageEngine (LightT env m) ()
 -> StateT MessageEngine (LightT env m) ())
-> StateT MessageEngine (LightT env m) ()
-> StateT MessageEngine (LightT env m) ()
forall a b. (a -> b) -> a -> b
$ do
      Int
cnt <- Getting Int MessageEngine Int
-> StateT MessageEngine (LightT env m) Int
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Int MessageEngine Int
Lens' MessageEngine Int
_counter
      Bool
-> StateT MessageEngine (LightT env m) ()
-> StateT MessageEngine (LightT env m) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
cnt Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` 10 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0) (StateT MessageEngine (LightT env m) ()
 -> StateT MessageEngine (LightT env m) ())
-> StateT MessageEngine (LightT env m) ()
-> StateT MessageEngine (LightT env m) ()
forall a b. (a -> b) -> a -> b
$ do
        (Int -> Identity Int) -> MessageEngine -> Identity MessageEngine
Lens' MessageEngine Int
_textCounter ((Int -> Identity Int) -> MessageEngine -> Identity MessageEngine)
-> (Int -> Int) -> StateT MessageEngine (LightT env m) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Int -> Int -> Int
forall a. Num a => a -> a -> a
+1)

        Int
tc <- Getting Int MessageEngine Int
-> StateT MessageEngine (LightT env m) Int
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Int MessageEngine Int
Lens' MessageEngine Int
_textCounter
        Int
p <- Getting Int MessageEngine Int
-> StateT MessageEngine (LightT env m) Int
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Int MessageEngine Int
Lens' MessageEngine Int
_page
        Vector Text
messages <- Getting (Vector Text) MessageEngine (Vector Text)
-> StateT MessageEngine (LightT env m) (Vector Text)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Vector Text) MessageEngine (Vector Text)
Lens' MessageEngine (Vector Text)
_currentMessages
        Bool
-> StateT MessageEngine (LightT env m) ()
-> StateT MessageEngine (LightT env m) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
p Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Vector Text -> Int
forall a. Vector a -> Int
V.length Vector Text
messages Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1 Bool -> Bool -> Bool
&& Int
tc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Int
T.length (Vector Text
messages Vector Text -> Int -> Text
forall a. Vector a -> Int -> a
V.! Int
p)) (StateT MessageEngine (LightT env m) ()
 -> StateT MessageEngine (LightT env m) ())
-> StateT MessageEngine (LightT env m) ()
-> StateT MessageEngine (LightT env m) ()
forall a b. (a -> b) -> a -> b
$ do
          (Bool -> Identity Bool) -> MessageEngine -> Identity MessageEngine
Lens' MessageEngine Bool
_finished ((Bool -> Identity Bool)
 -> MessageEngine -> Identity MessageEngine)
-> Bool -> StateT MessageEngine (LightT env m) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True

      (Int -> Identity Int) -> MessageEngine -> Identity MessageEngine
Lens' MessageEngine Int
_counter ((Int -> Identity Int) -> MessageEngine -> Identity MessageEngine)
-> (Int -> Int) -> StateT MessageEngine (LightT env m) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Int -> Int -> Int
forall a. Num a => a -> a -> a
+1)

  figures :: MessageEngine -> LightT env m [Figure]
figures comp :: MessageEngine
comp = do
    let messages :: Vector Text
messages = MessageEngine
comp MessageEngine
-> Getting (Vector Text) MessageEngine (Vector Text) -> Vector Text
forall s a. s -> Getting a s a -> a
^. Getting (Vector Text) MessageEngine (Vector Text)
Lens' MessageEngine (Vector Text)
_currentMessages
    (w :: Int
w, h :: Int
h) <- Font -> Text -> LightT env m (Int, Int)
forall (m :: * -> *). MonadIO m => Font -> Text -> m (Int, Int)
SDL.Font.size (MessageEngine
comp MessageEngine -> Getting Font MessageEngine Font -> Font
forall s a. s -> Getting a s a -> a
^. Getting Font MessageEngine Font
Lens' MessageEngine Font
_fontData) (Int -> Text -> Text
T.take (MessageEngine
comp MessageEngine -> Getting Int MessageEngine Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int MessageEngine Int
Lens' MessageEngine Int
_textCounter) (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Vector Text
messages Vector Text -> Int -> Text
forall a. Vector a -> Int -> a
V.! (MessageEngine
comp MessageEngine -> Getting Int MessageEngine Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int MessageEngine Int
Lens' MessageEngine Int
_page))

    [Figure] -> LightT env m [Figure]
forall (m :: * -> *) a. Monad m => a -> m a
return [
      Rectangle Int -> Figure -> Figure
forall r (m :: * -> *). Rendering r m => Rectangle Int -> r -> r
clip (Point V2 Int -> V2 Int -> Rectangle Int
forall a. Point V2 a -> V2 a -> Rectangle a
SDL.Rectangle 0 (Int -> Int -> V2 Int
forall a. a -> a -> V2 a
Vect.V2 Int
w Int
h)) (Figure -> Figure) -> Figure -> Figure
forall a b. (a -> b) -> a -> b
$ MessageEngine -> Figure
textTexture MessageEngine
comp
      ]

  useCache :: MessageEngine -> MessageEngine -> Bool
useCache c1 :: MessageEngine
c1 c2 :: MessageEngine
c2 = MessageEngine -> Int
page MessageEngine
c1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== MessageEngine -> Int
page MessageEngine
c2 Bool -> Bool -> Bool
&& MessageEngine -> Int
textCounter MessageEngine
c1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== MessageEngine -> Int
textCounter MessageEngine
c2

  onSignal :: Event -> MessageEngine -> LightT env m MessageEngine
onSignal ev :: Event
ev = StateT MessageEngine (LightT env m) ()
-> MessageEngine -> LightT env m MessageEngine
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT (StateT MessageEngine (LightT env m) ()
 -> MessageEngine -> LightT env m MessageEngine)
-> StateT MessageEngine (LightT env m) ()
-> MessageEngine
-> LightT env m MessageEngine
forall a b. (a -> b) -> a -> b
$ case Event -> Maybe EngineEvent
forall a. EventType a => Event -> Maybe a
asSignal Event
ev of
    Just NextPage -> do
      Bool
fin <- Getting Bool MessageEngine Bool
-> StateT MessageEngine (LightT env m) Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Bool MessageEngine Bool
Lens' MessageEngine Bool
_finished
      Bool
-> StateT MessageEngine (LightT env m) ()
-> StateT MessageEngine (LightT env m) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
fin (StateT MessageEngine (LightT env m) ()
 -> StateT MessageEngine (LightT env m) ())
-> StateT MessageEngine (LightT env m) ()
-> StateT MessageEngine (LightT env m) ()
forall a b. (a -> b) -> a -> b
$ do
        (Int -> Identity Int) -> MessageEngine -> Identity MessageEngine
Lens' MessageEngine Int
_page ((Int -> Identity Int) -> MessageEngine -> Identity MessageEngine)
-> (Int -> Int) -> StateT MessageEngine (LightT env m) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Int -> Int -> Int
forall a. Num a => a -> a -> a
+1)
        (Int -> Identity Int) -> MessageEngine -> Identity MessageEngine
Lens' MessageEngine Int
_textCounter ((Int -> Identity Int) -> MessageEngine -> Identity MessageEngine)
-> Int -> StateT MessageEngine (LightT env m) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= 0

        Font
font <- Getting Font MessageEngine Font
-> StateT MessageEngine (LightT env m) Font
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Font MessageEngine Font
Lens' MessageEngine Font
_fontData
        V4 Word8
fontColor <- Getting (V4 Word8) MessageEngine (V4 Word8)
-> StateT MessageEngine (LightT env m) (V4 Word8)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting (V4 Word8) MessageEngine (V4 Word8)
 -> StateT MessageEngine (LightT env m) (V4 Word8))
-> Getting (V4 Word8) MessageEngine (V4 Word8)
-> StateT MessageEngine (LightT env m) (V4 Word8)
forall a b. (a -> b) -> a -> b
$ (Config -> Const (V4 Word8) Config)
-> MessageEngine -> Const (V4 Word8) MessageEngine
Lens' MessageEngine Config
_config ((Config -> Const (V4 Word8) Config)
 -> MessageEngine -> Const (V4 Word8) MessageEngine)
-> ((V4 Word8 -> Const (V4 Word8) (V4 Word8))
    -> Config -> Const (V4 Word8) Config)
-> Getting (V4 Word8) MessageEngine (V4 Word8)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Config -> Const (V4 Word8) Config)
-> Config -> Const (V4 Word8) Config
Lens' Config Config
_font ((Config -> Const (V4 Word8) Config)
 -> Config -> Const (V4 Word8) Config)
-> ((V4 Word8 -> Const (V4 Word8) (V4 Word8))
    -> Config -> Const (V4 Word8) Config)
-> (V4 Word8 -> Const (V4 Word8) (V4 Word8))
-> Config
-> Const (V4 Word8) Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (V4 Word8 -> Const (V4 Word8) (V4 Word8))
-> Config -> Const (V4 Word8) Config
forall c. HasConfig c => Lens' c (V4 Word8)
Font._color
        Int
p <- Getting Int MessageEngine Int
-> StateT MessageEngine (LightT env m) Int
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Int MessageEngine Int
Lens' MessageEngine Int
_page
        Vector Text
messages <- Getting (Vector Text) MessageEngine (Vector Text)
-> StateT MessageEngine (LightT env m) (Vector Text)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Vector Text) MessageEngine (Vector Text)
Lens' MessageEngine (Vector Text)
_currentMessages
        Figure
tex <- LightT env m Figure -> StateT MessageEngine (LightT env m) Figure
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (LightT env m Figure -> StateT MessageEngine (LightT env m) Figure)
-> LightT env m Figure
-> StateT MessageEngine (LightT env m) Figure
forall a b. (a -> b) -> a -> b
$ MiniLight Figure -> LightT env m Figure
forall env (m :: * -> *) a.
(HasLightEnv env, MonadIO m) =>
MiniLight a -> LightT env m a
liftMiniLight (MiniLight Figure -> LightT env m Figure)
-> MiniLight Figure -> LightT env m Figure
forall a b. (a -> b) -> a -> b
$ Font -> V4 Word8 -> Text -> MiniLight Figure
forall r (m :: * -> *).
Rendering r m =>
Font -> V4 Word8 -> Text -> m r
text Font
font V4 Word8
fontColor (Vector Text
messages Vector Text -> Int -> Text
forall a. Vector a -> Int -> a
V.! Int
p)
        (Figure -> Identity Figure)
-> MessageEngine -> Identity MessageEngine
Lens' MessageEngine Figure
_textTexture ((Figure -> Identity Figure)
 -> MessageEngine -> Identity MessageEngine)
-> Figure -> StateT MessageEngine (LightT env m) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Figure
tex
    Just (SetMessage ms :: [Text]
ms) -> do
      let vs :: Vector Text
vs = [Text] -> Vector Text
forall a. [a] -> Vector a
V.fromList [Text]
ms
      (Int -> Identity Int) -> MessageEngine -> Identity MessageEngine
Lens' MessageEngine Int
_counter ((Int -> Identity Int) -> MessageEngine -> Identity MessageEngine)
-> Int -> StateT MessageEngine (LightT env m) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= 0
      (Int -> Identity Int) -> MessageEngine -> Identity MessageEngine
Lens' MessageEngine Int
_page ((Int -> Identity Int) -> MessageEngine -> Identity MessageEngine)
-> Int -> StateT MessageEngine (LightT env m) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= 0

      Bool
st <- Getting Bool MessageEngine Bool
-> StateT MessageEngine (LightT env m) Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting Bool MessageEngine Bool
 -> StateT MessageEngine (LightT env m) Bool)
-> Getting Bool MessageEngine Bool
-> StateT MessageEngine (LightT env m) Bool
forall a b. (a -> b) -> a -> b
$ (Config -> Const Bool Config)
-> MessageEngine -> Const Bool MessageEngine
Lens' MessageEngine Config
_config ((Config -> Const Bool Config)
 -> MessageEngine -> Const Bool MessageEngine)
-> ((Bool -> Const Bool Bool) -> Config -> Const Bool Config)
-> Getting Bool MessageEngine Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool) -> Config -> Const Bool Config
Lens' Config Bool
_static
      (Int -> Identity Int) -> MessageEngine -> Identity MessageEngine
Lens' MessageEngine Int
_textCounter ((Int -> Identity Int) -> MessageEngine -> Identity MessageEngine)
-> Int -> StateT MessageEngine (LightT env m) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= if Bool
st then Text -> Int
T.length (Vector Text
vs Vector Text -> Int -> Text
forall a. Vector a -> Int -> a
V.! 0) else 0

      Font
font        <- Getting Font MessageEngine Font
-> StateT MessageEngine (LightT env m) Font
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Font MessageEngine Font
Lens' MessageEngine Font
_fontData
      V4 Word8
fontColor   <- Getting (V4 Word8) MessageEngine (V4 Word8)
-> StateT MessageEngine (LightT env m) (V4 Word8)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting (V4 Word8) MessageEngine (V4 Word8)
 -> StateT MessageEngine (LightT env m) (V4 Word8))
-> Getting (V4 Word8) MessageEngine (V4 Word8)
-> StateT MessageEngine (LightT env m) (V4 Word8)
forall a b. (a -> b) -> a -> b
$ (Config -> Const (V4 Word8) Config)
-> MessageEngine -> Const (V4 Word8) MessageEngine
Lens' MessageEngine Config
_config ((Config -> Const (V4 Word8) Config)
 -> MessageEngine -> Const (V4 Word8) MessageEngine)
-> ((V4 Word8 -> Const (V4 Word8) (V4 Word8))
    -> Config -> Const (V4 Word8) Config)
-> Getting (V4 Word8) MessageEngine (V4 Word8)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Config -> Const (V4 Word8) Config)
-> Config -> Const (V4 Word8) Config
Lens' Config Config
_font ((Config -> Const (V4 Word8) Config)
 -> Config -> Const (V4 Word8) Config)
-> ((V4 Word8 -> Const (V4 Word8) (V4 Word8))
    -> Config -> Const (V4 Word8) Config)
-> (V4 Word8 -> Const (V4 Word8) (V4 Word8))
-> Config
-> Const (V4 Word8) Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (V4 Word8 -> Const (V4 Word8) (V4 Word8))
-> Config -> Const (V4 Word8) Config
forall c. HasConfig c => Lens' c (V4 Word8)
Font._color
      Figure
tex         <- LightT env m Figure -> StateT MessageEngine (LightT env m) Figure
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (LightT env m Figure -> StateT MessageEngine (LightT env m) Figure)
-> LightT env m Figure
-> StateT MessageEngine (LightT env m) Figure
forall a b. (a -> b) -> a -> b
$ MiniLight Figure -> LightT env m Figure
forall env (m :: * -> *) a.
(HasLightEnv env, MonadIO m) =>
MiniLight a -> LightT env m a
liftMiniLight (MiniLight Figure -> LightT env m Figure)
-> MiniLight Figure -> LightT env m Figure
forall a b. (a -> b) -> a -> b
$ Font -> V4 Word8 -> Text -> MiniLight Figure
forall r (m :: * -> *).
Rendering r m =>
Font -> V4 Word8 -> Text -> m r
text Font
font V4 Word8
fontColor (Text -> MiniLight Figure) -> Text -> MiniLight Figure
forall a b. (a -> b) -> a -> b
$ Vector Text
vs Vector Text -> Int -> Text
forall a. Vector a -> Int -> a
V.! 0
      (Figure -> Identity Figure)
-> MessageEngine -> Identity MessageEngine
Lens' MessageEngine Figure
_textTexture ((Figure -> Identity Figure)
 -> MessageEngine -> Identity MessageEngine)
-> Figure -> StateT MessageEngine (LightT env m) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Figure
tex
      (Bool -> Identity Bool) -> MessageEngine -> Identity MessageEngine
Lens' MessageEngine Bool
_finished    ((Bool -> Identity Bool)
 -> MessageEngine -> Identity MessageEngine)
-> Bool -> StateT MessageEngine (LightT env m) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
st
      (Vector Text -> Identity (Vector Text))
-> MessageEngine -> Identity MessageEngine
Lens' MessageEngine (Vector Text)
_currentMessages ((Vector Text -> Identity (Vector Text))
 -> MessageEngine -> Identity MessageEngine)
-> Vector Text -> StateT MessageEngine (LightT env m) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Vector Text
vs
    _ -> () -> StateT MessageEngine (LightT env m) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

new :: Config -> MiniLight MessageEngine
new :: Config -> MiniLight MessageEngine
new conf :: Config
conf = do
  Font
font        <- Config -> MiniLight Font
Font.loadFontFrom (Config -> Config
font Config
conf)
  Figure
textTexture <- Font -> V4 Word8 -> Text -> MiniLight Figure
forall r (m :: * -> *).
Rendering r m =>
Font -> V4 Word8 -> Text -> m r
text Font
font (Config
conf Config -> Getting Config Config Config -> Config
forall s a. s -> Getting a s a -> a
^. Getting Config Config Config
Lens' Config Config
_font Config
-> ((V4 Word8 -> Const (V4 Word8) (V4 Word8))
    -> Config -> Const (V4 Word8) Config)
-> V4 Word8
forall s a. s -> Getting a s a -> a
^. (V4 Word8 -> Const (V4 Word8) (V4 Word8))
-> Config -> Const (V4 Word8) Config
forall c. HasConfig c => Lens' c (V4 Word8)
Font._color) (Text -> MiniLight Figure) -> Text -> MiniLight Figure
forall a b. (a -> b) -> a -> b
$ Config -> Vector Text
messages Config
conf Vector Text -> Int -> Text
forall a. Vector a -> Int -> a
V.! 0

  MessageEngine -> MiniLight MessageEngine
forall (m :: * -> *) a. Monad m => a -> m a
return (MessageEngine -> MiniLight MessageEngine)
-> MessageEngine -> MiniLight MessageEngine
forall a b. (a -> b) -> a -> b
$ $WMessageEngine :: Font
-> Int
-> Int
-> Int
-> Figure
-> Bool
-> Vector Text
-> Config
-> MessageEngine
MessageEngine
    { fontData :: Font
fontData        = Font
font
    , counter :: Int
counter         = 0
    , page :: Int
page            = 0
    , textCounter :: Int
textCounter = if Config -> Bool
static Config
conf then Text -> Int
T.length (Config -> Vector Text
messages Config
conf Vector Text -> Int -> Text
forall a. Vector a -> Int -> a
V.! 0) else 0
    , textTexture :: Figure
textTexture     = Figure
textTexture
    , finished :: Bool
finished        = Config -> Bool
static Config
conf
    , currentMessages :: Vector Text
currentMessages = Config -> Vector Text
messages Config
conf
    , config :: Config
config          = Config
conf
    }

wrapSignal
  :: ( HasLightEnv env
     , HasLoopEnv env
     , HasComponentEnv env
     , MonadIO m
     , MonadMask m
     )
  => (Lens' c MessageEngine)
  -> (Event -> c -> LightT env m c)
  -> (Event -> c -> LightT env m c)
wrapSignal :: Lens' c MessageEngine
-> (Event -> c -> LightT env m c) -> Event -> c -> LightT env m c
wrapSignal lens :: Lens' c MessageEngine
lens f :: Event -> c -> LightT env m c
f ev :: Event
ev = StateT c (LightT env m) () -> c -> LightT env m c
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT (StateT c (LightT env m) () -> c -> LightT env m c)
-> StateT c (LightT env m) () -> c -> LightT env m c
forall a b. (a -> b) -> a -> b
$ do
  LensLike'
  (Zoomed (StateT MessageEngine (LightT env m)) ()) c MessageEngine
-> StateT MessageEngine (LightT env m) ()
-> StateT c (LightT env m) ()
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT MessageEngine (LightT env m)) ()) c MessageEngine
Lens' c MessageEngine
lens (StateT MessageEngine (LightT env m) ()
 -> StateT c (LightT env m) ())
-> StateT MessageEngine (LightT env m) ()
-> StateT c (LightT env m) ()
forall a b. (a -> b) -> a -> b
$ do
    MessageEngine
st  <- Getting MessageEngine MessageEngine MessageEngine
-> StateT MessageEngine (LightT env m) MessageEngine
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting MessageEngine MessageEngine MessageEngine
forall a. a -> a
id
    MessageEngine
st' <- LightT env m MessageEngine
-> StateT MessageEngine (LightT env m) MessageEngine
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (LightT env m MessageEngine
 -> StateT MessageEngine (LightT env m) MessageEngine)
-> LightT env m MessageEngine
-> StateT MessageEngine (LightT env m) MessageEngine
forall a b. (a -> b) -> a -> b
$ Event -> MessageEngine -> LightT env m MessageEngine
forall c env (m :: * -> *).
(ComponentUnit c, HasLightEnv env, HasLoopEnv env,
 HasComponentEnv env, MonadIO m, MonadMask m) =>
Event -> c -> LightT env m c
onSignal Event
ev MessageEngine
st
    (MessageEngine -> Identity MessageEngine)
-> MessageEngine -> Identity MessageEngine
forall a. a -> a
id ((MessageEngine -> Identity MessageEngine)
 -> MessageEngine -> Identity MessageEngine)
-> MessageEngine -> StateT MessageEngine (LightT env m) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= MessageEngine
st'

  c
st  <- Getting c c c -> StateT c (LightT env m) c
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting c c c
forall a. a -> a
id
  c
st' <- LightT env m c -> StateT c (LightT env m) c
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (LightT env m c -> StateT c (LightT env m) c)
-> LightT env m c -> StateT c (LightT env m) c
forall a b. (a -> b) -> a -> b
$ Event -> c -> LightT env m c
f Event
ev c
st
  (c -> Identity c) -> c -> Identity c
forall a. a -> a
id ((c -> Identity c) -> c -> Identity c)
-> c -> StateT c (LightT env m) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= c
st'