Safe Haskell | None |
---|---|
Language | Haskell2010 |
Synopsis
- type HookMap = HashMap Text (Text, Object -> Value)
- class HasComponentEnv c where
- componentEnv :: Lens' c ComponentEnv
- _callbacks :: Lens' c (Maybe HookMap)
- _uid :: Lens' c Text
- data ComponentEnv = ComponentEnv {}
- emit :: (HasLoopEnv env, HasComponentEnv env, MonadIO m, EventType et) => Maybe Text -> et -> LightT env m ()
- emitGlobally :: (HasLoopEnv env, HasComponentEnv env, MonadIO m, EventType et) => et -> LightT env m ()
- class ComponentUnit c where
- update :: (HasLightEnv env, HasLoopEnv env, HasComponentEnv env, MonadIO m, MonadMask m) => c -> LightT env m c
- figures :: (HasLightEnv env, MonadIO m, MonadMask m) => c -> LightT env m [Figure]
- draw :: (HasLightEnv env, MonadIO m, MonadMask m) => c -> LightT env m ()
- onSignal :: (HasLightEnv env, HasLoopEnv env, HasComponentEnv env, MonadIO m, MonadMask m) => Event -> c -> LightT env m c
- useCache :: c -> c -> Bool
- beforeClearCache :: (HasLightEnv env, MonadIO m, MonadMask m) => c -> [Figure] -> LightT env m ()
- data Component
- _unsafeAs :: ComponentUnit c => Lens' Component c
- newComponent :: (ComponentUnit c, HasLightEnv env, MonadIO m, MonadMask m) => Text -> c -> LightT env m Component
- getComponentSize :: (ComponentUnit c, HasLightEnv env, MonadIO m, MonadMask m) => c -> LightT env m (Rectangle Int)
- getUID :: Component -> Text
- getHooks :: Component -> Maybe HookMap
- setHooks :: Component -> Maybe HookMap -> Component
- propagate :: Component -> Component
Documentation
class HasComponentEnv c where Source #
componentEnv :: Lens' c ComponentEnv Source #
Instances
:: (HasLoopEnv env, HasComponentEnv env, MonadIO m, EventType et) | |
=> Maybe Text | target component ID |
-> et | |
-> LightT env m () |
Emit a signal, which will be catched at the next frame.
emitGlobally :: (HasLoopEnv env, HasComponentEnv env, MonadIO m, EventType et) => et -> LightT env m () Source #
Emit a signal globally.
class ComponentUnit c where Source #
CompoonentUnit typeclass provides a way to define a new component.
Any ComponentUnit
instance can be embedded into Component
type.
update :: (HasLightEnv env, HasLoopEnv env, HasComponentEnv env, MonadIO m, MonadMask m) => c -> LightT env m c Source #
Updating a model.
figures :: (HasLightEnv env, MonadIO m, MonadMask m) => c -> LightT env m [Figure] Source #
Descirbes a view. The figures here would be cached. See also useCache
for the cache configuration.
draw :: (HasLightEnv env, MonadIO m, MonadMask m) => c -> LightT env m () Source #
Drawing a figures.
onSignal :: (HasLightEnv env, HasLoopEnv env, HasComponentEnv env, MonadIO m, MonadMask m) => Event -> c -> LightT env m c Source #
Event handlers
:: c | A model value in the previous frame |
-> c | A model value in the current frame |
-> Bool |
Return True
if a cache stored in the previous frame should be used.
beforeClearCache :: (HasLightEnv env, MonadIO m, MonadMask m) => c -> [Figure] -> LightT env m () Source #
To be called just before clearing caches. If you want to destroy cached textures for memory efficiency, override this method.
NB: Freeing SDL textures and figures are not performed automatically. You must call freeFigure
at your own risk.
Instances
A wrapper for ComponentUnit
instances.
Instances
ComponentUnit Component Source # | |
Defined in MiniLight.Component update :: forall env (m :: Type -> Type). (HasLightEnv env, HasLoopEnv env, HasComponentEnv env, MonadIO m, MonadMask m) => Component -> LightT env m Component Source # figures :: forall env (m :: Type -> Type). (HasLightEnv env, MonadIO m, MonadMask m) => Component -> LightT env m [Figure] Source # draw :: forall env (m :: Type -> Type). (HasLightEnv env, MonadIO m, MonadMask m) => Component -> LightT env m () Source # onSignal :: forall env (m :: Type -> Type). (HasLightEnv env, HasLoopEnv env, HasComponentEnv env, MonadIO m, MonadMask m) => Event -> Component -> LightT env m Component Source # useCache :: Component -> Component -> Bool Source # beforeClearCache :: forall env (m :: Type -> Type). (HasLightEnv env, MonadIO m, MonadMask m) => Component -> [Figure] -> LightT env m () Source # |
newComponent :: (ComponentUnit c, HasLightEnv env, MonadIO m, MonadMask m) => Text -> c -> LightT env m Component Source #
Create a new component.
getComponentSize :: (ComponentUnit c, HasLightEnv env, MonadIO m, MonadMask m) => c -> LightT env m (Rectangle Int) Source #
Get the size of a component.