@@ -25,6 +25,8 @@ module Reflex.Vty.Widget
2525 , HasDisplaySize(..)
2626 , HasFocus(..)
2727 , HasVtyInput(..)
28+ , DynRegion(..)
29+ , currentRegion
2830 , Region(..)
2931 , regionSize
3032 , regionBlankImage
@@ -35,10 +37,9 @@ module Reflex.Vty.Widget
3537 , mouseDown
3638 , mouseUp
3739 , pane
38− , pane'
3940 , tellImages
4041 , splitV
41− -- , splitVDrag TODO
42+ , splitVDrag
4243 , box
4344 , boxStatic
4445 , RichTextConfig(..)
@@ -66,10 +67,9 @@ import qualified Data.Text.Zipper as TZ
6667import Graphics.Vty (Image)
6768import qualified Graphics.Vty as V
6869import Reflex
70+import Reflex.Class.Orphans
6971import Reflex.NotReady.Class
7072import Reflex.NotReady.Class.Orphans ()
71−import Reflex.BehaviorWriter.Class (tellBehavior)
72−import Reflex.BehaviorWriter.Base (BehaviorWriterT, runBehaviorWriterT)
7373
7474import Reflex.Vty.Host
7575
@@ -194,6 +194,14 @@ data Region = Region
194194 }
195195 deriving (Show, Read, Eq, Ord)
196196
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+
197205-- | The width and height of a 'Region'
198206regionSize :: Region -> (Int, Int)
199207regionSize (Region _ _ w h) = (w, h)
@@ -203,6 +211,10 @@ regionBlankImage :: Region -> Image
203211regionBlankImage r@(Region _ _ width height) =
204212 withinImage r $ V.charFill V.defAttr ' ' width height
205213
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+
206218-- | Translates and crops an 'Image' so that it is contained by
207219-- the given 'Region'.
208220withinImage
@@ -222,53 +234,11 @@ withinImage (Region left top width height)
222234-- that (0,0) is the top-left corner of the region
223235pane
224236 :: (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
226238 -> Dynamic t Bool -- ^ Whether the widget should be focused when the parent is.
227239 -> VtyWidget t m a
228240 -> 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
272242 ctx <- lift ask
273243 let reg = Region <$> l <*> t <*> w <*> h
274244 let ctx' = VtyWidgetCtx
@@ -398,13 +368,22 @@ splitV :: (Reflex t, Monad m)
398368splitV sizeFunD focD wA wB = do
399369 dw <- displayWidth
400370 dh <- displayHeight
401− let regA = (\f w h -> Region 0 0 w (f h)) <$> sizeFunD <*> dw <*> dh
402− regB = (\w h (Region _ _ _ hA) -> Region 0 hA w (h - hA)) <$> dw <*> dh <*> regA
371+ let regA = DynRegion
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+ }
403383 ra <- pane regA (fst <$> focD) wA
404384 rb <- pane regB (snd <$> focD) wB
405385 return (ra,rb)
406386
407−{-
408387-- | A split of the available space into two parts with a draggable separator.
409388-- Starts with half the space allocated to each, and the first pane has focus.
410389-- Clicking in a pane switches focus.
@@ -414,22 +393,23 @@ splitVDrag :: (Reflex t, MonadFix m, MonadHold t m)
414393 -> VtyWidget t m b
415394 -> VtyWidget t m (a,b)
416395splitVDrag wS wA wB = do
417− sz <- displaySize
418− (_, h0) <- sample $ current sz
396+ dh <- displayHeight
397+ dw <- displayWidth
398+ h0 <- sample $ current dh -- TODO
419399 dragE <- drag V.BLeft
420400 let splitter0 = h0 `div` 2
421401 rec splitterCheckpoint <- holdDyn splitter0 $ leftmost [fst <$> ffilter snd dragSplitter, resizeSplitter]
422402 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) ->
424404 fromIntegral x / fromIntegral h
425405 let dragSplitter = fforMaybe (attach (current splitterCheckpoint) dragE) $
426406 \(splitterY, Drag (_, fromY) (_, toY) _ _ end) ->
427407 if splitterY == fromY then Just (toY, end) else Nothing
428− regA = (\(w,_) sp -> Region 0 0 w sp) <$> sz <*> splitterPos
429− regS = (\(w,_) sp -> Region 0 sp w 1) <$> sz <*> splitterPos
430− regB = (\(w,h) sp -> Region 0 (sp + 1) w (h - sp - 1)) <$> sz <*> splitterPos
431− resizeSplitter = ffor (attach (current splitterFrac) (updated sz)) $
432− \(frac, (_,h)) -> round (frac * fromIntegral h)
408+ regA = DynRegion 0 0 dw splitterPos
409+ regS = DynRegion 0 splitterPos dw 1
410+ regB = DynRegion 0 (splitterPos + 1) dw (dh - splitterPos - 1)
411+ resizeSplitter = ffor (attach (current splitterFrac) (updated dh)) $
412+ \(frac, h) -> round (frac * fromIntegral h)
433413 focA <- holdDyn True $ leftmost
434414 [ True <$ mA
435415 , False <$ mB
@@ -443,7 +423,7 @@ splitVDrag wS wA wB = do
443423 m <- mouseDown V.BLeft
444424 x' <- x
445425 return (m, x')
446−-}
426+
447427-- | Fill the background with a particular character.
448428fill :: (Reflex t, Monad m) => Char -> VtyWidget t m ()
449429fill c = do
@@ -501,10 +481,10 @@ box :: (Monad m, Reflex t)
501481box boxStyle child = do
502482 dh <- displayHeight
503483 dw <- displayWidth
504− let boxReg = liftA2 (\w h -> Region 0 0 w h) dw dh
505− innerReg = liftA2 (\w h -> Region 1 1 (w - 2) (h - 2)) dw dh
506− tellImages (boxImages <$> boxStyle <*> current boxReg)
507− tellImages (fmap (\r -> [regionBlankImage r]) (current innerReg))
484+ let boxReg = DynRegion (pure 0) (pure 0) dw dh
485+ innerReg = DynRegion (pure 1) (pure 1) (subtract 2 <$> dw) (subtract 2 <$> dh)
486+ tellImages (boxImages <$> boxStyle <*> currentRegion boxReg)
487+ tellImages (fmap (\r -> [regionBlankImage r]) (currentRegion innerReg))
508488 pane innerReg (pure True) child
509489 where
510490 boxImages :: BoxStyle -> Region -> [Image]