packages feed

vty-ui 1.7.1 → 1.8

raw patch · 37 files changed

+441/−352 lines, 37 filesdep +data-defaultdep ~vty

Dependencies added: data-default

Dependency ranges changed: vty

Files

demos/CollectionDemo.hs view
@@ -25,7 +25,8 @@  mkSecondUI = do   fg <- newFocusGroup-  lst <- newTextList (green `on` blue) items 1+  lst <- newTextList items 1+  setSelectedUnfocusedAttr lst $ Just (green `on` blue)   addToFocusGroup fg lst   c <- centered =<< vLimit 10 =<< hLimit 50 =<< bordered lst   return (c, fg)@@ -60,7 +61,7 @@    let keyHandler nextUI = \_ k mods ->         case (k, mods) of-            (KASCII 'n', [MCtrl]) -> nextUI >> return True+            (KChar 'n', [MCtrl]) -> nextUI >> return True             (KEsc, []) -> exitSuccess             _ -> return False
demos/ComplexDemo.hs view
@@ -16,7 +16,7 @@ fg = white bg = black focAttr = black `on` yellow-headerAttr = fgColor bright_green+headerAttr = fgColor brightGreen msgAttr = fgColor blue  -- Multi-state checkbox value type@@ -64,7 +64,8 @@   edit1Header <- textWidget wrap T.empty >>= withNormalAttribute headerAttr   edit2Header <- textWidget wrap T.empty >>= withNormalAttribute headerAttr -  lst <- newList (fgColor bright_green) 1+  lst <- newList 1+  setSelectedUnfocusedAttr lst $ Just (fgColor brightGreen)    selector <- vLimit 3 lst   listHeader <- plainText T.empty
demos/EditDemo.hs view
@@ -10,15 +10,19 @@   e2 <- multiLineEditWidget   setEditLineLimit e2 $ Just 3   e3 <- editWidget+  e4 <- editWidget+  setEditRewriter e4 (const '*')    fg <- newFocusGroup   _ <- addToFocusGroup fg e1   _ <- addToFocusGroup fg e2   _ <- addToFocusGroup fg e3+  _ <- addToFocusGroup fg e4    be1 <- bordered =<< boxFixed 40 5 e1   be2 <- bordered =<< boxFixed 40 3 e2   be3 <- bordered =<< boxFixed 40 1 e3+  be4 <- bordered =<< boxFixed 40 1 e4    c <- centered =<< ((plainText "Multi-Line Editor (unlimited lines):")                          <--> (return be1)@@ -26,6 +30,8 @@                          <--> (return be2)                          <--> (plainText "Single-Line Editor:")                          <--> (return be3)+                         <--> (plainText "Password input:")+                         <--> (return be4)                          <--> (plainText "- Esc to quit\n\n- TAB to switch editors") >>= withBoxSpacing 1                     )
demos/ListDemo.hs view
@@ -11,11 +11,10 @@     AppElements { theList :: Widget (List T.Text FormattedText)                 , theBody :: Widget FormattedText                 , theFooter :: Widget FormattedText-                , theListLimit :: Widget (VLimit (List T.Text FormattedText))                 , uis :: Collection                 } -titleAttr = bright_white `on` blue+titleAttr = brightWhite `on` blue focAttr = black `on` green bodyAttr = white `on` black selAttr = black `on` yellow@@ -26,19 +25,19 @@            \See the keystrokes below to try the demo."  message2 :: [(T.Text, Attr)]-message2 = [ ("- Press ", def_attr), ("q", keyAttr), (" to quit\n", def_attr)-           , ("- Press ", def_attr), ("+", keyAttr)-           , (" / ", def_attr), ("a", keyAttr)-           , (" to add a list item\n", def_attr)-           , ("- Press ", def_attr), ("-", keyAttr)-           , (" / ", def_attr), ("d", keyAttr)-           , (" to remove the selected list item\n", def_attr)-           , ("- Press ", def_attr)-           , ("up", keyAttr), (" / ", def_attr)-           , ("down", keyAttr), (" / ", def_attr)-           , ("page up", keyAttr), (" / ", def_attr)+message2 = [ ("- Press ", defAttr), ("q", keyAttr), (" to quit\n", defAttr)+           , ("- Press ", defAttr), ("+", keyAttr)+           , (" / ", defAttr), ("a", keyAttr)+           , (" to add a list item\n", defAttr)+           , ("- Press ", defAttr), ("-", keyAttr)+           , (" / ", defAttr), ("d", keyAttr)+           , (" to remove the selected list item\n", defAttr)+           , ("- Press ", defAttr)+           , ("up", keyAttr), (" / ", defAttr)+           , ("down", keyAttr), (" / ", defAttr)+           , ("page up", keyAttr), (" / ", defAttr)            , ("page down", keyAttr)-           , (" to navigate the list\n", def_attr)+           , (" to navigate the list\n", defAttr)            ]  buildUi appst = do@@ -62,17 +61,16 @@ -- Construct the application statea using the message map. mkAppElements :: IO AppElements mkAppElements = do-  lw <- newTextList selAttr [] 1+  lw <- newTextList [] 1+  setSelectedUnfocusedAttr lw $ Just selAttr   b <- textWidget wrap T.empty   ft <- plainText T.empty >>= withNormalAttribute titleAttr-  ll <- vLimit 5 lw    c <- newCollection    return $ AppElements { theList = lw                        , theBody = b                        , theFooter = ft-                       , theListLimit = ll                        , uis = c                        } @@ -115,11 +113,11 @@    (theList st) `onKeyPressed` \_ k _ -> do          case k of-           (KASCII 'q') -> exitSuccess-           (KASCII '-') -> removeCurrentItem >> return True-           (KASCII 'd') -> removeCurrentItem >> return True-           (KASCII '+') -> addNewItem >> return True-           (KASCII 'a') -> addNewItem >> return True+           (KChar 'q') -> exitSuccess+           (KChar '-') -> removeCurrentItem >> return True+           (KChar 'd') -> removeCurrentItem >> return True+           (KChar '+') -> addNewItem >> return True+           (KChar 'a') -> addNewItem >> return True            _ -> return False    -- We need to call these handlers manually because while they will
demos/ProgressBarDemo.hs view
@@ -12,7 +12,7 @@  -- Visual attributes. focAttr = black `on` green-bodyAttr = bright_green `on` black+bodyAttr = brightGreen `on` black completeAttr = white `on` red incompleteAttr = red `on` white
doc/ch2/event_loop.tex view
@@ -137,7 +137,7 @@ \fw{someAttr `withStyle` underline} & adding a style \\ \hline \end{tabular} -The Vty \fw{def\_attr} value's default configuration is used as a+The Vty \fw{defAttr} value's default configuration is used as a basis for all partially-specified attributes.  The functions described above are defined in the \fw{Util} module.
doc/ch2/focus_groups.tex view
@@ -68,7 +68,7 @@ \begin{haskellcode}  fg <- newFocusGroup  fg `onKeyPressed` \_ key _ ->-   if key == KASCII 'q' then+   if key == KChar 'q' then      exitSuccess else return False \end{haskellcode}
doc/ch2/handling_user_input.tex view
@@ -28,12 +28,12 @@  \begin{haskellcode}  w `onKeyPressed` \_ key _ ->-   if key == KASCII 'f' then+   if key == KChar 'f' then      (launchTheMissiles >> return True) else      return False   w `onKeyPressed` \_ key _ ->-   if key == KASCII 'q' then+   if key == KChar 'q' then      exitSuccess else return False \end{haskellcode}
doc/ch3/new_widget_type.tex view
@@ -41,16 +41,15 @@  \begin{haskellcode}  let st = Counter initialValue- wRef <- newWidget st $ \w -> ...+ newWidget st $ \w -> ... \end{haskellcode}  The \fw{Core} module's \fw{newWidget} function creates a new \fw{IORef} wrapping a \fw{WidgetImpl a}.  The \fw{WidgetImpl} type is where all of the widget logic is actually implemented.  You implement this logic by overriding the fields of the \fw{WidgetImpl} type, such-as \fw{render\_}.  We call \fw{newWidget}'s result \fw{wRef} because-it is a reference to a widget, and this helps distinguish it from the-actual widget data in the next step.+as \fw{render\_}. The \fw{newWidget} function will return the+\fw{IORef} as \fw{Widget Counter}; \fw{Widget} is a type alias.  The \fw{newWidget} function takes an initial state of the widget (of type \fw{a}) and a transformation function \fw{WidgetImpl a ->@@ -67,7 +66,7 @@    \this size ctx -> do      (Counter v) <- getState this      let s = T.pack $ show v-         width = (fromEnum $ region_width size) -+         width = (fromEnum $ regionWidth size) -                  (fromEnum $ textWidth s)          (truncated, _, _) = clip1d (Phys 0) (Phys width) s      return $ string (getNormalAttr ctx) $ T.unpack truncated@@ -117,7 +116,7 @@  \begin{haskellcode}  let s = T.pack $ show v-     width = (fromEnum $ region_width size) -+     width = (fromEnum $ regionWidth size) -              (fromEnum $ textWidth s)      (truncated, _, _) = clip1d (Phys 0) (Phys width) s \end{haskellcode}
doc/ch3/rendering.tex view
@@ -21,7 +21,7 @@   specified attribute. \item \fw{char} -- Creates an image from a character using the   specified attribute.-\item \fw{char\_fill} -- Creates an image with the specified width and+\item \fw{charFill} -- Creates an image with the specified width and   height, filled with the specified character and attribute. \item \fw{<->} -- Vertical concatenation of images. \item \fw{<|>} -- Horizontal concatenation of images.
doc/ch3/widgetimpl_api.tex view
@@ -54,10 +54,10 @@   Sometimes used when positioning child widgets and when positioning   the cursor, if any. \item \fw{normalAttribute} -- the widget's normal attribute.  Defaults-  to Vty's \fw{def\_attr} value, which merges transparently with the+  to Vty's \fw{defAttr} value, which merges transparently with the   \fw{RenderContext}'s normal attribute. \item \fw{focusAttribute} -- the widget's focus attribute.  Defaults-  to Vty's \fw{def\_attr} value, which merges transparently with the+  to Vty's \fw{defAttr} value, which merges transparently with the   \fw{RenderContext}'s focus attribute. \item \fw{keyEventHandler} -- the action responsible for handling key   events for this widget.  The default implementation merely starts
doc/ch4/Fixed.tex view
@@ -51,7 +51,7 @@ guarantee that the specified space is consumed.  \begin{haskellcode}- lst <- newList (green `on` black) 1+ lst <- newList 1  ui <- vFixed 5 lst \end{haskellcode}
doc/ch4/FormattedText.tex view
@@ -9,7 +9,7 @@ \fw{plainText} function and can be laid out in the usual way:  \begin{haskellcode}- t1 <- plainText "blue" >>= withNormalAttribute (fgColor blue)+ t1 <- plainText "blue" >>= withNormal (fgColor blue)  t2 <- plainText "green" >>= withNormalAttribute (fgColor green)  ui <- (return t1) <++> (return t2) \end{haskellcode}@@ -28,7 +28,7 @@ All text widget update functions \textit{tokenize} their inputs, finding contiguous sequences of whitespace and non-whitespace characters and newlines, and store the list of tokens in the widget.-Each token is assigned a default attribute of \fw{def\_attr}, which+Each token is assigned a default attribute of \fw{defAttr}, which defaults to the ``normal'' attribute of the widget (see Section \ref{sec:attributes} for more information on attributes). @@ -48,9 +48,9 @@ \begin{haskellcode}  t <- plainText ""  setTextWithAttrs t [ ("foo", fgColor green)-                    , (" ", def_attr)+                    , (" ", defAttr)                     , ("bar", fgColor yellow)-                    , (" ", def_attr)+                    , (" ", defAttr)                     , ("baz", red `on` blue)                     ] \end{haskellcode}
doc/ch4/List.tex view
@@ -36,16 +36,21 @@ Lists are created with the \fw{newList} function:  \begin{haskellcode}- lst <- newList attr 1+ lst <- newList 1 \end{haskellcode} -\fw{newList} takes two parameters: the attribute of the currently-selected item-to be used when the list is \textit{not} focused, and the height, in rows, of-each widget in the list.  The \fw{List} uses its own focus attribute (Section+\fw{newList} takes one parameter: the height, in rows, of each widget in the+list.  The \fw{List} uses its own focus attribute (Section \ref{sec:attributes}) as the attribute of the currently-selected item when it has the focus.  The widget type of the list (\fw{b} above) won't be chosen by the type system until you actually add something to the list. +The \fw{List} widget uses the default focus attribute of the rendering context+to render the selected item when the list has the focus.  To control how the+selected item appears when the list has or lacks focus, use see+\fw{set\-Selected\-Focused\-Attr} and+\fw{set\-Se\-lec\-ted\-Un\-fo\-cused\-Attr}.+ Items may be added to a \fw{List} with the \fw{addToList} function, which takes an internal value (e.g., \fw{String}) and a widget of the appropriate type:@@ -110,7 +115,7 @@   value, and widget of the currently-selected list item. \item \fw{getListItem} -- takes a \fw{Widget (List a b)} and an index   and returns \fw{Nothing} if the \fw{List} has no item at the-  specified index item or returns \fw{Just (pos, (val, widget))}+  specified index item or returns \fw{Just (val, widget)}   corresponding to the list index. \end{itemize}
doc/macros.tex view
@@ -1,6 +1,6 @@ % Custom macros. -\newcommand{\vtyuiversion}{1.7.1}+\newcommand{\vtyuiversion}{1.8}  \newcommand{\fw}[1]{\texttt{#1}} \newcommand{\vtyui}{\fw{vty-ui}}
src/Graphics/Vty/Widgets/Borders.hs view
@@ -71,7 +71,7 @@ -- attribute and character. hBorder :: IO (Widget HBorder) hBorder = do-  let initSt = HBorder def_attr T.empty+  let initSt = HBorder defAttr T.empty   wRef <- newWidget initSt $ \w ->       w { growHorizontal_ = const $ return True         , render_ = renderHBorder@@ -80,8 +80,8 @@   return wRef  renderHBorder :: Widget HBorder -> DisplayRegion -> RenderContext -> IO Image-renderHBorder _ (DisplayRegion 0 _) _ = return empty_image-renderHBorder _ (DisplayRegion _ 0) _ = return empty_image+renderHBorder _ (0, _) _ = return emptyImage+renderHBorder _ (_, 0) _ = return emptyImage renderHBorder this s ctx = do   HBorder attr str <- getState this   let attr' = mergeAttrs [ overrideAttr ctx@@ -89,7 +89,7 @@                          , normalAttr ctx                          ]       ch = skinHorizontal $ skin ctx-      noTitle = T.pack $ replicate (fromEnum $ region_width s) ch+      noTitle = T.pack $ replicate (fromEnum $ regionWidth s) ch    wStr <- case T.null str of             True -> return noTitle@@ -98,10 +98,10 @@                                    , str                                    , T.pack " "                                    ]-              case (textWidth title) > (Phys $ fromEnum $ region_width s) of+              case (textWidth title) > (Phys $ fromEnum $ regionWidth s) of                 True -> return noTitle                 False -> do-                       let remaining = (Phys $ fromEnum $ region_width s) - (textWidth title)+                       let remaining = (Phys $ fromEnum $ regionWidth s) - (textWidth title)                            Phys side1 = remaining `div` Phys 2                            side2 = if remaining `mod` Phys 2 == Phys 0 then side1 else side1 + 1                        return $ T.concat [ T.pack $ replicate side1 ch@@ -123,7 +123,7 @@ -- attribute and character. vBorder :: IO (Widget VBorder) vBorder = do-  let initSt = VBorder def_attr+  let initSt = VBorder defAttr   wRef <- newWidget initSt $ \w ->       w { growVertical_ = const $ return True         , getCursorPosition_ = const $ return Nothing@@ -133,7 +133,7 @@                                           , attr                                           , normalAttr ctx                                           ]-                   return $ char_fill attr' (skinVertical $ skin ctx) 1 (region_height s)+                   return $ charFill attr' (skinVertical $ skin ctx) 1 (regionHeight s)         }   return wRef @@ -154,7 +154,7 @@ -- |Wrap a widget in a bordering box. bordered :: (Show a) => Widget a -> IO (Widget (Bordered a)) bordered child = do-  let initSt = Bordered def_attr child T.empty+  let initSt = Bordered defAttr child T.empty   wRef <- newWidget initSt $ \w ->       w { growVertical_ = const $ growVertical child         , growHorizontal_ = const $ growHorizontal child@@ -182,7 +182,7 @@ drawBordered :: (Show a) =>                 Bordered a -> DisplayRegion -> RenderContext -> IO Image drawBordered this s ctx-    | region_width s < 2 || region_height s < 2 = return empty_image+    | regionWidth s < 2 || regionHeight s < 2 = return emptyImage     | otherwise = do   let Bordered attr child label = this       attr' = mergeAttrs [ overrideAttr ctx@@ -194,12 +194,13 @@   -- Render the contained widget with enough room to draw borders.   -- Then, use the size of the rendered widget to constrain the space   -- used by the (expanding) borders.-  let constrained = DisplayRegion (region_width s - 2) (region_height s - 2)+  let constrained = (regionWidth s - 2, regionHeight s - 2)    childImage <- render child constrained ctx -  let adjusted = DisplayRegion (image_width childImage + 2)-                 (image_height childImage)+  let adjusted = ( imageWidth childImage + 2+                 , imageHeight childImage+                 )    tlCorner <- plainText (T.singleton $ skinCornerTL sk)               >>= withNormalAttribute attr'@@ -225,6 +226,6 @@    leftRight <- render vb adjusted ctx -  let middle = horiz_cat [leftRight, childImage, leftRight]+  let middle = horizCat [leftRight, childImage, leftRight] -  return $ vert_cat [top, middle, bottom]+  return $ vertCat [top, middle, bottom]
src/Graphics/Vty/Widgets/Box.hs view
@@ -28,7 +28,6 @@     ) where -import GHC.Word ( Word ) import Data.Typeable import Control.Exception import Control.Monad@@ -81,11 +80,11 @@                    -- growth comparison function                    , secondGrows :: IO Bool                    -- region dimension fetch function-                   , regDimension :: DisplayRegion -> Word+                   , regDimension :: DisplayRegion -> Int                    -- image dimension fetch function-                   , imgDimension :: Image -> Word+                   , imgDimension :: Image -> Int                    -- dimension modification function-                   , withDimension :: DisplayRegion -> Word -> DisplayRegion+                   , withDimension :: DisplayRegion -> Int -> DisplayRegion                    -- Oriented image concatenation                    , img_cat :: [Image] -> Image                    }@@ -145,13 +144,13 @@                    , secondGrows =                        (if o == Vertical then growVertical else growHorizontal) wb                    , regDimension =-                       if o == Vertical then region_height else region_width+                       if o == Vertical then snd else fst                    , imgDimension =-                       if o == Vertical then image_height else image_width+                       if o == Vertical then imageHeight else imageWidth                    , withDimension =                        if o == Vertical then withHeight else withWidth                    , img_cat =-                       if o == Vertical then vert_cat else horiz_cat+                       if o == Vertical then vertCat else horizCat                    }    wRef <- newWidget initSt $ \w ->@@ -209,9 +208,9 @@               setCurrentPosition (boxFirst b) pos               case boxOrientation b of                 Horizontal -> setCurrentPosition (boxSecond b) $-                              pos `plusWidth` ((region_width ch1_size) + (toEnum $ boxSpacing b))+                              pos `plusWidth` ((fst ch1_size) + (toEnum $ boxSpacing b))                 Vertical -> setCurrentPosition (boxSecond b) $-                            pos `plusHeight` ((region_height ch1_size) + (toEnum $ boxSpacing b))+                            pos `plusHeight` ((snd ch1_size) + (toEnum $ boxSpacing b))         }    wRef `relayFocusEvents` wa@@ -290,34 +289,34 @@   let spAttr = getNormalAttr ctx       spacing = boxSpacing this       spacer = case spacing of-                 0 -> empty_image+                 0 -> emptyImage                  _ -> case boxOrientation this of-                         Horizontal -> let h = max (image_height img1) (image_height img2)-                                       in char_fill spAttr ' ' (toEnum spacing) h-                         Vertical -> let w = max (image_width img1) (image_width img2)-                                     in char_fill spAttr ' ' w (toEnum spacing)+                         Horizontal -> let h = max (imageHeight img1) (imageHeight img2)+                                       in charFill spAttr ' ' (toEnum spacing) h+                         Vertical -> let w = max (imageWidth img1) (imageWidth img2)+                                     in charFill spAttr ' ' w (toEnum spacing)        -- Use the larger of the two images to determine padding in the       -- opposite dimension.  E.g. if this is a vertical box, we want       -- to pad the images such that they have the same width.       common_opposite_dim = case boxOrientation this of-                              Horizontal -> max (image_height img1) (image_height img2)-                              Vertical -> max (image_width img1) (image_width img2)+                              Horizontal -> max (imageHeight img1) (imageHeight img2)+                              Vertical -> max (imageWidth img1) (imageWidth img2)        padded_img1 = case boxOrientation this of                       Horizontal -> img1 <->-                                    (char_fill spAttr ' ' (image_width img1)-                                     (common_opposite_dim - image_height img1))+                                    (charFill spAttr ' ' (imageWidth img1)+                                     (common_opposite_dim - imageHeight img1))                       Vertical -> img1 <|>-                                  (char_fill spAttr ' ' (common_opposite_dim - image_width img1)-                                   (image_height img1))+                                  (charFill spAttr ' ' (common_opposite_dim - imageWidth img1)+                                   (imageHeight img1))       padded_img2 = case boxOrientation this of                       Horizontal -> img2 <->-                                    (char_fill spAttr ' ' (image_width img2)-                                     (common_opposite_dim - image_height img2))+                                    (charFill spAttr ' ' (imageWidth img2)+                                     (common_opposite_dim - imageHeight img2))                       Vertical -> img2 <|>-                                  (char_fill spAttr ' ' (common_opposite_dim - image_width img2)-                                   (image_height img2))+                                  (charFill spAttr ' ' (common_opposite_dim - imageWidth img2)+                                   (imageHeight img2))     return $ (img_cat this) [padded_img1, spacer, padded_img2]@@ -333,7 +332,7 @@     -- If the box is too large to fit in the available space (since it     -- has fixed dimensions and can't be scaled), return the empty     -- image.-    | toEnum firstDim + toEnum secondDim > regDimension this s = return (empty_image, empty_image)+    | toEnum firstDim + toEnum secondDim > regDimension this s = return (emptyImage, emptyImage)     | otherwise = do   let withDim = withDimension this   img1 <- render (boxFirst this) (s `withDim` (toEnum firstDim)) ctx@@ -341,8 +340,8 @@    -- pad the images so they fill the space appropriately.   let fill img amt = case boxOrientation this of-                   Vertical -> char_fill (getNormalAttr ctx) ' ' (image_width img) amt-                   Horizontal -> char_fill (getNormalAttr ctx) ' ' amt (image_height img)+                   Vertical -> charFill (getNormalAttr ctx) ' ' (imageWidth img) amt+                   Horizontal -> charFill (getNormalAttr ctx) ' ' amt (imageHeight img)       firstDimW = toEnum firstDim       secondDimW = toEnum secondDim       img1_size = (imgDimension this) img1@@ -380,7 +379,7 @@         b_img <- render b s' ctx          return $ if renderDimension a_img >= regDim actualSpace-                 then [a_img, empty_image]+                 then [a_img, emptyImage]                  else [a_img, b_img]        renderHalves = do
src/Graphics/Vty/Widgets/Centering.hs view
@@ -11,7 +11,6 @@     ) where -import GHC.Word ( Word ) import Graphics.Vty.Widgets.Core import Graphics.Vty import Graphics.Vty.Widgets.Util@@ -34,12 +33,12 @@                    img <- render child s ctx                     let attr' = getNormalAttr ctx-                       (half, half') = centered_halves region_width s (image_width img)+                       (half, half') = centered_halves regionWidth s (imageWidth img)                     return $ if half > 0-                            then horiz_cat [ char_fill attr' ' ' half (image_height img)+                            then horizCat [ charFill attr' ' ' half (imageHeight img)                                            , img-                                           , char_fill attr' ' ' half' (image_height img)+                                           , charFill attr' ' ' half' (imageHeight img)                                            ]                             else img @@ -48,7 +47,7 @@               HCentered child <- getState this               s <- getCurrentSize this               chSz <- getCurrentSize child-              let (half, _) = centered_halves region_width s (region_width chSz)+              let (half, _) = centered_halves regionWidth s (regionWidth chSz)                   chPos = pos `plusWidth` half               setCurrentPosition child chPos @@ -77,12 +76,12 @@                    img <- render child s ctx                     let attr' = getNormalAttr ctx-                       (half, half') = centered_halves region_height s (image_height img)+                       (half, half') = centered_halves regionHeight s (imageHeight img)                     return $ if half > 0-                            then vert_cat [ char_fill attr' ' ' (image_width img) half+                            then vertCat [ charFill attr' ' ' (imageWidth img) half                                           , img-                                          , char_fill attr' ' ' (image_width img) half'+                                          , charFill attr' ' ' (imageWidth img) half'                                           ]                             else img @@ -91,7 +90,7 @@               VCentered child <- getState this               s <- getCurrentSize this               chSz <- getCurrentSize child-              let (half, _) = centered_halves region_height s (region_height chSz)+              let (half, _) = centered_halves regionHeight s (regionHeight chSz)                   chPos = pos `plusHeight` half               setCurrentPosition child chPos @@ -107,7 +106,7 @@ centered :: (Show a) => Widget a -> IO (Widget (VCentered (HCentered a))) centered wRef = vCentered =<< hCentered wRef -centered_halves :: (DisplayRegion -> Word) -> DisplayRegion -> Word -> (Word, Word)+centered_halves :: (DisplayRegion -> Int) -> DisplayRegion -> Int -> (Int, Int) centered_halves region_size s obj_sz =     let remaining = region_size s - obj_sz         half = remaining `div` 2
src/Graphics/Vty/Widgets/CheckBox.hs view
@@ -236,7 +236,7 @@ getCheckboxLabel = (checkboxLabel <~~)  radioKeyEvent :: (Eq a) => Widget (CheckBox a) -> Key -> [Modifier] -> IO Bool-radioKeyEvent this (KASCII ' ') [] = cycleCheckbox this >> return True+radioKeyEvent this (KChar ' ') [] = cycleCheckbox this >> return True radioKeyEvent this KEnter [] = cycleCheckbox this >> return True radioKeyEvent _ _ _ = return False
src/Graphics/Vty/Widgets/Core.hs view
@@ -137,7 +137,7 @@                   , overrideAttr :: Attr                   -- ^An override attribute to be used to override                   -- both the normal and focus attributes in effect-                  -- during rendering.  Usually def_attr, this+                  -- during rendering.  Usually defAttr, this                   -- attribute is used when child widgets need to have                   -- their attributes overridden by a parent widget.                   , skin :: Skin@@ -152,7 +152,7 @@  -- |Default context settings. defaultContext :: RenderContext-defaultContext = RenderContext def_attr (white `on` blue) def_attr unicodeSkin+defaultContext = RenderContext defAttr (white `on` blue) defAttr unicodeSkin  -- |The type of widget implementations, parameterized on the type of -- the widget's state.@@ -276,10 +276,10 @@    v <- visible <~ wRef   case v of-    False -> return empty_image+    False -> return emptyImage     True -> do            -- Merge the override attributes with the context.  If the-           -- overrides haven't been set (still def_attr), they will+           -- overrides haven't been set (still defAttr), they will            -- have no effect on the context attributes.            norm <- normalAttribute <~ wRef            foc <- focusAttribute <~ wRef@@ -288,12 +288,13 @@                             }             img <- render_ impl wRef sz newCtx-           let imgsz =  DisplayRegion (image_width img) (image_height img)+           let imgsz = (imageWidth img, imageHeight img) -           when (image_width img > region_width sz ||-                 image_height img > region_height sz) $ throw $ ImageTooBig (show impl) sz imgsz+           when ((imageWidth img > 0 && imageHeight img > 0) &&+                 (imageWidth img > regionWidth sz || imageHeight img > regionHeight sz)) $+                 throw $ ImageTooBig (show impl) sz imgsz -           setCurrentSize wRef $ DisplayRegion (image_width img) (image_height img)+           setCurrentSize wRef (imageWidth img, imageHeight img)            return img  -- |Render a widget and set its position after rendering is complete.@@ -352,12 +353,12 @@    wRef <- newIORef $           WidgetImpl { state = initState-                     , render_ = \_ _ _ -> return empty_image+                     , render_ = \_ _ _ -> return emptyImage                      , growVertical_ = const $ return False                      , growHorizontal_ = const $ return False                      , setCurrentPosition_ = \_ _ -> return ()-                     , currentSize = DisplayRegion 0 0-                     , currentPosition = DisplayRegion 0 0+                     , currentSize = (0, 0)+                     , currentPosition = (0, 0)                      , focused = False                      , visible = True                      , gainFocusHandlers = gfhs@@ -365,8 +366,8 @@                      , loseFocusHandlers = lfhs                      , keyEventHandler = \_ _ _ -> return False                      , getCursorPosition_ = defaultCursorInfo-                     , normalAttribute = def_attr-                     , focusAttribute = def_attr+                     , normalAttribute = defAttr+                     , focusAttribute = defAttr                      }    updateWidget wRef f@@ -375,10 +376,10 @@ -- |Default cursor positioning implementation used by 'newWidget'. defaultCursorInfo :: Widget a -> IO (Maybe DisplayRegion) defaultCursorInfo w = do-  sz <- getCurrentSize w+  (rW, _) <- getCurrentSize w   pos <- getCurrentPosition w-  if region_width sz > 0 then-      return $ Just $ pos `plusWidth` (region_width sz - 1) else+  if rW > 0 then+      return $ Just $ pos `plusWidth` (rW - 1) else       return Nothing  -- |Given a widget and key event information, invoke the widget's key@@ -545,7 +546,7 @@    let initSt = FocusGroup { entries = []                           , currentEntryNum = -1-                          , nextKey = (KASCII '\t', [])+                          , nextKey = (KChar '\t', [])                           , prevKey = (KBackTab, [])                           }
src/Graphics/Vty/Widgets/DirBrowser.hs view
@@ -137,7 +137,9 @@              <++> (return fileInfo) <++> (hFill ' ' 1) <++> (return errorText))             >>= withNormalAttribute (browserHeaderAttr bSkin) -  l <- newList (browserUnfocusedSelAttr bSkin) 1+  l <- newList 1+  setSelectedUnfocusedAttr l $ Just (browserUnfocusedSelAttr bSkin)+   ui <- vBox header =<< vBox l footer    r <- newIORef ""@@ -231,7 +233,7 @@     [ (\_ s -> isRegularFile s       , \_ s -> return $ T.pack $ "regular file, " ++                 (show $ fileSize s) ++ " bytes"-      , def_attr)+      , defAttr)     , (\_ s -> isSymbolicLink s,        (\p stat -> do           linkDest <- if not $ isSymbolicLink stat@@ -255,7 +257,7 @@       annotation = getAnnotation' fullPath st $ (browserCustomAnnotations sk) ++                    (builtInAnnotations cur sk) -      getAnnotation' _ _ [] = (def_attr, return T.empty)+      getAnnotation' _ _ [] = (defAttr, return T.empty)       getAnnotation' pth stat ((f,mkAnn,a):rest) =           if f pth stat           then (a, mkAnn pth stat)@@ -268,8 +270,8 @@ handleBrowserKey b _ KRight [] = descend b False >> return True handleBrowserKey b _ KLeft [] = ascend b >> return True handleBrowserKey b _ KEsc [] = cancelBrowse b >> return True-handleBrowserKey b _ (KASCII 'q') [] = cancelBrowse b >> return True-handleBrowserKey b _ (KASCII 'r') [] = refreshBrowser b >> return True+handleBrowserKey b _ (KChar 'q') [] = cancelBrowse b >> return True+handleBrowserKey b _ (KChar 'r') [] = refreshBrowser b >> return True handleBrowserKey _ _ _ _ = return False  -- |Refresh the browser by reloading and displaying the contents of
src/Graphics/Vty/Widgets/Edit.hs view
@@ -41,6 +41,8 @@     , getEditText     , getEditCurrentLine     , setEditText+    , setEditRewriter+    , setCharFilter     , getEditCursorPosition     , setEditCursorPosition     , setEditLineLimit@@ -76,6 +78,8 @@                  , cursorMoveHandlers :: Handlers (Int, Int)                  , lineLimit :: Maybe Int                  , maxLength :: Maybe Int+                 , rewriter :: Char -> Char+                 , charFilter :: Char -> Bool                  }  instance Show Edit where@@ -103,6 +107,8 @@                     , cursorMoveHandlers = cmhs                     , lineLimit = Nothing                     , maxLength = Nothing+                    , rewriter = id+                    , charFilter = const True                     }    wRef <- newWidget initSt $ \w ->@@ -128,15 +134,28 @@   let (cursorRow, _) = Z.cursorPosition (contents st)       Phys offset = physCursorCol st - clipLeft (clipRect st)       newPos = pos-               `withWidth` (toEnum ((fromEnum $ region_width pos) + offset))+               `withWidth` (toEnum ((fromEnum $ regionWidth pos) + offset))                `plusHeight` (toEnum (cursorRow - (fromEnum $ clipTop $ clipRect st)))    return $ if f then Just newPos else Nothing +-- |Set the function which rewrites all characters at rendering time.  Defaults+-- to 'id'.  Does not affect text stored in the editor.+setEditRewriter :: Widget Edit -> (Char -> Char) -> IO ()+setEditRewriter w f =+    updateWidgetState w $ \st -> st { rewriter = f }++-- |Set the function which allows typed characters in the edit widget.+-- Defaults to 'const' 'True', allowing all characters.  For example, setting the+-- filter to ('elem' \"0123456789\") will only allow numbers in the edit widget.+setCharFilter :: Widget Edit -> (Char -> Bool) -> IO ()+setCharFilter w f =+    updateWidgetState w $ \st -> st { charFilter = f }+ renderEditWidget :: Widget Edit -> DisplayRegion -> RenderContext -> IO Image renderEditWidget this size ctx = do-  resize this ( Phys $ fromEnum $ region_height size-              , Phys $ fromEnum $ region_width size )+  resizeEdit this ( Phys $ fromEnum $ regionHeight size+                  , Phys $ fromEnum $ regionWidth size )    st <- getState this   isFocused <- focused <~ this@@ -147,9 +166,10 @@       attr = if isFocused then focusAttr ctx else nAttr        clipped = doClipping (Z.getText $ contents st) (clipRect st)+      rewritten = ((rewriter st) <$>) <$> clipped -      totalAllowedLines = fromEnum $ region_height size-      numEmptyLines = lim - length clipped+      totalAllowedLines = fromEnum $ regionHeight size+      numEmptyLines = lim - length rewritten           where             lim = case lineLimit st of                     Just v -> min v totalAllowedLines@@ -158,9 +178,9 @@       emptyLines = replicate numEmptyLines ""       lineWidget s = let Phys physLineLength = sum $ chWidth <$> s                      in string attr s <|>-                        char_fill attr ' ' (region_width size - toEnum physLineLength) 1+                        charFill attr ' ' (regionWidth size - toEnum physLineLength) 1 -  return $ vert_cat $ lineWidget <$> (clipped ++ emptyLines)+  return $ vertCat $ lineWidget <$> (rewritten ++ emptyLines)  doClipping :: [T.Text] -> ClipRect -> [String] doClipping ls rect =@@ -221,8 +241,8 @@ getEditMaxLength :: Widget Edit -> IO (Maybe Int) getEditMaxLength = (maxLength <~~) -resize :: Widget Edit -> (Phys, Phys) -> IO ()-resize e (newHeight, newWidth) = do+resizeEdit :: Widget Edit -> (Phys, Phys) -> IO ()+resizeEdit e (newHeight, newWidth) = do   updateWidgetState e $ \st ->       let newRect = (clipRect st) { clipHeight = newHeight                                   , clipWidth = newWidth@@ -366,10 +386,10 @@ editKeyEvent this k mods = do   let run f = applyEdit f this >> return True   case (k, mods) of-    (KASCII 'a', [MCtrl]) -> run Z.gotoBOL-    (KASCII 'k', [MCtrl]) -> run Z.killToEOL-    (KASCII 'e', [MCtrl]) -> run Z.gotoEOL-    (KASCII 'd', [MCtrl]) -> run Z.deleteChar+    (KChar 'a', [MCtrl]) -> run Z.gotoBOL+    (KChar 'k', [MCtrl]) -> run Z.killToEOL+    (KChar 'e', [MCtrl]) -> run Z.gotoEOL+    (KChar 'd', [MCtrl]) -> run Z.deleteChar     (KLeft, []) -> run Z.moveLeft     (KRight, []) -> run Z.moveRight     (KUp, []) -> run Z.moveUp@@ -389,7 +409,11 @@                    else st         return v     (KDel, []) -> run Z.deleteChar-    (KASCII ch, []) -> run (Z.insertChar ch)+    (KChar ch, []) -> do+        st <- getState this+        if charFilter st ch+            then run (Z.insertChar ch)+            else return True -- True even if the filter rejected the character.     (KHome, []) -> run Z.gotoBOL     (KEnd, []) -> run Z.gotoEOL     (KEnter, []) -> do
src/Graphics/Vty/Widgets/EventLoop.hs view
@@ -10,12 +10,16 @@     , shutdownUi     , newCollection     , addToCollection+    , addToCollectionWithCallbacks     , setCurrentEntry+    , EntryHide+    , EntryShow     ) where  import Data.IORef import Data.Typeable+import Data.Default (def) import Control.Concurrent ( forkIO ) import Control.Concurrent.STM ( atomically ) import Control.Concurrent.STM.TChan@@ -42,17 +46,18 @@ -- 'Collection' is empty. runUi :: Collection -> RenderContext -> IO () runUi collection ctx = do-  vty <- mkVty+  vty <- mkVty def    -- Create VTY event listener thread   _ <- forkIO $ vtyEventListener vty eventChan +  setCurrentEntry collection 0   runUi' vty eventChan collection ctx `finally` shutdown vty  vtyEventListener :: Vty -> TChan CombinedEvent -> IO () vtyEventListener vty chan =     forever $ do-      e <- next_event vty+      e <- nextEvent vty       atomically $ writeTChan chan $ VTYEvent e  -- |Schedule a widget-mutating 'IO' action to be run by the main event@@ -68,20 +73,20 @@  runUi' :: Vty -> TChan CombinedEvent -> Collection -> RenderContext -> IO () runUi' vty chan collection ctx = do-  sz <- display_bounds $ terminal vty+  sz <- displayBounds $ outputIface vty    e <- getCurrentEntry collection   let fg = entryFocusGroup e -  img <- entryRenderAndPosition e (DisplayRegion 0 0) sz ctx-  update vty $ pic_for_image img+  img <- entryRenderAndPosition e (0, 0) sz ctx+  update vty $ picForLayers [img]    mPos <- getCursorPosition fg   case mPos of-    Just (DisplayRegion w h) -> do-                        show_cursor $ terminal vty-                        set_cursor_pos (terminal vty) w h-    Nothing -> hide_cursor $ terminal vty+    Just (w, h) -> do+                        showCursor $ outputIface vty+                        setCursorPos (outputIface vty) w h+    Nothing -> hideCursor $ outputIface vty    -- Get the next event(s) in the queue.  Returns all available events;   -- blocks until at least one event is available.@@ -114,8 +119,16 @@  instance Exception CollectionError -data Entry = forall a. (Show a) => Entry (Widget a) (Widget FocusGroup)+type EntryShow = IO ()+type EntryHide = IO () +data Entry = forall a. (Show a) => Entry+    { entryWidget :: Widget a+    , entryFocusGroup :: Widget FocusGroup+    , entryShowCallback :: EntryShow+    , entryHideCallback :: EntryHide+    }+ data CollectionData =     CollectionData { entries :: [Entry]                    , currentEntryNum :: Int@@ -132,10 +145,7 @@                                           ]  entryRenderAndPosition :: Entry -> DisplayRegion -> DisplayRegion -> RenderContext -> IO Image-entryRenderAndPosition (Entry w _) = renderAndPosition w--entryFocusGroup :: Entry -> Widget FocusGroup-entryFocusGroup (Entry _ fg) = fg+entryRenderAndPosition (Entry { entryWidget = w }) = renderAndPosition w  -- |Create a new collection. newCollection :: IO Collection@@ -144,24 +154,41 @@                               , currentEntryNum = -1                               } +getMaybeCurrentEntry :: Collection -> IO (Maybe Entry)+getMaybeCurrentEntry cRef = do+  cur <- currentEntryNum <~ cRef+  es <- entries <~ cRef+  if cur == -1+    then return Nothing+    else if cur >= 0 && cur < length es+      then return . Just $ es !! cur+      else return Nothing+ getCurrentEntry :: Collection -> IO Entry getCurrentEntry cRef = do+  maybeEntry <- getMaybeCurrentEntry cRef   cur <- currentEntryNum <~ cRef-  es <- entries <~ cRef-  if cur == -1 then-      throw $ BadCollectionIndex cur else-      if cur >= 0 && cur < length es then-          return $ es !! cur else-          throw $ BadCollectionIndex cur+  case maybeEntry of+    Nothing -> throw $ BadCollectionIndex cur+    Just entry -> return entry  -- |Add a widget and its focus group to a collection.  Returns an -- action which, when invoked, will switch to the interface specified -- in the call. addToCollection :: (Show a) => Collection -> Widget a -> Widget FocusGroup -> IO (IO ())-addToCollection cRef wRef fg = do+addToCollection cRef wRef fg = addToCollectionWithCallbacks cRef wRef fg (return ()) (return ())++-- |Add a widget and its focus group to a collection.  In addition, two+-- callbacks -- one to call when showing the widget and one to call when hiding+-- it (i.e. showing some other widget) -- must be provided.  Returns an action+-- which, when invoked, will switch to the interface specified.+addToCollectionWithCallbacks :: (Show a) => Collection -> Widget a+                             -> Widget FocusGroup -> EntryShow+                             -> EntryHide -> IO (IO ())+addToCollectionWithCallbacks cRef wRef fg onShowCb onHideCb = do   i <- (length . entries) <~ cRef   modifyIORef cRef $ \st ->-      st { entries = (entries st) ++ [Entry wRef fg]+      st { entries = (entries st) ++ [Entry wRef fg onShowCb onHideCb]          , currentEntryNum = if currentEntryNum st == -1                              then 0                              else currentEntryNum st@@ -172,9 +199,18 @@ setCurrentEntry :: Collection -> Int -> IO () setCurrentEntry cRef i = do   st <- readIORef cRef-  if i < length (entries st) && i >= 0 then-      (modifyIORef cRef $ \s -> s { currentEntryNum = i }) else-      throw $ BadCollectionIndex i +  if i < length (entries st) && i >= 0+    then do+      -- Let the old entry know it's no longer current.+      maybeOldEntry <- getMaybeCurrentEntry cRef+      case maybeOldEntry of+        Nothing -> return ()+        Just oldEntry -> entryHideCallback oldEntry+      -- Set the current entry index.+      (modifyIORef cRef $ \s -> s { currentEntryNum = i })+    else throw $ BadCollectionIndex i+   e <- getCurrentEntry cRef+  entryShowCallback e   resetFocusGroup $ entryFocusGroup e
src/Graphics/Vty/Widgets/Fills.hs view
@@ -28,7 +28,7 @@                    let attr' = mergeAttrs [ if foc then focusAttr ctx else overrideAttr ctx                                           , normalAttr ctx                                           ]-                   return $ char_fill attr' ch (region_width s) (region_height s)+                   return $ charFill attr' ch (regionWidth s) (regionHeight s)          , getCursorPosition_ = const $ return Nothing         }@@ -50,7 +50,7 @@                    let attr' = mergeAttrs [ if foc then focusAttr ctx else overrideAttr ctx                                           , normalAttr ctx                                           ]-                   return $ char_fill attr' ch (region_width s) (toEnum height)+                   return $ charFill attr' ch (regionWidth s) (toEnum height)          , getCursorPosition_ = const $ return Nothing         }
src/Graphics/Vty/Widgets/Fixed.hs view
@@ -35,12 +35,12 @@   wRef <- newWidget initSt $ \w ->       w { render_ = \this s ctx -> do                    HFixed width ch <- getState this-                   let region = s `withWidth` fromIntegral (min (toEnum width) (region_width s))+                   let region = s `withWidth` fromIntegral (min (toEnum width) (regionWidth s))                    img <- render ch region ctx                    -- Pad the image if it's smaller than the region.-                   let img' = if image_width img < region_width region-                              then img <|> (char_fill (getNormalAttr ctx) ' '-                                            (toEnum width - image_width img)+                   let img' = if imageWidth img < regionWidth region+                              then img <|> (charFill (getNormalAttr ctx) ' '+                                            (toEnum width - imageWidth img)                                             1)                               else img                    return img'@@ -72,13 +72,13 @@          , render_ = \this s ctx -> do                    VFixed height ch <- getState this-                   let region = s `withHeight` fromIntegral (min (toEnum height) (region_height s))+                   let region = s `withHeight` fromIntegral (min (toEnum height) (regionHeight s))                    img <- render ch region ctx                    -- Pad the image if it's smaller than the region.-                   let img' = if image_height img < region_height region-                              then img <-> (char_fill (getNormalAttr ctx) ' '+                   let img' = if imageHeight img < regionHeight region+                              then img <-> (charFill (getNormalAttr ctx) ' '                                             1-                                            (toEnum height - image_height img))+                                            (toEnum height - imageHeight img))                               else img                    return img'
src/Graphics/Vty/Widgets/Group.hs view
@@ -13,7 +13,7 @@ where  import Control.Monad ( when )-import Graphics.Vty ( empty_image )+import Graphics.Vty ( emptyImage ) import Graphics.Vty.Widgets.Core  -- |A group of widgets of a specified type.@@ -65,7 +65,7 @@         , render_ = \this sz ctx -> do                       cur <- currentEntryNum <~~ this                       case cur of-                        (-1) -> return empty_image+                        (-1) -> return emptyImage                         _ -> do                           e <- currentEntry this                           render e sz ctx
src/Graphics/Vty/Widgets/Limits.hs view
@@ -21,7 +21,6 @@ where  import Control.Monad-import Graphics.Vty import Graphics.Vty.Widgets.Core import Graphics.Vty.Widgets.Util @@ -39,7 +38,7 @@         , growVertical_ = const $ growVertical child         , render_ = \this s ctx -> do                    HLimit width ch <- getState this-                   let region = s `withWidth` fromIntegral (min (toEnum width) (region_width s))+                   let region = s `withWidth` fromIntegral (min (toEnum width) (regionWidth s))                    render ch region ctx          , setCurrentPosition_ =@@ -70,7 +69,7 @@          , render_ = \this s ctx -> do                    VLimit height ch <- getState this-                   let region = s `withHeight` fromIntegral (min (toEnum height) (region_height s))+                   let region = s `withHeight` fromIntegral (min (toEnum height) (regionHeight s))                    render ch region ctx          , setCurrentPosition_ =
src/Graphics/Vty/Widgets/List.hs view
@@ -19,6 +19,8 @@     , addToList     , insertIntoList     , removeFromList+    , setSelectedFocusedAttr+    , setSelectedUnfocusedAttr     -- ** List manipulation     , scrollBy     , scrollUp@@ -92,7 +94,8 @@ -- /value type/ @a@, the type of internal values used to refer to the -- visible representations of the list contents, and the /widget type/ -- @b@, the type of widgets used to represent the list visually.-data List a b = List { selectedUnfocusedAttr :: !Attr+data List a b = List { selectedUnfocusedAttr :: Maybe Attr+                     , selectedFocusedAttr :: Maybe Attr                      , selectedIndex :: !Int                      -- ^The currently selected list index.                      , scrollTopIndex :: !Int@@ -112,6 +115,7 @@ instance Show (List a b) where     show lst = concat [ "List { "                       , "selectedUnfocusedAttr = ", show $ selectedUnfocusedAttr lst+                      , ", selectedFocusedAttr = ", show $ selectedFocusedAttr lst                       , ", selectedIndex = ", show $ selectedIndex lst                       , ", scrollTopIndex = ", show $ scrollTopIndex lst                       , ", scrollWindowSize = ", show $ scrollWindowSize lst@@ -120,16 +124,16 @@                       , " }"                       ] -newListData :: Attr -- ^The attribute of the selected item-            -> Int -- ^Item widget height in rows+newListData :: Int -- ^Item widget height in rows             -> IO (List a b)-newListData selAttr h = do+newListData h = do   schs <- newHandlers   iahs <- newHandlers   irhs <- newHandlers   iacths <- newHandlers -  return $ List { selectedUnfocusedAttr = selAttr+  return $ List { selectedUnfocusedAttr = Nothing+                , selectedFocusedAttr = Nothing                 , selectedIndex = -1                 , scrollTopIndex = 0                 , scrollWindowSize = 0@@ -213,6 +217,18 @@   -- Return the removed item.   return (label, w) +-- |Sets the attributes to be merged on the selected list item when the list+-- widget has the focus.+setSelectedFocusedAttr :: Widget (List a b) -> Maybe Attr -> IO ()+setSelectedFocusedAttr w attr = do+  updateWidgetState w $ \l -> l { selectedFocusedAttr = attr }++-- |Sets the attributes to be merged on the selected list item when the list+-- widget does not have the focus.+setSelectedUnfocusedAttr :: Widget (List a b) -> Maybe Attr -> IO ()+setSelectedUnfocusedAttr w attr = do+  updateWidgetState w $ \l -> l { selectedUnfocusedAttr = attr }+ -- |Add an item to the list.  Its widget will be constructed from the -- specified internal value using the widget constructor passed to -- 'newList'.@@ -301,14 +317,13 @@         , listItems = V.empty         } --- |Create a new list using the specified attribute for the--- currently-selected element when the list does NOT have focus.+-- |Create a new list.  The list's item widgets will be rendered using the+-- specified height in rows. newList :: (Show b) =>-           Attr -- ^The attribute of the selected item-        -> Int -- ^Height of list item widgets in rows+           Int -- ^Height of list item widgets in rows         -> IO (Widget (List a b))-newList selAttr ht = do-  list <- newListData selAttr ht+newList ht = do+  list <- newListData ht   wRef <- newWidget list $ \w ->       w { keyEventHandler = listKeyEvent @@ -331,12 +346,9 @@               -- Resize the list based on the available space and the               -- height of each item.               when (h > 0) $-                   resize this (max 1 ((fromEnum $ region_height sz) `div` h))--              listData <- getState this-              foc <- focused <~ this+                   resizeList this (max 1 ((fromEnum $ regionHeight sz) `div` h)) -              renderListWidget foc listData sz ctx+              renderListWidget this sz ctx          , setCurrentPosition_ =             \this pos -> do@@ -374,55 +386,55 @@     Nothing -> return False     Just (_, (_, e)) -> handleKeyEvent e k mods -renderListWidget :: (Show b) => Bool -> List a b -> DisplayRegion -> RenderContext -> IO Image-renderListWidget foc list s ctx = do+renderListWidget :: (Show b) => Widget (List a b) -> DisplayRegion -> RenderContext -> IO Image+renderListWidget this s ctx = do+  list <- getState this+  foc <- focused <~ this+   let items = map (\((_, w), sel) -> (w, sel)) $ getVisibleItems_ list+      childSelFocAttr   = (maybe (focusAttr ctx) id) $ selectedFocusedAttr list+      childSelUnfocAttr = (maybe (focusAttr ctx) id) $ selectedUnfocusedAttr list       defaultAttr = mergeAttrs [ overrideAttr ctx                                , normalAttr ctx                                ]        renderVisible [] = return []       renderVisible ((w, sel):ws) = do-        na <- normalAttribute <~ w         let att = if sel                   then if foc-                       then focusAttr ctx-                       else mergeAttrs [ selectedUnfocusedAttr list-                                       , defaultAttr-                                       ]-                  else mergeAttrs [ na-                                  , defaultAttr-                                  ]+                       then mergeAttrs [ childSelFocAttr, defaultAttr ]+                       else mergeAttrs [ childSelUnfocAttr, defaultAttr ]+                  else defaultAttr+         -- Height-limit the widget by wrapping it with a VFixed/VLimit         limited <- vLimit (itemHeight list) =<< vFixed (itemHeight list) w          img <- render limited s $ ctx { overrideAttr = att } -        let actualHeight = min (region_height s) (toEnum $ itemHeight list)-            img' = img <|> char_fill att ' '-                   (region_width s - image_width img)+        let actualHeight = min (regionHeight s) (toEnum $ itemHeight list)+            img' = img <|> charFill att ' '+                   (regionWidth s - imageWidth img)                    actualHeight         imgs <- renderVisible ws         return (img':imgs) -  let filler = char_fill defaultAttr ' ' (region_width s) fill_height+  let filler = charFill defaultAttr ' ' (regionWidth s) fill_height       fill_height = if scrollWindowSize list == 0-                    then region_height s+                    then regionHeight s                     else toEnum $ ((scrollWindowSize list - length items) * itemHeight list)    visible_imgs <- renderVisible items -  return $ vert_cat (visible_imgs ++ [filler])+  return $ vertCat (visible_imgs ++ [filler])  -- |A convenience function to create a new list using 'Text' values as -- the internal values and 'FormattedText' widgets to represent those -- strings.-newTextList :: Attr -- ^The attribute of the selected item-            -> [T.Text] -- ^The list items+newTextList :: [T.Text] -- ^The list items             -> Int -- ^Maximum number of rows of text to show per list item             -> IO (Widget (List T.Text FormattedText))-newTextList selAttr labels h = do-  list <- newList selAttr h+newTextList labels h = do+  list <- newList h   forM_ labels $ \l ->       (addToList list l =<< plainText l)   return list@@ -480,8 +492,8 @@   where     matcher = \(match, _) -> item == match -resize :: Widget (List a b) -> Int -> IO ()-resize wRef newSize = do+resizeList :: Widget (List a b) -> Int -> IO ()+resizeList wRef newSize = do   when (newSize == 0) $ throw ResizeError    size <- (scrollWindowSize . state) <~ wRef
src/Graphics/Vty/Widgets/Padding.hs view
@@ -19,7 +19,6 @@     ) where -import Data.Word import Data.Monoid import Graphics.Vty import Graphics.Vty.Widgets.Core@@ -53,16 +52,16 @@ instance Paddable Padding where     pad p1 p2 = p1 +++ p2 -leftPadding :: Padding -> Word+leftPadding :: Padding -> Int leftPadding (Padding _ _ _ l) = toEnum l -rightPadding :: Padding -> Word+rightPadding :: Padding -> Int rightPadding (Padding _ r _ _) = toEnum r -bottomPadding :: Padding -> Word+bottomPadding :: Padding -> Int bottomPadding (Padding _ _ b _) = toEnum b -topPadding :: Padding -> Word+topPadding :: Padding -> Int topPadding (Padding t _ _ _) = toEnum t  -- |Padding constructor with no padding.@@ -111,19 +110,21 @@         , growHorizontal_ = const $ growHorizontal ch          , render_ =-            \this sz ctx ->-                if (region_width sz < 2) || (region_height sz < 2)-                then return empty_image-                else do-                  Padded child p <- getState this+            \this sz ctx -> do+                Padded child p <- getState this++                if (regionWidth sz < leftPadding p + rightPadding p) ||+                   (regionHeight sz < bottomPadding p + topPadding p) then+                  return emptyImage else+                 do                   f <- focused <~ this                    -- Compute constrained space based on padding                   -- settings.                   let constrained = sz `withWidth` (toEnum $ max 0 newWidth)                                     `withHeight` (toEnum $ max 0 newHeight)-                      newWidth = (fromEnum $ region_width sz) - fromEnum (leftPadding p + rightPadding p)-                      newHeight = (fromEnum $ region_height sz) - fromEnum (topPadding p + bottomPadding p)+                      newWidth = (fromEnum $ regionWidth sz) - fromEnum (leftPadding p + rightPadding p)+                      newHeight = (fromEnum $ regionHeight sz) - fromEnum (topPadding p + bottomPadding p)                       attr = mergeAttrs [ if f then focusAttr ctx else overrideAttr ctx                                         , normalAttr ctx                                         ]@@ -132,11 +133,11 @@                   img <- render child constrained ctx                    -- Create padding images.-                  let leftImg = char_fill attr ' ' (leftPadding p) (image_height img)-                      rightImg = char_fill attr ' ' (rightPadding p) (image_height img)-                      topImg = char_fill attr ' ' (image_width img + leftPadding p + rightPadding p)+                  let leftImg = charFill attr ' ' (leftPadding p) (imageHeight img)+                      rightImg = charFill attr ' ' (rightPadding p) (imageHeight img)+                      topImg = charFill attr ' ' (imageWidth img + leftPadding p + rightPadding p)                                (topPadding p)-                      bottomImg = char_fill attr ' ' (image_width img + leftPadding p + rightPadding p)+                      bottomImg = charFill attr ' ' (imageWidth img + leftPadding p + rightPadding p)                                   (bottomPadding p)                    return $ topImg <-> (leftImg <|> img <|> rightImg) <-> bottomImg
src/Graphics/Vty/Widgets/ProgressBar.hs view
@@ -67,9 +67,9 @@        complete_width =           Phys $ fromEnum $ (toRational prog / toRational (100.0 :: Double)) *-                   (toRational $ fromEnum $ region_width size)+                   (toRational $ fromEnum $ regionWidth size) -      full_width = Phys $ fromEnum $ region_width size+      full_width = Phys $ fromEnum $ regionWidth size       full_str = truncateText full_width $ mkStr txt al        mkStr s AlignLeft =
src/Graphics/Vty/Widgets/Table.hs view
@@ -28,7 +28,6 @@ import Data.Monoid import qualified Data.Text as T import Data.Typeable-import Data.Word import Data.List import Control.Applicative hiding ((<|>)) import Control.Exception@@ -216,7 +215,7 @@                      , columnSpecs = specs                      , borderStyle = borderSty                      , numColumns = length specs-                     , borderAttr = def_attr+                     , borderAttr = defAttr                      , defaultCellAlignment = AlignLeft                      , defaultCellPadding = padNone                      }@@ -238,21 +237,21 @@               sideBorderL <- mkSideBorder this ctx True               sideBorderR <- mkSideBorder this ctx False -              let body = vert_cat $ intersperse rowBorder rowImgs-                  withTBBorders = vert_cat [topBorder, body, bottomBorder]-                  withSideBorders = horiz_cat [sideBorderL, withTBBorders, sideBorderR]+              let body = vertCat $ intersperse rowBorder rowImgs+                  withTBBorders = vertCat [topBorder, body, bottomBorder]+                  withSideBorders = horizCat [sideBorderL, withTBBorders, sideBorderR]                -- Ideally, we would only display rows that we have room               -- to render, but this is a much easier cop-out. :)-              if ((region_width sz < image_width withSideBorders) ||-                  (region_height sz < image_height withSideBorders)) then-                  return empty_image else+              if ((regionWidth sz < imageWidth withSideBorders) ||+                  (regionHeight sz < imageHeight withSideBorders)) then+                  return emptyImage else                   return withSideBorders          , setCurrentPosition_ =             \this pos -> do               sz <- getCurrentSize this-              if region_width sz == 0 || region_height sz == 0 then+              if regionWidth sz == 0 || regionHeight sz == 0 then                   return () else                   do                     bs <- borderStyle <~~ this@@ -272,7 +271,7 @@                             cellPhysSizes <- forM row $ \cell ->                                              case cell of                                                TableCell cw _ _ -> getCurrentSize cw-                                               EmptyCell -> return $ DisplayRegion 0 1+                                               EmptyCell -> return (0, 1)                              -- Include 1 as a possible height to                             -- prevent zero-height images from@@ -280,7 +279,7 @@                             -- won't hurt in the case where other                             -- cells are bigger, since their heights                             -- will be chosen instead.-                            let maxSize = maximum $ 1 : map region_height cellPhysSizes+                            let maxSize = maximum $ 1 : map regionHeight cellPhysSizes                                 borderOffset = if rowBorders bs                                                then 1 else 0 @@ -289,7 +288,7 @@                             positionRow this bs rowPos row                             positionRows (height + maxSize + borderOffset) rest -                    positionRows (region_height pos + edgeOffset) rs+                    positionRows (regionHeight pos + edgeOffset) rs         }   return t @@ -322,7 +321,7 @@   bs <- borderStyle <~~ t    if not $ rowBorders bs then-      return empty_image else+      return emptyImage else       mkRowBorder_ t sz ctx intChar  -- Make a row border that matches the width of each row but does not@@ -343,13 +342,13 @@       intersection = string bAttr' [intChar]       imgs = (flip map) szs $ \s ->              case s of-               ColFixed n -> char_fill bAttr' (skinHorizontal sk) n 1-               ColAuto -> char_fill bAttr' (skinHorizontal sk) aw 1+               ColFixed n -> charFill bAttr' (skinHorizontal sk) n 1+               ColAuto -> charFill bAttr' (skinHorizontal sk) aw 1       imgs' = if colBorders bs               then intersperse intersection imgs               else imgs -  return $ horiz_cat imgs'+  return $ horizCat imgs'  mkTopBottomBorder :: Widget Table -> DisplayRegion -> RenderContext -> Char -> IO Image mkTopBottomBorder t sz ctx intChar = do@@ -357,7 +356,7 @@    if edgeBorders bs then       mkRowBorder_ t sz ctx intChar else-      return empty_image+      return emptyImage  -- Make vertical side borders for the table, including row border -- intersections if necessary.@@ -367,7 +366,7 @@    if edgeBorders bs then       mkSideBorder_ t ctx isLeft else-      return empty_image+      return emptyImage  mkSideBorder_ :: Widget Table -> RenderContext -> Bool -> IO Image mkSideBorder_ t ctx isLeft = do@@ -396,16 +395,16 @@   rowHeights <- forM rs $ \(TableRow row) -> do                     hs <- forM row $ \cell ->                           case cell of-                            TableCell cw _ _ -> region_height <$> getCurrentSize cw+                            TableCell cw _ _ -> regionHeight <$> getCurrentSize cw                             EmptyCell -> return 1                     return $ maximum hs -  let borderImgs = (flip map) rowHeights $ \h -> char_fill bAttr' (skinVertical sk) 1 h+  let borderImgs = (flip map) rowHeights $ \h -> charFill bAttr' (skinVertical sk) 1 h       withIntersections = if rowBorders bs                           then intersperse intersection borderImgs                           else borderImgs -  return $ vert_cat $ topCorner : withIntersections ++ [bottomCorner]+  return $ vertCat $ topCorner : withIntersections ++ [bottomCorner]  positionRow :: Widget Table -> BorderStyle -> DisplayRegion -> [TableCell] -> IO () positionRow t bs pos cells = do@@ -434,7 +433,7 @@    doPositioning 0 $ zip szs cells -autoWidth :: Widget Table -> DisplayRegion -> IO Word+autoWidth :: Widget Table -> DisplayRegion -> IO Int autoWidth t sz = do   specs <- columnSpecs <~~ t   bs <- borderStyle <~~ t@@ -448,7 +447,7 @@       edgeWidth = if edgeBorders bs then 2 else 0       colWidth = if colBorders bs then (toEnum $ length sizes - 1) else 0 -  return $ toEnum ((max 0 ((fromEnum $ region_width sz) - totalFixed - edgeWidth - colWidth))+  return $ toEnum ((max 0 ((fromEnum $ regionWidth sz) - totalFixed - edgeWidth - colWidth))                    `div` numAuto)  -- |Add a heading row to a table.  Adds a row using the specified@@ -543,8 +542,8 @@ rowBorders BorderFull = True rowBorders _ = False -rowHeight :: [Image] -> Word-rowHeight = maximum . map image_height+rowHeight :: [Image] -> Int+rowHeight = maximum . map imageHeight  renderRow :: Widget Table -> DisplayRegion -> [TableCell] -> RenderContext -> IO Image renderRow tbl sz cells ctx = do@@ -563,7 +562,7 @@   cellImgs <-       forM (zip cells sizes) $ \(cellW, sizeSpec) ->           do-            let cellSz = DisplayRegion cellWidth (region_height sz)+            let cellSz = (cellWidth, regionHeight sz)                 cellWidth = case sizeSpec of                               ColFixed n -> toEnum n                               ColAuto -> aw@@ -571,16 +570,16 @@             img <- renderCell cellSz cellW $ ctx { normalAttr = newDefault }             -- Right-pad the image if it isn't big enough to fill the             -- cell.-            case compare (image_width img) (region_width cellSz) of+            case compare (imageWidth img) (regionWidth cellSz) of               EQ -> return img-              LT -> return $ img <|> char_fill att ' '-                       (max 0 (region_width cellSz - image_width img))-                       (max (image_height img) 1)+              LT -> return $ img <|> charFill att ' '+                       (max 0 (regionWidth cellSz - imageWidth img))+                       (max (imageHeight img) 1)               GT -> throw CellImageTooBig    let maxHeight = rowHeight cellImgs       cellImgsBottomPadded = (flip map) cellImgs $ \img ->-                             img <-> char_fill att ' ' (image_width img) (maxHeight - image_height img)+                             img <-> charFill att ' ' (imageWidth img) (maxHeight - imageHeight img)    -- If we need to draw borders in between columns, do that.   let bAttr' = mergeAttrs [ overrideAttr ctx@@ -589,6 +588,6 @@                           ]       withBorders = case colBorders borderSty of                       False -> cellImgsBottomPadded-                      True -> intersperse (char_fill bAttr' (skinVertical sk) 1 maxHeight) cellImgsBottomPadded+                      True -> intersperse (charFill bAttr' (skinVertical sk) 1 maxHeight) cellImgsBottomPadded -  return $ horiz_cat withBorders+  return $ horizCat withBorders
src/Graphics/Vty/Widgets/Text.hs view
@@ -57,7 +57,7 @@ -- |The type of formatted text widget state.  Stores the text itself -- and the formatter used to apply attributes to the text. data FormattedText =-    FormattedText { text :: TextStream Attr+    FormattedText { textContent :: TextStream Attr                   , formatter :: !Formatter                   , useFocusAttribute :: !Bool                   }@@ -90,7 +90,7 @@ wrap :: Formatter wrap =     Formatter $ \sz ts -> do-      let width = Phys $ fromEnum $ region_width sz+      let width = Phys $ fromEnum $ fst sz       return $ wrapStream width ts  -- |Construct a text widget formatted with the specified formatters@@ -98,7 +98,7 @@ -- given here (and, depending on the formatter, order might matter). textWidget :: Formatter -> T.Text -> IO (Widget FormattedText) textWidget format s = do-  let initSt = FormattedText { text = TS []+  let initSt = FormattedText { textContent = TS []                              , formatter = format                              , useFocusAttribute = False                              }@@ -110,7 +110,7 @@               ft <- getState this               f <- focused <~ this               appearFocused <- useFocusAttribute <~~ this-              renderText (text ft) (f && appearFocused) (formatter ft) size ctx+              renderText (textContent ft) (f && appearFocused) (formatter ft) size ctx         }   setText wRef s   return wRef@@ -135,17 +135,17 @@ -- |Set the text value of a 'FormattedText' widget.  The specified -- string will be 'tokenize'd. setText :: Widget FormattedText -> T.Text -> IO ()-setText wRef s = setTextWithAttrs wRef [(s, def_attr)]+setText wRef s = setTextWithAttrs wRef [(s, defAttr)]  -- |Append the text value to the text contained in a 'FormattedText' widget. -- The specified string will be 'tokenize'd. appendText :: Widget FormattedText -> T.Text -> IO ()-appendText wRef s = appendTextWithAttrs wRef [(s, def_attr)]+appendText wRef s = appendTextWithAttrs wRef [(s, defAttr)]  -- |Prepend the text value to the text contained in a 'FormattedText' widget. -- The specified string will be 'tokenize'd. prependText :: Widget FormattedText -> T.Text -> IO ()-prependText wRef s = prependTextWithAttrs wRef [(s, def_attr)]+prependText wRef s = prependTextWithAttrs wRef [(s, defAttr)]  -- |Prepend text to the text value of a 'FormattedText' widget directly, in -- case you have done formatting elsewhere and already have text with@@ -155,7 +155,7 @@ prependTextWithAttrs :: Widget FormattedText -> [(T.Text, Attr)] -> IO () prependTextWithAttrs wRef pairs = _setTextWithAttrs wRef pairs f     where-      f st new = let TS old = text st+      f st new = let TS old = textContent st                  in new ++ old  -- |Append text to the text value of a 'FormattedText' widget directly, in case@@ -166,7 +166,7 @@ appendTextWithAttrs :: Widget FormattedText -> [(T.Text, Attr)] -> IO () appendTextWithAttrs wRef pairs = _setTextWithAttrs wRef pairs f     where-      f st new = let TS old = text st+      f st new = let TS old = textContent st                  in old ++ new  -- |Set the text value of a 'FormattedText' widget directly, in case@@ -186,7 +186,7 @@       ts = concat $ map streamEntities streams    updateWidgetState wRef $ \st ->-      st { text = TS $ f st ts }+      st { textContent = TS $ f st ts }  -- |Low-level text-rendering routine. renderText :: TextStream Attr@@ -211,13 +211,13 @@       lineImgs = map mkLineImg ls       lineLength l = length $ tokenStr <$> l       maxLineLength = maximum $ lineLength <$> ls-      emptyLineLength = min (fromEnum $ region_width sz) maxLineLength+      emptyLineLength = min (fromEnum $ fst sz) maxLineLength        ls = map truncLine $ map (map entityToken) $ findLines newText-      truncLine = truncateLine (Phys $ fromEnum $ region_width sz)+      truncLine = truncateLine (Phys $ fromEnum $ fst sz)        -- When building images for empty lines, it's critical that we-      -- *don't* use the empty_image, because that will cause empty+      -- *don't* use the emptyImage, because that will cause empty       -- lines to collapse vertically.  Instead, we create line images       -- using spaces.  When doing this it's important to make them as       -- wide as the rest of the text because otherwise we could have@@ -225,15 +225,15 @@       -- affecting the whole empty line.  We compute the length of the       -- longest line above and use that to build the 'empty' lines.       mkLineImg line = if null line-                       then char_fill attr' ' ' emptyLineLength 1-                       else horiz_cat $ map mkTokenImg line-      nullImg = string def_attr ""+                       then charFill attr' ' ' emptyLineLength 1+                       else horizCat $ map mkTokenImg line+      nullImg = string defAttr ""        mkTokenImg :: Token Attr -> Image       mkTokenImg tok = string (finalAttr tok) (T.unpack $ tokenStr tok) -  return $ if region_height sz == 0+  return $ if snd sz == 0            then nullImg            else if null ls || all null ls                 then nullImg-                else vert_cat $ take (fromEnum $ region_height sz) lineImgs+                else vertCat $ take (fromEnum $ snd sz) lineImgs
src/Graphics/Vty/Widgets/Util.hs view
@@ -18,17 +18,15 @@     , chWidth     , strWidth     , textWidth+    , regionWidth+    , regionHeight     , Phys(..)     ) where  import Control.Applicative-import Data.Word import qualified Data.Text as T import Graphics.Vty-import Graphics.Vty.Image-    ( safe_wcwidth-    )  -- A newtype to wrap physical screen coordinates, as opposed to -- character-logical coordinates.  Used when transforming cursor@@ -38,7 +36,7 @@     deriving (Num, Eq, Show, Ord, Integral, Enum, Real)  chWidth :: Char -> Phys-chWidth = Phys . fromEnum . safe_wcwidth+chWidth = Phys . fromEnum . safeWcwidth  textWidth :: T.Text -> Phys textWidth = strWidth . T.unpack@@ -61,21 +59,21 @@ -- |Infix attribute constructor.  Use: foregroundColor `on` -- backgroundColor. on :: Color -> Color -> Attr-on a b = def_attr `with_back_color` b `with_fore_color` a+on a b = defAttr `withBackColor` b `withForeColor` a  -- |Foreground-only attribute constructor.  Background color and style -- are defaulted. fgColor :: Color -> Attr-fgColor = (def_attr `with_fore_color`)+fgColor = (defAttr `withForeColor`)  -- |Background-only attribute constructor.  Foreground color and style -- are defaulted. bgColor :: Color -> Attr-bgColor = (def_attr `with_back_color`)+bgColor = (defAttr `withBackColor`)  -- |Style-only attribute constructor.  Colors are defaulted. style :: Style -> Attr-style = (def_attr `with_style`)+style = (defAttr `withStyle`)  -- Left-most attribute's fields take precedence. -- |Merge two attributes.  Leftmost attribute takes precedence where@@ -84,42 +82,42 @@ -- style mask will take precedence if any are set. mergeAttr :: Attr -> Attr -> Attr mergeAttr a b =-    let b1 = case attr_style a of-               SetTo v -> b { attr_style = SetTo v }+    let b1 = case attrStyle a of+               SetTo v -> b { attrStyle = SetTo v }                _ -> b-        b2 = case attr_fore_color a of-               SetTo v -> b1 `with_fore_color` v+        b2 = case attrForeColor a of+               SetTo v -> b1 `withForeColor` v                _ -> b1-        b3 = case attr_back_color a of-               SetTo v -> b2 `with_back_color` v+        b3 = case attrBackColor a of+               SetTo v -> b2 `withBackColor` v                _ -> b2     in b3  -- |List fold version of 'mergeAttr'. mergeAttrs :: [Attr] -> Attr-mergeAttrs attrs = foldr mergeAttr def_attr attrs+mergeAttrs attrs = foldr mergeAttr defAttr attrs  -- |Modify the width component of a 'DisplayRegion'.-withWidth :: DisplayRegion -> Word -> DisplayRegion-withWidth (DisplayRegion _ h) w = DisplayRegion w h+withWidth :: DisplayRegion -> Int -> DisplayRegion+withWidth (_, h) w = (w, h)  -- |Modify the height component of a 'DisplayRegion'.-withHeight :: DisplayRegion -> Word -> DisplayRegion-withHeight (DisplayRegion w _) h = DisplayRegion w h+withHeight :: DisplayRegion -> Int -> DisplayRegion+withHeight (w, _) h = (w, h)  -- |Modify the width component of a 'DisplayRegion'.-plusWidth :: DisplayRegion -> Word -> DisplayRegion-plusWidth (DisplayRegion w' h) w =-    if (fromEnum w' + fromEnum w < 0)+plusWidth :: DisplayRegion -> Int -> DisplayRegion+plusWidth (w', h) w =+    if (w' + w < 0)     then error $ "plusWidth: would overflow on " ++ (show w') ++ " + " ++ (show w)-    else DisplayRegion (w + w') h+    else ((w + w'), h)  -- |Modify the height component of a 'DisplayRegion'.-plusHeight :: DisplayRegion -> Word -> DisplayRegion-plusHeight (DisplayRegion w h') h =-    if (fromEnum h' + fromEnum h < 0)+plusHeight :: DisplayRegion -> Int -> DisplayRegion+plusHeight (w, h') h =+    if (h' + h < 0)     then error $ "plusHeight: would overflow on " ++ (show h') ++ " + " ++ (show h)-    else DisplayRegion w (h + h')+    else (w, (h + h'))  remove :: Int -> [a] -> [a] remove pos as = (take pos as) ++ (drop (pos + 1) as)@@ -130,3 +128,9 @@  repl :: Int -> a -> [a] -> [a] repl !pos !a !as = inject pos a (remove pos as)++regionWidth :: DisplayRegion -> Int+regionWidth = fst++regionHeight :: DisplayRegion -> Int+regionHeight = snd
test/src/Tests/FormattedText.hs view
@@ -9,22 +9,23 @@ import Graphics.Vty import Graphics.Vty.Widgets.Text import Graphics.Vty.Widgets.Core+import Graphics.Vty.Widgets.Util  import Tests.Util  import Tests.Instances ()  sz :: DisplayRegion-sz = DisplayRegion 100 100+sz = (100, 100)  textHeight :: Property textHeight =     monadicIO $ forAllM textString $ \str -> do       w <- run $ plainText str       img <- run $ render w sz defaultContext-      if region_height sz == 0 then-          return $ image_height img == 0 else-          return $ image_height img == (toEnum $ numNewlines str + 1)+      if regionHeight sz == 0 then+          return $ imageHeight img == 0 else+          return $ imageHeight img == (toEnum $ numNewlines str + 1)  textImageSize :: Property textImageSize =
test/src/Tests/Instances.hs view
@@ -22,11 +22,6 @@ instance Arbitrary Attr where     arbitrary = Attr <$> arbitrary <*> arbitrary <*> arbitrary -instance Arbitrary DisplayRegion where-    arbitrary = DisplayRegion <$> coord <*> coord-        where-          coord = sized $ \n -> fromIntegral <$> choose (0, n)- instance Random Phys where     random g =         let (val, g') = random g
test/src/Tests/Util.hs view
@@ -12,7 +12,7 @@  imageSize :: Image -> DisplayRegion -> Bool imageSize img sz =-    image_width img <= region_width sz && image_height img <= region_height sz+    imageWidth img <= regionWidth sz && imageHeight img <= regionHeight sz  count :: (a -> Bool) -> [a] -> Int count _ [] = 0@@ -21,15 +21,20 @@ numNewlines :: T.Text -> Int numNewlines = count (== '\n') . T.unpack +sizeGen :: Gen DisplayRegion+sizeGen = (,)+          <$> (arbitrary `suchThat` (>= 0))+          <*> (arbitrary `suchThat` (>= 0))+ sizeTest :: (Show a) => IO (Widget a) -> PropertyM IO Bool sizeTest mkWidget =-    forAllM arbitrary $ \sz -> do+    forAllM sizeGen $ \sz -> do       w <- run mkWidget       img <- run $ render w sz defaultContext-      if region_height sz == 0 || region_width sz == 0 then-          return $ image_height img == 0 && image_width img == 0 else-          return $ image_width img <= region_width sz &&-                 image_height img <= region_height sz+      if regionHeight sz == 0 || regionWidth sz == 0 then+          return $ imageHeight img == 0 && imageWidth img == 0 else+          return $ imageWidth img <= regionWidth sz &&+                 imageHeight img <= regionHeight sz  lineLength :: [Token a] -> Phys lineLength = sum . (textWidth <$>) . (tokenStr <$>)
vty-ui.cabal view
@@ -1,5 +1,5 @@ Name:                vty-ui-Version:             1.7.1+Version:             1.8 Synopsis:   An interactive terminal user interface library for Vty @@ -89,7 +89,7 @@ Library   Build-Depends:     base >= 4 && < 5,-    vty >= 4.7.0.18 && < 5,+    vty >= 5.1.0,     containers >= 0.2 && < 0.6,     regex-base >= 0.93 && < 0.94,     directory >= 1.0 && < 1.3,@@ -99,7 +99,8 @@     stm >= 2.1 && < 2.5,     array >= 0.3.0.0 && < 0.6.0.0,     text >= 0.11,-    vector >= 0.9+    vector >= 0.9,+    data-default >= 0.5.3    GHC-Options:       -Wall @@ -139,11 +140,11 @@     QuickCheck >= 2.4 && < 2.8,     random >= 1.0,     text,-    vty < 5,+    vty >= 5.1.0,     vty-ui    CPP-Options: -DTESTING-  GHC-Options: -Wall+  GHC-Options: -Wall -threaded    if flag(no-tests)     Buildable:     False@@ -162,12 +163,12 @@  Executable vty-ui-collection-demo   Hs-Source-Dirs:  demos-  GHC-Options:     -Wall+  GHC-Options:     -Wall -threaded   Main-is:         CollectionDemo.hs   Build-Depends:     base >= 4 && < 5,     mtl >= 2.0 && < 2.3,-    vty >= 4.7.0.18 && < 5,+    vty >= 5.1.0,     text,     vty-ui   if !flag(demos)@@ -175,12 +176,12 @@  Executable vty-ui-list-demo   Hs-Source-Dirs:  demos-  GHC-Options:     -Wall+  GHC-Options:     -Wall -threaded   Main-is:         ListDemo.hs   Build-Depends:     base >= 4 && < 5,     mtl >= 2.0 && < 2.3,-    vty >= 4.7.0.18 && < 5,+    vty >= 5.1.0,     text,     vty-ui   if !flag(demos)@@ -188,12 +189,12 @@  Executable vty-ui-progressbar-demo   Hs-Source-Dirs:  demos-  GHC-Options:     -Wall+  GHC-Options:     -Wall -threaded   Main-is:         ProgressBarDemo.hs   Build-Depends:     base >= 4 && < 5,     mtl >= 2.0 && < 2.3,-    vty >= 4.7.0.18 && < 5,+    vty >= 5.1.0,     text,     vty-ui   if !flag(demos)@@ -201,7 +202,7 @@  Executable vty-ui-complex-demo   Hs-Source-Dirs:  demos-  GHC-Options:     -Wall+  GHC-Options:     -Wall -threaded   Main-is:         ComplexDemo.hs   Build-Depends:     base >= 4 && < 5,@@ -209,7 +210,7 @@     bytestring >= 0.9 && < 1.0,     time >= 1.1 && < 1.5,     old-locale >= 1.0 && < 1.1,-    vty >= 4.7.0.18 && < 5,+    vty >= 5.1.0,     text,     vty-ui   if !flag(demos)@@ -217,24 +218,24 @@  Executable vty-ui-dirbrowser-demo   Hs-Source-Dirs:  demos-  GHC-Options:     -Wall+  GHC-Options:     -Wall -threaded   Main-is:         DirBrowserDemo.hs   Build-Depends:     base >= 4 && < 5,     mtl >= 2.0 && < 2.3,-    vty >= 4.7.0.18 && < 5,+    vty >= 5.1.0,     vty-ui   if !flag(demos)     Buildable: False  Executable vty-ui-phoneinput-demo   Hs-Source-Dirs:  demos-  GHC-Options:     -Wall+  GHC-Options:     -Wall -threaded   Main-is:         PhoneInputDemo.hs   Build-Depends:     base >= 4 && < 5,     mtl >= 2.0 && < 2.3,-    vty >= 4.7.0.18 && < 5,+    vty >= 5.1.0,     text,     vty-ui   if !flag(demos)@@ -242,12 +243,12 @@  Executable vty-ui-dialog-demo   Hs-Source-Dirs:  demos-  GHC-Options:     -Wall+  GHC-Options:     -Wall -threaded   Main-is:         DialogDemo.hs   Build-Depends:     base >= 4 && < 5,     mtl >= 2.0 && < 2.3,-    vty >= 4.7.0.18 && < 5,+    vty >= 5.1.0,     text,     vty-ui   if !flag(demos)@@ -255,12 +256,12 @@  Executable vty-ui-edit-demo   Hs-Source-Dirs:  demos-  GHC-Options:     -Wall+  GHC-Options:     -Wall -threaded   Main-is:         EditDemo.hs   Build-Depends:     base >= 4 && < 5,     mtl >= 2.0 && < 2.3,-    vty >= 4.7.0.18 && < 5,+    vty >= 5.1.0,     vty-ui   if !flag(demos)     Buildable: False