git.iko.soy/reflex-vty
on develop help sign in
Update splitVDrag and examples to use DynRegion
0e7e1f1Ali Abrar
reflex-vty.cabal+1
compare with develop
unifiedsplit
@@ -23,6 +23,7 @@ library
23 , Reflex.Vty.Widget.Input.Text
23 , Reflex.Vty.Widget.Input.Text
24 , Data.Text.Zipper
24 , Data.Text.Zipper
25 , Control.Monad.Writer.Adjustable
25 , Control.Monad.Writer.Adjustable
26+ , Reflex.Class.Orphans
26 , Reflex.Class.Switchable
27 , Reflex.Class.Switchable
27 , Reflex.NotReady.Class.Orphans
28 , Reflex.NotReady.Class.Orphans
28 , Reflex.Spider.Orphans
29 , Reflex.Spider.Orphans
src-bin/example.hs+26−21
@@ -21,27 +21,39 @@ import qualified Data.Text as T
21import qualified Data.Text.Zipper as TZ
21import qualified Data.Text.Zipper as TZ
22import qualified Graphics.Vty as V
22import qualified Graphics.Vty as V
23import Reflex
23import Reflex
24+import Reflex.Class.Orphans
24import Reflex.Network
25import Reflex.Network
25import Reflex.Class.Switchable
26import Reflex.Class.Switchable
26import Reflex.NotReady.Class
27import Reflex.NotReady.Class
27import Reflex.Vty
28import Reflex.Vty
28
29
30+import Data.Tree
31+
32+-- Unlimited Stack
33+ -- Parent provides orientation and maximum cross-dimension size
34+ -- Each child takes as much main-dimension space as it wants and reports what it took
35+ -- Parent offsets each child so that it does not overlap with other children
36+ -- If parent runs of out space, parent provides a scroll bar
37+
29data Example = Example_TextEditor
38data Example = Example_TextEditor
30 | Example_Todo
39 | Example_Todo
31 deriving (Show, Read, Eq, Ord, Enum, Bounded)
40 deriving (Show, Read, Eq, Ord, Enum, Bounded)
32
41
42+div' :: (Integral a, Applicative f) => f a ->f a -> f a
43+div' = liftA2 div
44+
33main :: IO ()
45main :: IO ()
34main = mainWidget $ do
46main = mainWidget $ do
35 inp <- input
47 inp <- input
36− taskList
37
48
38−{-
49+ w <- displayWidth
50+ h <- displayHeight
39 let buttons = do
51 let buttons = do
40 text $ pure "Select an example. Esc will bring you back here. Ctrl+c to quit."
52 text $ pure "Select an example. Esc will bring you back here. Ctrl+c to quit."
41− let region1 = ffor size $ \(w,h) ->
53+ let w' = fmap (`div`6) w
42− Region (w `div` 6) (h `div` 6) (w `div` 6) (h `div` 6)
54+ h' = fmap (`div`6) h
43− region2 = ffor size $ \(w,h) ->
55+ region1 = DynRegion w' h' w' h'
44− Region (2 * w `div` 6) (h `div` 6) (w `div` 6) (h `div` 6)
56+ region2 = DynRegion (2 * w') h' w' h'
45 todo' <- pane region1 (pure True) $ textButtonStatic def "Todo List"
57 todo' <- pane region1 (pure True) $ textButtonStatic def "Todo List"
46 editor <- pane region2 (pure True) $ textButtonStatic def "Text Editor"
58 editor <- pane region2 (pure True) $ textButtonStatic def "Text Editor"
47 return $ leftmost
59 return $ leftmost
@@ -59,7 +71,6 @@ main = mainWidget $ do
59 Left Example_Todo -> escapable taskList
71 Left Example_Todo -> escapable taskList
60 Right () -> buttons
72 Right () -> buttons
61
73
62−-}
63 return $ fforMaybe inp $ \case
74 return $ fforMaybe inp $ \case
64 V.EvKey (V.KChar 'c') [V.MCtrl] -> Just ()
75 V.EvKey (V.KChar 'c') [V.MCtrl] -> Just ()
65 _ -> Nothing
76 _ -> Nothing
@@ -80,18 +91,16 @@ taskList = do
80 splitV (pure (subtract 3)) (pure (True, True)) btn (display $ current m)
91 splitV (pure (subtract 3)) (pure (True, True)) btn (display $ current m)
81 return ()
92 return ()
82
93
83−{-
84testBoxes :: (Reflex t, MonadHold t m, MonadFix m) => VtyWidget t m ()
94testBoxes :: (Reflex t, MonadHold t m, MonadFix m) => VtyWidget t m ()
85testBoxes = do
95testBoxes = do
86 dw <- displayWidth
96 dw <- displayWidth
87 dh <- displayHeight
97 dh <- displayHeight
88− let region1 = liftA2 (\w h -> Region (w `div` 6) (h `div` 6) (w `div` 2) (h `div` 2)) dw dh
98+ let region1 = DynRegion (div' dw 6) (div' dh 6) (div' dw 2) (div' dh 2)
89− region2 = liftA2 (\w h -> Region (w `div` 4) (h `div` 4) (2 * (w `div` 3)) (2*(h `div` 3))) dw dh
99+ region2 = DynRegion (div' dw 4) (div' dh 4) (2 * div' dw 3) (2 * div' dh 3)
90 pane region1 (constDyn False) . boxStatic singleBoxStyle $ debugInput
100 pane region1 (constDyn False) . boxStatic singleBoxStyle $ debugInput
91 _ <- pane region2 (constDyn True) . boxStatic singleBoxStyle $
101 _ <- pane region2 (constDyn True) . boxStatic singleBoxStyle $
92 splitVDrag (hRule doubleBoxStyle) (boxStatic roundedBoxStyle $ multilineTextInput def) (boxStatic roundedBoxStyle dragTest)
102 splitVDrag (hRule doubleBoxStyle) (boxStatic roundedBoxStyle $ multilineTextInput def) (boxStatic roundedBoxStyle dragTest)
93 return ()
103 return ()
94−-}
95
104
96debugFocus :: (Reflex t, Monad m) => VtyWidget t m ()
105debugFocus :: (Reflex t, Monad m) => VtyWidget t m ()
97debugFocus = do
106debugFocus = do
@@ -137,14 +146,14 @@ todo
137todo t0 = do
146todo t0 = do
138 w <- displayWidth
147 w <- displayWidth
139 rec let checkboxWidth = 3
148 rec let checkboxWidth = 3
140− checkboxRegion = pure $ Region 0 0 checkboxWidth 1
149+ checkboxRegion = DynRegion 0 0 checkboxWidth 1
141 labelHeight = _textInput_lines ti
150 labelHeight = _textInput_lines ti
142− labelWidth = ffor w $ \w' -> w' - 1 - checkboxWidth
151+ labelWidth = w - 1 - checkboxWidth
143− labelLeft = constDyn $ checkboxWidth + 1
152+ labelLeft = checkboxWidth + 1
144 labelTop = constDyn 0
153 labelTop = constDyn 0
145− -- labelRegion = liftA2 (\w' h -> Region (checkboxWidth + 1) 0 (w' - 1 - checkboxWidth) h) w (_textInput_lines ti)
154+ labelRegion = DynRegion labelLeft labelTop labelWidth labelHeight
146 value <- pane checkboxRegion (pure True) $ checkbox def $ _todo_done t0
155 value <- pane checkboxRegion (pure True) $ checkbox def $ _todo_done t0
147− (ti, d) <- pane' labelLeft labelTop labelWidth labelHeight (pure True) $ do
156+ (ti, d) <- pane labelRegion (pure True) $ do
148 i <- input
157 i <- input
149 v <- textInput $ def { _textInputConfig_initialValue = TZ.fromText $ _todo_label t0 }
158 v <- textInput $ def { _textInputConfig_initialValue = TZ.fromText $ _todo_label t0 }
150 let deleteSelf = attachWithMaybe backspaceOnEmpty (current $ _textInput_value v) i
159 let deleteSelf = attachWithMaybe backspaceOnEmpty (current $ _textInput_value v) i
@@ -171,11 +180,7 @@ todos todos0 newTodo = do
171 let reg = zipDynWith (\w' ts ->
180 let reg = zipDynWith (\w' ts ->
172 let l = Map.size $ Map.takeWhileAntitone (<row) ts
181 let l = Map.size $ Map.takeWhileAntitone (<row) ts
173 in Region 0 l w' 1) w todosMap
182 in Region 0 l w' 1) w todosMap
174− pane'
175− (pure 0)
176− (fromMaybe 0 . Map.lookup row <$> offsets)
183+ pane (DynRegion 0 (fromMaybe 0 . Map.lookup row <$> offsets) w (fromMaybe 1 . Map.lookup row <$> heights))
177− w
178− (fromMaybe 1 . Map.lookup row <$> heights)
179 (fmap (==row) selected) $ do
184 (fmap (==row) selected) $ do
180 e <- mouseUp
185 e <- mouseUp
181 r <- todo t
186 r <- todo t
src/Reflex/Class/Orphans.hsnew file+19
@@ -0,0 +1,19 @@
1+{-
2+Module: Reflex.Class.Orphans
3+Description: Orphan instances for Dynamic. These should be upstreamed.
4+-}
5+module Reflex.Class.Orphans where
6+
7+import Control.Applicative
8+import Reflex.Class
9+
10+instance (Num a, Reflex t) => Num (Dynamic t a) where
11+ (+) = liftA2 (+)
12+ (*) = liftA2 (*)
13+ abs = fmap abs
14+ signum = fmap signum
15+ fromInteger = pure . fromInteger
16+ negate = fmap negate
17+ (-) = liftA2 (-)
18+
19+
src/Reflex/Vty/Widget.hs+44−64
@@ -25,6 +25,8 @@ module Reflex.Vty.Widget
25 , HasDisplaySize(..)
25 , HasDisplaySize(..)
26 , HasFocus(..)
26 , HasFocus(..)
27 , HasVtyInput(..)
27 , HasVtyInput(..)
28+ , DynRegion(..)
29+ , currentRegion
28 , Region(..)
30 , Region(..)
29 , regionSize
31 , regionSize
30 , regionBlankImage
32 , regionBlankImage
@@ -35,10 +37,9 @@ module Reflex.Vty.Widget
35 , mouseDown
37 , mouseDown
36 , mouseUp
38 , mouseUp
37 , pane
39 , pane
38− , pane'
39 , tellImages
40 , tellImages
40 , splitV
41 , splitV
41− -- , splitVDrag TODO
42+ , splitVDrag
42 , box
43 , box
43 , boxStatic
44 , boxStatic
44 , RichTextConfig(..)
45 , RichTextConfig(..)
@@ -66,10 +67,9 @@ import qualified Data.Text.Zipper as TZ
66import Graphics.Vty (Image)
67import Graphics.Vty (Image)
67import qualified Graphics.Vty as V
68import qualified Graphics.Vty as V
68import Reflex
69import Reflex
70+import Reflex.Class.Orphans
69import Reflex.NotReady.Class
71import Reflex.NotReady.Class
70import Reflex.NotReady.Class.Orphans ()
72import Reflex.NotReady.Class.Orphans ()
71−import Reflex.BehaviorWriter.Class (tellBehavior)
72−import Reflex.BehaviorWriter.Base (BehaviorWriterT, runBehaviorWriterT)
73
73
74import Reflex.Vty.Host
74import Reflex.Vty.Host
75
75
@@ -194,6 +194,14 @@ data Region = Region
194 }
194 }
195 deriving (Show, Read, Eq, Ord)
195 deriving (Show, Read, Eq, Ord)
196
196
197+-- | A dynamic chunk of the display area
198+data DynRegion t = DynRegion
199+ { _dynRegion_left :: Dynamic t Int
200+ , _dynRegion_top :: Dynamic t Int
201+ , _dynRegion_width :: Dynamic t Int
202+ , _dynRegion_height :: Dynamic t Int
203+ }
204+
197-- | The width and height of a 'Region'
205-- | The width and height of a 'Region'
198regionSize :: Region -> (Int, Int)
206regionSize :: Region -> (Int, Int)
199regionSize (Region _ _ w h) = (w, h)
207regionSize (Region _ _ w h) = (w, h)
@@ -203,6 +211,10 @@ regionBlankImage :: Region -> Image
203regionBlankImage r@(Region _ _ width height) =
211regionBlankImage r@(Region _ _ width height) =
204 withinImage r $ V.charFill V.defAttr ' ' width height
212 withinImage r $ V.charFill V.defAttr ' ' width height
205
213
214+-- | A behavior of the current display area represented by a 'DynRegion'
215+currentRegion :: Reflex t => DynRegion t -> Behavior t Region
216+currentRegion (DynRegion l t w h) = Region <$> current l <*> current t <*> current w <*> current h
217+
206-- | Translates and crops an 'Image' so that it is contained by
218-- | Translates and crops an 'Image' so that it is contained by
207-- the given 'Region'.
219-- the given 'Region'.
208withinImage
220withinImage
@@ -222,53 +234,11 @@ withinImage (Region left top width height)
222-- that (0,0) is the top-left corner of the region
234-- that (0,0) is the top-left corner of the region
223pane
235pane
224 :: (Reflex t, Monad m)
236 :: (Reflex t, Monad m)
225− => Dynamic t Region -- ^ Region into which we should draw the widget (in coordinates relative to our own)
237+ => DynRegion t
226 -> Dynamic t Bool -- ^ Whether the widget should be focused when the parent is.
238 -> Dynamic t Bool -- ^ Whether the widget should be focused when the parent is.
227 -> VtyWidget t m a
239 -> VtyWidget t m a
228 -> VtyWidget t m a
240 -> VtyWidget t m a
229−pane reg foc child = VtyWidget $ do
230− ctx <- lift ask
231− let ctx' = VtyWidgetCtx
232− { _vtyWidgetCtx_input = leftmost -- TODO: think about this leftmost more.
233− [ fmapMaybe id $
234− attachWith (\(r,f) e -> filterInput r f e)
235− (liftA2 (,) (current reg) (current foc))
236− (_vtyWidgetCtx_input ctx)
237− ]
238− , _vtyWidgetCtx_focus = liftA2 (&&) (_vtyWidgetCtx_focus ctx) foc
239− , _vtyWidgetCtx_width = fmap (fst . regionSize) reg
240− , _vtyWidgetCtx_height = fmap (snd . regionSize) reg
241− }
242− (result, images) <- lift . lift $ runVtyWidget ctx' child
243− let images' = liftA2 (\r is -> map (withinImage r) is) (current reg) images
244− tellImages images'
245− return result
246− where
247− filterInput :: Region -> Bool -> VtyEvent -> Maybe VtyEvent
248− filterInput (Region l t w h) focused e = case e of
249− V.EvKey _ _ | not focused -> Nothing
250− V.EvMouseDown x y btn m -> mouse (\u v -> V.EvMouseDown u v btn m) x y
251− V.EvMouseUp x y btn -> mouse (\u v -> V.EvMouseUp u v btn) x y
252− _ -> Just e
253− where
254− mouse con x y
255− | or [ x < l
256− , y < t
257− , x >= l + w
258− , y >= t + h ] = Nothing
259− | otherwise =
260− Just (con (x - l) (y - t))
261−
262−pane'
263− :: (Reflex t, Monad m)
264− => Dynamic t Int
265− -> Dynamic t Int
266− -> Dynamic t Int
267− -> Dynamic t Int
268− -> Dynamic t Bool -- ^ Whether the widget should be focused when the parent is.
269− -> VtyWidget t m a
270− -> VtyWidget t m a
271−pane' l t w h foc child = VtyWidget $ do
241+pane (DynRegion l t w h) foc child = VtyWidget $ do
272 ctx <- lift ask
242 ctx <- lift ask
273 let reg = Region <$> l <*> t <*> w <*> h
243 let reg = Region <$> l <*> t <*> w <*> h
274 let ctx' = VtyWidgetCtx
244 let ctx' = VtyWidgetCtx
@@ -398,13 +368,22 @@ splitV :: (Reflex t, Monad m)
398splitV sizeFunD focD wA wB = do
368splitV sizeFunD focD wA wB = do
399 dw <- displayWidth
369 dw <- displayWidth
400 dh <- displayHeight
370 dh <- displayHeight
401− let regA = (\f w h -> Region 0 0 w (f h)) <$> sizeFunD <*> dw <*> dh
371+ let regA = DynRegion
402− regB = (\w h (Region _ _ _ hA) -> Region 0 hA w (h - hA)) <$> dw <*> dh <*> regA
372+ { _dynRegion_left = pure 0
373+ , _dynRegion_top = pure 0
374+ , _dynRegion_width = dw
375+ , _dynRegion_height = sizeFunD <*> dh
376+ }
377+ regB = DynRegion
378+ { _dynRegion_left = pure 0
379+ , _dynRegion_top = _dynRegion_height regA
380+ , _dynRegion_width = dw
381+ , _dynRegion_height = liftA2 (-) dh (_dynRegion_height regA)
382+ }
403 ra <- pane regA (fst <$> focD) wA
383 ra <- pane regA (fst <$> focD) wA
404 rb <- pane regB (snd <$> focD) wB
384 rb <- pane regB (snd <$> focD) wB
405 return (ra,rb)
385 return (ra,rb)
406
386
407−{-
408-- | A split of the available space into two parts with a draggable separator.
387-- | A split of the available space into two parts with a draggable separator.
409-- Starts with half the space allocated to each, and the first pane has focus.
388-- Starts with half the space allocated to each, and the first pane has focus.
410-- Clicking in a pane switches focus.
389-- Clicking in a pane switches focus.
@@ -414,22 +393,23 @@ splitVDrag :: (Reflex t, MonadFix m, MonadHold t m)
414 -> VtyWidget t m b
393 -> VtyWidget t m b
415 -> VtyWidget t m (a,b)
394 -> VtyWidget t m (a,b)
416splitVDrag wS wA wB = do
395splitVDrag wS wA wB = do
417− sz <- displaySize
396+ dh <- displayHeight
397+ dw <- displayWidth
418− (_, h0) <- sample $ current sz
398+ h0 <- sample $ current dh -- TODO
419 dragE <- drag V.BLeft
399 dragE <- drag V.BLeft
420 let splitter0 = h0 `div` 2
400 let splitter0 = h0 `div` 2
421 rec splitterCheckpoint <- holdDyn splitter0 $ leftmost [fst <$> ffilter snd dragSplitter, resizeSplitter]
401 rec splitterCheckpoint <- holdDyn splitter0 $ leftmost [fst <$> ffilter snd dragSplitter, resizeSplitter]
422 splitterPos <- holdDyn splitter0 $ leftmost [fst <$> dragSplitter, resizeSplitter]
402 splitterPos <- holdDyn splitter0 $ leftmost [fst <$> dragSplitter, resizeSplitter]
423− splitterFrac <- holdDyn ((1::Double) / 2) $ ffor (attach (current sz) (fst <$> dragSplitter)) $ \((_,h),x) ->
403+ splitterFrac <- holdDyn ((1::Double) / 2) $ ffor (attach (current dh) (fst <$> dragSplitter)) $ \(h, x) ->
424 fromIntegral x / fromIntegral h
404 fromIntegral x / fromIntegral h
425 let dragSplitter = fforMaybe (attach (current splitterCheckpoint) dragE) $
405 let dragSplitter = fforMaybe (attach (current splitterCheckpoint) dragE) $
426 \(splitterY, Drag (_, fromY) (_, toY) _ _ end) ->
406 \(splitterY, Drag (_, fromY) (_, toY) _ _ end) ->
427 if splitterY == fromY then Just (toY, end) else Nothing
407 if splitterY == fromY then Just (toY, end) else Nothing
428− regA = (\(w,_) sp -> Region 0 0 w sp) <$> sz <*> splitterPos
408+ regA = DynRegion 0 0 dw splitterPos
429− regS = (\(w,_) sp -> Region 0 sp w 1) <$> sz <*> splitterPos
409+ regS = DynRegion 0 splitterPos dw 1
430− regB = (\(w,h) sp -> Region 0 (sp + 1) w (h - sp - 1)) <$> sz <*> splitterPos
410+ regB = DynRegion 0 (splitterPos + 1) dw (dh - splitterPos - 1)
431− resizeSplitter = ffor (attach (current splitterFrac) (updated sz)) $
411+ resizeSplitter = ffor (attach (current splitterFrac) (updated dh)) $
432− \(frac, (_,h)) -> round (frac * fromIntegral h)
412+ \(frac, h) -> round (frac * fromIntegral h)
433 focA <- holdDyn True $ leftmost
413 focA <- holdDyn True $ leftmost
434 [ True <$ mA
414 [ True <$ mA
435 , False <$ mB
415 , False <$ mB
@@ -443,7 +423,7 @@ splitVDrag wS wA wB = do
443 m <- mouseDown V.BLeft
423 m <- mouseDown V.BLeft
444 x' <- x
424 x' <- x
445 return (m, x')
425 return (m, x')
446−-}
426+
447-- | Fill the background with a particular character.
427-- | Fill the background with a particular character.
448fill :: (Reflex t, Monad m) => Char -> VtyWidget t m ()
428fill :: (Reflex t, Monad m) => Char -> VtyWidget t m ()
449fill c = do
429fill c = do
@@ -501,10 +481,10 @@ box :: (Monad m, Reflex t)
501box boxStyle child = do
481box boxStyle child = do
502 dh <- displayHeight
482 dh <- displayHeight
503 dw <- displayWidth
483 dw <- displayWidth
504− let boxReg = liftA2 (\w h -> Region 0 0 w h) dw dh
484+ let boxReg = DynRegion (pure 0) (pure 0) dw dh
505− innerReg = liftA2 (\w h -> Region 1 1 (w - 2) (h - 2)) dw dh
485+ innerReg = DynRegion (pure 1) (pure 1) (subtract 2 <$> dw) (subtract 2 <$> dh)
506− tellImages (boxImages <$> boxStyle <*> current boxReg)
486+ tellImages (boxImages <$> boxStyle <*> currentRegion boxReg)
507− tellImages (fmap (\r -> [regionBlankImage r]) (current innerReg))
487+ tellImages (fmap (\r -> [regionBlankImage r]) (currentRegion innerReg))
508 pane innerReg (pure True) child
488 pane innerReg (pure True) child
509 where
489 where
510 boxImages :: BoxStyle -> Region -> [Image]
490 boxImages :: BoxStyle -> Region -> [Image]
src/Reflex/Vty/Widget/Input/Text.hs+3
@@ -32,6 +32,9 @@ data TextInputConfig t = TextInputConfig
32instance Reflex t => Default (TextInputConfig t) where
32instance Reflex t => Default (TextInputConfig t) where
33 def = TextInputConfig empty never 4
33 def = TextInputConfig empty never 4
34
34
35+-- | The output produced by text input widgets, including the text
36+-- value and the number of display lines (post-wrapping). Note that some
37+-- display lines may not be visible due to scrolling.
35data TextInput t = TextInput
38data TextInput t = TextInput
36 { _textInput_value :: Dynamic t Text
39 { _textInput_value :: Dynamic t Text
37 , _textInput_lines :: Dynamic t Int
40 , _textInput_lines :: Dynamic t Int