on d506ea5 help sign in
vty/src/Graphics/Vty/Debug.hs
80 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.DisplayRegion
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)
48region_for_window :: DebugWindow -> DisplayRegion
49region_for_window (DebugWindow w h) = DisplayRegion w h
51type TestWindow = DebugWindow
53type ImageConstructLog = [ImageConstructEvent]
54data ImageConstructEvent = ImageConstructEvent
55 deriving ( Show, Eq )
57forward_image_ops = map forward_transform debug_image_ops
59forward_transform, reverse_transform :: ImageOp -> (Image -> Image)
61forward_transform (ImageOp f _) = f
62reverse_transform (ImageOp _ r) = r
64data ImageOp = ImageOp ImageEndo ImageEndo
65type ImageEndo = Image -> Image
67debug_image_ops =
68 [ id_image_op
69 -- , render_single_column_char_op
70 -- , render_double_column_char_op
71 ]
73id_image_op :: ImageOp
74id_image_op = ImageOp id id
76-- render_char_op :: ImageOp
77-- render_char_op = ImageOp id id
79instance Show Picture where
80 show (Picture _ image _ ) = "Picture ?? " ++ show image ++ " ??"