git.iko.soy/vty
on master help sign in
test fixes
2f8e0bcCorey O'Connor
CHANGELOG+16−7
compare with master
unifiedsplit
@@ -1,12 +1,21 @@
15.0.0
15.0.0
2− * API changes:
3− * removed the typeclass based terminal and display context interface in favor of a data
2+ * removed the typeclass based terminal and display context interface in favor of a data
4− structure of properties interface.
3+ structure of properties interface.
4+ * The default picture for an image now uses the "clear" background. This background fills
5+ background spans with spaces or just ends the line.
6+ * Layer support
7+ * Each layer is an image.
8+ * The layers for a picture are a list of images.
9+ * The first image is the top-most layer.
10+ * The final rendering is as if the bottom layer (last image) was rendered, then the next
11+ (second to last image) etc.
12+ * Background image components are transparent. Background image components kinda mean that
13+ the picture background should be shown unless the layer below defines content.
5 * compatibility improvements:
14 * compatibility improvements:
6− * terminfo based terminals with no cursor support are now silently accepted. The cursor
15+ * terminfo based terminals with no cursor support are now silently accepted. The cursor
7− visibility changes in the Picture will have no effect.
16+ visibility changes in the Picture will have no effect.
8− * alternate (setf/setb) color maps supported. Though colors beyond the first 8 are just a
17+ * alternate (setf/setb) color maps supported. Though colors beyond the first 8 are just a
9− guess.
18+ guess.
10
19
114.7.0.0
204.7.0.0
12 * API changes:
21 * API changes:
src/Graphics/Vty/Picture.hs+12−6
@@ -54,7 +54,7 @@ pic_for_image :: Image -> Picture
54pic_for_image i = Picture
54pic_for_image i = Picture
55 { pic_cursor = NoCursor
55 { pic_cursor = NoCursor
56 , pic_layers = [i]
56 , pic_layers = [i]
57− , pic_background = Background ' ' current_attr
57+ , pic_background = ClearBackground
58 }
58 }
59
59
60-- | A picture can be configured either to not show the cursor or show the cursor at the specified
60-- | A picture can be configured either to not show the cursor or show the cursor at the specified
@@ -80,17 +80,23 @@ instance NFData Cursor where
80--
80--
81-- \todo The current attribute is always set to the default attributes at the start of updating the
81-- \todo The current attribute is always set to the default attributes at the start of updating the
82-- screen to a picture.
82-- screen to a picture.
83−--
84−-- \todo The background character *must* occupy a single column and no more.
85−--
86−-- \todo background char should be optional
87−data Background = Background
83+data Background
84+ = Background
88 { background_char :: Char
85 { background_char :: Char
89 , background_attr :: Attr
86 , background_attr :: Attr
90 }
87 }
88+ -- | The background is:
89+ --
90+ -- * the space character if there are remaining non-skip ops
91+ -- * (?) nothing if there are no remaining non-skip ops.
92+ --
93+ -- Might require the terminal interface to do a line clear?
94+ -- Or should the nothing case be switched with crlf?
95+ | ClearBackground
91
96
92instance NFData Background where
97instance NFData Background where
93 rnf (Background c a) = c `seq` a `seq` ()
98 rnf (Background c a) = c `seq` a `seq` ()
99+ rnf ClearBackground = ()
94
100
95-- | Compatibility with applications that do not use more than a single layer.
101-- | Compatibility with applications that do not use more than a single layer.
96pic_image :: Picture -> Image
102pic_image :: Picture -> Image
src/Graphics/Vty/PictureToSpans.hs+70−27
@@ -21,7 +21,7 @@ import Control.Monad.ST.Strict hiding ( unsafeIOToST )
21
21
22import qualified Data.Vector as Vector hiding ( take, replicate )
22import qualified Data.Vector as Vector hiding ( take, replicate )
23import Data.Vector.Mutable ( MVector(..))
23import Data.Vector.Mutable ( MVector(..))
24−import qualified Data.Vector.Mutable as Vector
24+import qualified Data.Vector.Mutable as MVector
25
25
26import qualified Data.Text as T
26import qualified Data.Text as T
27import qualified Data.Text.Encoding as T
27import qualified Data.Text.Encoding as T
@@ -51,8 +51,7 @@ data BlitState = BlitState
51makeLenses ''BlitState
51makeLenses ''BlitState
52
52
53data BlitEnv s = BlitEnv
53data BlitEnv s = BlitEnv
54− { _bg :: Background
55− , _region :: DisplayRegion
54+ { _region :: DisplayRegion
56 , _mrow_ops :: MRowOps s
55 , _mrow_ops :: MRowOps s
57 }
56 }
58
57
@@ -70,22 +69,74 @@ spans_for_pic pic r = DisplayOps r $ Vector.create (combined_spans_for_layers pi
70-- TODO: a fold over a builder function. start with span ops that are a bg fill of the entire
69-- TODO: a fold over a builder function. start with span ops that are a bg fill of the entire
71-- region.
70-- region.
72combined_spans_for_layers :: Picture -> DisplayRegion -> ST s (MRowOps s)
71combined_spans_for_layers :: Picture -> DisplayRegion -> ST s (MRowOps s)
73−combined_spans_for_layers pic r = do
72+combined_spans_for_layers pic r
73+ | region_width r == 0 || region_height r == 0 = MVector.new 0
74+ | otherwise = do
74− layer_ops <- mapM (\layer -> build_spans layer r (pic_background pic)) (pic_layers pic)
75+ layer_ops <- mapM (\layer -> build_spans layer r) (pic_layers pic)
75− case layer_ops of
76+ case layer_ops of
76− [] -> fail "empty picture"
77+ [] -> fail "empty picture"
77− [ops] -> return ops
78+ [ops] -> substitute_skips (pic_background pic) ops
78− _ -> fail "TODO: picture with more than one layer not supported"
79+ _ -> fail "TODO: picture with more than one layer not supported"
80+
81+substitute_skips :: Background -> MRowOps s -> ST s (MRowOps s)
82+substitute_skips ClearBackground ops = do
83+ forM_ [0 .. MVector.length ops - 1] $ \row -> do
84+ row_ops <- MVector.read ops row
85+ -- the image operations assure that background fills are combined.
86+ -- clipping a background fill does not split the background fill.
87+ -- merging of image layers can split a skip, but only by the insertion of a non skip.
88+ -- all this combines to mean we can check the last operation and remove it if it's a skip
89+ -- todo: or does it?
90+ let row_ops' = case Vector.last row_ops of
91+ Skip w -> Vector.init row_ops `Vector.snoc` RowEnd w
92+ _ -> row_ops
93+ -- now all the skips can be replaced by replications of ' ' of the required width.
94+ let row_ops'' = swap_skips_for_single_column_char_span ' ' row_ops'
95+ MVector.write ops row row_ops''
96+ return ops
97+substitute_skips (Background {background_char, background_attr}) ops = do
98+ -- At this point we decide if the background character is single column or not.
99+ -- obviously, single column is easier.
100+ case safe_wcwidth background_char of
101+ w | w == 0 -> fail $ "invalid background character " ++ show background_char
102+ | w == 1 -> do
103+ forM_ [0 .. MVector.length ops - 1] $ \row -> do
104+ row_ops <- MVector.read ops row
105+ let row_ops' = swap_skips_for_single_column_char_span background_char row_ops
106+ row_ops'' = (AttributeChange background_attr) `Vector.cons` row_ops'
107+ MVector.write ops row row_ops''
108+ | otherwise -> do
109+ forM_ [0 .. MVector.length ops - 1] $ \row -> do
110+ row_ops <- MVector.read ops row
111+ let row_ops' = swap_skips_for_char_span w background_char row_ops
112+ row_ops'' = (AttributeChange background_attr) `Vector.cons` row_ops'
113+ MVector.write ops row row_ops''
114+ return ops
115+
116+swap_skips_for_single_column_char_span :: Char -> SpanOps -> SpanOps
117+swap_skips_for_single_column_char_span c = Vector.map f
118+ where f (Skip ow) = TextSpan ow ow (T.encodeUtf8 $ T.pack $ replicate ow c)
119+ f v = v
120+
121+swap_skips_for_char_span :: Int -> Char -> SpanOps -> SpanOps
122+swap_skips_for_char_span w c = Vector.map f
123+ where
124+ f (Skip ow) = let txt_0_cw = ow `div` w
125+ txt_0 = T.pack $ replicate txt_0_cw c
126+ txt_1_cw = ow `mod` w
127+ txt_1 = T.pack $ replicate txt_1_cw '…'
128+ in TextSpan ow (txt_0_cw + txt_1_cw) $ T.encodeUtf8 (txt_0 `T.append` txt_1)
129+ f v = v
79
130
80-- | Builds a vector of row operations that will output the given picture to the terminal.
131-- | Builds a vector of row operations that will output the given picture to the terminal.
81--
132--
82-- Crops to the given display region.
133-- Crops to the given display region.
83--
134--
84-- TODO: I'm pretty sure there is an algorithm that does not require a mutable buffer.
135-- TODO: I'm pretty sure there is an algorithm that does not require a mutable buffer.
85−build_spans :: Image -> DisplayRegion -> Background -> ST s (MRowOps s)
136+build_spans :: Image -> DisplayRegion -> ST s (MRowOps s)
86−build_spans image out_region background = do
137+build_spans image out_region = do
87 -- First we create a mutable vector for each rows output operations.
138 -- First we create a mutable vector for each rows output operations.
88− out_ops <- Vector.replicate (region_height out_region) Vector.empty
139+ out_ops <- MVector.replicate (region_height out_region) Vector.empty
89 -- \todo I think building the span operations in display order would provide better performance.
140 -- \todo I think building the span operations in display order would provide better performance.
90 -- However, I got stuck trying to implement an algorithm that did this. This will be considered
141 -- However, I got stuck trying to implement an algorithm that did this. This will be considered
91 -- as a possible future optimization.
142 -- as a possible future optimization.
@@ -103,9 +154,9 @@ build_spans image out_region background = do
103 -- bounds is also provided. This is used to clip the span ops produced to the display.
154 -- bounds is also provided. This is used to clip the span ops produced to the display.
104 let full_build = do
155 let full_build = do
105 start_image_build image
156 start_image_build image
106− -- Fill in any unspecified columns with the background pattern.
157+ -- Fill in any unspecified columns with a skip.
107 forM_ [0 .. (region_height out_region - 1)] (add_row_completion out_region)
158 forM_ [0 .. (region_height out_region - 1)] (add_row_completion out_region)
108− init_env = BlitEnv background out_region out_ops
159+ init_env = BlitEnv out_region out_ops
109 init_state = BlitState 0 0 0 0 (region_width out_region) (region_height out_region)
160 init_state = BlitState 0 0 0 0 (region_width out_region) (region_height out_region)
110 _ <- runStateT (runReaderT full_build init_env) init_state
161 _ <- runStateT (runReaderT full_build init_env) init_state
111 return ()
162 return ()
@@ -143,13 +194,10 @@ add_unclipped (VertJoin part_top part_bottom _ow _oh) = do
143 add_unclipped part_top
194 add_unclipped part_top
144 row_offset .= y + image_height part_top
195 row_offset .= y + image_height part_top
145 add_unclipped part_bottom
196 add_unclipped part_bottom
146− -- TODO: assumes background character is 1 column
147add_unclipped (BGFill ow oh) = do
197add_unclipped (BGFill ow oh) = do
148− Background c a <- view bg
149 y <- use row_offset
198 y <- use row_offset
150− let op = TextSpan ow ow (T.encodeUtf8 $ T.replicate (fromIntegral ow) (T.singleton c))
199+ let op = Skip ow
151 forM_ [y..y+oh-1] $ \row -> do
200 forM_ [y..y+oh-1] $ \row -> do
152− snoc_op (AttributeChange a) row
153 snoc_op op row
201 snoc_op op row
154-- TODO: we know it's clipped actually, the equations that are exposed that introduce a
202-- TODO: we know it's clipped actually, the equations that are exposed that introduce a
155-- Crop all assure the image exceeds the crop in the relevant direction.
203-- Crop all assure the image exceeds the crop in the relevant direction.
@@ -271,26 +319,21 @@ add_unclipped_text txt = do
271 used_display_columns = wcswidth $ TL.unpack txt
319 used_display_columns = wcswidth $ TL.unpack txt
272 use row_offset >>= snoc_op op
320 use row_offset >>= snoc_op op
273
321
274−-- todo: If there is no background pattern defined then skip to next line.
275−-- todo: assumes background character is 1 column
276add_row_completion :: DisplayRegion -> Int -> BlitM s ()
322add_row_completion :: DisplayRegion -> Int -> BlitM s ()
277add_row_completion display_region row = do
323add_row_completion display_region row = do
278 all_row_ops <- view mrow_ops
324 all_row_ops <- view mrow_ops
279− Background c a <- view bg
280− row_ops <- lift $ lift $ Vector.read all_row_ops row
325+ row_ops <- lift $ lift $ MVector.read all_row_ops row
281 let end_x = span_ops_effected_columns row_ops
326 let end_x = span_ops_effected_columns row_ops
282 when (end_x < region_width display_region) $ do
327 when (end_x < region_width display_region) $ do
283 let ow = region_width display_region - end_x
328 let ow = region_width display_region - end_x
284− op = TextSpan ow ow (T.encodeUtf8 $ T.replicate (fromIntegral ow) (T.singleton c))
329+ snoc_op (Skip ow) row
285− snoc_op (AttributeChange a) row
286− snoc_op op row
287
330
288-- | snocs the operation to the operations for the given row.
331-- | snocs the operation to the operations for the given row.
289snoc_op :: SpanOp -> Int -> BlitM s ()
332snoc_op :: SpanOp -> Int -> BlitM s ()
290snoc_op !op !row = do
333snoc_op !op !row = do
291 the_mrow_ops <- view mrow_ops
334 the_mrow_ops <- view mrow_ops
292 lift $ lift $ do
335 lift $ lift $ do
293− ops <- Vector.read the_mrow_ops row
336+ ops <- MVector.read the_mrow_ops row
294 let ops' = Vector.snoc ops op
337 let ops' = Vector.snoc ops op
295− Vector.write the_mrow_ops row ops'
338+ MVector.write the_mrow_ops row ops'
296
339
src/Graphics/Vty/Span.hs+18−1
@@ -35,6 +35,15 @@ data SpanOp =
35 -- character does not necessarially represent 1 colunm. See Codec.Binary.UTF8.Width
35 -- character does not necessarially represent 1 colunm. See Codec.Binary.UTF8.Width
36 -- TextSpan [output width in columns] [number of characters] [data]
36 -- TextSpan [output width in columns] [number of characters] [data]
37 | TextSpan !Int !Int BS.ByteString
37 | TextSpan !Int !Int BS.ByteString
38+ -- | Skips the given number of columns
39+ -- A skip is transparent.... maybe? I am not sure how attribute changes interact.
40+ -- todo: separate from this type.
41+ | Skip !Int
42+ -- | Marks the end of a row. specifies how many columns are remaining. These columns will not be
43+ -- explicitly overwritten with the span ops. The terminal is require to assure the remaining
44+ -- columns are clear.
45+ -- todo: separate from this type.
46+ | RowEnd !Int
38 deriving Eq
47 deriving Eq
39
48
40-- | vector of span operations. executed in succession. This represents the operations required to
49-- | vector of span operations. executed in succession. This represents the operations required to
@@ -57,7 +66,9 @@ instance Show DisplayOps where
57
66
58instance Show SpanOp where
67instance Show SpanOp where
59 show (AttributeChange attr) = show attr
68 show (AttributeChange attr) = show attr
60− show (TextSpan ow cw _) = "TextSpan " ++ show ow ++ " " ++ show cw
69+ show (TextSpan ow cw _) = "TextSpan(" ++ show ow ++ ", " ++ show cw ++ ")"
70+ show (Skip ow) = "Skip(" ++ show ow ++ ")"
71+ show (RowEnd ow) = "RowEnd(" ++ show ow ++ ")"
61
72
62-- | Number of columns the DisplayOps are defined for
73-- | Number of columns the DisplayOps are defined for
63span_ops_columns :: DisplayOps -> Int
74span_ops_columns :: DisplayOps -> Int
@@ -72,11 +83,15 @@ span_ops_effected_columns :: SpanOps -> Int
72span_ops_effected_columns in_ops = Vector.foldl' span_ops_effected_columns' 0 in_ops
83span_ops_effected_columns in_ops = Vector.foldl' span_ops_effected_columns' 0 in_ops
73 where
84 where
74 span_ops_effected_columns' t (TextSpan w _ _ ) = t + w
85 span_ops_effected_columns' t (TextSpan w _ _ ) = t + w
86+ span_ops_effected_columns' t (Skip w) = t + w
87+ span_ops_effected_columns' t (RowEnd w) = t + w
75 span_ops_effected_columns' t _ = t
88 span_ops_effected_columns' t _ = t
76
89
77-- | The width of a single SpanOp in columns
90-- | The width of a single SpanOp in columns
78span_op_has_width :: SpanOp -> Maybe (Int, Int)
91span_op_has_width :: SpanOp -> Maybe (Int, Int)
79span_op_has_width (TextSpan ow cw _) = Just (cw, ow)
92span_op_has_width (TextSpan ow cw _) = Just (cw, ow)
93+span_op_has_width (Skip ow) = Just (ow,ow)
94+span_op_has_width (RowEnd ow) = Just (ow,ow)
80span_op_has_width _ = Nothing
95span_op_has_width _ = Nothing
81
96
82-- | returns the number of columns to the character at the given position in the span op
97-- | returns the number of columns to the character at the given position in the span op
@@ -84,5 +99,7 @@ columns_to_char_offset :: Int -> SpanOp -> Int
84columns_to_char_offset cx (TextSpan _ _ utf8_str) =
99columns_to_char_offset cx (TextSpan _ _ utf8_str) =
85 let str = T.unpack (T.decodeUtf8 utf8_str)
100 let str = T.unpack (T.decodeUtf8 utf8_str)
86 in wcswidth (take cx str)
101 in wcswidth (take cx str)
102+columns_to_char_offset cx (Skip _) = cx
103+columns_to_char_offset cx (RowEnd _) = cx
87columns_to_char_offset _cx _ = error "columns_to_char_offset applied to span op without width"
104columns_to_char_offset _cx _ = error "columns_to_char_offset applied to span op without width"
88
105
src/Graphics/Vty/Terminal/Interface.hs+4
@@ -235,6 +235,8 @@ span_op_required_bytes dc fattr (AttributeChange attr) =
235 fattr' = fix_display_attr fattr attr'
235 fattr' = fix_display_attr fattr attr'
236 in (c, fattr')
236 in (c, fattr')
237span_op_required_bytes _dc fattr (TextSpan _ _ str) = (utf8_text_required_bytes str, fattr)
237span_op_required_bytes _dc fattr (TextSpan _ _ str) = (utf8_text_required_bytes str, fattr)
238+span_op_required_bytes _dc _fattr (Skip _) = error "span_op_required_bytes for Skip."
239+span_op_required_bytes _dc fattr (RowEnd _) = (0,fattr)
238
240
239serialize_output_ops :: DisplayContext
241serialize_output_ops :: DisplayContext
240 -> OutputBuffer
242 -> OutputBuffer
@@ -284,6 +286,8 @@ serialize_span_op dc (AttributeChange attr) out_ptr fattr = do
284serialize_span_op _dc (TextSpan _ _ str) out_ptr fattr = do
286serialize_span_op _dc (TextSpan _ _ str) out_ptr fattr = do
285 out_ptr' <- serialize_utf8_text str out_ptr
287 out_ptr' <- serialize_utf8_text str out_ptr
286 return (out_ptr', fattr)
288 return (out_ptr', fattr)
289+serialize_span_op _dc (Skip _) _out_ptr _fattr = error "serialize_span_op for Skip"
290+serialize_span_op _dc (RowEnd _) out_ptr fattr = return (out_ptr, fattr)
287
291
288send_to_terminal :: Terminal -> Int -> (Ptr Word8 -> IO (Ptr Word8)) -> IO ()
292send_to_terminal :: Terminal -> Int -> (Ptr Word8 -> IO (Ptr Word8)) -> IO ()
289send_to_terminal t c f = allocaBytes (fromEnum c) $ \start_ptr -> do
293send_to_terminal t c f = allocaBytes (fromEnum c) $ \start_ptr -> do
test/Verify.hs+1
@@ -59,6 +59,7 @@ verify test_name p = Test $ TestInstance
59 qc_result <- quickCheckResult p
59 qc_result <- quickCheckResult p
60 case qc_result of
60 case qc_result of
61 QC.Success {..} -> return $ Finished TS.Pass
61 QC.Success {..} -> return $ Finished TS.Pass
62+ QC.Failure {output} -> return $ Finished $ TS.Fail output
62 _ -> return $ Finished $ TS.Fail "TODO(corey): add failure message"
63 _ -> return $ Finished $ TS.Fail "TODO(corey): add failure message"
63 , tags = []
64 , tags = []
64 , options = []
65 , options = []
test/VerifyTerminal.hs+12−12
@@ -18,6 +18,14 @@ import qualified Data.String.UTF8 as UTF8
18
18
19import System.IO
19import System.IO
20
20
21+compare_bytes out_bytes expected_bytes =
22+ if out_bytes /= expected_bytes
23+ then return $ failed { reason = "bytes\n" ++ show out_bytes
24+ ++ "\nare not the expected bytes\n"
25+ ++ show expected_bytes
26+ }
27+ else return succeeded
28+
21unit_image_unit_bounds :: UnitImage -> Property
29unit_image_unit_bounds :: UnitImage -> Property
22unit_image_unit_bounds (UnitImage _ i) = liftIOResult $ do
30unit_image_unit_bounds (UnitImage _ i) = liftIOResult $ do
23 (_,t) <- mock_terminal (DisplayRegion 1 1)
31 (_,t) <- mock_terminal (DisplayRegion 1 1)
@@ -49,9 +57,7 @@ single_T_row (MockWindow w h) = liftIOResult $ do
49 -- character
57 -- character
50 ++ concat (replicate (fromEnum h - 1) $ "MA" ++ replicate (fromEnum w) 'B')
58 ++ concat (replicate (fromEnum h - 1) $ "MA" ++ replicate (fromEnum w) 'B')
51 expected_bytes :: BS.ByteString = UTF8.toRep $ UTF8.fromString expected
59 expected_bytes :: BS.ByteString = UTF8.toRep $ UTF8.fromString expected
52− if out_bytes /= expected_bytes
53− then return $ failed { reason = "\n" ++ show out_bytes ++ "\n\n" ++ show expected_bytes }
60+ compare_bytes out_bytes expected_bytes
54− else return succeeded
55
61
56many_T_rows :: MockWindow -> Property
62many_T_rows :: MockWindow -> Property
57many_T_rows (MockWindow w h) = liftIOResult $ do
63many_T_rows (MockWindow w h) = liftIOResult $ do
@@ -66,9 +72,7 @@ many_T_rows (MockWindow w h) = liftIOResult $ do
66 -- attribute change. 'A', followed by w 'T's
72 -- attribute change. 'A', followed by w 'T's
67 let expected = "HD" ++ concat (replicate (fromEnum h) $ "MA" ++ replicate (fromEnum w) 'T')
73 let expected = "HD" ++ concat (replicate (fromEnum h) $ "MA" ++ replicate (fromEnum w) 'T')
68 expected_bytes :: BS.ByteString = UTF8.toRep $ UTF8.fromString expected
74 expected_bytes :: BS.ByteString = UTF8.toRep $ UTF8.fromString expected
69− if out_bytes /= expected_bytes
70− then return $ failed { reason = "\n" ++ show out_bytes ++ "\n\n" ++ show expected_bytes }
75+ compare_bytes out_bytes expected_bytes
71− else return succeeded
72
76
73many_T_rows_cropped_width :: MockWindow -> Property
77many_T_rows_cropped_width :: MockWindow -> Property
74many_T_rows_cropped_width (MockWindow w h) = liftIOResult $ do
78many_T_rows_cropped_width (MockWindow w h) = liftIOResult $ do
@@ -83,9 +87,7 @@ many_T_rows_cropped_width (MockWindow w h) = liftIOResult $ do
83 -- attribute change. 'A', followed by w 'T's
87 -- attribute change. 'A', followed by w 'T's
84 let expected = "HD" ++ concat (replicate (fromEnum h) $ "MA" ++ replicate (fromEnum w) 'T')
88 let expected = "HD" ++ concat (replicate (fromEnum h) $ "MA" ++ replicate (fromEnum w) 'T')
85 expected_bytes :: BS.ByteString = UTF8.toRep $ UTF8.fromString expected
89 expected_bytes :: BS.ByteString = UTF8.toRep $ UTF8.fromString expected
86− if out_bytes /= expected_bytes
87− then return $ failed { reason = "\n" ++ show out_bytes ++ "\n\n" ++ show expected_bytes }
90+ compare_bytes out_bytes expected_bytes
88− else return succeeded
89
91
90many_T_rows_cropped_height :: MockWindow -> Property
92many_T_rows_cropped_height :: MockWindow -> Property
91many_T_rows_cropped_height (MockWindow w h) = liftIOResult $ do
93many_T_rows_cropped_height (MockWindow w h) = liftIOResult $ do
@@ -100,9 +102,7 @@ many_T_rows_cropped_height (MockWindow w h) = liftIOResult $ do
100 -- attribute change. 'A', followed by w count 'T's
102 -- attribute change. 'A', followed by w count 'T's
101 let expected = "HD" ++ concat (replicate (fromEnum h) $ "MA" ++ replicate (fromEnum w) 'T')
103 let expected = "HD" ++ concat (replicate (fromEnum h) $ "MA" ++ replicate (fromEnum w) 'T')
102 expected_bytes :: BS.ByteString = UTF8.toRep $ UTF8.fromString expected
104 expected_bytes :: BS.ByteString = UTF8.toRep $ UTF8.fromString expected
103− if out_bytes /= expected_bytes
104− then return $ failed { reason = "\n" ++ show out_bytes ++ "\n\n" ++ show expected_bytes }
105+ compare_bytes out_bytes expected_bytes
105− else return succeeded
106
106
107tests :: IO [Test]
107tests :: IO [Test]
108tests = return [ verify "unit_image_unit_bounds" unit_image_unit_bounds
108tests = return [ verify "unit_image_unit_bounds" unit_image_unit_bounds