git.iko.soy/vty
on fe55cd4 help sign in
vty/src/Graphics/Vty/Terminal/Debug.hs
115 lines 4.5 kB history raw
1-- Copyright 2009 Corey O'Connor
2{-# LANGUAGE FlexibleInstances #-}
3{-# LANGUAGE TypeFamilies #-}
4module Graphics.Vty.Terminal.Debug ( DebugTerminal(..)
5 , DebugDisplay(..)
6 , terminal_instance
7 , dehandle
8 )
9 where
11import Graphics.Vty.WinRegion
12import Graphics.Vty.Terminal.Generic
14import Control.Monad.State.Strict
16import qualified Data.ByteString.UTF8 as BS
17import qualified Data.ByteString as BSCore
18import Data.IORef
19import qualified Data.Sequence as Seq
20import qualified Data.String.UTF8 as UTF8
21import Data.Word
23import Foreign.Marshal.Array ( peekArray )
24import Foreign.Ptr ( plusPtr )
25import Foreign.Storable ( poke )
27import Unsafe.Coerce
29-- | The debug display terminal produces a string representation of the requested picture. There is
30-- *not* an isomorphism between the string representation and the picture. The string
31-- representation is a simplification of the picture that is only useful in debugging VTY without
32-- considering terminal specific issues.
33--
34-- The debug implementation is useful in manually determining if the sequence of terminal operations
35-- matches the expected sequence. So requirement of the produced representation is simplicity in
36-- parsing the text representation and determining how the picture was mapped to terminal
37-- operations.
38--
39-- All terminals support the operations specified in the Terminal class defined in
40-- Graphics.Vty.Terminal. As an instance of the Terminal class is also an instance of the Monad
41-- class there exists a monoid that defines it's algebra. The string representation is a sequence of
42-- identifiers where each identifier is the name of an operation in the algebra.
44data DebugTerminal = DebugTerminal
45 { debug_terminal_last_output :: IORef (UTF8.UTF8 BS.ByteString)
46 , debug_terminal_bounds :: DisplayBounds
47 }
49instance Terminal DebugTerminal where
50 terminal_ID _t = "debug_terminal"
51 release_terminal _t = return ()
52 reserve_display _t = return ()
53 release_display _t = return ()
54 display_bounds t = return $ debug_terminal_bounds t
55 display_context t bounds = return $ DisplayHandle (DebugDisplay bounds) (TerminalHandle t)
56 output_byte_buffer t out_buffer buffer_size
57 = do
58 putStrLn $ "output_byte_buffer ?? " ++ show buffer_size
59 peekArray (fromEnum buffer_size) out_buffer
60 >>= return . UTF8.fromRep . BSCore.pack
61 >>= writeIORef (debug_terminal_last_output t)
63data DebugDisplay = DebugDisplay
64 { debug_display_bounds :: DisplayBounds
65 }
67terminal_instance :: DisplayBounds -> IO TerminalHandle
68terminal_instance bounds = do
69 output_ref <- newIORef undefined
70 return $ TerminalHandle $ DebugTerminal output_ref bounds
72dehandle :: TerminalHandle -> DebugTerminal
73dehandle (TerminalHandle t) = unsafeCoerce t
75instance DisplayTerminal DebugDisplay where
76 -- | Provide the current bounds of the output terminal.
77 context_bounds d = debug_display_bounds d
79 -- | A cursor move is always visualized as the single character 'M'
80 move_cursor_required_bytes _d _x _y = 1
82 -- | A cursor move is always visualized as the single character 'M'
83 serialize_move_cursor _d _x _y ptr = do
84 poke ptr (toEnum $ fromEnum 'M')
85 return $ ptr `plusPtr` 1
87 -- | Show cursor is always visualized as the single character 'S'
88 show_cursor_required_bytes _d = 1
90 -- | Show cursor is always visualized as the single character 'S'
91 serialize_show_cursor _d ptr = do
92 poke ptr (toEnum $ fromEnum 'S')
93 return $ ptr `plusPtr` 1
95 -- | Hide cursor is always visualized as the single character 'H'
96 hide_cursor_required_bytes _d = 1
98 -- | Hide cursor is always visualized as the single character 'H'
99 serialize_hide_cursor _d ptr = do
100 poke ptr (toEnum $ fromEnum 'H')
101 return $ ptr `plusPtr` 1
103 -- | An attr change is always visualized as the single character 'A'
104 attr_required_bytes _d _fattr _attr = 1
106 -- | An attr change is always visualized as the single character 'A'
107 serialize_set_attr _d _fattr _attr ptr = do
108 poke ptr (toEnum $ fromEnum 'A')
109 return $ ptr `plusPtr` 1
111 default_attr_required_bytes _d = 1
112 serialize_default_attr _d ptr = do
113 poke ptr (toEnum $ fromEnum 'D')
114 return $ ptr `plusPtr` 1