@@ -35,6 +35,7 @@ mainWidgetWithHandle
3535 , HasDisplayRegion t m
3636 , HasFocusReader t m
3737 , HasInput t m
38+ , HasTheme t m
3839 ) => m (Event t ()))
3940 -> IO ()
4041mainWidgetWithHandle vty child =
@@ -45,12 +46,14 @@ mainWidgetWithHandle vty child =
4546 let inp' = fforMaybe inp $ \case
4647 V.EvResize {} -> Nothing
4748 x -> Just x
48− (shutdown, images) <- runFocusReader (pure True) $ runDisplayRegion (fmap (\(w, h) -> Region 0 0 w h) size) $
49− runImageWriter $
50− runNodeIdT $
51− runInput inp' $ do
52− tellImages . ffor (current size) $ \(w, h) -> [V.charFill V.defAttr ' ' w h]
53− child
49+ (shutdown, images) <- runThemeReader (constant V.defAttr) $
50+ runFocusReader (pure True) $
51+ runDisplayRegion (fmap (\(w, h) -> Region 0 0 w h) size) $
52+ runImageWriter $
53+ runNodeIdT $
54+ runInput inp' $ do
55+ tellImages . ffor (current size) $ \(w, h) -> [V.charFill V.defAttr ' ' w h]
56+ child
5457 return $ VtyResult
5558 { _vtyResult_picture = fmap (V.picForLayers . reverse) images
5659 , _vtyResult_shutdown = shutdown
@@ -69,6 +72,7 @@ mainWidget
6972 , MonadNodeId m
7073 , HasDisplayRegion t m
7174 , HasFocusReader t m
75+ , HasTheme t m
7276 , HasInput t m
7377 ) => m (Event t ()))
7478 -> IO ()
@@ -233,9 +237,9 @@ regionSize :: Region -> (Int, Int)
233237regionSize (Region _ _ w h) = (w, h)
234238
235239-- | Produces an 'Image' that fills a region with space characters
236−regionBlankImage :: Region -> Image
237−regionBlankImage r@(Region _ _ width height) =
238− withinImage r $ V.charFill V.defAttr ' ' width height
240+regionBlankImage :: V.Attr -> Region -> Image
241+regionBlankImage attr r@(Region _ _ width height) =
242+ withinImage r $ V.charFill attr ' ' width height
239243
240244-- | A class for things that know their own display size dimensions
241245class (Reflex t, Monad m) => HasDisplayRegion t m | m -> t where
@@ -403,7 +407,7 @@ newtype ImageWriter t m a = ImageWriter
403407 , NotReady t
404408 , PerformEvent t
405409 , PostBuild t
406− , TriggerEvent t
410+ , TriggerEvent t
407411 )
408412
409413instance MonadTrans (ImageWriter t) where
@@ -441,6 +445,75 @@ runImageWriter
441445 -> m (a, Behavior t [Image])
442446runImageWriter = runBehaviorWriterT . unImageWriter
443447
448+-- * Theming
449+
450+-- | A class for things that can be visually styled
451+class (Reflex t, Monad m) => HasTheme t m | m -> t where
452+ theme :: m (Behavior t V.Attr)
453+ default theme :: (f m' ~ m, Monad m', MonadTrans f, HasTheme t m') => m (Behavior t V.Attr)
454+ theme = lift theme
455+ localTheme :: (Behavior t V.Attr -> Behavior t V.Attr) -> m a -> m a
456+ default localTheme :: (f m' ~ m, Monad m', MFunctor f, HasTheme t m') => (Behavior t V.Attr -> Behavior t V.Attr) -> m a -> m a
457+ localTheme f = hoist (localTheme f)
458+
459+instance HasTheme t m => HasTheme t (ReaderT x m)
460+instance HasTheme t m => HasTheme t (BehaviorWriterT t x m)
461+instance HasTheme t m => HasTheme t (DynamicWriterT t x m)
462+instance HasTheme t m => HasTheme t (EventWriterT t x m)
463+instance HasTheme t m => HasTheme t (NodeIdT m)
464+instance HasTheme t m => HasTheme t (Input t m)
465+instance HasTheme t m => HasTheme t (ImageWriter t m)
466+instance HasTheme t m => HasTheme t (DisplayRegion t m)
467+instance HasTheme t m => HasTheme t (FocusReader t m)
468+
469+-- | A widget that has access to theme information
470+newtype ThemeReader t m a = ThemeReader
471+ { unThemeReader :: ReaderT (Behavior t V.Attr) m a }
472+ deriving
473+ ( Functor
474+ , Applicative
475+ , Monad
476+ , MonadFix
477+ , MonadHold t
478+ , MonadIO
479+ , MonadRef
480+ , MonadSample t
481+ )
482+
483+instance (Monad m, Reflex t) => HasTheme t (ThemeReader t m) where
484+ theme = ThemeReader ask
485+ localTheme f = ThemeReader . local f . unThemeReader
486+
487+deriving instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (ThemeReader t m)
488+deriving instance NotReady t m => NotReady t (ThemeReader t m)
489+deriving instance PerformEvent t m => PerformEvent t (ThemeReader t m)
490+deriving instance PostBuild t m => PostBuild t (ThemeReader t m)
491+deriving instance TriggerEvent t m => TriggerEvent t (ThemeReader t m)
492+instance HasImageWriter t m => HasImageWriter t (ThemeReader t m)
493+
494+instance (Adjustable t m, MonadFix m, MonadHold t m) => Adjustable t (ThemeReader t m) where
495+ runWithReplace (ThemeReader a) e = ThemeReader $ runWithReplace a $ fmap unThemeReader e
496+ traverseIntMapWithKeyWithAdjust f m e = ThemeReader $ traverseIntMapWithKeyWithAdjust (\k v -> unThemeReader $ f k v) m e
497+ traverseDMapWithKeyWithAdjust f m e = ThemeReader $ traverseDMapWithKeyWithAdjust (\k v -> unThemeReader $ f k v) m e
498+ traverseDMapWithKeyWithAdjustWithMove f m e = ThemeReader $ traverseDMapWithKeyWithAdjustWithMove (\k v -> unThemeReader $ f k v) m e
499+
500+instance MonadTrans (ThemeReader t) where
501+ lift = ThemeReader . lift
502+
503+instance MFunctor (ThemeReader t) where
504+ hoist f = ThemeReader . hoist f . unThemeReader
505+
506+instance MonadNodeId m => MonadNodeId (ThemeReader t m)
507+
508+-- | Run a 'ThemeReader' action with the given focus value
509+runThemeReader
510+ :: (Reflex t, Monad m)
511+ => Behavior t V.Attr
512+ -> ThemeReader t m a
513+ -> m a
514+runThemeReader b = flip runReaderT b . unThemeReader
515+
516+
444517-- ** Manipulating images
445518
446519-- | Translates and crops an 'Image' so that it is contained by