git.iko.soy/vty
on 74ee853 help sign in
vty/src/Graphics/Vty/Debug.hs
79 lines 2.3 kB history raw
1-- Copyright 2009-2010 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.Picture
10import Graphics.Vty.Span
11import Graphics.Vty.DisplayRegion
13import Control.Monad
14import Data.Array
15import Data.Word
17instance Show SpanOpSequence where
18 show (SpanOpSequence _ row_ops)
19 = concat $ ["{ "] ++ map (\ops -> show ops ++ "; " ) (elems row_ops) ++ [" }"]
21instance Show SpanOp where
22 show (AttributeChange attr) = show attr
23 show (TextSpan ow cw _) = "TextSpan " ++ show ow ++ " " ++ show cw
25row_ops_effected_columns :: SpanOpSequence -> [Word]
26row_ops_effected_columns spans
27 = map span_ops_effected_columns (elems $ row_ops spans)
29all_spans_have_width spans expected
30 = all (== expected) ( map span_ops_effected_columns (elems $ row_ops spans) )
32span_ops_effected_rows :: SpanOpSequence -> Word
33span_ops_effected_rows (SpanOpSequence _ row_ops)
34 = toEnum $ length (filter (not . null) (elems row_ops))
36type SpanConstructLog = [SpanConstructEvent]
37data SpanConstructEvent = SpanSetAttr Attr
39is_set_attr :: Attr -> SpanConstructEvent -> Bool
40is_set_attr expected_attr (SpanSetAttr in_attr)
41 | in_attr == expected_attr = True
42is_set_attr _attr _event = False
44data DebugWindow = DebugWindow Word Word
45 deriving (Show, Eq)
47region_for_window :: DebugWindow -> DisplayRegion
48region_for_window (DebugWindow w h) = DisplayRegion w h
50type TestWindow = DebugWindow
52type ImageConstructLog = [ImageConstructEvent]
53data ImageConstructEvent = ImageConstructEvent
54 deriving ( Show, Eq )
56forward_image_ops = map forward_transform debug_image_ops
58forward_transform, reverse_transform :: ImageOp -> (Image -> Image)
60forward_transform (ImageOp f _) = f
61reverse_transform (ImageOp _ r) = r
63data ImageOp = ImageOp ImageEndo ImageEndo
64type ImageEndo = Image -> Image
66debug_image_ops =
67 [ id_image_op
68 -- , render_single_column_char_op
69 -- , render_double_column_char_op
70 ]
72id_image_op :: ImageOp
73id_image_op = ImageOp id id
75-- render_char_op :: ImageOp
76-- render_char_op = ImageOp id id
78instance Show Picture where
79 show (Picture _ image _ ) = "Picture ?? " ++ show image ++ " ??"