e59ce7f · vty · git.iko.soy

src/Graphics/Vty/Debug.hs+3−13

compare with master

unifiedsplit

@@ -11,28 +11,20 @@ import Graphics.Vty.Picture

11import Graphics.Vty.Span

12import Graphics.Vty.DisplayRegion

13

14−import Control.Monad

15import Data.Array

14import Data.Array

16import Data.Word

15import Data.Word

17

16

18−instance Show SpanOpSequence where

19− show (SpanOpSequence _ row_ops)

20− = concat $ ["{ "] ++ map (\ops -> show ops ++ "; " ) (elems row_ops) ++ [" }"]

21−

22−instance Show SpanOp where

23− show (AttributeChange attr) = show attr

24− show (TextSpan ow cw _) = "TextSpan " ++ show ow ++ " " ++ show cw

25−

26row_ops_effected_columns :: SpanOpSequence -> [Word]

17row_ops_effected_columns :: SpanOpSequence -> [Word]

27row_ops_effected_columns spans

18row_ops_effected_columns spans

28 = map span_ops_effected_columns (elems $ row_ops spans)

19 = map span_ops_effected_columns (elems $ row_ops spans)

29

20

21+all_spans_have_width :: SpanOpSequence -> Word -> Bool

30all_spans_have_width spans expected

22all_spans_have_width spans expected

31 = all (== expected) ( map span_ops_effected_columns (elems $ row_ops spans) )

23 = all (== expected) ( map span_ops_effected_columns (elems $ row_ops spans) )

32

24

33span_ops_effected_rows :: SpanOpSequence -> Word

25span_ops_effected_rows :: SpanOpSequence -> Word

34−span_ops_effected_rows (SpanOpSequence _ row_ops)

26+span_ops_effected_rows (SpanOpSequence _ the_row_ops)

35− = toEnum $ length (filter (not . null) (elems row_ops))

27+ = toEnum $ length (filter (not . null) (elems the_row_ops))

36

28

37type SpanConstructLog = [SpanConstructEvent]

29type SpanConstructLog = [SpanConstructEvent]

38data SpanConstructEvent = SpanSetAttr Attr

30data SpanConstructEvent = SpanSetAttr Attr

@@ -50,5 +42,3 @@ region_for_window (DebugWindow w h) = DisplayRegion w h

50

42

51type TestWindow = DebugWindow

43type TestWindow = DebugWindow

52

44

53−instance Show Picture where

54− show (Picture _ image _ ) = "Picture ?? " ++ show image ++ " ??"

src/Graphics/Vty/Debug/Image.hs+2

@@ -7,6 +7,7 @@ type ImageConstructLog = [ImageConstructEvent]

7data ImageConstructEvent = ImageConstructEvent

8 deriving ( Show, Eq )

9

10+forward_image_ops :: [Image -> Image]

10forward_image_ops = map forward_transform debug_image_ops

11forward_image_ops = map forward_transform debug_image_ops

11

12

12forward_transform, reverse_transform :: ImageOp -> (Image -> Image)

13forward_transform, reverse_transform :: ImageOp -> (Image -> Image)

@@ -17,6 +18,7 @@ reverse_transform (ImageOp _ r) = r

17data ImageOp = ImageOp ImageEndo ImageEndo

18data ImageOp = ImageOp ImageEndo ImageEndo

18type ImageEndo = Image -> Image

19type ImageEndo = Image -> Image

19

20

21+debug_image_ops :: [ImageOp]

20debug_image_ops =

22debug_image_ops =

21 [ id_image_op

23 [ id_image_op

22 -- , render_single_column_char_op

24 -- , render_single_column_char_op

src/Graphics/Vty/Image.hs+13−5

@@ -3,7 +3,8 @@

3{-# LANGUAGE NamedFieldPuns #-}

4{-# LANGUAGE DisambiguateRecordFields #-}

5{-# OPTIONS_GHC -funbox-strict-fields #-}

6−module Graphics.Vty.Image ( Image(..)

6+module Graphics.Vty.Image ( DisplayString

7+ , Image(..)

7 , image_width

8 , image_width

8 , image_height

9 , image_height

9 , (<|>)

10 , (<|>)

@@ -321,16 +322,23 @@ string = iso_10646_string

321utf8_string :: Attr -> [Word8] -> Image

322utf8_string :: Attr -> [Word8] -> Image

322utf8_string !a !str = string a ( decode str )

323utf8_string !a !str = string a ( decode str )

323

324

325+-- XXX: Characters with unknown widths occupy 1 column?

326+--

327+-- Not sure if this is actually correct. I presume there is a replacement character that is output

328+-- by the terminal instead of the character and this replacement character is 1 column wide. If this

329+-- is not true for all terminals then a per-terminal replacement character width needs to be

330+-- implemented.

331+

324−-- | Returns the display width of a character. Assumes all characters with unknown widths are 0 width

332+-- | Returns the display width of a character. Assumes all characters with unknown widths are 1 width

325safe_wcwidth :: Char -> Word

333safe_wcwidth :: Char -> Word

326safe_wcwidth c = case wcwidth c of

334safe_wcwidth c = case wcwidth c of

327− i | i < 0 -> 0

335+ i | i < 0 -> 1

328 | otherwise -> toEnum i

336 | otherwise -> toEnum i

329

337

330−-- | Returns the display width of a string. Assumes all characters with unknown widths are 0 width

338+-- | Returns the display width of a string. Assumes all characters with unknown widths are 1 width

331safe_wcswidth :: String -> Word

339safe_wcswidth :: String -> Word

332safe_wcswidth str = case wcswidth str of

340safe_wcswidth str = case wcswidth str of

333− i | i < 0 -> 0

341+ i | i < 0 -> 1

334 | otherwise -> toEnum i

342 | otherwise -> toEnum i

335

343

336-- | Renders a UTF-8 encoded bytestring.

344-- | Renders a UTF-8 encoded bytestring.

src/Graphics/Vty/Picture.hs+3

@@ -37,6 +37,9 @@ data Picture = Picture

37 , pic_background :: Background

38 }

39

40+instance Show Picture where

41+ show (Picture _ image _ ) = "Picture ?? " ++ show image ++ " ??"

42+

40-- | Create a picture for display for the given image. The picture will not have a displayed cursor

43-- | Create a picture for display for the given image. The picture will not have a displayed cursor

41-- and the background display attribute will be `current_attr`.

44-- and the background display attribute will be `current_attr`.

42pic_for_image :: Image -> Picture

45pic_for_image :: Image -> Picture

src/Graphics/Vty/Span.hs+18−22

@@ -9,8 +9,6 @@

9module Graphics.Vty.Span

10 where

11

12−import Codec.Binary.UTF8.Width ( wcwidth )

13−

14import Graphics.Vty.Image

12import Graphics.Vty.Image

15import Graphics.Vty.Picture

13import Graphics.Vty.Picture

16import Graphics.Vty.DisplayRegion

14import Graphics.Vty.DisplayRegion

@@ -25,9 +23,8 @@ import qualified Data.ByteString as B

25import qualified Data.ByteString.Internal as BInt

23import qualified Data.ByteString.Internal as BInt

26import qualified Data.Foldable as Foldable

24import qualified Data.Foldable as Foldable

27import Data.List

25import Data.List

28−import Data.Word

29−import qualified Data.ByteString.UTF8 as BSUTF8

30import qualified Data.String.UTF8 as UTF8

26import qualified Data.String.UTF8 as UTF8

27+import Data.Word

31

28

32import Foreign.Storable ( pokeByteOff )

29import Foreign.Storable ( pokeByteOff )

33

30

@@ -53,6 +50,14 @@ data SpanOpSequence = SpanOpSequence

53type RowOps = Array Word SpanOps

50type RowOps = Array Word SpanOps

54type SpanOps = [SpanOp]

51type SpanOps = [SpanOp]

55

52

53+instance Show SpanOpSequence where

54+ show (SpanOpSequence _ the_row_ops)

55+ = concat $ ["{ "] ++ map (\ops -> show ops ++ "; " ) (elems the_row_ops) ++ [" }"]

56+

57+instance Show SpanOp where

58+ show (AttributeChange attr) = show attr

59+ show (TextSpan ow cw _) = "TextSpan " ++ show ow ++ " " ++ show cw

60+

56span_ops_columns :: SpanOpSequence -> Word

61span_ops_columns :: SpanOpSequence -> Word

57span_ops_columns ops = region_width $ effected_region ops

62span_ops_columns ops = region_width $ effected_region ops

58

63

@@ -204,9 +209,8 @@ ops_for_row mrow_ops bg region image skip_dim@(skip_row,skip_col) y remaining_co

204 else empty_image

209 else empty_image

205 ops_for_row mrow_ops bg region ((i <|> hpad) <-> vpad) skip_dim y remaining_columns

210 ops_for_row mrow_ops bg region ((i <|> hpad) <-> vpad) skip_dim y remaining_columns

206

211

207−snoc_text_span :: (Foldable.Foldable t)

212+snoc_text_span :: Attr

208− => Attr

213+ -> DisplayString

209− -> t Char

210 -> MRowOps s

214 -> MRowOps s

211 -> Word

215 -> Word

212 -> Word

216 -> Word

@@ -215,30 +219,22 @@ snoc_text_span :: (Foldable.Foldable t)

215snoc_text_span a text_str mrow_ops skip_col y remaining_columns = do

219snoc_text_span a text_str mrow_ops skip_col y remaining_columns = do

216 snoc_op mrow_ops y $ AttributeChange a

220 snoc_op mrow_ops y $ AttributeChange a

217 let (ow', dw', cw', txt) = Foldable.foldl'

221 let (ow', dw', cw', txt) = Foldable.foldl'

218− build_cropped_txt

222+ build_text_span

219 ( 0, 0, 0, B.empty )

223 ( 0, 0, 0, B.empty )

220 text_str

224 text_str

221 snoc_op mrow_ops y $ TextSpan ow' cw' (UTF8.fromRep txt)

225 snoc_op mrow_ops y $ TextSpan ow' cw' (UTF8.fromRep txt)

222 return $ skip_col - dw'

226 return $ skip_col - dw'

223 where

227 where

224− build_cropped_txt (ow', dw', char_count', b0) c = {-# SCC "build_cropped_txt" #-}

228+ build_text_span (ow', dw', char_count', b0) (c,w) = {-# SCC "build_text_span" #-}

225− let w = wcwidth c

226− -- Characters with unknown widths occupy 1 column.

227− --

228− -- todo: Not sure if this is actually correct.

229− -- I presume there is a replacement character that is output by the terminal instead of

230− -- the character. If so then this replacement process may need to be implemented

231− -- manually for consistent behavior across terminals.

232− w' = toEnum $ if w < 0 then 1 else w

233− in if dw' == skip_col

229+ if dw' == skip_col

234 then if ow' == remaining_columns

230 then if ow' == remaining_columns

235 then ( ow', dw', char_count', b0 )

231 then ( ow', dw', char_count', b0 )

236− else if (w' + ow') > remaining_columns

232+ else if (w + ow') > remaining_columns

237 then ( remaining_columns, dw', char_count' + ooverflow, B.append b0 $ B.pack $ encode $ genericReplicate ooverflow '…' )

233 then ( remaining_columns, dw', char_count' + ooverflow, B.append b0 $ B.pack $ encode $ genericReplicate ooverflow '…' )

238− else ( ow' + w', dw', char_count' + 1, B.append b0 $ B.pack $ encode [c] )

234+ else ( ow' + w, dw', char_count' + 1, B.append b0 $ B.pack $ encode [c] )

239− else if (w' + dw') > skip_col

235+ else if (w + dw') > skip_col

240 then ( doverflow, skip_col, doverflow, B.append b0 $ B.pack $ encode $ genericReplicate doverflow '…' )

236 then ( doverflow, skip_col, doverflow, B.append b0 $ B.pack $ encode $ genericReplicate doverflow '…' )

241− else ( ow', w' + dw', char_count', b0 )

237+ else ( ow', w + dw', char_count', b0 )

242 where

238 where

243 doverflow = skip_col - dw'

239 doverflow = skip_col - dw'

244 ooverflow = remaining_columns - ow'

240 ooverflow = remaining_columns - ow'

test/Verify.hs−2

@@ -24,10 +24,8 @@ import qualified Codec.Binary.UTF8.String as UTF8

24

25import Control.Applicative

26import Control.Monad.State.Strict

27−import Control.Monad.Trans ( liftIO )

28

27

29import Data.IORef

28import Data.IORef

30−import Data.Word

31

29

32import Numeric ( showHex )

30import Numeric ( showHex )

33

31

test/Verify/Graphics/Vty/DisplayRegion.hs+1

@@ -1,6 +1,7 @@

1{-# LANGUAGE ScopedTypeVariables #-}

2module Verify.Graphics.Vty.DisplayRegion ( module Verify.Graphics.Vty.DisplayRegion

3 , module Graphics.Vty.DisplayRegion

4+ , DebugWindow(..)

4 )

5 )

5 where

6 where

6

7

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

@@ -50,7 +50,7 @@ instance Arbitrary SingleRowSingleAttrImage where

50 -- The text must contain at least one character. Otherwise the image simplifies to the

51 -- IdImage which has a height of 0. If this is to represent a single row then the height

52 -- must be 1

53− single_column_row_text <- resize 512 (listOf1 arbitrary)

53+ single_column_row_text <- resize 128 (listOf1 arbitrary)

54 attr <- arbitrary

55 return $ SingleRowSingleAttrImage

56 attr

@@ -80,7 +80,7 @@ data SingleAttrSingleSpanStack = SingleAttrSingleSpanStack

80

81instance Arbitrary SingleAttrSingleSpanStack where

82 arbitrary = do

83− image_list <- resize 512 (listOf1 arbitrary)

83+ image_list <- resize 128 (listOf1 arbitrary)

84 let image = vert_cat [ i | SingleRowSingleAttrImage { row_image = i } <- image_list ]

85 return $ SingleAttrSingleSpanStack

86 image

test/Verify/Graphics/Vty/Span.hs+8−7

@@ -20,10 +20,11 @@ is_attr_span_op _ = False

20verify_all_spans_have_width i spans w

21 = case all_spans_have_width spans w of

22 True -> succeeded

23− False -> failed $ result { reason = "Not all spans contained operations defining exactly "

23+ False -> failed { reason = "Not all spans contained operations defining exactly "

24− ++ show w

24+ ++ show w

25− ++ " columns of output -\n"

25+ ++ " columns of output -\n"

26− ++ show i

26+ ++ show i

27− ++ "\n->\n"

27+ ++ "\n->\n"

28− ++ show spans

28+ ++ show spans

29− }

29+ }

30+

test/verify_span_ops.hs+20−19

@@ -150,30 +150,31 @@ single_attr_single_span_stack_op_coverage stack =

150

151main :: IO ()

152main = run_test $ do

153− verify "unit image is cropped when window size == (0,0) [0]" unit_image_and_zero_window_0

153+ _ <- verify "unit image is cropped when window size == (0,0) [0]" unit_image_and_zero_window_0

154− verify "unit image is cropped when window size == (0,0) [1]" unit_image_and_zero_window_1

154+ _ <- verify "unit image is cropped when window size == (0,0) [1]" unit_image_and_zero_window_1

155− verify "horiz span image is cropped when window size == (0,0) [0]" horiz_span_image_and_zero_window_0

155+ _ <- verify "horiz span image is cropped when window size == (0,0) [0]" horiz_span_image_and_zero_window_0

156− verify "horiz span image is cropped when window size == (0,0) [1]" horiz_span_image_and_zero_window_1

156+ _ <- verify "horiz span image is cropped when window size == (0,0) [1]" horiz_span_image_and_zero_window_1

157− verify "horiz span image is not cropped when window size == size of image [width]" horiz_span_image_and_equal_window_0

157+ _ <- verify "horiz span image is not cropped when window size == size of image [width]" horiz_span_image_and_equal_window_0

158− verify "horiz span image is not cropped when window size == size of image [height]" horiz_span_image_and_equal_window_1

158+ _ <- verify "horiz span image is not cropped when window size == size of image [height]" horiz_span_image_and_equal_window_1

159− verify "horiz span image is not cropped when window size < size of image [width]" horiz_span_image_and_lesser_window_0

159+ _ <- verify "horiz span image is not cropped when window size < size of image [width]" horiz_span_image_and_lesser_window_0

160− verify "horiz span image is not cropped when window size > size of image [width]" horiz_span_image_and_greater_window_0

160+ _ <- verify "horiz span image is not cropped when window size > size of image [width]" horiz_span_image_and_greater_window_0

161− verify "arbitrary image is padded or cropped" arb_image_is_cropped

161+ _ <- verify "arbitrary image is padded or cropped" arb_image_is_cropped

162− verify "The span ops actually define content for all the rows in the output region" span_ops_actually_fill_rows

162+ _ <- verify "The span ops actually define content for all the rows in the output region" span_ops_actually_fill_rows

163− verify "The span ops actually define content for all the columns in the output region" span_ops_actually_fill_columns

163+ _ <- verify "The span ops actually define content for all the columns in the output region" span_ops_actually_fill_columns

164− verify "first span op is always to set the text attribute" first_span_op_sets_attr

164+ _ <- verify "first span op is always to set the text attribute" first_span_op_sets_attr

165− verify "a stack of single attr text spans should define content for all the columns [output region == size of stack]"

165+ _ <- verify "a stack of single attr text spans should define content for all the columns [output region == size of stack]"

166 single_attr_single_span_stack_op_coverage

167− verify "a single attr text span is cropped when window size < size of stack image [width]"

167+ _ <- verify "a single attr text span is cropped when window size < size of stack image [width]"

168 single_attr_single_span_stack_cropped_0

169− verify "a single attr text span is cropped when window size < size of stack image [height]"

169+ _ <- verify "a single attr text span is cropped when window size < size of stack image [height]"

170 single_attr_single_span_stack_cropped_1

171− verify "single attr text span <|> single attr text span cropped. [width]"

171+ _ <- verify "single attr text span <|> single attr text span cropped. [width]"

172 single_attr_single_span_stack_cropped_2

173− verify "single attr text span <|> single attr text span cropped. [height]"

173+ _ <- verify "single attr text span <|> single attr text span cropped. [height]"

174 single_attr_single_span_stack_cropped_3

175− verify "single attr text span <-> single attr text span cropped. [width]"

175+ _ <- verify "single attr text span <-> single attr text span cropped. [width]"

176 single_attr_single_span_stack_cropped_4

177− verify "single attr text span <-> single attr text span cropped. [height]"

177+ _ <- verify "single attr text span <-> single attr text span cropped. [height]"

178 single_attr_single_span_stack_cropped_5

179 return ()

180+