e59ce7f · vty · git.iko.soy

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

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

1111import Graphics.Vty.Span

1212import Graphics.Vty.DisplayRegion

1313

14−import Control.Monad

1514import Data.Array

1615import Data.Word

1716

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−

2617row_ops_effected_columns :: SpanOpSequence -> [Word]

2718row_ops_effected_columns spans

2819 = map span_ops_effected_columns (elems $ row_ops spans)

2920

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

3022all_spans_have_width spans expected

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

3224

3325span_ops_effected_rows :: SpanOpSequence -> Word

34−span_ops_effected_rows (SpanOpSequence _ row_ops)

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

26+span_ops_effected_rows (SpanOpSequence _ the_row_ops)

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

3628

3729type SpanConstructLog = [SpanConstructEvent]

3830data SpanConstructEvent = SpanSetAttr Attr

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

5042

5143type TestWindow = DebugWindow

5244

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]

77data ImageConstructEvent = ImageConstructEvent

88 deriving ( Show, Eq )

99

10+forward_image_ops :: [Image -> Image]

1011forward_image_ops = map forward_transform debug_image_ops

1112

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

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

1718data ImageOp = ImageOp ImageEndo ImageEndo

1819type ImageEndo = Image -> Image

1920

21+debug_image_ops :: [ImageOp]

2022debug_image_ops =

2123 [ id_image_op

2224 -- , render_single_column_char_op

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

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

33{-# LANGUAGE NamedFieldPuns #-}

44{-# LANGUAGE DisambiguateRecordFields #-}

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

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

6+module Graphics.Vty.Image ( DisplayString

7+ , Image(..)

78 , image_width

89 , image_height

910 , (<|>)

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

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

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

323324

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

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+

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

325333safe_wcwidth :: Char -> Word

326334safe_wcwidth c = case wcwidth c of

327− i | i < 0 -> 0

335+ i | i < 0 -> 1

328336 | otherwise -> toEnum i

329337

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

331339safe_wcswidth :: String -> Word

332340safe_wcswidth str = case wcswidth str of

333− i | i < 0 -> 0

341+ i | i < 0 -> 1

334342 | otherwise -> toEnum i

335343

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

src/Graphics/Vty/Picture.hs+3

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

3737 , pic_background :: Background

3838 }

3939

40+instance Show Picture where

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

42+

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

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

4245pic_for_image :: Image -> Picture

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

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

99module Graphics.Vty.Span

1010 where

1111

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

13−

1412import Graphics.Vty.Image

1513import Graphics.Vty.Picture

1614import Graphics.Vty.DisplayRegion

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

2523import qualified Data.ByteString.Internal as BInt

2624import qualified Data.Foldable as Foldable

2725import Data.List

28−import Data.Word

29−import qualified Data.ByteString.UTF8 as BSUTF8

3026import qualified Data.String.UTF8 as UTF8

27+import Data.Word

3128

3229import Foreign.Storable ( pokeByteOff )

3330

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

5350type RowOps = Array Word SpanOps

5451type SpanOps = [SpanOp]

5552

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+

5661span_ops_columns :: SpanOpSequence -> Word

5762span_ops_columns ops = region_width $ effected_region ops

5863

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

204209 else empty_image

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

206211

207−snoc_text_span :: (Foldable.Foldable t)

208− => Attr

209− -> t Char

212+snoc_text_span :: Attr

213+ -> DisplayString

210214 -> MRowOps s

211215 -> Word

212216 -> Word

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

215219snoc_text_span a text_str mrow_ops skip_col y remaining_columns = do

216220 snoc_op mrow_ops y $ AttributeChange a

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

218− build_cropped_txt

222+ build_text_span

219223 ( 0, 0, 0, B.empty )

220224 text_str

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

222226 return $ skip_col - dw'

223227 where

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

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

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

229+ if dw' == skip_col

234230 then if ow' == remaining_columns

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

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

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

237233 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] )

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

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

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

240236 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 )

242238 where

243239 doverflow = skip_col - dw'

244240 ooverflow = remaining_columns - ow'

test/Verify.hs−2

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

2424

2525import Control.Applicative

2626import Control.Monad.State.Strict

27−import Control.Monad.Trans ( liftIO )

2827

2928import Data.IORef

30−import Data.Word

3129

3230import Numeric ( showHex )

3331

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

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

11{-# LANGUAGE ScopedTypeVariables #-}

22module Verify.Graphics.Vty.DisplayRegion ( module Verify.Graphics.Vty.DisplayRegion

33 , module Graphics.Vty.DisplayRegion

4+ , DebugWindow(..)

45 )

56 where

67

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

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

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

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

5252 -- must be 1

53− single_column_row_text <- resize 512 (listOf1 arbitrary)

53+ single_column_row_text <- resize 128 (listOf1 arbitrary)

5454 attr <- arbitrary

5555 return $ SingleRowSingleAttrImage

5656 attr

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

8080

8181instance Arbitrary SingleAttrSingleSpanStack where

8282 arbitrary = do

83− image_list <- resize 512 (listOf1 arbitrary)

83+ image_list <- resize 128 (listOf1 arbitrary)

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

8585 return $ SingleAttrSingleSpanStack

8686 image

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

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

2020verify_all_spans_have_width i spans w

2121 = case all_spans_have_width spans w of

2222 True -> succeeded

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

24− ++ show w

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

26− ++ show i

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

28− ++ show spans

29− }

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

24+ ++ show w

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

26+ ++ show i

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

28+ ++ show spans

29+ }

30+

test/verify_span_ops.hs+20−19

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

150150

151151main :: IO ()

152152main = run_test $ do

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

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

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

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

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

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

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

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

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

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

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

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

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

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

166166 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]"

168168 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]"

170170 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]"

172172 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]"

174174 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]"

176176 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]"

178178 single_attr_single_span_stack_cropped_5

179179 return ()

180+