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 {
uid :: T.Text,
callbacks :: Maybe HookMap
}
makeClassy_ ''ComponentEnv
emit
:: (HasLoopEnv env, HasComponentEnv env, MonadIO m, EventType et)
=> Maybe T.Text
-> et
-> LightT env m ()
emit target et = do
uid <- view _uid
ref <- view _signalQueue
liftIO $ modifyIORef' ref $ (signal uid target et :)
hs <- view _callbacks
case HM.lookup (getEventType et) =<< hs of
Just (name, param) -> liftIO $ modifyIORef'
ref
(signal uid Nothing (EventData name (param $ getEventProperties et)) :)
Nothing -> return ()
emitGlobally
:: (HasLoopEnv env, HasComponentEnv env, MonadIO m, EventType et)
=> et
-> LightT env m ()
emitGlobally = emit Nothing
class ComponentUnit c where
update :: (HasLightEnv env, HasLoopEnv env, HasComponentEnv env, MonadIO m, MonadMask m) => c -> LightT env m c
update = 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 = liftMiniLight . renders =<< figures comp
{-# INLINE draw #-}
onSignal :: (HasLightEnv env, HasLoopEnv env, HasComponentEnv env, MonadIO m, MonadMask m) => Event -> c -> LightT env m c
onSignal _ = return
useCache
:: c
-> c
-> Bool
useCache _ _ = False
beforeClearCache :: (HasLightEnv env, MonadIO m, MonadMask m) => c -> [Figure] -> LightT env m ()
beforeClearCache _ _ = return ()
data Component = forall c. ComponentUnit c => Component {
uidOf :: T.Text,
component :: c,
prev :: c,
cache :: IORef [Figure],
callbackObject :: Maybe HookMap
}
_unsafeAs :: (ComponentUnit c) => Lens' Component c
_unsafeAs = lens
(\(Component _ c _ _ _) -> unsafeCoerce c)
(\(Component a _ c d e) b -> Component a (unsafeCoerce b) c d e)
newComponent
:: (ComponentUnit c, HasLightEnv env, MonadIO m, MonadMask m)
=> T.Text
-> c
-> LightT env m Component
newComponent uid c = do
figs <- figures c
ref <- liftIO $ newIORef figs
return $ Component
{ uidOf = uid
, component = c
, prev = c
, cache = ref
, callbackObject = Nothing
}
getComponentSize
:: (ComponentUnit c, HasLightEnv env, MonadIO m, MonadMask m)
=> c
-> LightT env m (SDL.Rectangle Int)
getComponentSize comp = do
figs <- figures comp
return $ foldl union (SDL.Rectangle (SDL.P 0) 0) $ map targetArea figs
getUID :: Component -> T.Text
getUID (Component uid _ _ _ _) = uid
getHooks :: Component -> Maybe HookMap
getHooks (Component _ _ _ _ h) = h
setHooks :: Component -> Maybe HookMap -> Component
setHooks (Component uid comp prev cache _) h = Component uid comp prev cache h
propagate :: Component -> Component
propagate (Component uid comp _ cache h) = Component uid comp comp cache h
instance ComponentUnit Component where
update (Component uid comp prev cache h) = do
comp' <- update comp
return $ Component uid comp' prev cache h
figures (Component _ comp _ _ _) = figures comp
draw (Component _ comp prev ref _) = do
if useCache prev comp
then liftMiniLight . renders =<< liftIO (readIORef ref)
else do
figs <- liftIO (readIORef ref)
beforeClearCache comp figs
figs <- figures comp
liftMiniLight $ renders figs
liftIO $ writeIORef ref figs
onSignal ev (Component uid comp prev cache h) = fmap (\comp' -> Component uid comp' prev cache h) $ onSignal ev comp