74b505a · reflex-vty · git.iko.soy

git.iko.soy/reflex-vty

on develop help sign in

Merge pull request #13 from reflex-frp/aa-scrollabletext

74b505aAli Abrar7 years ago

ChangeLog.md+5−1

compare with develop

unifiedsplit

@@ -1,7 +1,11 @@

1# Revision history for reflex-vty

3−## 0.1.2.1

3+## 0.1.3.0

4+* Add `mouseScroll` to capture scroll wheel events

5+* Add `scrollableText`: a text display widget that can be scrolled using the mouse or keyboard

6+* Add widget to the example executable that displays scrollable text

8+## 0.1.2.1

5* Add `keyCombo` function (single-key-combination version of `keyCombos`)

9* Add `keyCombo` function (single-key-combination version of `keyCombos`)

6* Use upstream `NotReady` instances instead of orphans defined in this package if reflex-0.6.3 is available

10* Use upstream `NotReady` instances instead of orphans defined in this package if reflex-0.6.3 is available

reflex-platform/stable/github.json+2−2

@@ -2,6 +2,6 @@

2 "owner": "reflex-frp",

3 "repo": "reflex-platform",

4 "branch": "master",

5− "rev": "04672fbd55bb6d97d4efcc3657af9f4bc0d1215d",

5+ "rev": "510b990d0b11f0626afbec5fe8575b5b2395391b",

6− "sha256": "1xzvjzrclh1qvw7ccnpwdhpg534ghyfg4kz1zdy063wr50hsqgna"

6+ "sha256": "09cmahsbxr0963wq171c7j139iyzz49hramr4v9nsf684wcwkngv"

reflex-platform/unstable/github.json+2−2

@@ -2,6 +2,6 @@

2 "owner": "reflex-frp",

3 "repo": "reflex-platform",

4 "branch": "ghc865-nixpkgs1903",

5− "rev": "33907557fad929a19cd82df44bb4cd0276e1ffa5",

5+ "rev": "02389f2a709a3f28ae2f3224d2c8ba81cc64c40b",

6− "sha256": "1066pydpk7w8yhq9nlcv2r21zmiir7nr6c4hr10gdf6ar3vs965a"

6+ "sha256": "10g2yhf4la929aa1km0184asikmn0kayzlra16mqmni2f684v3z3"

reflex-vty.cabal+2−2

@@ -1,5 +1,5 @@

1name: reflex-vty

2−version: 0.1.2.1

2+version: 0.1.3.0

3synopsis: Reflex FRP host and widgets for vty applications

4description:

5 Host and widget library for Reflex-based FRP applications

@@ -46,7 +46,7 @@ library

46 exception-transformers >= 0.4.0 && < 0.5,

47 primitive >= 0.6.3 && < 0.7,

48 ref-tf >= 0.4.0 && < 0.5,

49− reflex >= 0.6.2.4 && < 0.7,

49+ reflex >= 0.6.2 && < 0.7,

50 time >= 1.8.0 && < 1.9,

51 vty >= 5.21 && < 5.26

52 hs-source-dirs: src

src-bin/example.hs+11−1

@@ -28,6 +28,7 @@ import Reflex.Vty

29data Example = Example_TextEditor

30 | Example_Todo

31+ | Example_ScrollableTextDisplay

31 deriving (Show, Read, Eq, Ord, Enum, Bounded)

32 deriving (Show, Read, Eq, Ord, Enum, Bounded)

33main :: IO ()

34main :: IO ()

@@ -40,9 +41,11 @@ main = mainWidget $ do

40 fixed 1 $ text "Ctrl+c to quit."

41 fixed 1 $ text "Ctrl+c to quit."

41 a <- fixed 5 $ textButtonStatic def "Todo List"

42 a <- fixed 5 $ textButtonStatic def "Todo List"

42 b <- fixed 5 $ textButtonStatic def "Text Editor"

43 b <- fixed 5 $ textButtonStatic def "Text Editor"

44+ c <- fixed 5 $ textButtonStatic def "Scrollable text display"

43 return $ leftmost

45 return $ leftmost

44 [ Left Example_Todo <$ a

46 [ Left Example_Todo <$ a

45 , Left Example_TextEditor <$ b

47 , Left Example_TextEditor <$ b

48+ , Left Example_ScrollableTextDisplay <$ c

46 ]

49 ]

47 escapable w = do

50 escapable w = do

48 void w

51 void w

@@ -53,11 +56,12 @@ main = mainWidget $ do

53 rec out <- networkHold buttons $ ffor (switch (current out)) $ \case

56 rec out <- networkHold buttons $ ffor (switch (current out)) $ \case

54 Left Example_TextEditor -> escapable testBoxes

57 Left Example_TextEditor -> escapable testBoxes

55 Left Example_Todo -> escapable taskList

58 Left Example_Todo -> escapable taskList

59+ Left Example_ScrollableTextDisplay -> escapable scrolling

56 Right () -> buttons

60 Right () -> buttons

57 return $ fforMaybe inp $ \case

61 return $ fforMaybe inp $ \case

58 V.EvKey (V.KChar 'c') [V.MCtrl] -> Just ()

62 V.EvKey (V.KChar 'c') [V.MCtrl] -> Just ()

59 _ -> Nothing

63 _ -> Nothing

60−

64+

61taskList

65taskList

62 :: (Reflex t, MonadHold t m, MonadFix m, Adjustable t m, NotReady t m, PostBuild t m, MonadNodeId m)

66 :: (Reflex t, MonadHold t m, MonadFix m, Adjustable t m, NotReady t m, PostBuild t m, MonadNodeId m)

63 => VtyWidget t m ()

67 => VtyWidget t m ()

@@ -167,6 +171,12 @@ todo t0 = do

167 V.EvKey V.KBS _ | T.null v -> Just ()

171 V.EvKey V.KBS _ | T.null v -> Just ()

168 _ -> Nothing

172 _ -> Nothing

169

173

174+scrolling :: (Reflex t, MonadHold t m, MonadFix m, PostBuild t m, MonadNodeId m) => VtyWidget t m ()

175+scrolling = col $ do

176+ fixed 2 $ text "Use your mouse wheel or up and down arrows to scroll:"

177+ 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."

178+ fixed 1 $ text $ ffor out $ \(ix, total) -> "Scrolled to line " <> T.pack (show ix) <> " of " <> T.pack (show total)

179+

170todos

180todos

171 :: forall t m.

181 :: forall t m.

172 ( MonadHold t m

182 ( MonadHold t m

src/Reflex/Vty/Widget.hs+51

@@ -39,6 +39,8 @@ module Reflex.Vty.Widget

39 , MouseUp(..)

40 , mouseDown

41 , mouseUp

42+ , ScrollDirection(..)

43+ , mouseScroll

42 , pane

44 , pane

43 , splitV

45 , splitV

44 , splitVDrag

46 , splitVDrag

@@ -47,6 +49,7 @@ module Reflex.Vty.Widget

47 , RichTextConfig(..)

49 , RichTextConfig(..)

48 , richText

50 , richText

49 , text

51 , text

52+ , scrollableText

50 , display

53 , display

51 , BoxStyle(..)

54 , BoxStyle(..)

52 , hyphenBoxStyle

55 , hyphenBoxStyle

@@ -393,6 +396,22 @@ data MouseUp = MouseUp

393 }

396 }

394 deriving (Eq, Ord, Show)

397 deriving (Eq, Ord, Show)

395

398

399+-- | Mouse scroll direction

400+data ScrollDirection = ScrollDirection_Up | ScrollDirection_Down

401+ deriving (Eq, Ord, Show)

402+

403+-- | Produce an event that fires when the mouse wheel is scrolled

404+mouseScroll

405+ :: (Reflex t, Monad m)

406+ => VtyWidget t m (Event t ScrollDirection)

407+mouseScroll = do

408+ up <- mouseDown V.BScrollUp

409+ down <- mouseDown V.BScrollDown

410+ return $ leftmost

411+ [ ScrollDirection_Up <$ up

412+ , ScrollDirection_Down <$ down

413+ ]

414+

396-- | Type synonym for a key and modifier combination

415-- | Type synonym for a key and modifier combination

397type KeyCombo = (V.Key, [V.Modifier])

416type KeyCombo = (V.Key, [V.Modifier])

398

417

@@ -625,6 +644,38 @@ text

625 -> VtyWidget t m ()

644 -> VtyWidget t m ()

626text = richText def

645text = richText def

627

646

647+-- | Scrollable text widget. The output pair exposes the current scroll position and total number of lines (including those

648+-- that are hidden)

649+scrollableText

650+ :: forall t m. (Reflex t, MonadHold t m, MonadFix m)

651+ => Event t Int

652+ -- ^ Number of lines to scroll by

653+ -> Behavior t Text

654+ -> VtyWidget t m (Behavior t (Int, Int))

655+ -- ^ (Current scroll position, total number of lines)

656+scrollableText scrollBy t = do

657+ dw <- displayWidth

658+ let imgs = wrap <$> current dw <*> t

659+ kup <- key V.KUp

660+ kdown <- key V.KDown

661+ m <- mouseScroll

662+ let requestedScroll :: Event t Int

663+ requestedScroll = leftmost

664+ [ 1 <$ kdown

665+ , (-1) <$ kup

666+ , ffor m $ \case

667+ ScrollDirection_Up -> (-1)

668+ ScrollDirection_Down -> 1

669+ , scrollBy

670+ ]

671+ updateLine maxN delta ix = min (max 0 (ix + delta)) maxN

672+ lineIndex :: Dynamic t Int <- foldDyn (\(maxN, delta) ix -> updateLine (maxN - 1) delta ix) 0 $

673+ attach (length <$> imgs) requestedScroll

674+ tellImages $ fmap ((:[]) . V.vertCat) $ drop <$> current lineIndex <*> imgs

675+ return $ (,) <$> ((+) <$> current lineIndex <*> pure 1) <*> (length <$> imgs)

676+ where

677+ wrap maxWidth = concatMap (fmap (V.string V.defAttr . T.unpack) . TZ.wrapWithOffset maxWidth 0) . T.split (=='\n')

678+

628-- | Renders any behavior whose value can be converted to

679-- | Renders any behavior whose value can be converted to

629-- 'String' as text

680-- 'String' as text

630display

681display