ae97150 · vty · git.iko.soy

git.iko.soy/vty

on master help sign in

remove the attributechange span op. greatly simplifies layer combining

ae97150Corey O'Connor13 years ago

src/Graphics/Vty/PictureToSpans.hs+11−14

compare with master

unifiedsplit

@@ -121,14 +121,13 @@ substitute_skips (Background {background_char, background_attr}) ops = do

121 return ops

122

123swap_skips_for_single_column_char_span :: Char -> Attr -> SpanOps -> SpanOps

124−swap_skips_for_single_column_char_span c a = Vector.concatMap f

124+swap_skips_for_single_column_char_span c a = Vector.map f

125 where f (Skip ow) = let txt = T.pack $ replicate ow c

126− in Vector.cons (AttributeChange a)

127− (Vector.singleton $ TextSpan ow ow (T.encodeUtf8 txt))

126+ in TextSpan a ow ow (T.encodeUtf8 txt)

128− f v = Vector.singleton v

127+ f v = v

129

128

130swap_skips_for_char_span :: Int -> Char -> Attr -> SpanOps -> SpanOps

129swap_skips_for_char_span :: Int -> Char -> Attr -> SpanOps -> SpanOps

131−swap_skips_for_char_span w c a = Vector.concatMap f

130+swap_skips_for_char_span w c a = Vector.map f

132 where

131 where

133 f (Skip ow) = let txt_0_cw = ow `div` w

132 f (Skip ow) = let txt_0_cw = ow `div` w

134 txt_0 = T.pack $ replicate txt_0_cw c

133 txt_0 = T.pack $ replicate txt_0_cw c

@@ -136,9 +135,8 @@ swap_skips_for_char_span w c a = Vector.concatMap f

136 txt_1 = T.pack $ replicate txt_1_cw '…'

135 txt_1 = T.pack $ replicate txt_1_cw '…'

137 cw = txt_0_cw + txt_1_cw

136 cw = txt_0_cw + txt_1_cw

138 txt = txt_0 `T.append` txt_1

137 txt = txt_0 `T.append` txt_1

139− in Vector.cons (AttributeChange a)

140− (Vector.singleton $ TextSpan ow cw $ T.encodeUtf8 txt)

138+ in TextSpan a ow cw $ T.encodeUtf8 txt

141− f v = Vector.singleton v

139+ f v = v

142

140

143-- | Builds a vector of row operations that will output the given picture to the terminal.

141-- | Builds a vector of row operations that will output the given picture to the terminal.

144--

142--

@@ -202,15 +200,14 @@ add_maybe_clipped (HorizText a text_str ow _cw) = do

202 -- TODO: assumption that text spans are only 1 row high.

200 -- TODO: assumption that text spans are only 1 row high.

203 s <- use skip_rows

201 s <- use skip_rows

204 when (s < 1) $ do

202 when (s < 1) $ do

205− use row_offset >>= snoc_op (AttributeChange a)

206 left_clip <- use skip_columns

203 left_clip <- use skip_columns

207 right_clip <- use remaining_columns

204 right_clip <- use remaining_columns

208 let left_clipped = left_clip > 0

205 let left_clipped = left_clip > 0

209 right_clipped = (ow - left_clip) > right_clip

206 right_clipped = (ow - left_clip) > right_clip

210 if left_clipped || right_clipped

207 if left_clipped || right_clipped

211 then let text_str' = clip_text text_str left_clip right_clip

208 then let text_str' = clip_text text_str left_clip right_clip

212− in add_unclipped_text text_str'

209+ in add_unclipped_text a text_str'

213− else add_unclipped_text text_str

210+ else add_unclipped_text a text_str

214add_maybe_clipped (VertJoin top_image bottom_image _ow oh) = do

211add_maybe_clipped (VertJoin top_image bottom_image _ow oh) = do

215 add_maybe_clipped_join "vert_join" skip_rows remaining_rows row_offset

212 add_maybe_clipped_join "vert_join" skip_rows remaining_rows row_offset

216 (image_height top_image)

213 (image_height top_image)

@@ -302,9 +299,9 @@ clip_text txt left_skip right_clip =

302 clip_for_char_width _ _ _ = error "clip_for_char_width applied to undefined"

299 clip_for_char_width _ _ _ = error "clip_for_char_width applied to undefined"

303 in txt''

300 in txt''

304

301

305−add_unclipped_text :: DisplayText -> BlitM s ()

302+add_unclipped_text :: Attr -> DisplayText -> BlitM s ()

306−add_unclipped_text txt = do

303+add_unclipped_text a txt = do

307− let op = TextSpan used_display_columns

304+ let op = TextSpan a used_display_columns

308 (fromIntegral $ TL.length txt)

305 (fromIntegral $ TL.length txt)

309 (T.encodeUtf8 $ TL.toStrict txt)

306 (T.encodeUtf8 $ TL.toStrict txt)

310 used_display_columns = wcswidth $ TL.unpack txt

307 used_display_columns = wcswidth $ TL.unpack txt

src/Graphics/Vty/Span.hs+5−10

@@ -30,11 +30,10 @@ import qualified Data.Text.Encoding as T

30-- | This represents an operation on the terminal. Either an attribute change or the output of a

31-- text string.

32data SpanOp =

33− AttributeChange !Attr

34 -- | a span of UTF-8 text occupies a specific number of screen space columns. A single UTF

33 -- | a span of UTF-8 text occupies a specific number of screen space columns. A single UTF

35 -- character does not necessarially represent 1 colunm. See Codec.Binary.UTF8.Width

34 -- character does not necessarially represent 1 colunm. See Codec.Binary.UTF8.Width

36 -- TextSpan [output width in columns] [number of characters] [data]

35 -- TextSpan [output width in columns] [number of characters] [data]

37− | TextSpan !Int !Int BS.ByteString

36+ TextSpan !Attr !Int !Int BS.ByteString

38 -- | Skips the given number of columns

37 -- | Skips the given number of columns

39 -- A skip is transparent.... maybe? I am not sure how attribute changes interact.

38 -- A skip is transparent.... maybe? I am not sure how attribute changes interact.

40 -- todo: separate from this type.

39 -- todo: separate from this type.

@@ -56,8 +55,7 @@ type SpanOps = Vector SpanOp

56type DisplayOps = Vector SpanOps

55type DisplayOps = Vector SpanOps

58instance Show SpanOp where

57instance Show SpanOp where

59− show (AttributeChange attr) = show attr

60− show (TextSpan ow cw _) = "TextSpan(" ++ show ow ++ ", " ++ show cw ++ ")"

58+ show (TextSpan attr ow cw _) = "TextSpan(" ++ show attr ++ ")(" ++ show ow ++ ", " ++ show cw ++ ")"

61 show (Skip ow) = "Skip(" ++ show ow ++ ")"

59 show (Skip ow) = "Skip(" ++ show ow ++ ")"

62 show (RowEnd ow) = "RowEnd(" ++ show ow ++ ")"

60 show (RowEnd ow) = "RowEnd(" ++ show ow ++ ")"

@@ -80,24 +78,21 @@ effected_region ops = DisplayRegion (display_ops_columns ops) (display_ops_rows

80span_ops_effected_columns :: SpanOps -> Int

78span_ops_effected_columns :: SpanOps -> Int

81span_ops_effected_columns in_ops = Vector.foldl' span_ops_effected_columns' 0 in_ops

79span_ops_effected_columns in_ops = Vector.foldl' span_ops_effected_columns' 0 in_ops

82 where

80 where

83− span_ops_effected_columns' t (TextSpan w _ _ ) = t + w

81+ span_ops_effected_columns' t (TextSpan _ w _ _ ) = t + w

84 span_ops_effected_columns' t (Skip w) = t + w

82 span_ops_effected_columns' t (Skip w) = t + w

85 span_ops_effected_columns' t (RowEnd w) = t + w

83 span_ops_effected_columns' t (RowEnd w) = t + w

86− span_ops_effected_columns' t _ = t

88-- | The width of a single SpanOp in columns

85-- | The width of a single SpanOp in columns

89span_op_has_width :: SpanOp -> Maybe (Int, Int)

86span_op_has_width :: SpanOp -> Maybe (Int, Int)

90−span_op_has_width (TextSpan ow cw _) = Just (cw, ow)

87+span_op_has_width (TextSpan _ ow cw _) = Just (cw, ow)

91span_op_has_width (Skip ow) = Just (ow,ow)

88span_op_has_width (Skip ow) = Just (ow,ow)

92span_op_has_width (RowEnd ow) = Just (ow,ow)

89span_op_has_width (RowEnd ow) = Just (ow,ow)

93−span_op_has_width _ = Nothing

95-- | returns the number of columns to the character at the given position in the span op

91-- | returns the number of columns to the character at the given position in the span op

96columns_to_char_offset :: Int -> SpanOp -> Int

92columns_to_char_offset :: Int -> SpanOp -> Int

97−columns_to_char_offset cx (TextSpan _ _ utf8_str) =

93+columns_to_char_offset cx (TextSpan _ _ _ utf8_str) =

98 let str = T.unpack (T.decodeUtf8 utf8_str)

94 let str = T.unpack (T.decodeUtf8 utf8_str)

99 in wcswidth (take cx str)

95 in wcswidth (take cx str)

100columns_to_char_offset cx (Skip _) = cx

96columns_to_char_offset cx (Skip _) = cx

101columns_to_char_offset cx (RowEnd _) = cx

97columns_to_char_offset cx (RowEnd _) = cx

102−columns_to_char_offset _cx _ = error "columns_to_char_offset applied to span op without width"

103

src/Graphics/Vty/Terminal/Interface.hs+5−8

@@ -210,13 +210,12 @@ span_ops_required_bytes dc y in_fattr span_ops =

210 span_ops

211

212span_op_required_bytes :: DisplayContext -> FixedAttr -> SpanOp -> (Int, FixedAttr)

213−span_op_required_bytes dc fattr (AttributeChange attr) =

213+span_op_required_bytes dc fattr (TextSpan attr _ _ str) =

214 let attr' = limit_attr_for_display (context_device dc) attr

215 diffs = display_attr_diffs fattr fattr'

216 c = attr_required_bytes dc fattr attr' diffs

217 fattr' = fix_display_attr fattr attr'

218− in (c, fattr')

219−span_op_required_bytes _dc fattr (TextSpan _ _ str) = (utf8_text_required_bytes str, fattr)

218+ in (c + utf8_text_required_bytes str, fattr')

220span_op_required_bytes _dc _fattr (Skip _) = error "span_op_required_bytes for Skip."

219span_op_required_bytes _dc _fattr (Skip _) = error "span_op_required_bytes for Skip."

221span_op_required_bytes dc fattr (RowEnd _) = (row_end_required_bytes dc, fattr)

220span_op_required_bytes dc fattr (RowEnd _) = (row_end_required_bytes dc, fattr)

222

221

@@ -261,15 +260,13 @@ serialize_span_op :: DisplayContext

261 -> OutputBuffer

260 -> OutputBuffer

262 -> FixedAttr

261 -> FixedAttr

263 -> IO (OutputBuffer, FixedAttr)

262 -> IO (OutputBuffer, FixedAttr)

264−serialize_span_op dc (AttributeChange attr) out_ptr fattr = do

263+serialize_span_op dc (TextSpan attr _ _ str) out_ptr fattr = do

265 let attr' = limit_attr_for_display (context_device dc) attr

264 let attr' = limit_attr_for_display (context_device dc) attr

266 fattr' = fix_display_attr fattr attr'

265 fattr' = fix_display_attr fattr attr'

267 diffs = display_attr_diffs fattr fattr'

266 diffs = display_attr_diffs fattr fattr'

268 out_ptr' <- serialize_set_attr dc fattr attr' diffs out_ptr

267 out_ptr' <- serialize_set_attr dc fattr attr' diffs out_ptr

269− return (out_ptr', fattr')

270−serialize_span_op _dc (TextSpan _ _ str) out_ptr fattr = do

271− out_ptr' <- serialize_utf8_text str out_ptr

268+ out_ptr'' <- serialize_utf8_text str out_ptr'

272− return (out_ptr', fattr)

269+ return (out_ptr'', fattr')

273serialize_span_op _dc (Skip _) _out_ptr _fattr = error "serialize_span_op for Skip"

270serialize_span_op _dc (Skip _) _out_ptr _fattr = error "serialize_span_op for Skip"

274serialize_span_op dc (RowEnd _) out_ptr fattr = do

271serialize_span_op dc (RowEnd _) out_ptr fattr = do

275 out_ptr' <- serialize_row_end dc out_ptr

272 out_ptr' <- serialize_row_end dc out_ptr

test/Verify/Graphics/Vty/Span.hs+2−2

@@ -15,8 +15,8 @@ import Data.Word

15import Verify

17is_attr_span_op :: SpanOp -> Bool

18−is_attr_span_op AttributeChange {} = True

18+is_attr_span_op TextSpan {} = True

19−is_attr_span_op _ = False

19+is_attr_span_op _ = False

21verify_all_spans_have_width i spans w

22 = let v = map (\s -> (span_ops_effected_columns s /= w, s)) (Vector.toList spans)