on develop help sign in
consolidate DisplayLinesWithAlignment and DisplayLines
commit97e0c656171bc0b36e098d27479434642de44d23 authorpdlla <chippermonky@gmail.com> dateMon 12 Apr 2021, 18:08 (6 years ago) parent95141a8
4 files changed+69−189
ChangeLog.md+4 src/Data/Text/Zipper.hs+56−180 src/Reflex/Vty/Widget/Input/Text.hs+1−1 test/Data/Text/ZipperSpec.hs+8−8
ChangeLog.md+4
@@ -68,6 +68,10 @@
6868 * `textInput`: Now requires `HasFocusReader`, `HasInput`, `HasImageWriter`, and `HasDisplayRegion`
6969 * `multilineTextInput`: Now requires `HasFocusReader`, `HasInput`, `HasImageWriter`, and `HasDisplayRegion`
7070 * `textInputTile`: Now requires `HasFocusReader`, `HasInput`, `HasLayout`, and `HasFocus`
71+ * TextZipper interface changes
72+ * `_displayLines_offsetMap` type changed to `OffsetMapWithAlignment`
73+ * `_displayLines_cursorY` replaced with `_displayLines_cursorPos` which include X position
74+ * some exposed methods intended for internal use only have been removed
7175* _Misc_:
7276 * (#40 Add alignment support to TextZipper)[https://github.com/reflex-frp/reflex-vty/pull/40]
7377 * Add alignment (left/center/right) support to TextZipper
src/Data/Text/Zipper.hs+56−180
@@ -193,105 +193,35 @@ fromText = flip insert empty
193193data Span tag = Span tag Text
194194 deriving (Show)
195195
196+-- | Text alignment type
197+data TextAlignment =
198+ TextAlignment_Left
199+ | TextAlignment_Right
200+ | TextAlignment_Center
201+ deriving (Eq, Show)
202+
203+-- A map from the index (row) of display line to (fst,snd)
204+-- fst: leading empty spaces from left (may be negative) to adjust for alignment
205+-- snd: the text offset from the beginning of the document
206+-- to the first character of the display line
207+type OffsetMapWithAlignment = Map Int (Int, Int)
208+
209+-- helper type representing a single visual line that may be part of a wrapped logical line
210+data WrappedLine = WrappedLine
211+ { _wrappedLines_text :: Text
212+ , _wrappedLines_hiddenWhitespace :: Bool -- ^ 'True' if this line ends with a deleted whitespace character
213+ , _wrappedLines_offset :: Int -- ^ offset from beginning of line
214+ }
215+ deriving (Eq, Show)
216+
196217-- | Information about the document as it is displayed (i.e., post-wrapping)
197218data DisplayLines tag = DisplayLines
198219 { _displayLines_spans :: [[Span tag]]
199− , _displayLines_offsetMap :: Map Int Int
200− , _displayLines_cursorY :: Int
220+ , _displayLines_offsetMap :: OffsetMapWithAlignment
221+ , _displayLines_cursorPos :: (Int, Int) -- cursor position relative to upper left hand corner
201222 }
202223 deriving (Show)
203224
204−-- | Given a width and a 'TextZipper', produce a list of display lines
205−-- (i.e., lines of wrapped text) with special attributes applied to
206−-- certain segments (e.g., the cursor). Additionally, produce the current
207−-- y-coordinate of the cursor and a mapping from display line number to text
208−-- offset
209−displayLines
210− :: Int -- ^ Width, used for wrapping
211− -> tag -- ^ Metadata for normal characters
212− -> tag -- ^ Metadata for the cursor
213− -> TextZipper -- ^ The text input contents and cursor state
214− -> DisplayLines tag
215−displayLines width tag cursorTag (TextZipper lb b a la) =
216− let linesBefore :: [[Text]] -- The wrapped lines before the cursor line
217− linesBefore = map (wrapWithOffset width 0) $ reverse lb
218− linesAfter :: [[Text]] -- The wrapped lines after the cursor line
219− linesAfter = map (wrapWithOffset width 0) la
220− offsets :: Map Int Int
221− offsets = offsetMap $ mconcat
222− [ linesBefore
223− , [wrapWithOffset width 0 $ b <> a]
224− , linesAfter
225− ]
226− spansBefore = map ((:[]) . Span tag) $ concat linesBefore
227− spansAfter = map ((:[]) . Span tag) $ concat linesAfter
228− -- Separate the spans before the cursor into
229− -- * spans that are on earlier display lines (though on the same logical line), and
230− -- * spans that are on the same display line
231− (spansCurrentBefore, spansCurLineBefore) = fromMaybe ([], []) $
232− initLast $ map ((:[]) . Span tag) (wrapWithOffset width 0 b)
233− -- Calculate the number of columns on the cursor's display line before the cursor
234− curLineOffset = spansWidth spansCurLineBefore
235− -- Check whether the spans on the current display line are long enough that
236− -- the cursor has to go to the next line
237− cursorAfterEOL = curLineOffset == width
238− cursorCharWidth = case T.uncons a of
239− Nothing -> 1
240− Just (c, _) -> charWidth c
241− -- Separate the span after the cursor into
242− -- * spans that are on the same display line, and
243− -- * spans that are on later display lines (though on the same logical line)
244− (spansCurLineAfter, spansCurrentAfter) = fromMaybe ([], []) $
245− headTail $ case T.uncons a of
246− Nothing -> [[Span cursorTag " "]]
247− Just (c, rest) ->
248− let o = if cursorAfterEOL then cursorCharWidth else curLineOffset + cursorCharWidth
249− cursor = Span cursorTag (T.singleton c)
250− in case map ((:[]) . Span tag) (wrapWithOffset width o rest) of
251− [] -> [[cursor]]
252− (l:ls) -> (cursor : l) : ls
253− in DisplayLines
254− { _displayLines_spans = concat
255− [ spansBefore
256− , spansCurrentBefore
257− , if cursorAfterEOL
258− then [ spansCurLineBefore, spansCurLineAfter ]
259− else [ spansCurLineBefore <> spansCurLineAfter ]
260− , spansCurrentAfter
261− , spansAfter
262− ]
263− , _displayLines_offsetMap = offsets
264− , _displayLines_cursorY = sum
265− [ length spansBefore
266− , length spansCurrentBefore
267− , if cursorAfterEOL then 1 else 0
268− ]
269− }
270− where
271− initLast :: [a] -> Maybe ([a], a)
272− initLast = \case
273− [] -> Nothing
274− (x:xs) -> case initLast xs of
275− Nothing -> Just ([], x)
276− Just (ys, y) -> Just (x:ys, y)
277− headTail :: [a] -> Maybe (a, [a])
278− headTail = \case
279− [] -> Nothing
280− x:xs -> Just (x, xs)
281−
282−-- | Wraps a logical line of text to fit within the given width. The first
283−-- wrapped line is offset by the number of columns provided. Subsequent wrapped
284−-- lines are not.
285−wrapWithOffset
286− :: Int -- ^ Maximum width
287− -> Int -- ^ Offset for first line
288− -> Text -- ^ Text to be wrapped
289− -> [Text]
290−wrapWithOffset maxWidth _ _ | maxWidth <= 0 = []
291−wrapWithOffset maxWidth n xs =
292− let (firstLine, rest) = splitAtWidth (maxWidth - n) xs
293− in firstLine : (fmap (takeWidth maxWidth) . takeWhile (not . T.null) . iterate (dropWidth maxWidth) $ rest)
294−
295225-- | Split a 'Text' at the given column index. For example
296226--
297227-- > splitAtWidth 3 "ᄀabc" == ("ᄀa", "bc")
@@ -339,56 +269,6 @@ dropWidth n = snd . splitAtWidth n
339269charWidth :: Char -> Int
340270charWidth = wcwidth
341271
342−
343−-- | For a given set of wrapped logical lines, computes a map
344−-- from display line index to text offset in the original text.
345−-- This is used to help determine how interactions with the displayed
346−-- text map back to the original text.
347−-- For example, given the document @\"AA\\nBBB\\nCCCCCCCC\\n\"@ wrapped to 5 columns,
348−-- this function will compute the offset in the original document of each character
349−-- in column 1:
350−--
351−-- > AA... (0, 0)
352−-- > BBB.. (1, 3)
353−-- > CCCCC (2, 7) -- (this line wraps to the next row)
354−-- > CCC.. (3, 12)
355−-- > ..... (4, 16)
356−offsetMap
357− :: [[Text]] -- ^ The outer list represents logical lines, and the
358− -- inner list represents the display lines into which
359− -- the logical line has been wrapped
360− -> Map Int Int -- ^ A map from the index (row) of display line to
361− -- the text offset from the beginning of the document
362− -- to the first character of the display line
363−offsetMap ts = evalState (offsetMap' ts) (0, 0)
364− where
365− offsetMap' xs = fmap Map.unions $ forM xs $ \x -> do
366− maps <- forM x $ \line -> do
367− let l = T.length line
368− (dl, o) <- get
369− put (dl + 1, o + l)
370− return $ Map.singleton dl o
371− (dl, o) <- get
372− put (dl, o + 1)
373− return $ Map.insert dl (o + 1) $ Map.unions maps
374−
375−-- | Move the cursor of the given 'TextZipper' to the logical position indicated
376−-- by the given display line coordinates, using the provided 'DisplayLines'
377−-- information. If the x coordinate is beyond the end of a line, the cursor is
378−-- moved to the end of the line.
379−goToDisplayLinePosition :: Int -> Int -> DisplayLines tag -> TextZipper -> TextZipper
380−goToDisplayLinePosition x y dl tz =
381− let offset = Map.lookup y $ _displayLines_offsetMap dl
382− in case offset of
383− Nothing -> tz
384− Just o ->
385− let
386− moveRight = case drop y $ _displayLines_spans dl of
387− [] -> x
388− (s:_) -> charIndexAt x . stream . mconcat . fmap (\(Span _ t) -> t) $ s
389− in rightN (o + min moveRight x) $ top tz
390−
391−
392272-- | Get the width of the text in a set of 'Span's, taking into account unicode character widths
393273spansWidth :: [Span tag] -> Int
394274spansWidth = sum . map (\(Span _ t) -> textWidth t)
@@ -474,33 +354,6 @@ splitWordsAtDisplayWidth maxWidth wwws = reverse $ loop wwws 0 [] where
474354 else loop (x:xs) 0 [] <> modifyOutForNewLine out
475355 else loop xs newWidth $ appendOut out x False
476356
477−data TextAlignment =
478− TextAlignment_Left
479− | TextAlignment_Right
480− | TextAlignment_Center
481− deriving (Eq, Show)
482−
483−-- A map from the index (row) of display line to
484−-- fst: leading empty spaces from left (may be negative) to adjust for alignment
485−-- snd: the text offset from the beginning of the document
486−-- to the first character of the display line
487−type OffsetMapWithAlignment = Map Int (Int, Int)
488−
489−-- | Information about the document as it is displayed (i.e., post-wrapping)
490−data DisplayLinesWithAlignment tag = DisplayLinesWithAlignment
491− { _displayLinesWithAlignment_spans :: [[Span tag]]
492− , _displayLinesWithAlignment_offsetMap :: OffsetMapWithAlignment
493− -- cursor position relative to upper left hand corner
494− , _displayLinesWithAlignment_cursorPos :: (Int, Int) -- cursor position relative to upper left hand corner
495− }
496− deriving (Show)
497−
498−data WrappedLine = WrappedLine
499− { _wrappedLines_text :: Text
500− , _wrappedLines_hiddenWhitespace :: Bool -- ^ 'True' if this line ends with a deleted whitespace character
501− , _wrappedLines_offset :: Int -- ^ offset from beginning of line
502− }
503− deriving (Eq, Show)
504357
505358
506359-- | Wraps a logical line of text to fit within the given width. The first
@@ -555,12 +408,12 @@ offsetMapWithAlignment ts = evalState (offsetMap' ts) (0, 0)
555408-- y-coordinate of the cursor and a mapping from display line number to text
556409-- offset
557410displayLinesWithAlignment
558− :: (Show tag) => TextAlignment
411+ :: TextAlignment
559412 -> Int -- ^ Width, used for wrapping
560413 -> tag -- ^ Metadata for normal characters
561414 -> tag -- ^ Metadata for the cursor
562415 -> TextZipper -- ^ The text input contents and cursor state
563− -> DisplayLinesWithAlignment tag
416+ -> DisplayLines tag
564417displayLinesWithAlignment alignment width tag cursorTag (TextZipper lb b a la) =
565418 let linesBefore :: [[WrappedLine]] -- The wrapped lines before the cursor line
566419 linesBefore = map (wrapWithOffsetAndAlignment alignment width 0) $ reverse lb
@@ -614,8 +467,8 @@ displayLinesWithAlignment alignment width tag cursorTag (TextZipper lb b a la) =
614467 -- a little silly to convert back to text but whatever, it works
615468 cursorX = if cursorAfterEOL then 0 else textWidth (mconcat $ fmap (\(Span _ t) -> t) spansCurLineBefore)
616469
617− in DisplayLinesWithAlignment
618− { _displayLinesWithAlignment_spans = concat
470+ in DisplayLines
471+ { _displayLines_spans = concat
619472 [ spansBefore
620473 , spansCurrentBefore
621474 , if cursorAfterEOL
@@ -624,8 +477,8 @@ displayLinesWithAlignment alignment width tag cursorTag (TextZipper lb b a la) =
624477 , spansCurrentAfter
625478 , spansAfter
626479 ]
627− , _displayLinesWithAlignment_offsetMap = offsets
628− , _displayLinesWithAlignment_cursorPos = (cursorX, cursorY)
480+ , _displayLines_offsetMap = offsets
481+ , _displayLines_cursorPos = (cursorX, cursorY)
629482 }
630483 where
631484 initLast :: [a] -> Maybe ([a], a)
@@ -644,15 +497,38 @@ displayLinesWithAlignment alignment width tag cursorTag (TextZipper lb b a la) =
644497-- by the given display line coordinates, using the provided 'DisplayLinesWithAlignment'
645498-- information. If the x coordinate is beyond the end of a line, the cursor is
646499-- moved to the end of the line.
647−goToDisplayLineWithAlignmentPosition :: Int -> Int -> DisplayLinesWithAlignment tag -> TextZipper -> TextZipper
648−goToDisplayLineWithAlignmentPosition x y dl tz =
649− let offset = Map.lookup y $ _displayLinesWithAlignment_offsetMap dl
500+goToDisplayLinePosition :: Int -> Int -> DisplayLines tag -> TextZipper -> TextZipper
501+goToDisplayLinePosition x y dl tz =
502+ let offset = Map.lookup y $ _displayLines_offsetMap dl
650503 in case offset of
651504 Nothing -> tz
652505 Just (alignOff,o) ->
653506 let
654507 trueX = max 0 (x - alignOff)
655− moveRight = case drop y $ _displayLinesWithAlignment_spans dl of
508+ moveRight = case drop y $ _displayLines_spans dl of
656509 [] -> 0
657510 (s:_) -> charIndexAt trueX . stream . mconcat . fmap (\(Span _ t) -> t) $ s
658511 in rightN (o + moveRight) $ top tz
512+
513+-- | Given a width and a 'TextZipper', produce a list of display lines
514+-- (i.e., lines of wrapped text) with special attributes applied to
515+-- certain segments (e.g., the cursor). Additionally, produce the current
516+-- y-coordinate of the cursor and a mapping from display line number to text
517+-- offset
518+displayLines
519+ :: Int -- ^ Width, used for wrapping
520+ -> tag -- ^ Metadata for normal characters
521+ -> tag -- ^ Metadata for the cursor
522+ -> TextZipper -- ^ The text input contents and cursor state
523+ -> DisplayLines tag
524+displayLines = displayLinesWithAlignment TextAlignment_Left
525+
526+-- | Wraps a logical line of text to fit within the given width. The first
527+-- wrapped line is offset by the number of columns provided. Subsequent wrapped
528+-- lines are not.
529+wrapWithOffset
530+ :: Int -- ^ Maximum width
531+ -> Int -- ^ Offset for first line
532+ -> Text -- ^ Text to be wrapped
533+ -> [Text]
534+wrapWithOffset maxWidth n xs = fmap _wrappedLines_text $ wrapWithOffsetAndAlignment TextAlignment_Left maxWidth n xs
src/Reflex/Vty/Widget/Input/Text.hs+1−1
@@ -65,7 +65,7 @@ textInput cfg = do
6565 <*> (mapZipper <$> _textInputConfig_display cfg <*> v)
6666 <*> cursorAttrs
6767 img = images . _displayLines_spans <$> rows
68− y <- holdUniqDyn $ _displayLines_cursorY <$> rows
68+ y <- holdUniqDyn $ fmap snd _displayLines_cursorPos <$> rows
6969 let newScrollTop :: Int -> (Int, Int) -> Int
7070 newScrollTop st (h, cursorY)
7171 | cursorY < st = cursorY
test/Data/Text/ZipperSpec.hs+8−8
@@ -67,7 +67,7 @@ spec = do
6767 , (4, (2,8)) -- jump by 2 for char and 1 for space
6868 , (5, (3,11)) -- jump by 2 for char and 1 for space
6969 ]
70− it "displayLinesWithAlignment - cursorPos" $ do
70+ it "displayLines - cursorPos" $ do
7171 let
7272 dl0 = displayLinesWithAlignment TextAlignment_Right 10 () () (fromText "")
7373 dl1 = displayLinesWithAlignment TextAlignment_Right 10 () () (fromText "aoeu")
@@ -76,10 +76,10 @@ spec = do
7676 dl4 = displayLinesWithAlignment TextAlignment_Right 10 () () (insertChar 'a' $ fromText "aoeu")
7777 dl5 = displayLinesWithAlignment TextAlignment_Right 10 () () (left $ insertChar 'a' $ fromText "aoeu")
7878 dl6 = displayLinesWithAlignment TextAlignment_Right 10 () () (deleteLeft $ insertChar 'a' $ fromText "aoeu")
79− _displayLinesWithAlignment_cursorPos dl0 `shouldBe` (0,0)
80− _displayLinesWithAlignment_cursorPos dl1 `shouldBe` (4,0)
81− _displayLinesWithAlignment_cursorPos dl2 `shouldBe` (0,1)
82− _displayLinesWithAlignment_cursorPos dl3 `shouldBe` (0,1)
83− _displayLinesWithAlignment_cursorPos dl4 `shouldBe` (5,0)
84− _displayLinesWithAlignment_cursorPos dl5 `shouldBe` (4,0)
85− _displayLinesWithAlignment_cursorPos dl6 `shouldBe` (4,0)
79+ _displayLines_cursorPos dl0 `shouldBe` (0,0)
80+ _displayLines_cursorPos dl1 `shouldBe` (4,0)
81+ _displayLines_cursorPos dl2 `shouldBe` (0,1)
82+ _displayLines_cursorPos dl3 `shouldBe` (0,1)
83+ _displayLines_cursorPos dl4 `shouldBe` (5,0)
84+ _displayLines_cursorPos dl5 `shouldBe` (4,0)
85+ _displayLines_cursorPos dl6 `shouldBe` (4,0)