on master help sign in
Resolve #76. Terminfo "clear to end of line" does not mean what I thought it means.

I though this would clear the text and current display attributes from the cursor to end of the line. This is not the case. The display attribute is state of the output cursor and not the already dislayed text. This change sets the default display attributes at the end of a line as well as the start of a new line. This passes all the tests but will cause a regression in Yi: The display of a selection area will not extend to the end of the screen. However, I have a branch of Yi that adds vertical splits. In order to implement this the selection area display code needed to handle extending the image to the end of the frame.

commitcceeeeeeb2a268fcc29831e76e208e8efa1757e2 authorCorey O'Connor <coreyoconnor@gmail.com> dateSat 8 Aug 2015, 18:14 (11 years ago) parent7617f21
3 files changed+29−22
src/Graphics/Vty/Output/Interface.hs+19−19 src/Graphics/Vty/PictureToSpans.hs+1−2 test/interactive_terminal_test.hs+9−1
src/Graphics/Vty/Output/Interface.hs+19−19
@@ -149,7 +149,6 @@ outputPicture dc pic = liftIO $ do
149149 (Vector.toList ops)
150150 -- build the Write corresponding to the output image
151151 out = (if manipCursor then writeHideCursor dc else mempty)
152− `mappend` writeDefaultAttr dc
153152 `mappend` writeOutputOps dc initialAttr diffs ops
154153 `mappend`
155154 (case picCursor pic of
@@ -167,30 +166,31 @@ outputPicture dc pic = liftIO $ do
167166 writeIORef (assumedStateRef $ contextDevice dc) as'
168167
169168writeOutputOps :: DisplayContext -> FixedAttr -> [Bool] -> DisplayOps -> Write
170−writeOutputOps dc inFattr diffs ops =
171− let (_, out, _, _) = Vector.foldl' writeOutputOps'
172− (0, mempty, inFattr, diffs)
169+writeOutputOps dc initialAttr diffs ops =
170+ let (_, out, _) = Vector.foldl' writeOutputOps'
171+ (0, mempty, diffs)
173172 ops
174173 in out
175174 where
176− writeOutputOps' (y, out, fattr, True : diffs') spanOps
177− = let (spanOut, fattr') = writeSpanOps dc y fattr spanOps
178− in (y+1, out `mappend` spanOut, fattr', diffs')
179− writeOutputOps' (y, out, fattr, False : diffs') _spanOps
180− = (y + 1, out, fattr, diffs')
181− writeOutputOps' (_y, _out, _fattr, []) _spanOps
175+ writeOutputOps' (y, out, True : diffs') spanOps
176+ = let spanOut = writeSpanOps dc y initialAttr spanOps
177+ out' = out `mappend` spanOut
178+ in (y+1, out', diffs')
179+ writeOutputOps' (y, out, False : diffs') _spanOps
180+ = (y + 1, out, diffs')
181+ writeOutputOps' (_y, _out, []) _spanOps
182182 = error "vty - output spans without a corresponding diff."
183183
184−writeSpanOps :: DisplayContext -> Int -> FixedAttr -> SpanOps -> (Write, FixedAttr)
185−writeSpanOps dc y inFattr spanOps =
184+writeSpanOps :: DisplayContext -> Int -> FixedAttr -> SpanOps -> Write
185+writeSpanOps dc y initialAttr spanOps =
186186 -- The first operation is to set the cursor to the start of the row
187− let start = writeMoveCursor dc 0 y
187+ let start = writeMoveCursor dc 0 y `mappend` writeDefaultAttr dc
188188 -- then the span ops are serialized in the order specified
189− in Vector.foldl' (\(out, fattr) op -> case writeSpanOp dc op fattr of
190− (opOut, fattr') -> (out `mappend` opOut, fattr')
191− )
192− (start, inFattr)
193− spanOps
189+ in fst $ Vector.foldl' (\(out, fattr) op -> case writeSpanOp dc op fattr of
190+ (opOut, fattr') -> (out `mappend` opOut, fattr')
191+ )
192+ (start, initialAttr)
193+ spanOps
194194
195195writeSpanOp :: DisplayContext -> SpanOp -> FixedAttr -> (Write, FixedAttr)
196196writeSpanOp dc (TextSpan attr _ _ str) fattr =
@@ -201,7 +201,7 @@ writeSpanOp dc (TextSpan attr _ _ str) fattr =
201201 `mappend` writeUtf8Text (T.encodeUtf8 $ TL.toStrict str)
202202 in (out, fattr')
203203writeSpanOp _dc (Skip _) _fattr = error "writeSpanOp for Skip"
204−writeSpanOp dc (RowEnd _) fattr = (writeRowEnd dc, fattr)
204+writeSpanOp dc (RowEnd _) fattr = (writeDefaultAttr dc `mappend` writeRowEnd dc, fattr)
205205
206206-- | The cursor position is given in X,Y character offsets. Due to multi-column characters this
207207-- needs to be translated to column, row positions.
src/Graphics/Vty/PictureToSpans.hs+1−2
@@ -221,8 +221,7 @@ buildSpans image outRegion = do
221221 return ()
222222 return outOps
223223
224−-- | Add the operations required to build a given image to the current set of row operations
225−-- returns the number of columns and rows contributed to the output.
224+-- | Add the operations required to build a given image to the current set of row operations.
226225startImageBuild :: Image -> BlitM s ()
227226startImageBuild image = do
228227 outOfBounds <- isOutOfBounds image <$> get
test/interactive_terminal_test.hs+9−1
@@ -1150,13 +1150,21 @@ cheesyAnim0 i background = do
11501150 reserveDisplay t
11511151 bounds <- displayBounds t
11521152 d <- displayContext t bounds
1153− forM_ [0..100] $ \t -> do
1153+ forM_ [0..2] $ \t -> do
1154+ forM_ [0..100] $ \t -> do
11541155 let i_offset = translate (t `mod` fst bounds)
11551156 (t `div` 2 `mod` snd bounds)
11561157 i
11571158 let pic = picForLayers $ i_offset : background
11581159 outputPicture d pic
11591160 threadDelay 50000
1161+ forM_ [0..100] $ \t -> do
1162+ let i_offset = translate (t * (-1) `mod` fst bounds)
1163+ (t * (-1) `div` 2 `mod` snd bounds)
1164+ i
1165+ let pic = picForLayers $ i_offset : background
1166+ outputPicture d pic
1167+ threadDelay 50000
11601168 releaseDisplay t
11611169 releaseTerminal t
11621170 return ()