MessageLayer.hs

module Data.Component.MessageLayer where

import Control.Lens
import Control.Lens.TH.Rules
import Control.Monad.State
import Data.Aeson
import Data.Typeable (Typeable)
import Linear
import MiniLight
import qualified Data.Component.Basic as Basic
import qualified Data.Component.Layer as CLayer
import qualified Data.Component.AnimationLayer as CAnim
import qualified Data.Component.MessageEngine as CME
import qualified SDL.Vect as Vect

data Config = Config {
  basic :: Basic.Config,
  engine :: CME.Config,
  window :: CLayer.Config,
  next :: CAnim.Config
}

instance FromJSON Config where
  parseJSON = withObject "config" $ \v -> do
    layerConf <- parseJSON =<< v .: "window"
    nextConf <- parseJSON =<< v .: "next"
    messageEngineConf <- parseJSON =<< v .: "engine"

    return $ Config (layerConf ^. Basic.config) messageEngineConf layerConf nextConf

data MessageLayer = MessageLayer {
  messageEngine :: CME.MessageEngine,
  layer :: CLayer.Layer,
  cursor :: CAnim.AnimationLayer,
  config :: Config
}

makeLensesWith lensRules_ ''Config
makeLensesWith lensRules_ ''MessageLayer

instance Basic.HasConfig Config where
  config = _basic

engineL :: Lens' MessageLayer CME.MessageEngine
engineL = lens messageEngine (\s a -> s { messageEngine = a })

cursorL :: Lens' MessageLayer CAnim.AnimationLayer
cursorL = lens cursor (\s a -> s { cursor = a })

data MessageLayerEvent where
  Finish :: MessageLayerEvent
  deriving Typeable

instance EventType MessageLayerEvent where
  getEventType Finish = "finish"

instance ComponentUnit MessageLayer where
  update = execStateT $ do
    zoom engineL $ do
      c <- use id
      id <~ lift (update c)

    zoom cursorL $ do
      c <- use id
      id <~ lift (update c)

  figures comp = do
    baseLayer <- figures $ layer comp
    cursorLayer <- figures $ cursor comp
    textLayer <- figures $ messageEngine comp

    let cursorSize = CAnim.tileSize (cursor comp)
    let windowSize = Basic.size $ CLayer.basic $ window $ config comp
    let position = Basic.position $ CLayer.basic $ window $ config comp

    return
      $ baseLayer
      ++ map (translate (position + Vect.V2 20 10)) textLayer
      ++ map (translate (position + Vect.V2 ((windowSize ^. _x - cursorSize ^. _x) `div` 2) (windowSize ^. _y - cursorSize ^. _y))) cursorLayer

  onSignal
    = Basic.wrapSignal (_config . Basic.config)
    $ CME.wrapSignal _messageEngine
    $ \ev -> execStateT $ case asSignal ev of
      Just (Basic.MouseReleased _) -> do
        me <- use _messageEngine

        if me ^. CME._finished
          then lift $ emitGlobally Finish
          else lift $ emitGlobally CME.NextPage
      _ -> return ()

new :: Config -> MiniLight MessageLayer
new conf = do
  engine <- CME.new (engine conf)
  layer  <- CLayer.newNineTile (window conf)
  cursor <- CAnim.new (next conf)

  return $ MessageLayer
    { messageEngine = engine
    , layer         = layer
    , cursor        = cursor
    , config        = conf
    }