theme text

src/Reflex/Vty/Widget/Input/Text.hs

@@ -43,7 +43,7 @@ data TextInput t = TextInput
 
 -- | A widget that allows text input
 textInput
-  :: (Reflex t, MonadHold t m, MonadFix m, HasInput t m, HasFocusReader t m, HasDisplayRegion t m, HasImageWriter t m, HasDisplayRegion t m)
+  :: (Reflex t, MonadHold t m, MonadFix m, HasInput t m, HasFocusReader t m, HasTheme t m, HasDisplayRegion t m, HasImageWriter t m, HasDisplayRegion t m)
   => TextInputConfig t
   -> m (TextInput t)
 textInput cfg = do
@@ -51,6 +51,8 @@ textInput cfg = do
   f <- focus
   dh <- displayHeight
   dw <- displayWidth
+  bt <- theme
+  attr0 <- sample bt
   rec v <- foldDyn ($) (_textInputConfig_initialValue cfg) $ mergeWith (.)
         [ uncurry (updateTextZipper (_textInputConfig_tabWidth cfg)) <$> attach (current dh) i
         , _textInputConfig_modify cfg
@@ -59,12 +61,20 @@ textInput cfg = do
             goToDisplayLinePosition mx (st + my) dl
         ]
       click <- mouseDown V.BLeft
-      let cursorAttrs = ffor f $ \x -> if x then cursorAttributes else V.defAttr
-      let rows = (\w s c -> displayLines w V.defAttr c s)
+
+      -- TODO reverseVideo is prob not what we want. Does not work with `darkTheme` in example.hs (cursor is dark rather than light bg)
+      let toCursorAttrs attr = V.withStyle attr V.reverseVideo
+          rowInputDyn = (,,)
             <$> dw
             <*> (mapZipper <$> _textInputConfig_display cfg <*> v)
-            <*> cursorAttrs
+            <*> f
+          toDisplayLines attr (w, s, x)  =
+            let c = if x then toCursorAttrs attr else attr
+            in displayLines w attr c s
+      attrDyn <- holdDyn attr0 $ pushAlways (\_ -> sample bt) (updated rowInputDyn)
+      let rows = ffor2 attrDyn rowInputDyn toDisplayLines
           img = images . _displayLines_spans <$> rows
+
       y <- holdUniqDyn $ _displayLines_cursorY <$> rows
       let newScrollTop :: Int -> (Int, Int) -> Int
           newScrollTop st (h, cursorY)
@@ -81,7 +91,7 @@ textInput cfg = do
 
 -- | A widget that allows multiline text input
 multilineTextInput
-  :: (Reflex t, MonadHold t m, MonadFix m, HasInput t m, HasFocusReader t m, HasDisplayRegion t m, HasImageWriter t m)
+  :: (Reflex t, MonadHold t m, MonadFix m, HasInput t m, HasFocusReader t m, HasTheme t m, HasDisplayRegion t m, HasImageWriter t m)
   => TextInputConfig t
   -> m (TextInput t)
 multilineTextInput cfg = do
@@ -99,7 +109,7 @@ multilineTextInput cfg = do
 -- the computed line count to greedily size the tile when vertically
 -- oriented, and uses the fallback width when horizontally oriented.
 textInputTile
-  :: (Monad m, Reflex t, MonadFix m, HasLayout t m, HasInput t m, HasFocus t m, HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m)
+  :: (Monad m, Reflex t, MonadFix m, HasLayout t m, HasInput t m, HasFocus t m, HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m, HasTheme t m)
   => m (TextInput t)
   -> Dynamic t Int
   -> m (TextInput t)
@@ -111,10 +121,6 @@ textInputTile txt width = do
             Orientation_Row -> width
   return t
 
--- | Default attributes for the text cursor
-cursorAttributes :: V.Attr
-cursorAttributes = V.withStyle V.defAttr V.reverseVideo
-
 -- | Turn a set of display line rows into a list of images (one per line)
 images :: [[Span V.Attr]] -> [V.Image]
 images = map (V.horizCat . map spanToImage)