@@ -403,7 +403,7 @@ newtype ImageWriter t m a = ImageWriter
403403 , NotReady t
404404 , PerformEvent t
405405 , PostBuild t
406− , TriggerEvent t
406+ , TriggerEvent t
407407 )
408408
409409instance MonadTrans (ImageWriter t) where
@@ -441,6 +441,71 @@ runImageWriter
441441 -> m (a, Behavior t [Image])
442442runImageWriter = runBehaviorWriterT . unImageWriter
443443
444+-- * theming
445+
446+-- | A class for things that can dynamically gain and lose focus
447+class (Reflex t, Monad m) => HasTheme t m | m -> t where
448+ theme :: m (Behavior t V.Attr)
449+ default theme :: (f m' ~ m, Monad m', MonadTrans f, HasTheme t m') => m (Behavior t V.Attr)
450+ theme = lift theme
451+ localTheme :: (Behavior t V.Attr -> Behavior t V.Attr) -> m a -> m a
452+ default localTheme :: (f m' ~ m, Monad m', MFunctor f, HasTheme t m') => (Behavior t V.Attr -> Behavior t V.Attr) -> m a -> m a
453+ localTheme f = hoist (localTheme f)
454+
455+instance HasTheme t m => HasTheme t (ReaderT x m)
456+instance HasTheme t m => HasTheme t (BehaviorWriterT t x m)
457+instance HasTheme t m => HasTheme t (DynamicWriterT t x m)
458+instance HasTheme t m => HasTheme t (EventWriterT t x m)
459+instance HasTheme t m => HasTheme t (NodeIdT m)
460+
461+-- | A widget that has access to information about whether it is focused
462+newtype ThemeReader t m a = ThemeReader
463+ { unThemeReader :: ReaderT (Behavior t V.Attr) m a }
464+ deriving
465+ ( Functor
466+ , Applicative
467+ , Monad
468+ , MonadFix
469+ , MonadHold t
470+ , MonadIO
471+ , MonadRef
472+ , MonadSample t
473+ )
474+
475+instance (Monad m, Reflex t) => HasTheme t (ThemeReader t m) where
476+ theme = ThemeReader ask
477+ localTheme f = ThemeReader . local f . unThemeReader
478+
479+deriving instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (ThemeReader t m)
480+deriving instance NotReady t m => NotReady t (ThemeReader t m)
481+deriving instance PerformEvent t m => PerformEvent t (ThemeReader t m)
482+deriving instance PostBuild t m => PostBuild t (ThemeReader t m)
483+deriving instance TriggerEvent t m => TriggerEvent t (ThemeReader t m)
484+instance HasImageWriter t m => HasImageWriter t (ThemeReader t m)
485+
486+instance (Adjustable t m, MonadFix m, MonadHold t m) => Adjustable t (ThemeReader t m) where
487+ runWithReplace (ThemeReader a) e = ThemeReader $ runWithReplace a $ fmap unThemeReader e
488+ traverseIntMapWithKeyWithAdjust f m e = ThemeReader $ traverseIntMapWithKeyWithAdjust (\k v -> unThemeReader $ f k v) m e
489+ traverseDMapWithKeyWithAdjust f m e = ThemeReader $ traverseDMapWithKeyWithAdjust (\k v -> unThemeReader $ f k v) m e
490+ traverseDMapWithKeyWithAdjustWithMove f m e = ThemeReader $ traverseDMapWithKeyWithAdjustWithMove (\k v -> unThemeReader $ f k v) m e
491+
492+instance MonadTrans (ThemeReader t) where
493+ lift = ThemeReader . lift
494+
495+instance MFunctor (ThemeReader t) where
496+ hoist f = ThemeReader . hoist f . unThemeReader
497+
498+instance MonadNodeId m => MonadNodeId (ThemeReader t m)
499+
500+-- | Run a 'FocusReader' action with the given focus value
501+runThemeReader
502+ :: (Reflex t, Monad m)
503+ => Behavior t V.Attr
504+ -> ThemeReader t m a
505+ -> m a
506+runThemeReader b = flip runReaderT b . unThemeReader
507+
508+
444509-- ** Manipulating images
445510
446511-- | Translates and crops an 'Image' so that it is contained by