packages feed

reflex-vty 0.1.2.1 → 0.1.3.0

raw patch · 4 files changed

+69/−4 lines, 4 filesdep ~reflex

Dependency ranges changed: reflex

Files

ChangeLog.md view
@@ -1,7 +1,11 @@ # Revision history for reflex-vty -## Unreleased+## 0.1.3.0+* Add `mouseScroll` to capture scroll wheel events+* Add `scrollableText`: a text display widget that can be scrolled using the mouse or keyboard+* Add widget to the example executable that displays scrollable text +## 0.1.2.1 * Add `keyCombo` function (single-key-combination version of `keyCombos`) * Use upstream `NotReady` instances instead of orphans defined in this package if reflex-0.6.3 is available 
reflex-vty.cabal view
@@ -1,5 +1,5 @@ name: reflex-vty-version: 0.1.2.1+version: 0.1.3.0 synopsis: Reflex FRP host and widgets for vty applications description:   Host and widget library for Reflex-based FRP applications@@ -46,7 +46,7 @@     exception-transformers            >= 0.4.0 && < 0.5,     primitive                         >= 0.6.3 && < 0.7,     ref-tf                            >= 0.4.0 && < 0.5,-    reflex                            >= 0.6.2.4 && < 0.7,+    reflex                            >= 0.6.2 && < 0.7,     time                              >= 1.8.0 && < 1.9,     vty                               >= 5.21 && < 5.26   hs-source-dirs: src
src-bin/example.hs view
@@ -28,6 +28,7 @@  data Example = Example_TextEditor              | Example_Todo+             | Example_ScrollableTextDisplay   deriving (Show, Read, Eq, Ord, Enum, Bounded)  main :: IO ()@@ -40,9 +41,11 @@           fixed 1 $ text "Ctrl+c to quit."         a <- fixed 5 $ textButtonStatic def "Todo List"         b <- fixed 5 $ textButtonStatic def "Text Editor"+        c <- fixed 5 $ textButtonStatic def "Scrollable text display"         return $ leftmost           [ Left Example_Todo <$ a           , Left Example_TextEditor <$ b+          , Left Example_ScrollableTextDisplay <$ c           ]       escapable w = do         void w@@ -53,11 +56,12 @@   rec out <- networkHold buttons $ ffor (switch (current out)) $ \case         Left Example_TextEditor -> escapable testBoxes         Left Example_Todo -> escapable taskList+        Left Example_ScrollableTextDisplay -> escapable scrolling         Right () -> buttons   return $ fforMaybe inp $ \case     V.EvKey (V.KChar 'c') [V.MCtrl] -> Just ()     _ -> Nothing-+  taskList   :: (Reflex t, MonadHold t m, MonadFix m, Adjustable t m, NotReady t m, PostBuild t m, MonadNodeId m)   => VtyWidget t m ()@@ -166,6 +170,12 @@     backspaceOnEmpty v = \case       V.EvKey V.KBS _ | T.null v -> Just ()       _ -> Nothing++scrolling :: (Reflex t, MonadHold t m, MonadFix m, PostBuild t m, MonadNodeId m) => VtyWidget t m ()+scrolling = col $ do+  fixed 2 $ text "Use your mouse wheel or up and down arrows to scroll:"+  out <- fixed 5 $ boxStatic def $ scrollableText never $ "Gallia est omnis divisa in partes tres, quarum unam incolunt Belgae, aliam Aquitani, tertiam qui ipsorum lingua Celtae, nostra Galli appellantur. Hi omnes lingua, institutis, legibus inter se differunt. Gallos ab Aquitanis Garumna flumen, a Belgis Matrona et Sequana dividit. Horum omnium fortissimi sunt Belgae, propterea quod a cultu atque humanitate provinciae longissime absunt, minimeque ad eos mercatores saepe commeant atque ea quae ad effeminandos animos pertinent important, proximique sunt Germanis, qui trans Rhenum incolunt, quibuscum continenter bellum gerunt. Qua de causa Helvetii quoque reliquos Gallos virtute praecedunt, quod fere cotidianis proeliis cum Germanis contendunt, cum aut suis finibus eos prohibent aut ipsi in eorum finibus bellum gerunt. Eorum una pars, quam Gallos obtinere dictum est, initium capit a flumine Rhodano, continetur Garumna flumine, Oceano, finibus Belgarum, attingit etiam ab Sequanis et Helvetiis flumen Rhenum, vergit ad septentriones. Belgae ab extremis Galliae finibus oriuntur, pertinent ad inferiorem partem fluminis Rheni, spectant in septentrionem et orientem solem. Aquitania a Garumna flumine ad Pyrenaeos montes et eam partem Oceani quae est ad Hispaniam pertinet; spectat inter occasum solis et septentriones.\nApud Helvetios longe nobilissimus fuit et ditissimus Orgetorix. Is M. Messala, [et P.] M. Pisone consulibus regni cupiditate inductus coniurationem nobilitatis fecit et civitati persuasit ut de finibus suis cum omnibus copiis exirent: perfacile esse, cum virtute omnibus praestarent, totius Galliae imperio potiri. Id hoc facilius iis persuasit, quod undique loci natura Helvetii continentur: una ex parte flumine Rheno latissimo atque altissimo, qui agrum Helvetium a Germanis dividit; altera ex parte monte Iura altissimo, qui est inter Sequanos et Helvetios; tertia lacu Lemanno et flumine Rhodano, qui provinciam nostram ab Helvetiis dividit. His rebus fiebat ut et minus late vagarentur et minus facile finitimis bellum inferre possent; qua ex parte homines bellandi cupidi magno dolore adficiebantur. Pro multitudine autem hominum et pro gloria belli atque fortitudinis angustos se fines habere arbitrabantur, qui in longitudinem milia passuum CCXL, in latitudinem CLXXX patebant."+  fixed 1 $ text $ ffor out $ \(ix, total) -> "Scrolled to line " <> T.pack (show ix) <> " of " <> T.pack (show total)  todos   :: forall t m.
src/Reflex/Vty/Widget.hs view
@@ -39,6 +39,8 @@   , MouseUp(..)   , mouseDown   , mouseUp+  , ScrollDirection(..)+  , mouseScroll   , pane   , splitV   , splitVDrag@@ -47,6 +49,7 @@   , RichTextConfig(..)   , richText   , text+  , scrollableText   , display   , BoxStyle(..)   , hyphenBoxStyle@@ -393,6 +396,22 @@   }   deriving (Eq, Ord, Show) +-- | Mouse scroll direction+data ScrollDirection = ScrollDirection_Up | ScrollDirection_Down+  deriving (Eq, Ord, Show)++-- | Produce an event that fires when the mouse wheel is scrolled+mouseScroll+  :: (Reflex t, Monad m)+  => VtyWidget t m (Event t ScrollDirection)+mouseScroll = do+  up <- mouseDown V.BScrollUp+  down <- mouseDown V.BScrollDown+  return $ leftmost+    [ ScrollDirection_Up <$ up+    , ScrollDirection_Down <$ down+    ]+ -- | Type synonym for a key and modifier combination type KeyCombo = (V.Key, [V.Modifier]) @@ -624,6 +643,38 @@   => Behavior t Text   -> VtyWidget t m () text = richText def++-- | Scrollable text widget. The output pair exposes the current scroll position and total number of lines (including those+-- that are hidden)+scrollableText+  :: forall t m. (Reflex t, MonadHold t m, MonadFix m)+  => Event t Int+  -- ^ Number of lines to scroll by+  -> Behavior t Text+  -> VtyWidget t m (Behavior t (Int, Int))+  -- ^ (Current scroll position, total number of lines)+scrollableText scrollBy t = do+  dw <- displayWidth+  let imgs = wrap <$> current dw <*> t+  kup <- key V.KUp+  kdown <- key V.KDown+  m <- mouseScroll+  let requestedScroll :: Event t Int+      requestedScroll = leftmost+        [ 1 <$ kdown+        , (-1) <$ kup+        , ffor m $ \case+            ScrollDirection_Up -> (-1)+            ScrollDirection_Down -> 1+        , scrollBy+        ]+      updateLine maxN delta ix = min (max 0 (ix + delta)) maxN+  lineIndex :: Dynamic t Int <- foldDyn (\(maxN, delta) ix -> updateLine (maxN - 1) delta ix) 0 $+    attach (length <$> imgs) requestedScroll+  tellImages $ fmap ((:[]) . V.vertCat) $ drop <$> current lineIndex <*> imgs+  return $ (,) <$> ((+) <$> current lineIndex <*> pure 1) <*> (length <$> imgs)+  where+    wrap maxWidth = concatMap (fmap (V.string V.defAttr . T.unpack) . TZ.wrapWithOffset maxWidth 0) . T.split (=='\n')  -- | Renders any behavior whose value can be converted to -- 'String' as text