@@ -32,7 +32,6 @@ module Reflex.Vty.Widget
3232 , tellShutdown
3333 , splitV
3434 , splitVDrag
35− , fractionSz
3635 , box
3736 , text
3837 , display
@@ -91,6 +90,7 @@ instance (Reflex t) => Monoid (VtyWidgetOut t) where
9190 mempty = VtyWidgetOut mempty mempty
9291 mappend wo wo' = wo <> wo'
9392
93+-- | A widget that can read its context and produce image output
9494newtype VtyWidget t m a = VtyWidget
9595 { unVtyWidget :: WriterT (VtyWidgetOut t) (ReaderT (VtyWidgetCtx t) m) a
9696 }
@@ -136,42 +136,50 @@ mainWidget child = do
136136 vty <- getDefaultVty
137137 mainWidgetWithHandle vty child
138138
139+-- | A class for things that know their own display size dimensions
139140class (Reflex t, Monad m) => HasDisplaySize t m | m -> t where
140141 displaySize :: m (Dynamic t (Int, Int))
141142
142143instance (Reflex t, Monad m) => HasDisplaySize t (VtyWidget t m) where
143144 displaySize = VtyWidget . lift $ asks _vtyWidgetCtx_size
144145
146+-- | Retrieve the display width (columns)
145147displayWidth :: HasDisplaySize t m => m (Dynamic t Int)
146148displayWidth = fmap fst <$> displaySize
147149
150+-- | Retrieve the display height (rows)
148151displayHeight :: HasDisplaySize t m => m (Dynamic t Int)
149152displayHeight = fmap snd <$> displaySize
150153
154+-- | A class for things that can receive vty events as input
151155class HasVtyInput t m | m -> t where
152156 input :: m (Event t VtyEvent)
153157
154158instance (Reflex t, Monad m) => HasVtyInput t (VtyWidget t m) where
155159 input = VtyWidget . lift $ asks _vtyWidgetCtx_input
156160
161+-- | A class for things that can dynamically gain and lose focus
157162class HasFocus t m | m -> t where
158163 focus :: m (Dynamic t Bool)
159164
160165instance (Reflex t, Monad m) => HasFocus t (VtyWidget t m) where
161166 focus = VtyWidget . lift $ asks _vtyWidgetCtx_focus
162167
168+-- | A class for widgets that can produce images to draw to the display
163169class (Reflex t, Monad m) => ImageWriter t m | m -> t where
164170 tellImages :: Behavior t [Image] -> m ()
165171
166172instance (Reflex t, Monad m) => ImageWriter t (VtyWidget t m) where
167173 tellImages imgs = VtyWidget $ tell (mempty { _vtyWidgetOut_images = imgs })
168174
175+-- | A class for things that can shut down the vty application
169176class (Reflex t, Monad m) => Shutdown t m where
170177 tellShutdown :: Event t () -> m ()
171178
172179instance (Reflex t, Monad m) => Shutdown t (VtyWidget t m) where
173180 tellShutdown sd = VtyWidget $ tell (mempty { _vtyWidgetOut_shutdown = sd })
174181
182+-- | A chunk of the display area
175183data Region = Region
176184 { _region_left :: Int
177185 , _region_top :: Int
@@ -180,9 +188,17 @@ data Region = Region
180188 }
181189 deriving (Show, Read, Eq, Ord)
182190
191+-- | The width and height of a 'Region'
183192regionSize :: Region -> (Int, Int)
184193regionSize (Region _ _ w h) = (w, h)
185194
195+-- | Low-level widget combinator that runs a child 'VtyWidget' within
196+-- a given region and context. This widget filters and modifies the input
197+-- that the child widget receives such that:
198+-- * unfocused widgets receive no key events
199+-- * mouse inputs outside the region are ignored
200+-- * mouse inputs inside the region have their coordinates translated such
201+-- that (0,0) is the top-left corner of the region
186202pane
187203 :: (Reflex t, Monad m)
188204 => Dynamic t Region -- ^ Region into which we should draw the widget (in coordinates relative to our own)
@@ -207,11 +223,6 @@ pane reg foc child = VtyWidget $ do
207223 tell wo'
208224 return result
209225 where
210− -- Filters input such that:
211− -- * unfocused widgets receive no key events
212− -- * mouse inputs outside the region are ignored
213− -- * mouse inputs inside the region have their coordinates translated
214− -- such that (0,0) is the top-left corner of the region
215226 filterInput :: Region -> Bool -> VtyEvent -> Maybe VtyEvent
216227 filterInput (Region l t w h) focused e = case e of
217228 V.EvKey _ _ | not focused -> Nothing
@@ -227,6 +238,7 @@ pane reg foc child = VtyWidget $ do
227238 | otherwise =
228239 Just (con (x - l) (y - t))
229240
241+-- | Information about a drag operation
230242data Drag = Drag
231243 { _drag_from :: (Int, Int) -- ^ Where the drag began
232244 , _drag_to :: (Int, Int) -- ^ Where the mouse currently is
@@ -236,14 +248,16 @@ data Drag = Drag
236248 }
237249 deriving (Eq, Ord, Show)
238250
251+-- | Converts raw vty mouse drag events into an event stream of 'Drag's
239252drag
240253 :: (Reflex t, MonadFix m, MonadHold t m)
241254 => V.Button
242255 -> VtyWidget t m (Event t Drag)
243256drag btn = do
244257 inp <- input
245− let f :: Drag -> V.Event -> Maybe Drag
246− f (Drag from _ _ mods end) = \case
258+ let f :: Maybe Drag -> V.Event -> Maybe Drag
259+ f Nothing = const Nothing
260+ f (Just (Drag from _ _ mods end)) = \case
247261 V.EvMouseDown x y btn' mods'
248262 | end -> Just $ Drag (x,y) (x,y) btn' mods' False
249263 | btn == btn' -> Just $ Drag from (x,y) btn mods' False
@@ -258,10 +272,10 @@ drag btn = do
258272 | otherwise -> Just $ Drag from (x,y) btn mods True
259273 _ -> Nothing
260274 rec let newDrag = attachWithMaybe f (current dragD) inp
261− dragD <- holdDyn (Drag (0,0) (0,0) btn [] True) -- gross, but ok because it'll never be produced.
262− newDrag
263− return (updated dragD)
275+ dragD <- holdDyn Nothing $ Just <$> newDrag
276+ return (fmapMaybe id $ updated dragD)
264277
278+-- | Mouse down events for a particular mouse button
265279mouseDown
266280 :: (Reflex t, Monad m)
267281 => V.Button
@@ -342,9 +356,7 @@ fill c = do
342356hRule :: (Reflex t, Monad m) => BoxStyle -> VtyWidget t m ()
343357hRule boxStyle = fill (_boxStyle_s boxStyle)
344358
345−fractionSz :: Double -> Int -> Int
346−fractionSz x h = round (fromIntegral h * x)
347−
359+-- | Transform the images produces by a widget
348360modifyImages
349361 :: (Reflex t, MonadHold t m, MonadFix m)
350362 => Behavior t ([Image] -> [Image])
@@ -353,6 +365,8 @@ modifyImages
353365modifyImages f (VtyWidget w) = VtyWidget $ flip censor w $ \wo ->
354366 wo { _vtyWidgetOut_images = f <*> (_vtyWidgetOut_images wo) }
355367
368+-- | Defines a set of symbols to use to draw the outlines of boxes
369+-- C.f. https://en.wikipedia.org/wiki/Box-drawing_character
356370data BoxStyle = BoxStyle
357371 { _boxStyle_nw :: Char
358372 , _boxStyle_n :: Char
@@ -367,21 +381,28 @@ data BoxStyle = BoxStyle
367381instance Default BoxStyle where
368382 def = singleBoxStyle
369383
384+-- | A box style that uses hyphens and pipe characters. Doesn't handle
385+-- corners very well.
370386hyphenBoxStyle :: BoxStyle
371387hyphenBoxStyle = BoxStyle '-' '-' '-' '|' '-' '-' '-' '|'
372388
389+-- | A single line box style
373390singleBoxStyle :: BoxStyle
374391singleBoxStyle = BoxStyle '┌' '─' '┐' '│' '┘' '─' '└' '│'
375392
393+-- | A thick single line box style
376394thickBoxStyle :: BoxStyle
377395thickBoxStyle = BoxStyle '┏' '━' '┓' '┃' '┛' '━' '┗' '┃'
378396
397+-- | A double line box style
379398doubleBoxStyle :: BoxStyle
380399doubleBoxStyle = BoxStyle '╔' '═' '╗' '║' '╝' '═' '╚' '║'
381400
401+-- | A single line box style with rounded corners
382402roundedBoxStyle :: BoxStyle
383403roundedBoxStyle = BoxStyle '╭' '─' '╮' '│' '╯' '─' '╰' '│'
384404
405+-- | Draws a box in the provided style and a child widget inside of that box
385406box :: (Monad m, Reflex t)
386407 => BoxStyle
387408 -> VtyWidget t m a
@@ -420,6 +441,7 @@ box style child = do
420441 ]
421442 in sides ++ if width > 1 && height > 1 then corners else []
422443
444+-- | Renders text, wrapped to the container width
423445text
424446 :: (Reflex t, Monad m)
425447 => Behavior t Text