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
data Config = Config {
Config -> Vector Text
messages :: V.Vector T.Text,
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]
-> 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'