module MiniLight.Component (
HookMap,
HasComponentEnv(..),
ComponentEnv(..),
emit,
emitGlobally,
ComponentUnit(..),
Component,
_unsafeAs,
newComponent,
getComponentSize,
getUID,
getHooks,
setHooks,
propagate,
) where
import Control.Lens
import Control.Monad.Catch
import Control.Monad.IO.Class
import Data.Aeson
import qualified Data.HashMap.Strict as HM
import Data.IORef
import qualified Data.Text as T
import MiniLight.Light
import MiniLight.Event
import MiniLight.Figure
import qualified SDL
import Unsafe.Coerce
type HookMap = HM.HashMap T.Text (T.Text, Object -> Value)
data ComponentEnv = ComponentEnv {
ComponentEnv -> Text
uid :: T.Text,
ComponentEnv -> Maybe HookMap
callbacks :: Maybe HookMap
}
makeClassy_ ''ComponentEnv
emit
:: (HasLoopEnv env, HasComponentEnv env, MonadIO m, EventType et)
=> Maybe T.Text
-> et
-> LightT env m ()
emit :: Maybe Text -> et -> LightT env m ()
emit target :: Maybe Text
target et :: et
et = do
Text
uid <- Getting Text env Text -> LightT env m Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text env Text
forall c. HasComponentEnv c => Lens' c Text
_uid
IORef [Event]
ref <- 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
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] -> [Event]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef [Event]
ref (([Event] -> [Event]) -> IO ()) -> ([Event] -> [Event]) -> IO ()
forall a b. (a -> b) -> a -> b
$ (Text -> Maybe Text -> et -> Event
forall a. EventType a => Text -> Maybe Text -> a -> Event
signal Text
uid Maybe Text
target et
et Event -> [Event] -> [Event]
forall a. a -> [a] -> [a]
:)
Maybe HookMap
hs <- Getting (Maybe HookMap) env (Maybe HookMap)
-> LightT env m (Maybe HookMap)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe HookMap) env (Maybe HookMap)
forall c. HasComponentEnv c => Lens' c (Maybe HookMap)
_callbacks
case Text -> HookMap -> Maybe (Text, Object -> Value)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup (et -> Text
forall e. EventType e => e -> Text
getEventType et
et) (HookMap -> Maybe (Text, Object -> Value))
-> Maybe HookMap -> Maybe (Text, Object -> Value)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe HookMap
hs of
Just (name :: Text
name, param :: Object -> Value
param) -> 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] -> [Event]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef'
IORef [Event]
ref
(Text -> Maybe Text -> EventData -> Event
forall a. EventType a => Text -> Maybe Text -> a -> Event
signal Text
uid Maybe Text
forall a. Maybe a
Nothing (Text -> Value -> EventData
EventData Text
name (Object -> Value
param (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ et -> Object
forall e. EventType e => e -> Object
getEventProperties et
et)) Event -> [Event] -> [Event]
forall a. a -> [a] -> [a]
:)
Nothing -> () -> LightT env m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
emitGlobally
:: (HasLoopEnv env, HasComponentEnv env, MonadIO m, EventType et)
=> et
-> LightT env m ()
emitGlobally :: et -> LightT env m ()
emitGlobally = 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 Maybe Text
forall a. Maybe a
Nothing
class ComponentUnit c where
update :: (HasLightEnv env, HasLoopEnv env, HasComponentEnv env, MonadIO m, MonadMask m) => c -> LightT env m c
update = c -> LightT env m c
forall (m :: * -> *) a. Monad m => a -> m a
return
figures :: (HasLightEnv env, MonadIO m, MonadMask m) => c -> LightT env m [Figure]
draw :: (HasLightEnv env, MonadIO m, MonadMask m) => c -> LightT env m ()
draw comp :: c
comp = MiniLight () -> LightT env m ()
forall env (m :: * -> *) a.
(HasLightEnv env, MonadIO m) =>
MiniLight a -> LightT env m a
liftMiniLight (MiniLight () -> LightT env m ())
-> ([Figure] -> MiniLight ()) -> [Figure] -> LightT env m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Figure] -> MiniLight ()
forall env (m :: * -> *).
(HasLightEnv env, MonadIO m, MonadMask m) =>
[Figure] -> LightT env m ()
renders ([Figure] -> LightT env m ())
-> LightT env m [Figure] -> LightT env m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< c -> LightT env m [Figure]
forall c env (m :: * -> *).
(ComponentUnit c, HasLightEnv env, MonadIO m, MonadMask m) =>
c -> LightT env m [Figure]
figures c
comp
{-# INLINE draw #-}
onSignal :: (HasLightEnv env, HasLoopEnv env, HasComponentEnv env, MonadIO m, MonadMask m) => Event -> c -> LightT env m c
onSignal _ = c -> LightT env m c
forall (m :: * -> *) a. Monad m => a -> m a
return
useCache
:: c
-> c
-> Bool
useCache _ _ = Bool
False
beforeClearCache :: (HasLightEnv env, MonadIO m, MonadMask m) => c -> [Figure] -> LightT env m ()
beforeClearCache _ _ = () -> LightT env m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
data Component = forall c. ComponentUnit c => Component {
Component -> Text
uidOf :: T.Text,
()
component :: c,
()
prev :: c,
Component -> IORef [Figure]
cache :: IORef [Figure],
Component -> Maybe HookMap
callbackObject :: Maybe HookMap
}
_unsafeAs :: (ComponentUnit c) => Lens' Component c
_unsafeAs :: Lens' Component c
_unsafeAs = (Component -> c)
-> (Component -> c -> Component) -> Lens' Component c
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
(\(Component _ c :: c
c _ _ _) -> c -> c
forall a b. a -> b
unsafeCoerce c
c)
(\(Component a :: Text
a _ c :: c
c d :: IORef [Figure]
d e :: Maybe HookMap
e) b :: c
b -> Text -> c -> c -> IORef [Figure] -> Maybe HookMap -> Component
forall c.
ComponentUnit c =>
Text -> c -> c -> IORef [Figure] -> Maybe HookMap -> Component
Component Text
a (c -> c
forall a b. a -> b
unsafeCoerce c
b) c
c IORef [Figure]
d Maybe HookMap
e)
newComponent
:: (ComponentUnit c, HasLightEnv env, MonadIO m, MonadMask m)
=> T.Text
-> c
-> LightT env m Component
newComponent :: Text -> c -> LightT env m Component
newComponent uid :: Text
uid c :: c
c = do
[Figure]
figs <- c -> LightT env m [Figure]
forall c env (m :: * -> *).
(ComponentUnit c, HasLightEnv env, MonadIO m, MonadMask m) =>
c -> LightT env m [Figure]
figures c
c
IORef [Figure]
ref <- IO (IORef [Figure]) -> LightT env m (IORef [Figure])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef [Figure]) -> LightT env m (IORef [Figure]))
-> IO (IORef [Figure]) -> LightT env m (IORef [Figure])
forall a b. (a -> b) -> a -> b
$ [Figure] -> IO (IORef [Figure])
forall a. a -> IO (IORef a)
newIORef [Figure]
figs
Component -> LightT env m Component
forall (m :: * -> *) a. Monad m => a -> m a
return (Component -> LightT env m Component)
-> Component -> LightT env m Component
forall a b. (a -> b) -> a -> b
$ $WComponent :: forall c.
ComponentUnit c =>
Text -> c -> c -> IORef [Figure] -> Maybe HookMap -> Component
Component
{ uidOf :: Text
uidOf = Text
uid
, component :: c
component = c
c
, prev :: c
prev = c
c
, cache :: IORef [Figure]
cache = IORef [Figure]
ref
, callbackObject :: Maybe HookMap
callbackObject = Maybe HookMap
forall a. Maybe a
Nothing
}
getComponentSize
:: (ComponentUnit c, HasLightEnv env, MonadIO m, MonadMask m)
=> c
-> LightT env m (SDL.Rectangle Int)
getComponentSize :: c -> LightT env m (Rectangle Int)
getComponentSize comp :: c
comp = do
[Figure]
figs <- c -> LightT env m [Figure]
forall c env (m :: * -> *).
(ComponentUnit c, HasLightEnv env, MonadIO m, MonadMask m) =>
c -> LightT env m [Figure]
figures c
comp
Rectangle Int -> LightT env m (Rectangle Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Rectangle Int -> LightT env m (Rectangle Int))
-> Rectangle Int -> LightT env m (Rectangle Int)
forall a b. (a -> b) -> a -> b
$ (Rectangle Int -> Rectangle Int -> Rectangle Int)
-> Rectangle Int -> [Rectangle Int] -> Rectangle Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Rectangle Int -> Rectangle Int -> Rectangle Int
union (Point V2 Int -> V2 Int -> Rectangle Int
forall a. Point V2 a -> V2 a -> Rectangle a
SDL.Rectangle (V2 Int -> Point V2 Int
forall (f :: * -> *) a. f a -> Point f a
SDL.P 0) 0) ([Rectangle Int] -> Rectangle Int)
-> [Rectangle Int] -> Rectangle Int
forall a b. (a -> b) -> a -> b
$ (Figure -> Rectangle Int) -> [Figure] -> [Rectangle Int]
forall a b. (a -> b) -> [a] -> [b]
map Figure -> Rectangle Int
targetArea [Figure]
figs
getUID :: Component -> T.Text
getUID :: Component -> Text
getUID (Component uid :: Text
uid _ _ _ _) = Text
uid
getHooks :: Component -> Maybe HookMap
getHooks :: Component -> Maybe HookMap
getHooks (Component _ _ _ _ h :: Maybe HookMap
h) = Maybe HookMap
h
setHooks :: Component -> Maybe HookMap -> Component
setHooks :: Component -> Maybe HookMap -> Component
setHooks (Component uid :: Text
uid comp :: c
comp prev :: c
prev cache :: IORef [Figure]
cache _) h :: Maybe HookMap
h = Text -> c -> c -> IORef [Figure] -> Maybe HookMap -> Component
forall c.
ComponentUnit c =>
Text -> c -> c -> IORef [Figure] -> Maybe HookMap -> Component
Component Text
uid c
comp c
prev IORef [Figure]
cache Maybe HookMap
h
propagate :: Component -> Component
propagate :: Component -> Component
propagate (Component uid :: Text
uid comp :: c
comp _ cache :: IORef [Figure]
cache h :: Maybe HookMap
h) = Text -> c -> c -> IORef [Figure] -> Maybe HookMap -> Component
forall c.
ComponentUnit c =>
Text -> c -> c -> IORef [Figure] -> Maybe HookMap -> Component
Component Text
uid c
comp c
comp IORef [Figure]
cache Maybe HookMap
h
instance ComponentUnit Component where
update :: Component -> LightT env m Component
update (Component uid :: Text
uid comp :: c
comp prev :: c
prev cache :: IORef [Figure]
cache h :: Maybe HookMap
h) = do
c
comp' <- c -> LightT env m c
forall c env (m :: * -> *).
(ComponentUnit c, HasLightEnv env, HasLoopEnv env,
HasComponentEnv env, MonadIO m, MonadMask m) =>
c -> LightT env m c
update c
comp
Component -> LightT env m Component
forall (m :: * -> *) a. Monad m => a -> m a
return (Component -> LightT env m Component)
-> Component -> LightT env m Component
forall a b. (a -> b) -> a -> b
$ Text -> c -> c -> IORef [Figure] -> Maybe HookMap -> Component
forall c.
ComponentUnit c =>
Text -> c -> c -> IORef [Figure] -> Maybe HookMap -> Component
Component Text
uid c
comp' c
prev IORef [Figure]
cache Maybe HookMap
h
figures :: Component -> LightT env m [Figure]
figures (Component _ comp :: c
comp _ _ _) = c -> LightT env m [Figure]
forall c env (m :: * -> *).
(ComponentUnit c, HasLightEnv env, MonadIO m, MonadMask m) =>
c -> LightT env m [Figure]
figures c
comp
draw :: Component -> LightT env m ()
draw (Component _ comp :: c
comp prev :: c
prev ref :: IORef [Figure]
ref _) = do
if c -> c -> Bool
forall c. ComponentUnit c => c -> c -> Bool
useCache c
prev c
comp
then MiniLight () -> LightT env m ()
forall env (m :: * -> *) a.
(HasLightEnv env, MonadIO m) =>
MiniLight a -> LightT env m a
liftMiniLight (MiniLight () -> LightT env m ())
-> ([Figure] -> MiniLight ()) -> [Figure] -> LightT env m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Figure] -> MiniLight ()
forall env (m :: * -> *).
(HasLightEnv env, MonadIO m, MonadMask m) =>
[Figure] -> LightT env m ()
renders ([Figure] -> LightT env m ())
-> LightT env m [Figure] -> LightT env m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO [Figure] -> LightT env m [Figure]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef [Figure] -> IO [Figure]
forall a. IORef a -> IO a
readIORef IORef [Figure]
ref)
else do
[Figure]
figs <- IO [Figure] -> LightT env m [Figure]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef [Figure] -> IO [Figure]
forall a. IORef a -> IO a
readIORef IORef [Figure]
ref)
c -> [Figure] -> LightT env m ()
forall c env (m :: * -> *).
(ComponentUnit c, HasLightEnv env, MonadIO m, MonadMask m) =>
c -> [Figure] -> LightT env m ()
beforeClearCache c
comp [Figure]
figs
[Figure]
figs <- c -> LightT env m [Figure]
forall c env (m :: * -> *).
(ComponentUnit c, HasLightEnv env, MonadIO m, MonadMask m) =>
c -> LightT env m [Figure]
figures c
comp
MiniLight () -> LightT env m ()
forall env (m :: * -> *) a.
(HasLightEnv env, MonadIO m) =>
MiniLight a -> LightT env m a
liftMiniLight (MiniLight () -> LightT env m ())
-> MiniLight () -> LightT env m ()
forall a b. (a -> b) -> a -> b
$ [Figure] -> MiniLight ()
forall env (m :: * -> *).
(HasLightEnv env, MonadIO m, MonadMask m) =>
[Figure] -> LightT env m ()
renders [Figure]
figs
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 [Figure] -> [Figure] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef [Figure]
ref [Figure]
figs
onSignal :: Event -> Component -> LightT env m Component
onSignal ev :: Event
ev (Component uid :: Text
uid comp :: c
comp prev :: c
prev cache :: IORef [Figure]
cache h :: Maybe HookMap
h) = (c -> Component) -> LightT env m c -> LightT env m Component
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\comp' :: c
comp' -> Text -> c -> c -> IORef [Figure] -> Maybe HookMap -> Component
forall c.
ComponentUnit c =>
Text -> c -> c -> IORef [Figure] -> Maybe HookMap -> Component
Component Text
uid c
comp' c
prev IORef [Figure]
cache Maybe HookMap
h) (LightT env m c -> LightT env m Component)
-> LightT env m c -> LightT env m Component
forall a b. (a -> b) -> a -> b
$ Event -> c -> LightT env m c
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 c
comp