on 3c97d77 help sign in
vty/src/Graphics/Vty/Debug.hs
81 lines 2.3 kB history raw
1-- Copyright 2009 Corey O'Connor
2{-# LANGUAGE ScopedTypeVariables #-}
3module Graphics.Vty.Debug ( module Graphics.Vty.Debug
4 )
5where
7import Graphics.Vty.Attributes
8import Graphics.Vty.Image
9import Graphics.Vty.Image.Debug
10import Graphics.Vty.Picture
11import Graphics.Vty.Span
12import Graphics.Vty.WinRegion
14import Control.Monad
15import Data.Array
16import Data.Word
18instance Show SpanOpSequence where
19 show (SpanOpSequence _ row_ops)
20 = concat $ ["{ "] ++ map (\ops -> show ops ++ "; " ) (elems row_ops) ++ [" }"]
22instance Show SpanOp where
23 show (AttributeChange attr) = show attr
24 show (TextSpan width _) = "TextSpan " ++ show width
26row_ops_effected_columns :: SpanOpSequence -> [Word]
27row_ops_effected_columns spans
28 = map span_ops_effected_columns (elems $ row_ops spans)
30all_spans_have_width spans expected
31 = all (== expected) ( map span_ops_effected_columns (elems $ row_ops spans) )
33span_ops_effected_rows :: SpanOpSequence -> Word
34span_ops_effected_rows (SpanOpSequence _ row_ops)
35 = toEnum $ length (filter (not . null) (elems row_ops))
37type SpanConstructLog = [SpanConstructEvent]
38data SpanConstructEvent = SpanSetAttr Attr
40is_set_attr :: Attr -> SpanConstructEvent -> Bool
41is_set_attr expected_attr (SpanSetAttr in_attr)
42 | in_attr == expected_attr = True
43is_set_attr _attr _event = False
45data DebugWindow = DebugWindow Word Word
46 deriving (Show, Eq)
48type TestWindow = DebugWindow
50instance WinRegion DebugWindow where
51 win_width (DebugWindow w _) = w
52 win_height (DebugWindow _ h) = h
54type ImageConstructLog = [ImageConstructEvent]
55data ImageConstructEvent = ImageConstructEvent
56 deriving ( Show, Eq )
58forward_image_ops = map forward_transform debug_image_ops
60forward_transform, reverse_transform :: ImageOp -> (Image -> Image)
62forward_transform (ImageOp f _) = f
63reverse_transform (ImageOp _ r) = r
65data ImageOp = ImageOp ImageEndo ImageEndo
66type ImageEndo = Image -> Image
68debug_image_ops =
69 [ id_image_op
70 -- , render_single_column_char_op
71 -- , render_double_column_char_op
72 ]
74id_image_op :: ImageOp
75id_image_op = ImageOp id id
77-- render_char_op :: ImageOp
78-- render_char_op = ImageOp id id
80instance Show Picture where
81 show (Picture _ image _ ) = "Picture ?? " ++ show image ++ " ??"