{-# 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)
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
data LightConfig = LightConfig {
LightConfig -> Bool
headless :: Bool,
LightConfig -> LogLevel -> IO LogQueue
logQueue :: Caster.LogLevel -> IO Caster.LogQueue,
LightConfig -> LogLevel
logLevel :: Caster.LogLevel
}
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
}
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
data LoopConfig = LoopConfig {
LoopConfig -> Maybe [Scancode]
watchKeys :: Maybe [SDL.Scancode],
LoopConfig -> Maybe FilePath
appConfigFile :: Maybe FilePath,
LoopConfig -> Maybe FilePath
hotConfigReplacement :: Maybe FilePath,
LoopConfig -> Resolver
componentResolver :: Resolver,
LoopConfig -> [Component]
additionalComponents :: [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 = []
}
data LoopState = LoopState {
LoopState -> LightEnv
light :: LightEnv,
LoopState -> LoopEnv
loop :: LoopEnv,
LoopState -> LoaderEnv
loader :: LoaderEnv
}
makeLensesWith classyRules_ ''LoopState
type MiniLoop = LightT LoopState IO
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
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)))
(@@!)
:: ( 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
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
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
runMainloop
:: ( 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 :: (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
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]
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
[(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)
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
[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 :: (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]
:)