{-| MiniLight module exports all basic concepts and oprations except for concrete components.
-}
{-# LANGUAGE FunctionalDependencies #-}
module MiniLight (
  module MiniLight.Light,
  module MiniLight.Event,
  module MiniLight.Figure,
  module MiniLight.Component,
  module MiniLight.Loader,

  runLightT,
  runLightTWith,
  LightConfig (..),
  defLightConfig,
  LoopState (..),
  LoopConfig (..),
  defConfig,
  runMainloop,
  MiniLoop,
  runMiniloop,
  runComponentEnv,
  (@@!),
  quit,
  registerComponent,
) where

import Control.Concurrent (threadDelay, forkIO)
import Control.Concurrent.MVar
import Control.Lens
import qualified Control.Monad.Caster as Caster
import Control.Monad.Catch
import Control.Monad.Reader
import Data.Foldable
import Data.Hashable (Hashable(..))
import qualified Data.HashMap.Strict as HM
import Data.Maybe
import Data.IORef
import qualified Data.Registry as R
import qualified Data.Text as T
import qualified Data.Vector as V
import Graphics.Text.TrueType
import MiniLight.Component
import MiniLight.Event
import MiniLight.Figure
import MiniLight.Light
import MiniLight.Loader
import qualified System.FSNotify as Notify
import qualified SDL
import qualified SDL.Font

instance Hashable SDL.Scancode where
  hashWithSalt :: Int -> Scancode -> Int
hashWithSalt n :: Int
n sc :: Scancode
sc = Int -> Word32 -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
n (Scancode -> Word32
SDL.unwrapScancode Scancode
sc)

-- | Run a light monad with default configuration.
-- @
-- runLightT = runLightTWith defLightConfig
-- @
runLightT :: (MonadIO m, MonadMask m) => LightT LightEnv m a -> m a
runLightT :: LightT LightEnv m a -> m a
runLightT = LightConfig -> LightT LightEnv m a -> m a
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
LightConfig -> LightT LightEnv m a -> m a
runLightTWith LightConfig
defLightConfig

-- | Custom configuration for LightT
data LightConfig = LightConfig {
  LightConfig -> Bool
headless :: Bool,  -- Set False if you don't need graphical user interface (mostly for testing)
  LightConfig -> LogLevel -> IO LogQueue
logQueue :: Caster.LogLevel -> IO Caster.LogQueue,  -- ^ LogQueue for logger
  LightConfig -> LogLevel
logLevel :: Caster.LogLevel  -- ^ LogLevel for logger
}

-- | Default configuration for 'runLightT'
defLightConfig :: LightConfig
defLightConfig :: LightConfig
defLightConfig = $WLightConfig :: Bool -> (LogLevel -> IO LogQueue) -> LogLevel -> LightConfig
LightConfig
  { headless :: Bool
headless = Bool
False
  , logQueue :: LogLevel -> IO LogQueue
logQueue = LogLevel -> IO LogQueue
Caster.stdoutLogger
  , logLevel :: LogLevel
logLevel = LogLevel
Caster.LogWarn
  }

-- | Run a Light monad.
runLightTWith
  :: (MonadIO m, MonadMask m) => LightConfig -> LightT LightEnv m a -> m a
runLightTWith :: LightConfig -> LightT LightEnv m a -> m a
runLightTWith conf :: LightConfig
conf prog :: LightT LightEnv m a
prog =
  m a -> m a
forall b. m b -> m b
withSDLFont
    (m a -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ ( if LightConfig -> Bool
headless LightConfig
conf
        then (\f :: Maybe Window -> m a
f -> Maybe Window -> m a
f Maybe Window
forall a. Maybe a
Nothing)
        else m a -> m a
forall b. m b -> m b
withSDL (m a -> m a)
-> ((Maybe Window -> m a) -> m a) -> (Maybe Window -> m a) -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Window -> m a) -> m a
forall b. (Window -> m b) -> m b
withWindow ((Window -> m a) -> m a)
-> ((Maybe Window -> m a) -> Window -> m a)
-> (Maybe Window -> m a)
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\f :: Maybe Window -> m a
f w :: Window
w -> Maybe Window -> m a
f (Window -> Maybe Window
forall a. a -> Maybe a
Just Window
w))
      )
    ((Maybe Window -> m a) -> m a) -> (Maybe Window -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \mwindow :: Maybe Window
mwindow -> do
        Maybe Renderer
renderer <- Maybe Window -> (Window -> m Renderer) -> m (Maybe Renderer)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe Window
mwindow
          ((Window -> m Renderer) -> m (Maybe Renderer))
-> (Window -> m Renderer) -> m (Maybe Renderer)
forall a b. (a -> b) -> a -> b
$ \window :: Window
window -> Window -> CInt -> RendererConfig -> m Renderer
forall (m :: * -> *).
MonadIO m =>
Window -> CInt -> RendererConfig -> m Renderer
SDL.createRenderer Window
window (-1) RendererConfig
SDL.defaultRenderer
        FontMap
fc     <- m FontMap
forall (m :: * -> *). MonadIO m => m FontMap
loadFontCache
        LogQueue
logger <- IO LogQueue -> m LogQueue
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO LogQueue -> m LogQueue) -> IO LogQueue -> m LogQueue
forall a b. (a -> b) -> a -> b
$ LightConfig -> LogLevel -> IO LogQueue
logQueue LightConfig
conf (LightConfig -> LogLevel
logLevel LightConfig
conf)
        ReaderT LightEnv m a -> LightEnv -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (LightT LightEnv m a -> ReaderT LightEnv m a
forall env (m :: * -> *) a. LightT env m a -> ReaderT env m a
runLightT' LightT LightEnv m a
prog)
          (LightEnv -> m a) -> LightEnv -> m a
forall a b. (a -> b) -> a -> b
$ $WLightEnv :: Maybe Renderer -> FontMap -> LogQueue -> LightEnv
LightEnv {renderer :: Maybe Renderer
renderer = Maybe Renderer
renderer, fontCache :: FontMap
fontCache = FontMap
fc, logger :: LogQueue
logger = LogQueue
logger}
 where
  withSDL :: m b -> m b
withSDL     = m () -> (() -> m ()) -> (() -> m b) -> m b
forall (m :: * -> *) a c b.
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket m ()
forall (m :: * -> *). (Functor m, MonadIO m) => m ()
SDL.initializeAll (\_ -> m ()
forall (m :: * -> *). MonadIO m => m ()
SDL.quit) ((() -> m b) -> m b) -> (m b -> () -> m b) -> m b -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m b -> () -> m b
forall a b. a -> b -> a
const
  withSDLFont :: m b -> m b
withSDLFont = m () -> (() -> m ()) -> (() -> m b) -> m b
forall (m :: * -> *) a c b.
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket m ()
forall (m :: * -> *). MonadIO m => m ()
SDL.Font.initialize (\_ -> m ()
forall (m :: * -> *). MonadIO m => m ()
SDL.Font.quit) ((() -> m b) -> m b) -> (m b -> () -> m b) -> m b -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m b -> () -> m b
forall a b. a -> b -> a
const

  withWindow :: (Window -> m b) -> m b
withWindow =
    m Window -> (Window -> m ()) -> (Window -> m b) -> m b
forall (m :: * -> *) a c b.
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket (Text -> WindowConfig -> m Window
forall (m :: * -> *). MonadIO m => Text -> WindowConfig -> m Window
SDL.createWindow "window" WindowConfig
SDL.defaultWindow) Window -> m ()
forall (m :: * -> *). MonadIO m => Window -> m ()
SDL.destroyWindow

-- | Use 'defConfig' for a default setting.
data LoopConfig = LoopConfig {
  LoopConfig -> Maybe [Scancode]
watchKeys :: Maybe [SDL.Scancode],  -- ^ Set @Nothing@ if all keys should be watched. See also 'LoopState'.
  LoopConfig -> Maybe FilePath
appConfigFile :: Maybe FilePath,  -- ^ Specify a yaml file which describes component settings. See 'MiniLight.Loader' for the yaml syntax.
  LoopConfig -> Maybe FilePath
hotConfigReplacement :: Maybe FilePath,  -- ^ The directory path to be watched. If set, the config file modification will replace the component dynamically.
  LoopConfig -> Resolver
componentResolver :: Resolver,  -- ^ Your custom mappings between a component name and its type.
  LoopConfig -> [Component]
additionalComponents :: [Component]  -- ^ The components here would be added during the initialization.
}

-- | Default configurations for the mainloop. You need to set @componentResolver@ if you use a component.
defConfig :: LoopConfig
defConfig :: LoopConfig
defConfig = $WLoopConfig :: Maybe [Scancode]
-> Maybe FilePath
-> Maybe FilePath
-> Resolver
-> [Component]
-> LoopConfig
LoopConfig
  { watchKeys :: Maybe [Scancode]
watchKeys            = Maybe [Scancode]
forall a. Maybe a
Nothing
  , appConfigFile :: Maybe FilePath
appConfigFile        = Maybe FilePath
forall a. Maybe a
Nothing
  , hotConfigReplacement :: Maybe FilePath
hotConfigReplacement = Maybe FilePath
forall a. Maybe a
Nothing
  , componentResolver :: Resolver
componentResolver    = \_ _ -> Value -> MiniLight (Either FilePath Component)
forall a. HasCallStack => a
undefined
  , additionalComponents :: [Component]
additionalComponents = []
  }

-- | The state in the mainloop.
data LoopState = LoopState {
  LoopState -> LightEnv
light :: LightEnv,
  LoopState -> LoopEnv
loop :: LoopEnv,
  LoopState -> LoaderEnv
loader :: LoaderEnv
}

makeLensesWith classyRules_ ''LoopState

-- | Type synonym to the minimal type of the mainloop
type MiniLoop = LightT LoopState IO


-- These instances are used in the internal computation.
instance HasLightEnv LoopState where
  lightEnv :: (LightEnv -> f LightEnv) -> LoopState -> f LoopState
lightEnv = (LightEnv -> f LightEnv) -> LoopState -> f LoopState
forall c. HasLoopState c => Lens' c LightEnv
_light ((LightEnv -> f LightEnv) -> LoopState -> f LoopState)
-> ((LightEnv -> f LightEnv) -> LightEnv -> f LightEnv)
-> (LightEnv -> f LightEnv)
-> LoopState
-> f LoopState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LightEnv -> f LightEnv) -> LightEnv -> f LightEnv
forall c. HasLightEnv c => Lens' c LightEnv
lightEnv

instance HasLoopEnv LoopState where
  loopEnv :: (LoopEnv -> f LoopEnv) -> LoopState -> f LoopState
loopEnv = (LoopEnv -> f LoopEnv) -> LoopState -> f LoopState
forall c. HasLoopState c => Lens' c LoopEnv
_loop ((LoopEnv -> f LoopEnv) -> LoopState -> f LoopState)
-> ((LoopEnv -> f LoopEnv) -> LoopEnv -> f LoopEnv)
-> (LoopEnv -> f LoopEnv)
-> LoopState
-> f LoopState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LoopEnv -> f LoopEnv) -> LoopEnv -> f LoopEnv
forall c. HasLoopEnv c => Lens' c LoopEnv
loopEnv

instance HasLoaderEnv LoopState where
  loaderEnv :: (LoaderEnv -> f LoaderEnv) -> LoopState -> f LoopState
loaderEnv = (LoaderEnv -> f LoaderEnv) -> LoopState -> f LoopState
forall c. HasLoopState c => Lens' c LoaderEnv
_loader ((LoaderEnv -> f LoaderEnv) -> LoopState -> f LoopState)
-> ((LoaderEnv -> f LoaderEnv) -> LoaderEnv -> f LoaderEnv)
-> (LoaderEnv -> f LoaderEnv)
-> LoopState
-> f LoopState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LoaderEnv -> f LoaderEnv) -> LoaderEnv -> f LoaderEnv
forall c. HasLoaderEnv c => Lens' c LoaderEnv
loaderEnv


data ComponentState a = ComponentState {
  ComponentState a -> a
stateL :: a,
  ComponentState a -> ComponentEnv
componentEnvL :: ComponentEnv
}

makeLensesWith classyRules_ ''ComponentState

instance HasLightEnv env => HasLightEnv (ComponentState env) where
  lightEnv :: (LightEnv -> f LightEnv)
-> ComponentState env -> f (ComponentState env)
lightEnv = (env -> f env) -> ComponentState env -> f (ComponentState env)
forall c a. HasComponentState c a => Lens' c a
_stateL ((env -> f env) -> ComponentState env -> f (ComponentState env))
-> ((LightEnv -> f LightEnv) -> env -> f env)
-> (LightEnv -> f LightEnv)
-> ComponentState env
-> f (ComponentState env)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LightEnv -> f LightEnv) -> env -> f env
forall c. HasLightEnv c => Lens' c LightEnv
lightEnv

instance HasLoopEnv env => HasLoopEnv (ComponentState env) where
  loopEnv :: (LoopEnv -> f LoopEnv)
-> ComponentState env -> f (ComponentState env)
loopEnv = (env -> f env) -> ComponentState env -> f (ComponentState env)
forall c a. HasComponentState c a => Lens' c a
_stateL ((env -> f env) -> ComponentState env -> f (ComponentState env))
-> ((LoopEnv -> f LoopEnv) -> env -> f env)
-> (LoopEnv -> f LoopEnv)
-> ComponentState env
-> f (ComponentState env)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LoopEnv -> f LoopEnv) -> env -> f env
forall c. HasLoopEnv c => Lens' c LoopEnv
loopEnv

instance HasLoaderEnv env => HasLoaderEnv (ComponentState env) where
  loaderEnv :: (LoaderEnv -> f LoaderEnv)
-> ComponentState env -> f (ComponentState env)
loaderEnv = (env -> f env) -> ComponentState env -> f (ComponentState env)
forall c a. HasComponentState c a => Lens' c a
_stateL ((env -> f env) -> ComponentState env -> f (ComponentState env))
-> ((LoaderEnv -> f LoaderEnv) -> env -> f env)
-> (LoaderEnv -> f LoaderEnv)
-> ComponentState env
-> f (ComponentState env)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LoaderEnv -> f LoaderEnv) -> env -> f env
forall c. HasLoaderEnv c => Lens' c LoaderEnv
loaderEnv

instance HasComponentEnv (ComponentState env) where
  componentEnv :: (ComponentEnv -> f ComponentEnv)
-> ComponentState env -> f (ComponentState env)
componentEnv = (ComponentEnv -> f ComponentEnv)
-> ComponentState env -> f (ComponentState env)
forall c a. HasComponentState c a => Lens' c ComponentEnv
_componentEnvL

-- | Run an action over a component.
runComponentEnv
  :: (HasLightEnv env, HasLoopEnv env)
  => Component
  -> (  forall env'
      . (HasComponentEnv env', HasLoopEnv env', HasLightEnv env')
     => LightT env' m ()
     )
  -> LightT env m ()
runComponentEnv :: Component
-> (forall env'.
    (HasComponentEnv env', HasLoopEnv env', HasLightEnv env') =>
    LightT env' m ())
-> LightT env m ()
runComponentEnv c :: Component
c =
  (env -> ComponentState env)
-> LightT (ComponentState env) m () -> LightT env m ()
forall env' env (m :: * -> *) a.
(env' -> env) -> LightT env m a -> LightT env' m a
envLightT (\env :: env
env -> env -> ComponentEnv -> ComponentState env
forall a. a -> ComponentEnv -> ComponentState a
ComponentState env
env (Text -> Maybe HookMap -> ComponentEnv
ComponentEnv (Component -> Text
getUID Component
c) (Component -> Maybe HookMap
getHooks Component
c)))


-- | Emit a signal with a loader-defined target name
-- @
-- (@@!) :: EventType et => T.Text -> et -> MiniLoop ()
-- @
(@@!)
  :: ( EventType et
     , HasLoaderEnv env
     , HasLoopEnv env
     , HasLightEnv env
     , MonadIO m
     )
  => T.Text
  -> et
  -> LightT env m ()
t :: Text
t @@! :: Text -> et -> LightT env m ()
@@! ev :: et
ev = do
  Text
key <- (Maybe Text -> Text)
-> LightT env m (Maybe Text) -> LightT env m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Just x :: Text
x) -> Text
x) (LightT env m (Maybe Text) -> LightT env m Text)
-> LightT env m (Maybe Text) -> LightT env m Text
forall a b. (a -> b) -> a -> b
$ Text -> LightT env m (Maybe Text)
forall env (m :: * -> *).
(HasLightEnv env, HasLoaderEnv env, MonadIO m) =>
Text -> LightT env m (Maybe Text)
lookupByTagID Text
t
  Registry Component
reg <- Getting (Registry Component) env (Registry Component)
-> LightT env m (Registry Component)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Registry Component) env (Registry Component)
forall c. HasLoaderEnv c => Lens' c (Registry Component)
_registry
  Component
v   <- Registry Component
reg Registry Component -> Text -> LightT env m Component
forall (reg :: * -> *) (m :: * -> *) v.
(IRegistry reg, MonadIO m) =>
reg v -> Text -> m v
R.! Text
key
  Component
-> (forall env'.
    (HasComponentEnv env', HasLoopEnv env', HasLightEnv env') =>
    LightT env' m ())
-> LightT env m ()
forall env (m :: * -> *).
(HasLightEnv env, HasLoopEnv env) =>
Component
-> (forall env'.
    (HasComponentEnv env', HasLoopEnv env', HasLightEnv env') =>
    LightT env' m ())
-> LightT env m ()
runComponentEnv Component
v ((forall env'.
  (HasComponentEnv env', HasLoopEnv env', HasLightEnv env') =>
  LightT env' m ())
 -> LightT env m ())
-> (forall env'.
    (HasComponentEnv env', HasLoopEnv env', HasLightEnv env') =>
    LightT env' m ())
-> LightT env m ()
forall a b. (a -> b) -> a -> b
$ Maybe Text -> et -> LightT env' m ()
forall env (m :: * -> *) et.
(HasLoopEnv env, HasComponentEnv env, MonadIO m, EventType et) =>
Maybe Text -> et -> LightT env m ()
emit (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
key) (et -> LightT env' m ()) -> et -> LightT env' m ()
forall a b. (a -> b) -> a -> b
$ et
ev


-- | Register a component to the component system
registerComponent
  :: ( HasLoaderEnv env
     , HasLightEnv env
     , MonadIO m
     , MonadMask m
     , ComponentUnit c
     )
  => T.Text
  -> c
  -> LightT env m Component
registerComponent :: Text -> c -> LightT env m Component
registerComponent name :: Text
name cu :: c
cu = do
  Text
uuid <- LightT env m Text
forall (m :: * -> *). MonadIO m => m Text
newUID
  Component
comp <- Text -> c -> LightT env m Component
forall c env (m :: * -> *).
(ComponentUnit c, HasLightEnv env, MonadIO m, MonadMask m) =>
Text -> c -> LightT env m Component
newComponent Text
uuid c
cu

  Registry Component
reg  <- Getting (Registry Component) env (Registry Component)
-> LightT env m (Registry Component)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Registry Component) env (Registry Component)
forall c. HasLoaderEnv c => Lens' c (Registry Component)
_registry
  Registry Component -> Text -> Component -> LightT env m ()
forall (reg :: * -> *) (m :: * -> *) v.
(IRegistry reg, MonadIO m) =>
reg v -> Text -> v -> m ()
R.register Registry Component
reg Text
uuid Component
comp

  IORef (HashMap Text Text)
tag <- Getting (IORef (HashMap Text Text)) env (IORef (HashMap Text Text))
-> LightT env m (IORef (HashMap Text Text))
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (IORef (HashMap Text Text)) env (IORef (HashMap Text Text))
forall c. HasLoaderEnv c => Lens' c (IORef (HashMap Text Text))
_tagRegistry
  IO () -> LightT env m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> LightT env m ()) -> IO () -> LightT env m ()
forall a b. (a -> b) -> a -> b
$ IORef (HashMap Text Text)
-> (HashMap Text Text -> HashMap Text Text) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef (HashMap Text Text)
tag ((HashMap Text Text -> HashMap Text Text) -> IO ())
-> (HashMap Text Text -> HashMap Text Text) -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> HashMap Text Text -> HashMap Text Text
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert Text
name Text
uuid

  Component -> LightT env m Component
forall (m :: * -> *) a. Monad m => a -> m a
return Component
comp


-- | Same as 'runMainloop' but fixing the type.
runMiniloop :: LoopConfig -> MiniLoop s -> (s -> MiniLoop s) -> MiniLight ()
runMiniloop :: LoopConfig -> MiniLoop s -> (s -> MiniLoop s) -> MiniLight ()
runMiniloop = (LightEnv -> LoopEnv -> LoaderEnv -> LoopState)
-> LoopConfig -> MiniLoop s -> (s -> MiniLoop s) -> MiniLight ()
forall env env' (m :: * -> *) s.
(HasLightEnv env, HasLightEnv env', HasLoopEnv env',
 HasLoaderEnv env', MonadIO m, MonadMask m) =>
(env -> LoopEnv -> LoaderEnv -> env')
-> LoopConfig
-> LightT env' m s
-> (s -> LightT env' m s)
-> LightT env m ()
runMainloop LightEnv -> LoopEnv -> LoaderEnv -> LoopState
LoopState

-- | Run a mainloop.
-- In a mainloop, components and events are managed.
--
-- Components in a mainloop: draw ~ update ~ (user-defined function) ~ event handling
runMainloop
  :: ( HasLightEnv env
     , HasLightEnv env'
     , HasLoopEnv env'
     , HasLoaderEnv env'
     , MonadIO m
     , MonadMask m
     )
  => (env -> LoopEnv -> LoaderEnv -> env')  -- ^ Environment conversion
  -> LoopConfig  -- ^ Loop config
  -> LightT env' m s  -- ^ Initial monad generating initial state
  -> (s -> LightT env' m s)  -- ^ A function called in every loop
  -> LightT env m ()
runMainloop :: (env -> LoopEnv -> LoaderEnv -> env')
-> LoopConfig
-> LightT env' m s
-> (s -> LightT env' m s)
-> LightT env m ()
runMainloop conv :: env -> LoopEnv -> LoaderEnv -> env'
conv conf :: LoopConfig
conf initial :: LightT env' m s
initial userloop :: s -> LightT env' m s
userloop = do
  MVar [Event]
events      <- IO (MVar [Event]) -> LightT env m (MVar [Event])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MVar [Event]) -> LightT env m (MVar [Event]))
-> IO (MVar [Event]) -> LightT env m (MVar [Event])
forall a b. (a -> b) -> a -> b
$ [Event] -> IO (MVar [Event])
forall a. a -> IO (MVar a)
newMVar []
  IORef [Event]
signalQueue <- IO (IORef [Event]) -> LightT env m (IORef [Event])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef [Event]) -> LightT env m (IORef [Event]))
-> IO (IORef [Event]) -> LightT env m (IORef [Event])
forall a b. (a -> b) -> a -> b
$ [Event] -> IO (IORef [Event])
forall a. a -> IO (IORef a)
newIORef []
  Registry Component
reg         <- LightT env m (Registry Component)
forall (m :: * -> *) v. MonadIO m => m (Registry v)
R.new
  IORef (HashMap Text Text)
tag         <- IO (IORef (HashMap Text Text))
-> LightT env m (IORef (HashMap Text Text))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (HashMap Text Text))
 -> LightT env m (IORef (HashMap Text Text)))
-> IO (IORef (HashMap Text Text))
-> LightT env m (IORef (HashMap Text Text))
forall a b. (a -> b) -> a -> b
$ HashMap Text Text -> IO (IORef (HashMap Text Text))
forall a. a -> IO (IORef a)
newIORef (HashMap Text Text -> IO (IORef (HashMap Text Text)))
-> HashMap Text Text -> IO (IORef (HashMap Text Text))
forall a b. (a -> b) -> a -> b
$ HashMap Text Text
forall k v. HashMap k v
HM.empty
  IORef AppConfig
conf        <- IO (IORef AppConfig) -> LightT env m (IORef AppConfig)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef AppConfig) -> LightT env m (IORef AppConfig))
-> IO (IORef AppConfig) -> LightT env m (IORef AppConfig)
forall a b. (a -> b) -> a -> b
$ AppConfig -> IO (IORef AppConfig)
forall a. a -> IO (IORef a)
newIORef (AppConfig -> IO (IORef AppConfig))
-> AppConfig -> IO (IORef AppConfig)
forall a b. (a -> b) -> a -> b
$ Vector ComponentConfig -> Vector Text -> AppConfig
AppConfig Vector ComponentConfig
forall a. Vector a
V.empty Vector Text
forall a. Vector a
V.empty

  LoopEnv -> LoaderEnv -> LightT env' m s -> LightT env m ()
run
    ($WLoopEnv :: HashMap Scancode Int -> MVar [Event] -> IORef [Event] -> LoopEnv
LoopEnv {keyStates :: HashMap Scancode Int
keyStates = HashMap Scancode Int
forall k v. HashMap k v
HM.empty, events :: MVar [Event]
events = MVar [Event]
events, signalQueue :: IORef [Event]
signalQueue = IORef [Event]
signalQueue})
    ($WLoaderEnv :: Registry Component
-> IORef (HashMap Text Text) -> IORef AppConfig -> LoaderEnv
LoaderEnv {registry :: Registry Component
registry = Registry Component
reg, tagRegistry :: IORef (HashMap Text Text)
tagRegistry = IORef (HashMap Text Text)
tag, appConfig :: IORef AppConfig
appConfig = IORef AppConfig
conf})
    LightT env' m s
initial
 where
  run :: LoopEnv -> LoaderEnv -> LightT env' m s -> LightT env m ()
run loop :: LoopEnv
loop loader :: LoaderEnv
loader ms :: LightT env' m s
ms = do
    LoopEnv -> LoaderEnv -> LightT env m ()
setup LoopEnv
loop LoaderEnv
loader
    s
s <- (env -> env') -> LightT env' m s -> LightT env m s
forall env' env (m :: * -> *) a.
(env' -> env) -> LightT env m a -> LightT env' m a
envLightT (\env :: env
env -> env -> LoopEnv -> LoaderEnv -> env'
conv env
env LoopEnv
loop LoaderEnv
loader) LightT env' m s
ms
    LoopEnv -> LoaderEnv -> s -> LightT env m ()
go LoopEnv
loop LoaderEnv
loader s
s

  setup :: LoopEnv -> LoaderEnv -> LightT env m ()
setup loop :: LoopEnv
loop loader :: LoaderEnv
loader = (env -> env') -> LightT env' m () -> LightT env m ()
forall env' env (m :: * -> *) a.
(env' -> env) -> LightT env m a -> LightT env' m a
envLightT (\env :: env
env -> env -> LoopEnv -> LoaderEnv -> env'
conv env
env LoopEnv
loop LoaderEnv
loader) (LightT env' m () -> LightT env m ())
-> LightT env' m () -> LightT env m ()
forall a b. (a -> b) -> a -> b
$ do
    case (LoopConfig -> Maybe FilePath
hotConfigReplacement LoopConfig
conf, LoopConfig -> Maybe FilePath
appConfigFile LoopConfig
conf) of
      (Just dir :: FilePath
dir, Just confPath :: FilePath
confPath) -> do
        IO ThreadId -> LightT env' m ThreadId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ThreadId -> LightT env' m ThreadId)
-> IO ThreadId -> LightT env' m ThreadId
forall a b. (a -> b) -> a -> b
$ IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ (WatchManager -> IO ()) -> IO ()
forall a. (WatchManager -> IO a) -> IO a
Notify.withManager ((WatchManager -> IO ()) -> IO ())
-> (WatchManager -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \mgr :: WatchManager
mgr -> do
          IO ()
_ <- WatchManager -> FilePath -> ActionPredicate -> Action -> IO (IO ())
Notify.watchDir WatchManager
mgr FilePath
dir (Bool -> ActionPredicate
forall a b. a -> b -> a
const Bool
True) (Action -> IO (IO ())) -> Action -> IO (IO ())
forall a b. (a -> b) -> a -> b
$ \ev :: Event
ev -> do
            MVar [Event] -> ([Event] -> IO [Event]) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (LoopEnv
loop LoopEnv
-> Getting (MVar [Event]) LoopEnv (MVar [Event]) -> MVar [Event]
forall s a. s -> Getting a s a -> a
^. Getting (MVar [Event]) LoopEnv (MVar [Event])
forall c. HasLoopEnv c => Lens' c (MVar [Event])
_events) (([Event] -> IO [Event]) -> IO ())
-> ([Event] -> IO [Event]) -> IO ()
forall a b. (a -> b) -> a -> b
$ [Event] -> IO [Event]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Event] -> IO [Event])
-> ([Event] -> [Event]) -> [Event] -> IO [Event]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Event -> Event
NotifyEvent Event
ev Event -> [Event] -> [Event]
forall a. a -> [a] -> [a]
:)

          IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay 1000000

        FilePath -> Resolver -> LightT env' m ()
forall env (m :: * -> *).
(HasLightEnv env, HasLoaderEnv env, MonadIO m, MonadCatch m) =>
FilePath -> Resolver -> LightT env m ()
loadAppConfig FilePath
confPath (LoopConfig -> Resolver
componentResolver LoopConfig
conf)
      _ -> () -> LightT env' m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    [Component] -> (Component -> LightT env' m ()) -> LightT env' m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (LoopConfig -> [Component]
additionalComponents LoopConfig
conf) ((Component -> LightT env' m ()) -> LightT env' m ())
-> (Component -> LightT env' m ()) -> LightT env' m ()
forall a b. (a -> b) -> a -> b
$ \component :: Component
component -> do
      Registry Component
reg <- Getting (Registry Component) env' (Registry Component)
-> LightT env' m (Registry Component)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Registry Component) env' (Registry Component)
forall c. HasLoaderEnv c => Lens' c (Registry Component)
_registry
      Registry Component -> Text -> Component -> LightT env' m ()
forall (reg :: * -> *) (m :: * -> *) v.
(IRegistry reg, MonadIO m) =>
reg v -> Text -> v -> m ()
R.register Registry Component
reg (Component -> Text
getUID Component
component) Component
component

  go :: LoopEnv -> LoaderEnv -> s -> LightT env m ()
go loop :: LoopEnv
loop loader :: LoaderEnv
loader s :: s
s = do
    Maybe Renderer
mrenderer <- Getting (Maybe Renderer) env (Maybe Renderer)
-> LightT env m (Maybe Renderer)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe Renderer) env (Maybe Renderer)
forall c. HasLightEnv c => Lens' c (Maybe Renderer)
_renderer
    Maybe Renderer -> (Renderer -> LightT env m ()) -> LightT env m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe Renderer
mrenderer ((Renderer -> LightT env m ()) -> LightT env m ())
-> (Renderer -> LightT env m ()) -> LightT env m ()
forall a b. (a -> b) -> a -> b
$ \renderer :: Renderer
renderer -> do
      IO () -> LightT env m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> LightT env m ()) -> IO () -> LightT env m ()
forall a b. (a -> b) -> a -> b
$ Renderer -> StateVar (V4 Word8)
SDL.rendererDrawColor Renderer
renderer StateVar (V4 Word8) -> V4 Word8 -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
SDL.$= 255
      IO () -> LightT env m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> LightT env m ()) -> IO () -> LightT env m ()
forall a b. (a -> b) -> a -> b
$ Renderer -> IO ()
forall (m :: * -> *). (Functor m, MonadIO m) => Renderer -> m ()
SDL.clear Renderer
renderer

    Registry Component
-> (Component -> LightT env m ()) -> LightT env m ()
forall (m :: * -> *) (reg :: * -> *) v.
(MonadIO m, IRegistry reg) =>
reg v -> (v -> m ()) -> m ()
R.forV_ (LoaderEnv
loader LoaderEnv
-> Getting (Registry Component) LoaderEnv (Registry Component)
-> Registry Component
forall s a. s -> Getting a s a -> a
^. Getting (Registry Component) LoaderEnv (Registry Component)
forall c. HasLoaderEnv c => Lens' c (Registry Component)
_registry) ((Component -> LightT env m ()) -> LightT env m ())
-> (Component -> LightT env m ()) -> LightT env m ()
forall a b. (a -> b) -> a -> b
$ \comp :: Component
comp -> Component -> LightT env m ()
forall c env (m :: * -> *).
(ComponentUnit c, HasLightEnv env, MonadIO m, MonadMask m) =>
c -> LightT env m ()
draw Component
comp

    -- state propagation
    Registry Component
-> (Component -> LightT env m Component) -> LightT env m ()
forall (m :: * -> *) (reg :: * -> *) v.
(MonadIO m, IRegistry reg) =>
reg v -> (v -> m v) -> m ()
R.modifyV_ (LoaderEnv
loader LoaderEnv
-> Getting (Registry Component) LoaderEnv (Registry Component)
-> Registry Component
forall s a. s -> Getting a s a -> a
^. Getting (Registry Component) LoaderEnv (Registry Component)
forall c. HasLoaderEnv c => Lens' c (Registry Component)
_registry) ((Component -> LightT env m Component) -> LightT env m ())
-> (Component -> LightT env m Component) -> LightT env m ()
forall a b. (a -> b) -> a -> b
$ Component -> LightT env m Component
forall (m :: * -> *) a. Monad m => a -> m a
return (Component -> LightT env m Component)
-> (Component -> Component) -> Component -> LightT env m Component
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Component -> Component
propagate

    Registry Component
-> (Component -> LightT env m Component) -> LightT env m ()
forall (m :: * -> *) (reg :: * -> *) v.
(MonadIO m, IRegistry reg) =>
reg v -> (v -> m v) -> m ()
R.modifyV_ (LoaderEnv
loader LoaderEnv
-> Getting (Registry Component) LoaderEnv (Registry Component)
-> Registry Component
forall s a. s -> Getting a s a -> a
^. Getting (Registry Component) LoaderEnv (Registry Component)
forall c. HasLoaderEnv c => Lens' c (Registry Component)
_registry) ((Component -> LightT env m Component) -> LightT env m ())
-> (Component -> LightT env m Component) -> LightT env m ()
forall a b. (a -> b) -> a -> b
$ \comp :: Component
comp ->
      (env -> ComponentState env')
-> LightT (ComponentState env') m Component
-> LightT env m Component
forall env' env (m :: * -> *) a.
(env' -> env) -> LightT env m a -> LightT env' m a
envLightT
          ( \env :: env
env -> env' -> ComponentEnv -> ComponentState env'
forall a. a -> ComponentEnv -> ComponentState a
ComponentState
            (env -> LoopEnv -> LoaderEnv -> env'
conv env
env LoopEnv
loop LoaderEnv
loader)
            (Text -> Maybe HookMap -> ComponentEnv
ComponentEnv (Component -> Text
getUID Component
comp) (Component -> Maybe HookMap
getHooks Component
comp))
          )
        (LightT (ComponentState env') m Component
 -> LightT env m Component)
-> LightT (ComponentState env') m Component
-> LightT env m Component
forall a b. (a -> b) -> a -> b
$ Component -> LightT (ComponentState env') m Component
forall c env (m :: * -> *).
(ComponentUnit c, HasLightEnv env, HasLoopEnv env,
 HasComponentEnv env, MonadIO m, MonadMask m) =>
c -> LightT env m c
update Component
comp

    s
s'           <- (env -> env') -> LightT env' m s -> LightT env m s
forall env' env (m :: * -> *) a.
(env' -> env) -> LightT env m a -> LightT env' m a
envLightT (\env :: env
env -> env -> LoopEnv -> LoaderEnv -> env'
conv env
env LoopEnv
loop LoaderEnv
loader) (LightT env' m s -> LightT env m s)
-> LightT env' m s -> LightT env m s
forall a b. (a -> b) -> a -> b
$ s -> LightT env' m s
userloop s
s

    -- event handling
    [Event]
globalEvents <- (env -> env') -> LightT env' m [Event] -> LightT env m [Event]
forall env' env (m :: * -> *) a.
(env' -> env) -> LightT env m a -> LightT env' m a
envLightT (\env :: env
env -> env -> LoopEnv -> LoaderEnv -> env'
conv env
env LoopEnv
loop LoaderEnv
loader) (LightT env' m [Event] -> LightT env m [Event])
-> LightT env' m [Event] -> LightT env m [Event]
forall a b. (a -> b) -> a -> b
$ do
      MVar [Event]
evref  <- Getting (MVar [Event]) env' (MVar [Event])
-> LightT env' m (MVar [Event])
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (MVar [Event]) env' (MVar [Event])
forall c. HasLoopEnv c => Lens' c (MVar [Event])
_events
      [Event]
events <- IO [Event] -> LightT env' m [Event]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Event] -> LightT env' m [Event])
-> IO [Event] -> LightT env' m [Event]
forall a b. (a -> b) -> a -> b
$ MVar [Event] -> ([Event] -> IO ([Event], [Event])) -> IO [Event]
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar MVar [Event]
evref (\a :: [Event]
a -> ([Event], [Event]) -> IO ([Event], [Event])
forall (m :: * -> *) a. Monad m => a -> m a
return ([], [Event]
a))
      let (componentEvent :: [(Text, Event)]
componentEvent, globalEvent :: [Event]
globalEvent, notifyEvent :: [Event]
notifyEvent) = (([(Text, Event)], [Event], [Event])
 -> Event -> ([(Text, Event)], [Event], [Event]))
-> ([(Text, Event)], [Event], [Event])
-> [Event]
-> ([(Text, Event)], [Event], [Event])
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
            ( \(a :: [(Text, Event)]
a, b :: [Event]
b, c :: [Event]
c) -> \case
              NotifyEvent n :: Event
n            -> ([(Text, Event)]
a, [Event]
b, Event
n Event -> [Event] -> [Event]
forall a. a -> [a] -> [a]
: [Event]
c)
              ev :: Event
ev@(Signal _ (Just t :: Text
t) _) -> ((Text
t, Event
ev) (Text, Event) -> [(Text, Event)] -> [(Text, Event)]
forall a. a -> [a] -> [a]
: [(Text, Event)]
a, [Event]
b, [Event]
c)
              ev :: Event
ev                       -> ([(Text, Event)]
a, Event
ev Event -> [Event] -> [Event]
forall a. a -> [a] -> [a]
: [Event]
b, [Event]
c)
            )
            ([], [], [])
            [Event]
events

      -- send an event to the target
      [(Text, Event)]
-> ((Text, Event) -> LightT env' m ()) -> LightT env' m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Text, Event)]
componentEvent (((Text, Event) -> LightT env' m ()) -> LightT env' m ())
-> ((Text, Event) -> LightT env' m ()) -> LightT env' m ()
forall a b. (a -> b) -> a -> b
$ \(target :: Text
target, ev :: Event
ev) -> do
        Registry Component
-> Text
-> (Component -> LightT env' m Component)
-> LightT env' m ()
forall (reg :: * -> *) (m :: * -> *) v.
(IRegistry reg, MonadIO m) =>
reg v -> Text -> (v -> m v) -> m ()
R.update (LoaderEnv
loader LoaderEnv
-> Getting (Registry Component) LoaderEnv (Registry Component)
-> Registry Component
forall s a. s -> Getting a s a -> a
^. Getting (Registry Component) LoaderEnv (Registry Component)
forall c. HasLoaderEnv c => Lens' c (Registry Component)
_registry) Text
target ((Component -> LightT env' m Component) -> LightT env' m ())
-> (Component -> LightT env' m Component) -> LightT env' m ()
forall a b. (a -> b) -> a -> b
$ \v :: Component
v -> (env' -> ComponentState env')
-> LightT (ComponentState env') m Component
-> LightT env' m Component
forall env' env (m :: * -> *) a.
(env' -> env) -> LightT env m a -> LightT env' m a
envLightT
          (\env :: env'
env -> env' -> ComponentEnv -> ComponentState env'
forall a. a -> ComponentEnv -> ComponentState a
ComponentState env'
env (Text -> Maybe HookMap -> ComponentEnv
ComponentEnv (Component -> Text
getUID Component
v) (Component -> Maybe HookMap
getHooks Component
v)))
          (Event -> Component -> LightT (ComponentState env') m Component
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 Component
v)

      -- send a global event to all components
      Registry Component
-> (Component -> LightT env' m Component) -> LightT env' m ()
forall (m :: * -> *) (reg :: * -> *) v.
(MonadIO m, IRegistry reg) =>
reg v -> (v -> m v) -> m ()
R.modifyV_ (LoaderEnv
loader LoaderEnv
-> Getting (Registry Component) LoaderEnv (Registry Component)
-> Registry Component
forall s a. s -> Getting a s a -> a
^. Getting (Registry Component) LoaderEnv (Registry Component)
forall c. HasLoaderEnv c => Lens' c (Registry Component)
_registry) ((Component -> LightT env' m Component) -> LightT env' m ())
-> (Component -> LightT env' m Component) -> LightT env' m ()
forall a b. (a -> b) -> a -> b
$ \comp :: Component
comp -> do
        (Component -> Event -> LightT env' m Component)
-> Component -> [Event] -> LightT env' m Component
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM
          ( \comp :: Component
comp ev :: Event
ev ->
            (env' -> ComponentState env')
-> LightT (ComponentState env') m Component
-> LightT env' m Component
forall env' env (m :: * -> *) a.
(env' -> env) -> LightT env m a -> LightT env' m a
envLightT
                ( \env :: env'
env -> env' -> ComponentEnv -> ComponentState env'
forall a. a -> ComponentEnv -> ComponentState a
ComponentState
                  env'
env
                  (Text -> Maybe HookMap -> ComponentEnv
ComponentEnv (Component -> Text
getUID Component
comp) (Component -> Maybe HookMap
getHooks Component
comp))
                )
              (LightT (ComponentState env') m Component
 -> LightT env' m Component)
-> LightT (ComponentState env') m Component
-> LightT env' m Component
forall a b. (a -> b) -> a -> b
$ Event -> Component -> LightT (ComponentState env') m Component
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 Component
comp
          )
          Component
comp
          [Event]
globalEvent

      -- process notification events
      [Event] -> (Event -> LightT env' m ()) -> LightT env' m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Event]
notifyEvent
        ((Event -> LightT env' m ()) -> LightT env' m ())
-> (Event -> LightT env' m ()) -> LightT env' m ()
forall a b. (a -> b) -> a -> b
$ \ev :: Event
ev -> FilePath -> Resolver -> LightT env' m ()
forall env (m :: * -> *).
(HasLightEnv env, HasLoaderEnv env, MonadIO m, MonadCatch m) =>
FilePath -> Resolver -> LightT env m ()
patchAppConfig (Maybe FilePath -> FilePath
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe FilePath -> FilePath) -> Maybe FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ LoopConfig -> Maybe FilePath
appConfigFile LoopConfig
conf)
                                (LoopConfig -> Resolver
componentResolver LoopConfig
conf)

      [Event] -> LightT env' m [Event]
forall (m :: * -> *) a. Monad m => a -> m a
return [Event]
globalEvent

    Maybe Renderer -> (Renderer -> LightT env m ()) -> LightT env m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe Renderer
mrenderer ((Renderer -> LightT env m ()) -> LightT env m ())
-> (Renderer -> LightT env m ()) -> LightT env m ()
forall a b. (a -> b) -> a -> b
$ \renderer :: Renderer
renderer -> do
      IO () -> LightT env m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> LightT env m ()) -> IO () -> LightT env m ()
forall a b. (a -> b) -> a -> b
$ Renderer -> IO ()
forall (m :: * -> *). MonadIO m => Renderer -> m ()
SDL.present Renderer
renderer

    IO () -> LightT env m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> LightT env m ()) -> IO () -> LightT env m ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay (100000 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 60)
    [Event]
events <- LightT env m [Event]
forall (m :: * -> *). (Functor m, MonadIO m) => m [Event]
SDL.pollEvents
    Scancode -> Bool
keys   <- LightT env m (Scancode -> Bool)
forall (m :: * -> *). MonadIO m => m (Scancode -> Bool)
SDL.getKeyboardState

    (env -> env') -> LightT env' m () -> LightT env m ()
forall env' env (m :: * -> *) a.
(env' -> env) -> LightT env m a -> LightT env' m a
envLightT (\env :: env
env -> env -> LoopEnv -> LoaderEnv -> env'
conv env
env LoopEnv
loop LoaderEnv
loader) (LightT env' m () -> LightT env m ())
-> LightT env' m () -> LightT env m ()
forall a b. (a -> b) -> a -> b
$ do
      MVar [Event]
evref   <- Getting (MVar [Event]) env' (MVar [Event])
-> LightT env' m (MVar [Event])
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (MVar [Event]) env' (MVar [Event])
forall c. HasLoopEnv c => Lens' c (MVar [Event])
_events
      IORef [Event]
sigref  <- Getting (IORef [Event]) env' (IORef [Event])
-> LightT env' m (IORef [Event])
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (IORef [Event]) env' (IORef [Event])
forall c. HasLoopEnv c => Lens' c (IORef [Event])
_signalQueue
      [Event]
signals <- IO [Event] -> LightT env' m [Event]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Event] -> LightT env' m [Event])
-> IO [Event] -> LightT env' m [Event]
forall a b. (a -> b) -> a -> b
$ IORef [Event] -> IO [Event]
forall a. IORef a -> IO a
readIORef IORef [Event]
sigref
      IO () -> LightT env' m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
        (IO () -> LightT env' m ()) -> IO () -> LightT env' m ()
forall a b. (a -> b) -> a -> b
$ MVar [Event] -> ([Event] -> IO [Event]) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar [Event]
evref
        (([Event] -> IO [Event]) -> IO ())
-> ([Event] -> IO [Event]) -> IO ()
forall a b. (a -> b) -> a -> b
$ [Event] -> IO [Event]
forall (m :: * -> *) a. Monad m => a -> m a
return
        ([Event] -> IO [Event])
-> ([Event] -> [Event]) -> [Event] -> IO [Event]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Event -> Event) -> [Event] -> [Event]
forall a b. (a -> b) -> [a] -> [b]
map Event -> Event
RawEvent [Event]
events [Event] -> [Event] -> [Event]
forall a. [a] -> [a] -> [a]
++)
        ([Event] -> [Event]) -> ([Event] -> [Event]) -> [Event] -> [Event]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Event]
signals [Event] -> [Event] -> [Event]
forall a. [a] -> [a] -> [a]
++)
      IO () -> LightT env' m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> LightT env' m ()) -> IO () -> LightT env' m ()
forall a b. (a -> b) -> a -> b
$ IORef [Event] -> [Event] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef [Event]
sigref []

    let loop' :: LoopEnv
loop' =
          LoopEnv
loop
            LoopEnv -> (LoopEnv -> LoopEnv) -> LoopEnv
forall a b. a -> (a -> b) -> b
&  (HashMap Scancode Int -> Identity (HashMap Scancode Int))
-> LoopEnv -> Identity LoopEnv
forall c. HasLoopEnv c => Lens' c (HashMap Scancode Int)
_keyStates
            ((HashMap Scancode Int -> Identity (HashMap Scancode Int))
 -> LoopEnv -> Identity LoopEnv)
-> (HashMap Scancode Int -> HashMap Scancode Int)
-> LoopEnv
-> LoopEnv
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Scancode -> Int -> Int)
-> HashMap Scancode Int -> HashMap Scancode Int
forall k v1 v2. (k -> v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.mapWithKey (\k :: Scancode
k v :: Int
v -> if Scancode -> Bool
keys Scancode
k then Int
v Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1 else 0)
            (HashMap Scancode Int -> HashMap Scancode Int)
-> (HashMap Scancode Int -> HashMap Scancode Int)
-> HashMap Scancode Int
-> HashMap Scancode Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  (HashMap Scancode Int -> HashMap Scancode Int)
-> ([Scancode] -> HashMap Scancode Int -> HashMap Scancode Int)
-> Maybe [Scancode]
-> HashMap Scancode Int
-> HashMap Scancode Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                 HashMap Scancode Int -> HashMap Scancode Int
forall a. a -> a
id
                 ( \specified :: [Scancode]
specified m :: HashMap Scancode Int
m -> [(Scancode, Int)] -> HashMap Scancode Int
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([(Scancode, Int)] -> HashMap Scancode Int)
-> [(Scancode, Int)] -> HashMap Scancode Int
forall a b. (a -> b) -> a -> b
$ (Scancode -> (Scancode, Int)) -> [Scancode] -> [(Scancode, Int)]
forall a b. (a -> b) -> [a] -> [b]
map
                   (\s :: Scancode
s -> (Scancode
s, if Scancode -> HashMap Scancode Int -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
HM.member Scancode
s HashMap Scancode Int
m then HashMap Scancode Int
m HashMap Scancode Int -> Scancode -> Int
forall k v. (Eq k, Hashable k) => HashMap k v -> k -> v
HM.! Scancode
s else 0))
                   [Scancode]
specified
                 )
                 (LoopConfig -> Maybe [Scancode]
watchKeys LoopConfig
conf)

    let quit :: Bool
quit = (Event -> Bool) -> [Event] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any
          ( \case
            RawEvent (SDL.Event _ (SDL.WindowClosedEvent _)) -> Bool
True
            RawEvent (SDL.Event _ SDL.QuitEvent            ) -> Bool
True
            _ -> Bool
False
          )
          [Event]
globalEvents

    Bool -> LightT env m () -> LightT env m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
quit (LightT env m () -> LightT env m ())
-> LightT env m () -> LightT env m ()
forall a b. (a -> b) -> a -> b
$ LoopEnv -> LoaderEnv -> s -> LightT env m ()
go LoopEnv
loop' LoaderEnv
loader s
s'

-- | Quit the mainloop and terminate the application.
quit :: (MonadIO m, HasLoopEnv env) => LightT env m ()
quit :: LightT env m ()
quit = do
  MVar [Event]
evref <- Getting (MVar [Event]) env (MVar [Event])
-> LightT env m (MVar [Event])
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (MVar [Event]) env (MVar [Event])
forall c. HasLoopEnv c => Lens' c (MVar [Event])
_events
  IO () -> LightT env m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> LightT env m ()) -> IO () -> LightT env m ()
forall a b. (a -> b) -> a -> b
$ MVar [Event] -> ([Event] -> IO [Event]) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar [Event]
evref (([Event] -> IO [Event]) -> IO ())
-> ([Event] -> IO [Event]) -> IO ()
forall a b. (a -> b) -> a -> b
$ [Event] -> IO [Event]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Event] -> IO [Event])
-> ([Event] -> [Event]) -> [Event] -> IO [Event]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Event -> Event
RawEvent (Word32 -> EventPayload -> Event
SDL.Event 0 EventPayload
SDL.QuitEvent) Event -> [Event] -> [Event]
forall a. a -> [a] -> [a]
:)