82fd9c4 · vty · git.iko.soy

git.iko.soy/vty

on master help sign in

Moved all IO actions to MonadIO

82fd9c4coreyoconnor17 years ago

CHANGELOG+9−7

compare with master

unifiedsplit

@@ -3,13 +3,15 @@

3 * Attr record accessor fore_color changed to attr_fore_color

4 * Attr record accessor back_color changed to attr_back_color

5 * Attr record accessor style changed to attr_style

6− * Added an "inline" attribute changing DSL:

6+ * Added an "inline" display attribute changing DSL:

7− * put_attr_change applies and attribute change monad action

7+ * put_attr_change applies a display attribute change immediately to a terminal

8− * can be used to change the display attrbiutes of text output via putStrLn and putStr,

8+ * For instance, can be used to change the display attrbiutes of text output via putStrLn

9− for instance. EX: "put_attr_change $ back_color red" will set the background color to

9+ and putStr. EX: "put_attr_change $ back_color red" will set the

10− red.

10+ background color to red.

11− * Does not apply to output_picture.

11+ * Changes do not apply to a Picture output via output_picture.

12− * See Graphics.Vty.AttributeChange

12+ * See Graphics.Vty.Inline

13+ * Moved all IO actions into any monad an instance of MonadIO

14+

134.0.0.1

154.0.0.1

14 * binding for mk_wcswidth was incorrect. Most platforms just magically worked due to

16 * binding for mk_wcswidth was incorrect. Most platforms just magically worked due to

15 coincidence.

17 coincidence.

src/Data/Terminfo/Eval.hs+9−7

@@ -15,16 +15,18 @@ module Data.Terminfo.Eval ( cap_expression_required_bytes

15import Data.Marshalling

16import Data.Terminfo.Parse

18+import Control.Monad.Identity

18import Control.Monad.Reader

19import Control.Monad.Reader

19import Control.Monad.State.Strict

20import Control.Monad.State.Strict

21+import Control.Monad.Trans

21import Data.Array.Unboxed

23import Data.Array.Unboxed

22import Data.Bits ( (.|.) )

24import Data.Bits ( (.|.) )

23import Data.List

25import Data.List

24import Data.Word

26import Data.Word

26−type Eval a = ReaderT (CapExpression,[CapParam]) (State [CapParam]) a

27−type EvalIO a = ReaderT (CapExpression,[CapParam]) (StateT [CapParam] IO) a

28+type EvalT m a = ReaderT (CapExpression,[CapParam]) (StateT [CapParam] m) a

29+type Eval a = EvalT Identity a

29pop :: MonadState [CapParam] m => m CapParam

31pop :: MonadState [CapParam] m => m CapParam

30pop = do

32pop = do

@@ -61,7 +63,7 @@ bytes_for_range cap (offset, count)

61cap_expression_required_bytes :: CapExpression -> [CapParam] -> Word

63cap_expression_required_bytes :: CapExpression -> [CapParam] -> Word

62cap_expression_required_bytes cap params =

64cap_expression_required_bytes cap params =

63 let params' = apply_param_ops cap params

65 let params' = apply_param_ops cap params

64− in fst $ runState (runReaderT (cap_ops_required_bytes $ cap_ops cap) (cap, params)) []

66+ in fst $! runIdentity $ runStateT (runReaderT (cap_ops_required_bytes $ cap_ops cap) (cap, params')) []

66cap_ops_required_bytes :: CapOps -> Eval Word

68cap_ops_required_bytes :: CapOps -> Eval Word

67cap_ops_required_bytes ops = do

69cap_ops_required_bytes ops = do

@@ -104,16 +106,16 @@ cap_op_required_bytes CompareEq = do

104cap_op_required_bytes (LiteralInt i) = do

106cap_op_required_bytes (LiteralInt i) = do

105 return $ toEnum $ length $ show i

107 return $ toEnum $ length $ show i

106

108

107−serialize_cap_expression :: CapExpression -> [CapParam] -> OutputBuffer -> IO OutputBuffer

109+serialize_cap_expression :: MonadIO m => CapExpression -> [CapParam] -> OutputBuffer -> m OutputBuffer

108serialize_cap_expression cap params out_ptr = do

110serialize_cap_expression cap params out_ptr = do

109 let params' = apply_param_ops cap params

111 let params' = apply_param_ops cap params

110− (out_ptr', _) <- runStateT (runReaderT (serialize_cap_ops out_ptr (cap_ops cap)) (cap, params')) []

112+ (!out_ptr', _) <- runStateT (runReaderT (serialize_cap_ops out_ptr (cap_ops cap)) (cap, params')) []

111 return out_ptr'

113 return out_ptr'

112

114

113−serialize_cap_ops :: OutputBuffer -> CapOps -> EvalIO OutputBuffer

115+serialize_cap_ops :: MonadIO m => OutputBuffer -> CapOps -> EvalT m OutputBuffer

114serialize_cap_ops out_ptr ops = foldM serialize_cap_op out_ptr ops

116serialize_cap_ops out_ptr ops = foldM serialize_cap_op out_ptr ops

115

117

116−serialize_cap_op :: OutputBuffer -> CapOp -> EvalIO OutputBuffer

118+serialize_cap_op :: MonadIO m => OutputBuffer -> CapOp -> EvalT m OutputBuffer

117serialize_cap_op out_ptr (Bytes (offset, c)) = do

119serialize_cap_op out_ptr (Bytes (offset, c)) = do

118 (cap, _) <- ask

120 (cap, _) <- ask

119 let out_bytes = bytes_for_range cap (offset, c)

121 let out_bytes = bytes_for_range cap (offset, c)

src/Graphics/Vty/AttributeChange.hs+3−1

@@ -7,7 +7,9 @@ import Graphics.Vty.Attributes

7import Graphics.Vty.DisplayAttributes

8import Graphics.Vty.Terminal.Generic

10+import Control.Applicative

10import Control.Monad.State.Strict

11import Control.Monad.State.Strict

12+import Control.Monad.Trans

12import Data.Bits ( (.&.), complement )

14import Data.Bits ( (.&.), complement )

13import Data.Monoid ( mappend )

15import Data.Monoid ( mappend )

@@ -67,7 +69,7 @@ remove_all_styles =

67 , RemoveBold

69 , RemoveBold

68 ]

70 ]

70−put_attr_change :: TerminalHandle -> AttrChange () -> IO ()

72+put_attr_change :: MonadIO m => TerminalHandle -> AttrChange () -> m ()

71put_attr_change t c = do

73put_attr_change t c = do

72 return ()

74 return ()

src/Graphics/Vty/Debug.hs+4−5

@@ -9,7 +9,7 @@ import Graphics.Vty.Image

9import Graphics.Vty.Image.Debug

10import Graphics.Vty.Picture

11import Graphics.Vty.Span

12−import Graphics.Vty.WinRegion

12+import Graphics.Vty.DisplayRegion

14import Control.Monad

15import Data.Array

@@ -45,11 +45,10 @@ is_set_attr _attr _event = False

45data DebugWindow = DebugWindow Word Word

46 deriving (Show, Eq)

48−type TestWindow = DebugWindow

48+region_for_window :: DebugWindow -> DisplayRegion

49+region_for_window (DebugWindow w h) = DisplayRegion w h

50−instance WinRegion DebugWindow where

51− win_width (DebugWindow w _) = w

52− win_height (DebugWindow _ h) = h

51+type TestWindow = DebugWindow

54type ImageConstructLog = [ImageConstructEvent]

53type ImageConstructLog = [ImageConstructEvent]

55data ImageConstructEvent = ImageConstructEvent

54data ImageConstructEvent = ImageConstructEvent

src/Graphics/Vty/Span.hs+6

@@ -54,6 +54,12 @@ data SpanOpSequence = SpanOpSequence

54type RowOps = Array Word SpanOps

55type SpanOps = [SpanOp]

57+span_ops_columns :: SpanOpSequence -> Word

58+span_ops_columns ops = region_width $ effected_region ops

59+

60+span_ops_rows :: SpanOpSequence -> Word

61+span_ops_rows ops = region_height $ effected_region ops

62+

57span_ops_effected_columns :: [SpanOp] -> Word

63span_ops_effected_columns :: [SpanOp] -> Word

58span_ops_effected_columns in_ops = span_ops_effected_columns' 0 in_ops

64span_ops_effected_columns in_ops = span_ops_effected_columns' 0 in_ops

59 where

65 where

src/Graphics/Vty/Terminal.hs+10−7

@@ -29,7 +29,10 @@ import Graphics.Vty.Terminal.MacOSX as MacOSX

29import Graphics.Vty.Terminal.XTermColor as XTermColor

30import Graphics.Vty.Terminal.TerminfoBased as TerminfoBased

32+import Control.Applicative

32import Control.Exception ( SomeException, try )

33import Control.Exception ( SomeException, try )

34+import Control.Monad.Trans

35+

33import Data.Either

36import Data.Either

34import Data.List ( isPrefixOf )

37import Data.List ( isPrefixOf )

35import Data.Word

38import Data.Word

@@ -70,9 +73,9 @@ import System.Environment

70-- with only what is provided in the haskell platform.

73-- with only what is provided in the haskell platform.

71--

74--

72-- todo: The Terminal interface does not provide any input support.

75-- todo: The Terminal interface does not provide any input support.

73−terminal_handle :: IO TerminalHandle

76+terminal_handle :: ( Applicative m, MonadIO m ) => m TerminalHandle

74terminal_handle = do

77terminal_handle = do

75− term_type <- getEnv "TERM"

78+ term_type <- liftIO $ getEnv "TERM"

76 t <- if "xterm" `isPrefixOf` term_type

79 t <- if "xterm" `isPrefixOf` term_type

77 then do

80 then do

78 maybe_terminal_app <- get_env "TERM_PROGRAM"

81 maybe_terminal_app <- get_env "TERM_PROGRAM"

@@ -83,7 +86,7 @@ terminal_handle = do

83 -> do

86 -> do

84 maybe_xterm <- get_env "XTERM_VERSION"

87 maybe_xterm <- get_env "XTERM_VERSION"

85 case maybe_xterm of

88 case maybe_xterm of

86− Nothing -> MacOSX.terminal_instance >>= new_terminal_handle

89+ Nothing -> MacOSX.terminal_instance v >>= new_terminal_handle

87 Just _ -> XTermColor.terminal_instance term_type >>= new_terminal_handle

90 Just _ -> XTermColor.terminal_instance term_type >>= new_terminal_handle

88 -- Assume any other terminal that sets TERM_PROGRAM to not be an OS X terminal.app

91 -- Assume any other terminal that sets TERM_PROGRAM to not be an OS X terminal.app

89 -- like terminal?

92 -- like terminal?

@@ -93,7 +96,7 @@ terminal_handle = do

93 return t

96 return t

94 where

97 where

95 get_env var = do

98 get_env var = do

96− mv <- try $ getEnv var

99+ mv <- liftIO $ try $ getEnv var

97 case mv of

100 case mv of

98 Left (_e :: SomeException) -> return $ Nothing

101 Left (_e :: SomeException) -> return $ Nothing

99 Right v -> return $ Just v

102 Right v -> return $ Just v

@@ -105,21 +108,21 @@ terminal_handle = do

105--

108--

106-- Currently, the only way to set the cursor position to a given character coordinate is to specify

109-- Currently, the only way to set the cursor position to a given character coordinate is to specify

107-- the coordinate in the Picture instance provided to output_picture or refresh.

110-- the coordinate in the Picture instance provided to output_picture or refresh.

108−set_cursor_pos :: TerminalHandle -> Word -> Word -> IO ()

111+set_cursor_pos :: MonadIO m => TerminalHandle -> Word -> Word -> m ()

109set_cursor_pos t x y = do

112set_cursor_pos t x y = do

110 bounds <- display_bounds t

113 bounds <- display_bounds t

111 d <- display_context t bounds

114 d <- display_context t bounds

112 marshall_to_terminal t (move_cursor_required_bytes d x y) (serialize_move_cursor d x y)

115 marshall_to_terminal t (move_cursor_required_bytes d x y) (serialize_move_cursor d x y)

113

116

114-- | Hides the cursor

117-- | Hides the cursor

115−hide_cursor :: TerminalHandle -> IO ()

118+hide_cursor :: MonadIO m => TerminalHandle -> m ()

116hide_cursor t = do

119hide_cursor t = do

117 bounds <- display_bounds t

120 bounds <- display_bounds t

118 d <- display_context t bounds

121 d <- display_context t bounds

119 marshall_to_terminal t (hide_cursor_required_bytes d) (serialize_hide_cursor d)

122 marshall_to_terminal t (hide_cursor_required_bytes d) (serialize_hide_cursor d)

120

123

121-- | Shows the cursor

124-- | Shows the cursor

122−show_cursor :: TerminalHandle -> IO ()

125+show_cursor :: MonadIO m => TerminalHandle -> m ()

123show_cursor t = do

126show_cursor t = do

124 bounds <- display_bounds t

127 bounds <- display_bounds t

125 d <- display_context t bounds

128 d <- display_context t bounds

src/Graphics/Vty/Terminal/Debug.hs+18−16

@@ -8,9 +8,11 @@ module Graphics.Vty.Terminal.Debug ( DebugTerminal(..)

8 )

9 where

11−import Graphics.Vty.WinRegion

11+import Graphics.Vty.DisplayRegion

12import Graphics.Vty.Terminal.Generic

14+import Control.Applicative

15+import Control.Monad.Trans

14import Control.Monad.State.Strict

16import Control.Monad.State.Strict

16import qualified Data.ByteString.UTF8 as BS

18import qualified Data.ByteString.UTF8 as BS

@@ -43,7 +45,7 @@ import Unsafe.Coerce

44data DebugTerminal = DebugTerminal

46data DebugTerminal = DebugTerminal

45 { debug_terminal_last_output :: IORef (UTF8.UTF8 BS.ByteString)

47 { debug_terminal_last_output :: IORef (UTF8.UTF8 BS.ByteString)

46− , debug_terminal_bounds :: DisplayBounds

48+ , debug_terminal_bounds :: DisplayRegion

47 }

49 }

49instance Terminal DebugTerminal where

51instance Terminal DebugTerminal where

@@ -52,36 +54,36 @@ instance Terminal DebugTerminal where

52 reserve_display _t = return ()

54 reserve_display _t = return ()

53 release_display _t = return ()

55 release_display _t = return ()

54 display_bounds t = return $ debug_terminal_bounds t

56 display_bounds t = return $ debug_terminal_bounds t

55− display_context t bounds = return $ DisplayHandle (DebugDisplay bounds) (TerminalHandle t)

57+ display_terminal_instance t r c = return $ c (DebugDisplay r)

56 output_byte_buffer t out_buffer buffer_size

58 output_byte_buffer t out_buffer buffer_size

57− = do

59+ = liftIO $ do

58 putStrLn $ "output_byte_buffer ?? " ++ show buffer_size

60 putStrLn $ "output_byte_buffer ?? " ++ show buffer_size

59 peekArray (fromEnum buffer_size) out_buffer

61 peekArray (fromEnum buffer_size) out_buffer

60 >>= return . UTF8.fromRep . BSCore.pack

62 >>= return . UTF8.fromRep . BSCore.pack

61 >>= writeIORef (debug_terminal_last_output t)

63 >>= writeIORef (debug_terminal_last_output t)

63data DebugDisplay = DebugDisplay

65data DebugDisplay = DebugDisplay

64− { debug_display_bounds :: DisplayBounds

66+ { debug_display_bounds :: DisplayRegion

65 }

67 }

67−terminal_instance :: DisplayBounds -> IO TerminalHandle

69+terminal_instance :: ( Applicative m, MonadIO m ) => DisplayRegion -> m TerminalHandle

68−terminal_instance bounds = do

70+terminal_instance r = do

69− output_ref <- newIORef undefined

71+ output_ref <- liftIO $ newIORef undefined

70− return $ TerminalHandle $ DebugTerminal output_ref bounds

72+ new_terminal_handle $ DebugTerminal output_ref r

72dehandle :: TerminalHandle -> DebugTerminal

74dehandle :: TerminalHandle -> DebugTerminal

73−dehandle (TerminalHandle t) = unsafeCoerce t

75+dehandle (TerminalHandle t _) = unsafeCoerce t

75instance DisplayTerminal DebugDisplay where

77instance DisplayTerminal DebugDisplay where

76 -- | Provide the current bounds of the output terminal.

78 -- | Provide the current bounds of the output terminal.

77− context_bounds d = debug_display_bounds d

79+ context_region d = debug_display_bounds d

79 -- | A cursor move is always visualized as the single character 'M'

81 -- | A cursor move is always visualized as the single character 'M'

80 move_cursor_required_bytes _d _x _y = 1

82 move_cursor_required_bytes _d _x _y = 1

82 -- | A cursor move is always visualized as the single character 'M'

84 -- | A cursor move is always visualized as the single character 'M'

83 serialize_move_cursor _d _x _y ptr = do

85 serialize_move_cursor _d _x _y ptr = do

84− poke ptr (toEnum $ fromEnum 'M')

86+ liftIO $ poke ptr (toEnum $ fromEnum 'M')

85 return $ ptr `plusPtr` 1

87 return $ ptr `plusPtr` 1

87 -- | Show cursor is always visualized as the single character 'S'

89 -- | Show cursor is always visualized as the single character 'S'

@@ -89,7 +91,7 @@ instance DisplayTerminal DebugDisplay where

90 -- | Show cursor is always visualized as the single character 'S'

92 -- | Show cursor is always visualized as the single character 'S'

91 serialize_show_cursor _d ptr = do

93 serialize_show_cursor _d ptr = do

92− poke ptr (toEnum $ fromEnum 'S')

94+ liftIO $ poke ptr (toEnum $ fromEnum 'S')

93 return $ ptr `plusPtr` 1

95 return $ ptr `plusPtr` 1

95 -- | Hide cursor is always visualized as the single character 'H'

97 -- | Hide cursor is always visualized as the single character 'H'

@@ -97,7 +99,7 @@ instance DisplayTerminal DebugDisplay where

98 -- | Hide cursor is always visualized as the single character 'H'

100 -- | Hide cursor is always visualized as the single character 'H'

99 serialize_hide_cursor _d ptr = do

101 serialize_hide_cursor _d ptr = do

100− poke ptr (toEnum $ fromEnum 'H')

102+ liftIO $ poke ptr (toEnum $ fromEnum 'H')

101 return $ ptr `plusPtr` 1

103 return $ ptr `plusPtr` 1

102

104

103 -- | An attr change is always visualized as the single character 'A'

105 -- | An attr change is always visualized as the single character 'A'

@@ -105,11 +107,11 @@ instance DisplayTerminal DebugDisplay where

105

107

106 -- | An attr change is always visualized as the single character 'A'

108 -- | An attr change is always visualized as the single character 'A'

107 serialize_set_attr _d _fattr _attr ptr = do

109 serialize_set_attr _d _fattr _attr ptr = do

108− poke ptr (toEnum $ fromEnum 'A')

110+ liftIO $ poke ptr (toEnum $ fromEnum 'A')

109 return $ ptr `plusPtr` 1

111 return $ ptr `plusPtr` 1

110

112

111 default_attr_required_bytes _d = 1

113 default_attr_required_bytes _d = 1

112 serialize_default_attr _d ptr = do

114 serialize_default_attr _d ptr = do

113− poke ptr (toEnum $ fromEnum 'D')

115+ liftIO $ poke ptr (toEnum $ fromEnum 'D')

114 return $ ptr `plusPtr` 1

116 return $ ptr `plusPtr` 1

115

117

src/Graphics/Vty/Terminal/Generic.hs+36−32

@@ -18,6 +18,7 @@ import Graphics.Vty.DisplayRegion

18import Graphics.Vty.DisplayAttributes

20import Control.Monad ( liftM )

21+import Control.Monad.Trans

22import Data.Array

23import Data.Array

23import qualified Data.ByteString.Internal as BSCore

24import qualified Data.ByteString.Internal as BSCore

@@ -34,7 +35,7 @@ data TerminalHandle where

34terminal_state :: TerminalHandle -> TerminalState

35terminal_state :: TerminalHandle -> TerminalState

35terminal_state (TerminalHandle _ s) = s

36terminal_state (TerminalHandle _ s) = s

37−new_terminal_handle :: forall t. Terminal t => t -> IO TerminalHandle

38+new_terminal_handle :: forall m t. ( MonadIO m, Terminal t ) => t -> m TerminalHandle

38new_terminal_handle t = liftM (TerminalHandle t) initial_terminal_state

39new_terminal_handle t = liftM (TerminalHandle t) initial_terminal_state

40data TerminalState = TerminalState

41data TerminalState = TerminalState

@@ -42,14 +43,14 @@ data TerminalState = TerminalState

42 current_attr :: Maybe FixedAttr

43 current_attr :: Maybe FixedAttr

43 }

44 }

45−initial_terminal_state :: IO TerminalState

46+initial_terminal_state :: MonadIO m => m TerminalState

46initial_terminal_state = return $ TerminalState Nothing

47initial_terminal_state = return $ TerminalState Nothing

48class Terminal t where

49class Terminal t where

49 -- | Text identifier for the terminal. Used for debugging.

50 -- | Text identifier for the terminal. Used for debugging.

50 terminal_ID :: t -> String

51 terminal_ID :: t -> String

51 -- |

52 -- |

52− release_terminal :: t -> IO ()

53+ release_terminal :: MonadIO m => t -> m ()

53 -- | Clear the display and initialize the terminal to some initial display state.

54 -- | Clear the display and initialize the terminal to some initial display state.

54 --

55 --

55 -- The expectation of a program is that the display starts in some initial state.

56 -- The expectation of a program is that the display starts in some initial state.

@@ -61,25 +62,26 @@ class Terminal t where

61 -- access to a display such that:

62 -- access to a display such that:

62 -- - The previous state cannot be determined

63 -- - The previous state cannot be determined

63 -- - When exclusive access to a display is release the display returns to the previous state.

64 -- - When exclusive access to a display is release the display returns to the previous state.

64− reserve_display :: t -> IO ()

65+ reserve_display :: MonadIO m => t -> m ()

66 -- | Return the display to the state before reserve_display

67 -- | Return the display to the state before reserve_display

67 -- If no previous state then set the display state to the initial state.

68 -- If no previous state then set the display state to the initial state.

68− release_display :: t -> IO ()

69+ release_display :: MonadIO m => t -> m ()

70 -- | Returns the current display bounds.

71 -- | Returns the current display bounds.

71− display_bounds :: t -> IO DisplayRegion

72+ display_bounds :: MonadIO m => t -> m DisplayRegion

73 -- Internal method used to provide the DisplayTerminal instance to the DisplayHandle

74 -- Internal method used to provide the DisplayTerminal instance to the DisplayHandle

74 -- constructor.

75 -- constructor.

75− display_terminal_instance :: t

76+ display_terminal_instance :: MonadIO m

77+ => t

76 -> DisplayRegion

78 -> DisplayRegion

77 -> (forall d. DisplayTerminal d => d -> DisplayHandle)

79 -> (forall d. DisplayTerminal d => d -> DisplayHandle)

78− -> IO DisplayHandle

80+ -> m DisplayHandle

80 -- | Output the byte buffer of the specified size to the terminal device. The size is equal to

82 -- | Output the byte buffer of the specified size to the terminal device. The size is equal to

81 -- end_ptr - start_ptr

83 -- end_ptr - start_ptr

82− output_byte_buffer :: t -> OutputBuffer -> Word -> IO ()

84+ output_byte_buffer :: MonadIO m => t -> OutputBuffer -> Word -> m ()

84instance Terminal TerminalHandle where

86instance Terminal TerminalHandle where

85 terminal_ID (TerminalHandle t _) = terminal_ID t

87 terminal_ID (TerminalHandle t _) = terminal_ID t

@@ -96,7 +98,7 @@ data DisplayHandle where

96-- | Acquire display access to the given region of the display.

98-- | Acquire display access to the given region of the display.

97-- Currently all regions have the upper left corner of (0,0) and the lower right corner at

99-- Currently all regions have the upper left corner of (0,0) and the lower right corner at

98-- (max display_width provided_width, max display_height provided_height)

100-- (max display_width provided_width, max display_height provided_height)

99−display_context :: TerminalHandle -> DisplayRegion -> IO DisplayHandle

101+display_context :: MonadIO m => TerminalHandle -> DisplayRegion -> m DisplayHandle

100display_context t b = do

102display_context t b = do

101 s <- initial_display_state

103 s <- initial_display_state

102 let c d = DisplayHandle d t s

104 let c d = DisplayHandle d t s

@@ -106,8 +108,8 @@ data DisplayState = DisplayState

106 { previous_output_ref :: IORef (Maybe SpanOpSequence)

108 { previous_output_ref :: IORef (Maybe SpanOpSequence)

107 }

109 }

108

110

109−initial_display_state :: IO DisplayState

111+initial_display_state :: MonadIO m => m DisplayState

110−initial_display_state = liftM DisplayState $ newIORef Nothing

112+initial_display_state = liftM DisplayState $ liftIO $ newIORef Nothing

111

113

112class DisplayTerminal d where

114class DisplayTerminal d where

113 -- | Provide the bounds of the display context.

115 -- | Provide the bounds of the display context.

@@ -119,13 +121,13 @@ class DisplayTerminal d where

119 -- | sets the output position to the specified row and column. Where the number of bytes

121 -- | sets the output position to the specified row and column. Where the number of bytes

120 -- required for the control codes can be specified seperate from the actual byte sequence.

122 -- required for the control codes can be specified seperate from the actual byte sequence.

121 move_cursor_required_bytes :: d -> Word -> Word -> Word

123 move_cursor_required_bytes :: d -> Word -> Word -> Word

122− serialize_move_cursor :: d -> Word -> Word -> OutputBuffer -> IO OutputBuffer

124+ serialize_move_cursor :: MonadIO m => d -> Word -> Word -> OutputBuffer -> m OutputBuffer

123

125

124 show_cursor_required_bytes :: d -> Word

126 show_cursor_required_bytes :: d -> Word

125− serialize_show_cursor :: d -> OutputBuffer -> IO OutputBuffer

127+ serialize_show_cursor :: MonadIO m => d -> OutputBuffer -> m OutputBuffer

126

128

127 hide_cursor_required_bytes :: d -> Word

129 hide_cursor_required_bytes :: d -> Word

128− serialize_hide_cursor :: d -> OutputBuffer -> IO OutputBuffer

130+ serialize_hide_cursor :: MonadIO m => d -> OutputBuffer -> m OutputBuffer

129

131

130 -- | Assure the specified output attributes will be applied to all the following text until the

132 -- | Assure the specified output attributes will be applied to all the following text until the

131 -- next output attribute change. Where the number of bytes required for the control codes can

133 -- next output attribute change. Where the number of bytes required for the control codes can

@@ -139,11 +141,11 @@ class DisplayTerminal d where

139 -- In addition it may be possible to optimize the state changes based off the currently applied

141 -- In addition it may be possible to optimize the state changes based off the currently applied

140 -- display attributes.

142 -- display attributes.

141 attr_required_bytes :: d -> FixedAttr -> Attr -> DisplayAttrDiff -> Word

143 attr_required_bytes :: d -> FixedAttr -> Attr -> DisplayAttrDiff -> Word

142− serialize_set_attr :: d -> FixedAttr -> Attr -> DisplayAttrDiff -> OutputBuffer -> IO OutputBuffer

144+ serialize_set_attr :: MonadIO m => d -> FixedAttr -> Attr -> DisplayAttrDiff -> OutputBuffer -> m OutputBuffer

143

145

144 -- | Reset the display attributes to the default display attributes

146 -- | Reset the display attributes to the default display attributes

145 default_attr_required_bytes :: d -> Word

147 default_attr_required_bytes :: d -> Word

146− serialize_default_attr :: d -> OutputBuffer -> IO OutputBuffer

148+ serialize_default_attr :: MonadIO m => d -> OutputBuffer -> m OutputBuffer

147

149

148

150

149instance DisplayTerminal DisplayHandle where

151instance DisplayTerminal DisplayHandle where

@@ -167,10 +169,10 @@ utf8_text_required_bytes str =

167 in toEnum src_bytes_length

169 in toEnum src_bytes_length

168

170

169-- | All terminals serialize UTF8 text to the terminal device exactly as serialized in memory.

171-- | All terminals serialize UTF8 text to the terminal device exactly as serialized in memory.

170−serialize_utf8_text :: UTF8 BSCore.ByteString -> OutputBuffer -> IO OutputBuffer

172+serialize_utf8_text :: MonadIO m => UTF8 BSCore.ByteString -> OutputBuffer -> m OutputBuffer

171serialize_utf8_text str dest_ptr =

173serialize_utf8_text str dest_ptr =

172 let (src_fptr, src_ptr_offset, src_bytes_length) = BSCore.toForeignPtr (toRep str)

174 let (src_fptr, src_ptr_offset, src_bytes_length) = BSCore.toForeignPtr (toRep str)

173− in withForeignPtr src_fptr $ \src_ptr -> do

175+ in liftIO $ withForeignPtr src_fptr $ \src_ptr -> do

174 let src_ptr' = src_ptr `plusPtr` src_ptr_offset

176 let src_ptr' = src_ptr `plusPtr` src_ptr_offset

175 BSCore.memcpy dest_ptr src_ptr' (toEnum src_bytes_length)

177 BSCore.memcpy dest_ptr src_ptr' (toEnum src_bytes_length)

176 return (dest_ptr `plusPtr` src_bytes_length)

178 return (dest_ptr `plusPtr` src_bytes_length)

@@ -191,7 +193,7 @@ serialize_utf8_text str dest_ptr =

191--

193--

192-- todo: specify possible IO exceptions.

194-- todo: specify possible IO exceptions.

193-- abstract from IO monad to a MonadIO instance.

195-- abstract from IO monad to a MonadIO instance.

194−output_picture :: DisplayHandle -> Picture -> IO ()

196+output_picture :: MonadIO m => DisplayHandle -> Picture -> m ()

195output_picture (DisplayHandle d t s) pic = do

197output_picture (DisplayHandle d t s) pic = do

196 let !r = context_region d

198 let !r = context_region d

197 let !ops = spans_for_pic pic r

199 let !ops = spans_for_pic pic r

@@ -199,7 +201,7 @@ output_picture (DisplayHandle d t s) pic = do

199 -- Diff the previous output against the requested output. Differences are currently on a per-row

201 -- Diff the previous output against the requested output. Differences are currently on a per-row

200 -- basis.

202 -- basis.

201 diffs :: [Bool]

203 diffs :: [Bool]

202− <- readIORef (previous_output_ref s)

204+ <- liftIO ( readIORef (previous_output_ref s) )

203 >>= \mprevious_ops -> case mprevious_ops of

205 >>= \mprevious_ops -> case mprevious_ops of

204 Nothing

206 Nothing

205 -> return $ replicate ( fromEnum $ region_height $ effected_region ops )

207 -> return $ replicate ( fromEnum $ region_height $ effected_region ops )

@@ -221,7 +223,7 @@ output_picture (DisplayHandle d t s) pic = do

221 + move_cursor_required_bytes d x y

223 + move_cursor_required_bytes d x y

222

224

223 -- ... then serialize

225 -- ... then serialize

224− allocaBytes (fromEnum total) $ \start_ptr -> do

226+ liftIO $ allocaBytes (fromEnum total) $ \start_ptr -> do

225 ptr <- serialize_hide_cursor d start_ptr

227 ptr <- serialize_hide_cursor d start_ptr

226 ptr' <- serialize_default_attr d ptr

228 ptr' <- serialize_default_attr d ptr

227 ptr'' <- serialize_output_ops d ptr' initial_attr diffs ops

229 ptr'' <- serialize_output_ops d ptr' initial_attr diffs ops

@@ -237,7 +239,7 @@ output_picture (DisplayHandle d t s) pic = do

237 | toEnum count > total -> fail $ "End pointer past end of buffer by " ++ show (toEnum count - total)

239 | toEnum count > total -> fail $ "End pointer past end of buffer by " ++ show (toEnum count - total)

238 | otherwise -> output_byte_buffer t start_ptr (toEnum count)

240 | otherwise -> output_byte_buffer t start_ptr (toEnum count)

239 -- Cache the output spans.

241 -- Cache the output spans.

240− writeIORef (previous_output_ref s) (Just ops)

242+ liftIO $ writeIORef (previous_output_ref s) (Just ops)

241 return ()

243 return ()

242

244

243required_bytes :: DisplayTerminal d => d -> FixedAttr -> [Bool] -> SpanOpSequence -> Word

245required_bytes :: DisplayTerminal d => d -> FixedAttr -> [Bool] -> SpanOpSequence -> Word

@@ -272,13 +274,13 @@ span_op_required_bytes d fattr (AttributeChange attr) =

272 in (c, fattr')

274 in (c, fattr')

273span_op_required_bytes _d fattr (TextSpan _ _ str) = (utf8_text_required_bytes str, fattr)

275span_op_required_bytes _d fattr (TextSpan _ _ str) = (utf8_text_required_bytes str, fattr)

274

276

275−serialize_output_ops :: DisplayTerminal d

277+serialize_output_ops :: ( MonadIO m, DisplayTerminal d )

276 => d

278 => d

277 -> OutputBuffer

279 -> OutputBuffer

278 -> FixedAttr

280 -> FixedAttr

279 -> [Bool]

281 -> [Bool]

280 -> SpanOpSequence

282 -> SpanOpSequence

281− -> IO OutputBuffer

283+ -> m OutputBuffer

282serialize_output_ops d start_ptr in_fattr diffs ops = do

284serialize_output_ops d start_ptr in_fattr diffs ops = do

283 (_, end_ptr, _, _) <- foldlM serialize_output_ops'

285 (_, end_ptr, _, _) <- foldlM serialize_output_ops'

284 ( 0, start_ptr, in_fattr, diffs )

286 ( 0, start_ptr, in_fattr, diffs )

@@ -293,13 +295,13 @@ serialize_output_ops d start_ptr in_fattr diffs ops = do

293 serialize_output_ops' (_y, _out_ptr, _fattr, [] ) _span_ops

295 serialize_output_ops' (_y, _out_ptr, _fattr, [] ) _span_ops

294 = error "shouldn't be possible"

296 = error "shouldn't be possible"

295

297

296−serialize_span_ops :: DisplayTerminal d

298+serialize_span_ops :: ( MonadIO m, DisplayTerminal d )

297 => d

299 => d

298 -> Word

300 -> Word

299 -> OutputBuffer

301 -> OutputBuffer

300 -> FixedAttr

302 -> FixedAttr

301 -> SpanOps

303 -> SpanOps

302− -> IO (OutputBuffer, FixedAttr)

304+ -> m (OutputBuffer, FixedAttr)

303serialize_span_ops d y out_ptr in_fattr span_ops = do

305serialize_span_ops d y out_ptr in_fattr span_ops = do

304 -- The first operation is to set the cursor to the start of the row

306 -- The first operation is to set the cursor to the start of the row

305 out_ptr' <- serialize_move_cursor d 0 y out_ptr

307 out_ptr' <- serialize_move_cursor d 0 y out_ptr

@@ -308,12 +310,12 @@ serialize_span_ops d y out_ptr in_fattr span_ops = do

308 (out_ptr', in_fattr)

310 (out_ptr', in_fattr)

309 span_ops

311 span_ops

310

312

311−serialize_span_op :: DisplayTerminal d

313+serialize_span_op :: ( MonadIO m, DisplayTerminal d )

312 => d

314 => d

313 -> SpanOp

315 -> SpanOp

314 -> OutputBuffer

316 -> OutputBuffer

315 -> FixedAttr

317 -> FixedAttr

316− -> IO (OutputBuffer, FixedAttr)

318+ -> m (OutputBuffer, FixedAttr)

317serialize_span_op d (AttributeChange attr) out_ptr fattr = do

319serialize_span_op d (AttributeChange attr) out_ptr fattr = do

318 let attr' = limit_attr_for_display d attr

320 let attr' = limit_attr_for_display d attr

319 fattr' = fix_display_attr fattr attr'

321 fattr' = fix_display_attr fattr attr'

@@ -324,16 +326,18 @@ serialize_span_op _d (TextSpan _ _ str) out_ptr fattr = do

324 out_ptr' <- serialize_utf8_text str out_ptr

326 out_ptr' <- serialize_utf8_text str out_ptr

325 return (out_ptr', fattr)

327 return (out_ptr', fattr)

326

328

327−marshall_to_terminal :: Terminal t => t -> Word -> (Ptr Word8 -> IO (Ptr Word8)) -> IO ()

329+marshall_to_terminal :: ( MonadIO m, Terminal t )

330+ => t -> Word -> (Ptr Word8 -> m (Ptr Word8)) -> m ()

328marshall_to_terminal t c f = do

331marshall_to_terminal t c f = do

329− start_ptr <- mallocBytes (fromEnum c)

332+ start_ptr <- liftIO $ mallocBytes (fromEnum c)

330 --

333 --

331 -- todo: capture exceptions?

334 -- todo: capture exceptions?

332 end_ptr <- f start_ptr

335 end_ptr <- f start_ptr

333 case end_ptr `minusPtr` start_ptr of

336 case end_ptr `minusPtr` start_ptr of

334 count | count < 0 -> fail "End pointer before start pointer."

337 count | count < 0 -> fail "End pointer before start pointer."

338+ | toEnum count > c -> fail $ "End pointer past end of buffer by " ++ show (toEnum count - c)

335 | otherwise -> output_byte_buffer t start_ptr (toEnum count)

339 | otherwise -> output_byte_buffer t start_ptr (toEnum count)

336− free start_ptr

340+ liftIO $ free start_ptr

337 return ()

341 return ()

338

342

339data CursorOutputMap = CursorOutputMap

343data CursorOutputMap = CursorOutputMap

src/Graphics/Vty/Terminal/MacOSX.hs+12−7

@@ -17,22 +17,27 @@ module Graphics.Vty.Terminal.MacOSX ( terminal_instance

17import Graphics.Vty.Terminal.Generic

18import qualified Graphics.Vty.Terminal.TerminfoBased as TerminfoBased

20+import Control.Applicative

21+import Control.Monad.Trans

22+

20import System.IO

23import System.IO

22data Term = Term

25data Term = Term

23 { super_term :: TerminalHandle

26 { super_term :: TerminalHandle

24 }

27 }

26−-- Base this off the xterm terminfo database regardless of what the TERM environment variable is.

29+-- for Terminal.app use "xterm". For iTerm.app use "xterm-256color"

27−terminal_instance :: IO Term

30+terminal_instance :: ( Applicative m, MonadIO m ) => String -> m Term

28−terminal_instance = do

31+terminal_instance v = do

32+ let base_term "iTerm.app" = "xterm-256color"

33+ base_term _ = "xterm"

29− t <- TerminfoBased.terminal_instance "xterm" >>= new_terminal_handle

34+ t <- TerminfoBased.terminal_instance (base_term v) >>= new_terminal_handle

30 return $ Term t

35 return $ Term t

32−flushed_put :: String -> IO ()

37+flushed_put :: MonadIO m => String -> m ()

33flushed_put str = do

38flushed_put str = do

34− hPutStr stdout str

39+ liftIO $ hPutStr stdout str

35− hFlush stdout

40+ liftIO $ hFlush stdout

37-- Terminal.app really does want the xterm-color smcup and rmcup caps. Not the generic xterm ones.

42-- Terminal.app really does want the xterm-color smcup and rmcup caps. Not the generic xterm ones.

38smcup_str = "\ESC7\ESC[?47h"

43smcup_str = "\ESC7\ESC[?47h"

src/Graphics/Vty/Terminal/TerminfoBased.hs+12−9

@@ -18,6 +18,7 @@ import Graphics.Vty.DisplayRegion

19import Control.Applicative

20import Control.Monad ( foldM )

21+import Control.Monad.Trans

22import Data.Bits ( (.&.) )

23import Data.Bits ( (.&.) )

23import Data.Maybe ( fromJust )

24import Data.Maybe ( fromJust )

@@ -55,10 +56,10 @@ data DisplayAttrCaps = DisplayAttrCaps

55 , enter_bold_mode :: Maybe CapExpression

56 , enter_bold_mode :: Maybe CapExpression

56 }

57 }

58−marshall_cap_to_terminal :: Term -> (Term -> CapExpression) -> [CapParam] -> IO ()

59+marshall_cap_to_terminal :: MonadIO m => Term -> (Term -> CapExpression) -> [CapParam] -> m ()

59marshall_cap_to_terminal t cap_selector cap_params = do

60marshall_cap_to_terminal t cap_selector cap_params = do

60− marshall_to_terminal t (cap_expression_required_bytes (cap_selector t) cap_params)

61+ marshall_to_terminal t ( cap_expression_required_bytes (cap_selector t) cap_params )

61− (serialize_cap_expression (cap_selector t) cap_params)

62+ ( serialize_cap_expression (cap_selector t) cap_params )

62 return ()

63 return ()

64{- | Uses terminfo for all control codes. While this should provide the most compatible terminal

65{- | Uses terminfo for all control codes. While this should provide the most compatible terminal

@@ -71,9 +72,9 @@ marshall_cap_to_terminal t cap_selector cap_params = do

71 - todo: Some display attributes like underline and bold have independent string capabilities that

72 - todo: Some display attributes like underline and bold have independent string capabilities that

72 - should be used instead of the generic "sgr" string capability.

73 - should be used instead of the generic "sgr" string capability.

73 -}

74 -}

74−terminal_instance :: String -> IO Term

75+terminal_instance :: ( Applicative m, MonadIO m ) => String -> m Term

75terminal_instance in_ID = do

76terminal_instance in_ID = do

76− ti <- Terminfo.setupTerm in_ID

77+ ti <- liftIO $ Terminfo.setupTerm in_ID

77 let require_cap str

78 let require_cap str

78 = case Terminfo.getCapability ti (Terminfo.tiGetStr str) of

79 = case Terminfo.getCapability ti (Terminfo.tiGetStr str) of

79 Nothing -> fail $ "Terminal does not define required capability \"" ++ str ++ "\""

80 Nothing -> fail $ "Terminal does not define required capability \"" ++ str ++ "\""

@@ -100,7 +101,9 @@ terminal_instance in_ID = do

100 <*> require_cap "clear"

101 <*> require_cap "clear"

101 <*> current_display_attr_caps ti

102 <*> current_display_attr_caps ti

102

103

103−current_display_attr_caps :: Terminfo.Terminal -> IO DisplayAttrCaps

104+current_display_attr_caps :: ( Applicative m, MonadIO m )

105+ => Terminfo.Terminal

106+ -> m DisplayAttrCaps

104current_display_attr_caps ti

107current_display_attr_caps ti

105 = pure DisplayAttrCaps

108 = pure DisplayAttrCaps

106 <*> probe_cap "sgr"

109 <*> probe_cap "sgr"

@@ -147,15 +150,15 @@ instance Terminal Term where

147 return $ c (DisplayContext b t color_count)

150 return $ c (DisplayContext b t color_count)

148

151

149 display_bounds _t = do

152 display_bounds _t = do

150− raw_size <- get_window_size

153+ raw_size <- liftIO $ get_window_size

151 case raw_size of

154 case raw_size of

152 ( w, h ) | w < 0 || h < 0 -> fail $ "getwinsize returned < 0 : " ++ show raw_size

155 ( w, h ) | w < 0 || h < 0 -> fail $ "getwinsize returned < 0 : " ++ show raw_size

153 | otherwise -> return $ DisplayRegion (toEnum w) (toEnum h)

156 | otherwise -> return $ DisplayRegion (toEnum w) (toEnum h)

154

157

155 -- Output the byte buffer of the specified size to the terminal device.

158 -- Output the byte buffer of the specified size to the terminal device.

156 output_byte_buffer _t out_ptr out_byte_count = do

159 output_byte_buffer _t out_ptr out_byte_count = do

157− hPutBuf stdout out_ptr (fromEnum out_byte_count)

160+ liftIO $ hPutBuf stdout out_ptr (fromEnum out_byte_count)

158− hFlush stdout

161+ liftIO $ hFlush stdout

159

162

160foreign import ccall "gwinsz.h c_get_window_size" c_get_window_size :: IO CLong

163foreign import ccall "gwinsz.h c_get_window_size" c_get_window_size :: IO CLong

161

164

src/Graphics/Vty/Terminal/XTermColor.hs+7−4

@@ -11,6 +11,9 @@ module Graphics.Vty.Terminal.XTermColor ( terminal_instance

11import Graphics.Vty.Terminal.Generic

12import qualified Graphics.Vty.Terminal.TerminfoBased as TerminfoBased

14+import Control.Applicative

15+import Control.Monad.Trans

16+

14import System.IO

17import System.IO

16data XTermColor = XTermColor

19data XTermColor = XTermColor

@@ -20,16 +23,16 @@ data XTermColor = XTermColor

21-- Initialize the display to UTF-8

24-- Initialize the display to UTF-8

22-- Regardless of what is output the text encoding is assumed to be UTF-8

25-- Regardless of what is output the text encoding is assumed to be UTF-8

23−terminal_instance :: String -> IO XTermColor

26+terminal_instance :: ( Applicative m, MonadIO m ) => String -> m XTermColor

24terminal_instance variant = do

27terminal_instance variant = do

25 flushed_put set_utf8_char_set

28 flushed_put set_utf8_char_set

26 t <- TerminfoBased.terminal_instance variant >>= new_terminal_handle

29 t <- TerminfoBased.terminal_instance variant >>= new_terminal_handle

27 return $ XTermColor variant t

30 return $ XTermColor variant t

29−flushed_put :: String -> IO ()

32+flushed_put :: MonadIO m => String -> m ()

30flushed_put str = do

33flushed_put str = do

31− hPutStr stdout str

34+ liftIO $ hPutStr stdout str

32− hFlush stdout

35+ liftIO $ hFlush stdout

34-- Since I don't know of a terminfo string cap that produces these strings these are hardcoded.

37-- Since I don't know of a terminfo string cap that produces these strings these are hardcoded.

35set_utf8_char_set, set_default_char_set :: String

38set_utf8_char_set, set_default_char_set :: String

test/Bench.hs+2

@@ -1,3 +1,5 @@

1+module Main where

1import Graphics.Vty

3import Graphics.Vty

3import Control.Concurrent( threadDelay )

5import Control.Concurrent( threadDelay )

test/Makefile+2−1

@@ -2,6 +2,7 @@ VERIF_TESTS := \

2verify_attribute_ops \

3verify_display_attributes \

4verify_parse_terminfo_caps \

5+verify_eval_terminfo_caps \

5verify_utf8_width \

6verify_utf8_width \

6verify_image_ops \

7verify_image_ops \

7verify_image_trans \

8verify_image_trans \

@@ -38,7 +39,7 @@ $(TESTS) :

38 @echo running test $@

39 @echo running test $@

39 @mkdir -p results/$@

40 @mkdir -p results/$@

40 ( ghc $(GHC_PROF_ARGS) $@ \

41 ( ghc $(GHC_PROF_ARGS) $@ \

41− && time --output results/$@/time_report ./$@ +RTS -p -sresults/$@/mem_report \

42+ && time ./$@ +RTS -p -sresults/$@/mem_report \

42 && cp $@.prof results/$@/profile \

43 && cp $@.prof results/$@/profile \

43 )

44 )

test/Test.hs+2

@@ -1,4 +1,6 @@

1{-# LANGUAGE ScopedTypeVariables #-}

2+module Main where

2import Graphics.Vty

4import Graphics.Vty

4import qualified Data.ByteString as B

6import qualified Data.ByteString as B

test/Verify.hs+9−1

@@ -1,3 +1,6 @@

1+{-# LANGUAGE TypeSynonymInstances #-}

2+{-# LANGUAGE FlexibleInstances #-}

3+{-# LANGUAGE StandaloneDeriving #-}

1{-# LANGUAGE DisambiguateRecordFields #-}

4{-# LANGUAGE DisambiguateRecordFields #-}

2{-# LANGUAGE NamedFieldPuns #-}

5{-# LANGUAGE NamedFieldPuns #-}

3module Verify ( module Verify

6module Verify ( module Verify

@@ -20,6 +23,7 @@ import Test.QuickCheck.Monadic ( monadicIO )

21import qualified Codec.Binary.UTF8.String as UTF8

24import qualified Codec.Binary.UTF8.String as UTF8

26+import Control.Applicative

23import Control.Monad.State.Strict

27import Control.Monad.State.Strict

24import Control.Monad.Trans ( liftIO )

28import Control.Monad.Trans ( liftIO )

@@ -30,7 +34,11 @@ import Numeric ( showHex )

31import System.IO

35import System.IO

33−type Test v = StateT TestState IO v

37+type Test = StateT TestState IO

38+

39+instance Applicative Test where

40+ pure = return

41+ ( <*> ) = ap

35data TestState = TestState

43data TestState = TestState

36 { results_ref :: IORef [QC.Result]

44 { results_ref :: IORef [QC.Result]

test/Verify/Data/Terminfo/Parse.hs+2−2

@@ -97,8 +97,8 @@ is_bytes_op (Bytes {}) = True

98collect_bytes :: CapExpression -> [Word8]

99collect_bytes e = concat [ bytes

100− | Bytes byte_range <- cap_ops e

100+ | Bytes offset c <- cap_ops e

101− , let bytes = bytes_for_range e byte_range

101+ , let bytes = bytes_for_range e offset c

102 ]

103

104verify_bytes_equal out_bytes expected_bytes

test/Verify/Graphics/Vty/WinRegion.hs → test/Verify/Graphics/Vty/DisplayRegion.hsrenamed+4−4

@@ -1,11 +1,11 @@

1{-# LANGUAGE ScopedTypeVariables #-}

2−module Verify.Graphics.Vty.WinRegion ( module Verify.Graphics.Vty.WinRegion

2+module Verify.Graphics.Vty.DisplayRegion ( module Verify.Graphics.Vty.DisplayRegion

3− , module Graphics.Vty.WinRegion

3+ , module Graphics.Vty.DisplayRegion

4− )

4+ )

5 where

7import Graphics.Vty.Debug

8−import Graphics.Vty.WinRegion

8+import Graphics.Vty.DisplayRegion

10import Verify

test/Verify/Graphics/Vty/Image.hs+1−1

@@ -5,7 +5,7 @@ module Verify.Graphics.Vty.Image ( module Verify.Graphics.Vty.Image

6import Graphics.Vty.Debug

7import Graphics.Vty.Image

8−import Graphics.Vty.WinRegion

8+import Graphics.Vty.DisplayRegion

10import Verify

11import Verify.Graphics.Vty.Attributes

test/Verify/Graphics/Vty/Picture.hs+1−1

@@ -9,7 +9,7 @@ import Graphics.Vty.Debug

10import Verify.Graphics.Vty.Attributes

11import Verify.Graphics.Vty.Image

12−import Verify.Graphics.Vty.WinRegion

12+import Verify.Graphics.Vty.DisplayRegion

14import Verify

test/interactive_terminal_test.hs+5−5

@@ -7,7 +7,7 @@ import Graphics.Vty.AttributeChange

7import Graphics.Vty.Image

8import Graphics.Vty.Picture

9import Graphics.Vty.Terminal

10−import Graphics.Vty.WinRegion

10+import Graphics.Vty.DisplayRegion

12import Control.Monad

@@ -199,7 +199,7 @@ display_bounds_test_0 = Test

199 , test_action = do

200 t <- terminal_handle

201 reserve_display t

202− DisplayBounds w h <- display_bounds t

202+ DisplayRegion w h <- display_bounds t

203 let row_0 = replicate (fromEnum w) 'X' ++ "\n"

204 row_h = replicate (fromEnum w - 1) 'X'

205 row_n = "X" ++ replicate (fromEnum w - 2) ' ' ++ "X\n"

@@ -220,7 +220,7 @@ display_bounds_test_1 = Test

220 , test_action = do

221 t <- terminal_handle

222 reserve_display t

223− DisplayBounds w h <- display_bounds t

223+ DisplayRegion w h <- display_bounds t

224 set_cursor_pos t 0 0

225 let row_0 = replicate (fromEnum w) 'X' ++ "\n"

226 putStr row_0

@@ -247,7 +247,7 @@ display_bounds_test_2 = Test

247 , test_action = do

248 t <- terminal_handle

249 reserve_display t

250− bounds@(DisplayBounds w h) <- display_bounds t

250+ bounds@(DisplayRegion w h) <- display_bounds t

251 let first_row = horiz_cat $ replicate (fromEnum w) (char def_attr 'X')

252 middle_rows = vert_cat $ replicate (fromEnum h - 2) middle_row

253 middle_row = (char def_attr 'X') <|> background_fill (w - 2) 1 <|> (char def_attr 'X')

@@ -270,7 +270,7 @@ display_bounds_test_3 = Test

270 , test_action = do

271 t <- terminal_handle

272 reserve_display t

273− DisplayBounds w h <- display_bounds t

273+ DisplayRegion w h <- display_bounds t

274 hide_cursor t

275 set_cursor_pos t 0 0

276 let row_0 = replicate (fromEnum w) 'X'

test/verify_debug_terminal.hs+7−7

@@ -1,7 +1,7 @@

1{-# LANGUAGE ScopedTypeVariables #-}

2module Main where

4−import Verify.Graphics.Vty.WinRegion

4+import Verify.Graphics.Vty.DisplayRegion

5import Verify.Graphics.Vty.Picture

6import Verify.Graphics.Vty.Image

7import Verify.Graphics.Vty.Span

@@ -20,7 +20,7 @@ import System.IO

21unit_image_unit_bounds :: UnitImage -> Property

22unit_image_unit_bounds (UnitImage _ i) = liftIOResult $ do

23− t <- terminal_instance (DisplayBounds 1 1)

23+ t <- terminal_instance (DisplayRegion 1 1)

24 d <- display_bounds t >>= display_context t

25 let pic = pic_for_image i

26 output_picture d pic

@@ -28,7 +28,7 @@ unit_image_unit_bounds (UnitImage _ i) = liftIOResult $ do

29unit_image_arb_bounds :: UnitImage -> DebugWindow -> Property

30unit_image_arb_bounds (UnitImage _ i) (DebugWindow w h) = liftIOResult $ do

31− t <- terminal_instance (DisplayBounds w h)

31+ t <- terminal_instance (DisplayRegion w h)

32 d <- display_bounds t >>= display_context t

33 let pic = pic_for_image i

34 output_picture d pic

@@ -36,7 +36,7 @@ unit_image_arb_bounds (UnitImage _ i) (DebugWindow w h) = liftIOResult $ do

37single_T_row :: DebugWindow -> Property

38single_T_row (DebugWindow w h) = liftIOResult $ do

39− t <- terminal_instance (DisplayBounds w h)

39+ t <- terminal_instance (DisplayRegion w h)

40 d <- display_bounds t >>= display_context t

41 -- create an image that contains just the character T repeated for a single row

42 let i = horiz_cat $ replicate (fromEnum w) (char def_attr 'T')

@@ -55,7 +55,7 @@ single_T_row (DebugWindow w h) = liftIOResult $ do

56many_T_rows :: DebugWindow -> Property

57many_T_rows (DebugWindow w h) = liftIOResult $ do

58− t <- terminal_instance (DisplayBounds w h)

58+ t <- terminal_instance (DisplayRegion w h)

59 d <- display_bounds t >>= display_context t

60 -- create an image that contains the character 'T' repeated for all the rows

61 let i = vert_cat $ replicate (fromEnum h) $ horiz_cat $ replicate (fromEnum w) (char def_attr 'T')

@@ -72,7 +72,7 @@ many_T_rows (DebugWindow w h) = liftIOResult $ do

73many_T_rows_cropped_width :: DebugWindow -> Property

74many_T_rows_cropped_width (DebugWindow w h) = liftIOResult $ do

75− t <- terminal_instance (DisplayBounds w h)

75+ t <- terminal_instance (DisplayRegion w h)

76 d <- display_bounds t >>= display_context t

77 -- create an image that contains the character 'T' repeated for all the rows

78 let i = vert_cat $ replicate (fromEnum h) $ horiz_cat $ replicate (fromEnum w * 2) (char def_attr 'T')

@@ -89,7 +89,7 @@ many_T_rows_cropped_width (DebugWindow w h) = liftIOResult $ do

90many_T_rows_cropped_height :: DebugWindow -> Property

91many_T_rows_cropped_height (DebugWindow w h) = liftIOResult $ do

92− t <- terminal_instance (DisplayBounds w h)

92+ t <- terminal_instance (DisplayRegion w h)

93 d <- display_bounds t >>= display_context t

94 -- create an image that contains the character 'T' repeated for all the rows

95 let i = vert_cat $ replicate (fromEnum h * 2) $ horiz_cat $ replicate (fromEnum w) (char def_attr 'T')

test/verify_eval_terminfo_caps.hsnew file+129

@@ -0,0 +1,129 @@

1+{-# LANGUAGE ScopedTypeVariables #-}

2+{-# LANGUAGE NamedFieldPuns #-}

3+module Main where

5+import Data.Marshalling

7+import Data.Terminfo.Eval

8+import Data.Terminfo.Parse

10+import qualified System.Console.Terminfo as Terminfo

11+

12+import Verify

13+

14+import Control.Exception ( try, SomeException(..) )

15+

16+import Control.Monad ( mapM_, forM_ )

17+

18+import Data.Array.Unboxed

19+import Data.Maybe ( fromJust )

20+import Data.Word

21+

22+import Numeric

23+

24+-- A list of terminals that ubuntu includes a terminfo cap file for.

25+-- Assuming that is a good place to start.

26+terminals_of_interest =

27+ [ "wsvt25"

28+ , "wsvt25m"

29+ , "vt52"

30+ , "vt100"

31+ , "vt220"

32+ , "vt102"

33+ , "xterm-r5"

34+ , "xterm-xfree86"

35+ , "xterm-r6"

36+ , "xterm-256color"

37+ , "xterm-vt220"

38+ , "xterm-debian"

39+ , "xterm-mono"

40+ , "xterm-color"

41+ , "xterm"

42+ , "mach"

43+ , "mach-bold"

44+ , "mach-color"

45+ , "linux"

46+ , "ansi"

47+ , "hurd"

48+ , "Eterm"

49+ , "pcansi"

50+ , "screen-256color"

51+ , "screen-bce"

52+ , "screen-s"

53+ , "screen-w"

54+ , "screen"

55+ , "screen-256color-bce"

56+ , "sun"

57+ , "rxvt"

58+ , "rxvt-unicode"

59+ , "rxvt-basic"

60+ , "cygwin"

61+ , "cons25"

62+ , "dumb"

63+ ]

64+

65+-- If a terminal defines one of the caps then it's expected to be parsable.

66+caps_of_interest =

67+ [ "cup"

68+ , "sc"

69+ , "rc"

70+ , "setf"

71+ , "setb"

72+ , "setaf"

73+ , "setab"

74+ , "op"

75+ , "cnorm"

76+ , "civis"

77+ , "smcup"

78+ , "rmcup"

79+ , "clear"

80+ , "hpa"

81+ , "vpa"

82+ , "sgr"

83+ , "sgr0"

84+ ]

85+

86+from_capname ti name = fromJust $ Terminfo.getCapability ti (Terminfo.tiGetStr name)

87+

88+main = do

89+ run_test $ do

90+ forM_ terminals_of_interest $ \term_name -> do

91+ liftIO $ putStrLn $ "testing parsing of caps for terminal: " ++ term_name

92+ mti <- liftIO $ try $ Terminfo.setupTerm term_name

93+ case mti of

94+ Left (_e :: SomeException)

95+ -> return ()

96+ Right ti -> do

97+ forM_ caps_of_interest $ \cap_name -> do

98+ liftIO $ putStrLn $ "\tevaluating cap: " ++ cap_name

99+ case Terminfo.getCapability ti (Terminfo.tiGetStr cap_name) of

100+ Just cap_def -> do

101+ verify ( "\teval cap " ++ cap_name ++ " -> " ++ show cap_def )

102+ ( verify_eval_cap cap_def )

103+ return ()

104+ Nothing -> do

105+ return ()

106+ return ()

107+ return ()

108+

109+verify_eval_cap cap_string

110+ = case parse_cap_expression cap_string of

111+ Left error ->

112+ liftResult $ failed { reason = "parse error " ++ show error }

113+ Right expr ->

114+ forAll (vector 9) $ \input_values ->

115+ let byte_count = cap_expression_required_bytes expr input_values

116+ in liftIOResult $ do

117+ start_ptr :: Ptr Word8 <- mallocBytes (fromEnum byte_count)

118+ end_ptr <- serialize_cap_expression expr input_values start_ptr

119+ free start_ptr

120+ case end_ptr `minusPtr` start_ptr of

121+ count | count < 0 ->

122+ return $ failed { reason = "End pointer before start pointer." }

123+ | toEnum count > byte_count ->

124+ return $ failed { reason = "End pointer past end of buffer by "

125+ ++ show (toEnum count - byte_count)

126+ }

127+ | otherwise ->

128+ return succeeded

129+

test/verify_parse_terminfo_caps.hs+65−9

@@ -2,6 +2,8 @@

2{-# LANGUAGE NamedFieldPuns #-}

3module Main where

5+import Prelude hiding ( catch )

5import Data.Terminfo.Eval ( bytes_for_range )

7import Data.Terminfo.Eval ( bytes_for_range )

7import qualified System.Console.Terminfo as Terminfo

9import qualified System.Console.Terminfo as Terminfo

@@ -9,7 +11,8 @@ import qualified System.Console.Terminfo as Terminfo

9import Verify.Data.Terminfo.Parse

11import Verify.Data.Terminfo.Parse

10import Verify

12import Verify

12−import Control.Monad ( mapM_ )

14+import Control.Exception ( try, SomeException(..) )

15+import Control.Monad ( mapM_, forM_ )

14import Data.Array.Unboxed

17import Data.Array.Unboxed

15import Data.Maybe ( fromJust )

18import Data.Maybe ( fromJust )

@@ -17,7 +20,49 @@ import Data.Word

18import Numeric

21import Numeric

20−caps =

23+-- A list of terminals that ubuntu includes a terminfo cap file for.

24+-- Assuming that is a good place to start.

25+terminals_of_interest =

26+ [ "wsvt25"

27+ , "wsvt25m"

28+ , "vt52"

29+ , "vt100"

30+ , "vt220"

31+ , "vt102"

32+ , "xterm-r5"

33+ , "xterm-xfree86"

34+ , "xterm-r6"

35+ , "xterm-256color"

36+ , "xterm-vt220"

37+ , "xterm-debian"

38+ , "xterm-mono"

39+ , "xterm-color"

40+ , "xterm"

41+ , "mach"

42+ , "mach-bold"

43+ , "mach-color"

44+ , "linux"

45+ , "ansi"

46+ , "hurd"

47+ , "Eterm"

48+ , "pcansi"

49+ , "screen-256color"

50+ , "screen-bce"

51+ , "screen-s"

52+ , "screen-w"

53+ , "screen"

54+ , "screen-256color-bce"

55+ , "sun"

56+ , "rxvt"

57+ , "rxvt-unicode"

58+ , "rxvt-basic"

59+ , "cygwin"

60+ , "cons25"

61+ , "dumb"

62+ ]

63+

64+-- If a terminal defines one of the caps then it's expected to be parsable.

65+caps_of_interest =

21 [ "cup"

66 [ "cup"

22 , "sc"

67 , "sc"

23 , "rc"

68 , "rc"

@@ -40,13 +85,24 @@ caps =

40from_capname ti name = fromJust $ Terminfo.getCapability ti (Terminfo.tiGetStr name)

85from_capname ti name = fromJust $ Terminfo.getCapability ti (Terminfo.tiGetStr name)

42main = do

87main = do

43− ti <- Terminfo.setupTermFromEnv

44− mapM_ ( print_cap ti) caps

45 run_test $ do

88 run_test $ do

46− mapM_ ( \cap -> let cap_str = from_capname ti cap

89+ forM_ terminals_of_interest $ \term_name -> do

47− in verify ( "parse cap " ++ show cap ++ " -> " ++ show cap_str )

90+ liftIO $ putStrLn $ "testing parsing of caps for terminal: " ++ term_name

91+ mti <- liftIO $ try $ Terminfo.setupTerm term_name

92+ case mti of

93+ Left (_e :: SomeException)

94+ -> return ()

95+ Right ti -> do

96+ forM_ caps_of_interest $ \cap_name -> do

97+ liftIO $ putStrLn $ "\tparsing cap: " ++ cap_name

98+ case Terminfo.getCapability ti (Terminfo.tiGetStr cap_name) of

99+ Just cap_def -> do

100+ verify ( "\tparse cap " ++ cap_name ++ " -> " ++ show cap_def )

48− ( verify_parse_cap cap_str $ const (liftResult succeeded) )

101+ ( verify_parse_cap cap_def $ const (liftResult succeeded) )

49− ) caps

102+ return ()

103+ Nothing -> do

104+ return ()

105+ -- The quickcheck tests

50 verify "parse_non_paramaterized_caps" non_paramaterized_caps

106 verify "parse_non_paramaterized_caps" non_paramaterized_caps

51 verify "parse cap string with literal %" literal_percent_caps

107 verify "parse cap string with literal %" literal_percent_caps

52 verify "parse cap string with %i op" inc_first_two_caps

108 verify "parse cap string with %i op" inc_first_two_caps

@@ -63,7 +119,7 @@ non_paramaterized_caps (NonParamCapString cap) = do

63 verify_parse_cap cap $ \e ->

119 verify_parse_cap cap $ \e ->

64 let expected_count :: Word8 = toEnum $ length cap

120 let expected_count :: Word8 = toEnum $ length cap

65 expected_bytes = map (toEnum . fromEnum) cap

121 expected_bytes = map (toEnum . fromEnum) cap

66− out_bytes = bytes_for_range e (0, expected_count)

122+ out_bytes = bytes_for_range e 0 expected_count

67 in verify_bytes_equal out_bytes expected_bytes

123 in verify_bytes_equal out_bytes expected_bytes

124

69literal_percent_caps (LiteralPercentCap cap_string expected_bytes) = do

125literal_percent_caps (LiteralPercentCap cap_string expected_bytes) = do

test/verify_span_ops.hs+24−24

@@ -5,7 +5,7 @@ module Main where

5import Verify.Graphics.Vty.Picture

6import Verify.Graphics.Vty.Image

7import Verify.Graphics.Vty.Span

8−import Verify.Graphics.Vty.WinRegion

8+import Verify.Graphics.Vty.DisplayRegion

10import Graphics.Vty.Debug

@@ -16,39 +16,39 @@ import Data.Array

16unit_image_and_zero_window_0 :: UnitImage -> EmptyWindow -> Bool

17unit_image_and_zero_window_0 (UnitImage _ i) (EmptyWindow w) =

18 let p = pic_for_image i

19− spans = spans_for_pic p w

19+ spans = spans_for_pic p (region_for_window w)

20− in win_width spans == 0 && win_height spans == 0

20+ in span_ops_columns spans == 0 && span_ops_rows spans == 0

22unit_image_and_zero_window_1 :: UnitImage -> EmptyWindow -> Bool

23unit_image_and_zero_window_1 (UnitImage _ i) (EmptyWindow w) =

24 let p = pic_for_image i

25− spans = spans_for_pic p w

25+ spans = spans_for_pic p (region_for_window w)

26 in ( span_ops_effected_rows spans == 0 ) && ( all_spans_have_width spans 0 )

28horiz_span_image_and_zero_window_0 :: SingleRowSingleAttrImage -> EmptyWindow -> Bool

29horiz_span_image_and_zero_window_0 (SingleRowSingleAttrImage { row_image = i }) (EmptyWindow w) =

30 let p = pic_for_image i

31− spans = spans_for_pic p w

31+ spans = spans_for_pic p (region_for_window w)

32− in win_width spans == 0 && win_height spans == 0

32+ in span_ops_columns spans == 0 && span_ops_rows spans == 0

34horiz_span_image_and_zero_window_1 :: SingleRowSingleAttrImage -> EmptyWindow -> Bool

35horiz_span_image_and_zero_window_1 (SingleRowSingleAttrImage { row_image = i }) (EmptyWindow w) =

36 let p = pic_for_image i

37− spans = spans_for_pic p w

37+ spans = spans_for_pic p (region_for_window w)

38 in ( span_ops_effected_rows spans == 0 ) && ( all_spans_have_width spans 0 )

40horiz_span_image_and_equal_window_0 :: SingleRowSingleAttrImage -> Result

41horiz_span_image_and_equal_window_0 (SingleRowSingleAttrImage { row_image = i, expected_columns = c }) =

42 let p = pic_for_image i

43 w = DebugWindow c 1

44− spans = spans_for_pic p w

44+ spans = spans_for_pic p (region_for_window w)

45 in verify_all_spans_have_width i spans c

47horiz_span_image_and_equal_window_1 :: SingleRowSingleAttrImage -> Bool

48horiz_span_image_and_equal_window_1 (SingleRowSingleAttrImage { row_image = i, expected_columns = c }) =

49 let p = pic_for_image i

50 w = DebugWindow c 1

51− spans = spans_for_pic p w

51+ spans = spans_for_pic p (region_for_window w)

52 in span_ops_effected_rows spans == 1

54horiz_span_image_and_lesser_window_0 :: SingleRowSingleAttrImage -> Result

@@ -56,14 +56,14 @@ horiz_span_image_and_lesser_window_0 (SingleRowSingleAttrImage { row_image = i,

56 let p = pic_for_image i

57 lesser_width = c `div` 2

58 w = DebugWindow lesser_width 1

59− spans = spans_for_pic p w

59+ spans = spans_for_pic p (region_for_window w)

60 in verify_all_spans_have_width i spans lesser_width

62single_attr_single_span_stack_cropped_0 :: SingleAttrSingleSpanStack -> Result

63single_attr_single_span_stack_cropped_0 stack =

64 let p = pic_for_image (stack_image stack)

65 w = DebugWindow (stack_width stack `div` 2) (stack_height stack)

66− spans = spans_for_pic p w

66+ spans = spans_for_pic p (region_for_window w)

67 in verify_all_spans_have_width (stack_image stack) spans (stack_width stack `div` 2)

69single_attr_single_span_stack_cropped_1 :: SingleAttrSingleSpanStack -> Bool

@@ -71,7 +71,7 @@ single_attr_single_span_stack_cropped_1 stack =

71 let p = pic_for_image (stack_image stack)

72 expected_row_count = stack_height stack `div` 2

73 w = DebugWindow (stack_width stack) expected_row_count

74− spans = spans_for_pic p w

74+ spans = spans_for_pic p (region_for_window w)

75 actual_row_count = span_ops_effected_rows spans

76 in expected_row_count == actual_row_count

@@ -79,14 +79,14 @@ single_attr_single_span_stack_cropped_2 :: SingleAttrSingleSpanStack -> SingleAt

79single_attr_single_span_stack_cropped_2 stack_0 stack_1 =

80 let p = pic_for_image (stack_image stack_0 <|> stack_image stack_1)

81 w = DebugWindow (stack_width stack_0) (image_height (pic_image p))

82− spans = spans_for_pic p w

82+ spans = spans_for_pic p (region_for_window w)

83 in verify_all_spans_have_width (pic_image p) spans (stack_width stack_0)

85single_attr_single_span_stack_cropped_3 :: SingleAttrSingleSpanStack -> SingleAttrSingleSpanStack -> Bool

86single_attr_single_span_stack_cropped_3 stack_0 stack_1 =

87 let p = pic_for_image (stack_image stack_0 <|> stack_image stack_1)

88 w = DebugWindow (image_width (pic_image p)) expected_row_count

89− spans = spans_for_pic p w

89+ spans = spans_for_pic p (region_for_window w)

90 expected_row_count = image_height (pic_image p) `div` 2

91 actual_row_count = span_ops_effected_rows spans

92 in expected_row_count == actual_row_count

@@ -95,7 +95,7 @@ single_attr_single_span_stack_cropped_4 :: SingleAttrSingleSpanStack -> SingleAt

95single_attr_single_span_stack_cropped_4 stack_0 stack_1 =

96 let p = pic_for_image (stack_image stack_0 <-> stack_image stack_1)

97 w = DebugWindow expected_width (image_height (pic_image p))

98− spans = spans_for_pic p w

98+ spans = spans_for_pic p (region_for_window w)

99 expected_width = image_width (pic_image p) `div` 2

100 in verify_all_spans_have_width (pic_image p) spans expected_width

101

@@ -103,7 +103,7 @@ single_attr_single_span_stack_cropped_5 :: SingleAttrSingleSpanStack -> SingleAt

103single_attr_single_span_stack_cropped_5 stack_0 stack_1 =

104 let p = pic_for_image (stack_image stack_0 <-> stack_image stack_1)

105 w = DebugWindow (image_width (pic_image p)) (stack_height stack_0)

106− spans = spans_for_pic p w

106+ spans = spans_for_pic p (region_for_window w)

107 expected_row_count = stack_height stack_0

108 actual_row_count = span_ops_effected_rows spans

109 in expected_row_count == actual_row_count

@@ -114,38 +114,38 @@ horiz_span_image_and_greater_window_0 (SingleRowSingleAttrImage { row_image = i,

114 -- SingleRowSingleAttrImage always has width >= 1

115 greater_width = c * 2

116 w = DebugWindow greater_width 1

117− spans = spans_for_pic p w

117+ spans = spans_for_pic p (region_for_window w)

118 in verify_all_spans_have_width i spans greater_width

119

120arb_image_is_cropped :: DefaultImage -> DebugWindow -> Bool

121arb_image_is_cropped (DefaultImage image _) win@(DebugWindow w h) =

122 let pic = pic_for_image image

123− spans = spans_for_pic pic win

123+ spans = spans_for_pic pic (region_for_window win)

124 in ( span_ops_effected_rows spans == h ) && ( all_spans_have_width spans w )

125

126span_ops_actually_fill_rows :: DefaultPic -> Bool

127span_ops_actually_fill_rows (DefaultPic pic win _) =

128− let spans = spans_for_pic pic win

128+ let spans = spans_for_pic pic (region_for_window win)

129− expected_row_count = win_height win

129+ expected_row_count = region_height (region_for_window win)

130 actual_row_count = span_ops_effected_rows spans

131 in expected_row_count == actual_row_count

132

133span_ops_actually_fill_columns :: DefaultPic -> Bool

134span_ops_actually_fill_columns (DefaultPic pic win _) =

135− let spans = spans_for_pic pic win

135+ let spans = spans_for_pic pic (region_for_window win)

136− expected_column_count = win_width win

136+ expected_column_count = region_width (region_for_window win)

137 in all_spans_have_width spans expected_column_count

138

139first_span_op_sets_attr :: DefaultPic -> Bool

140first_span_op_sets_attr DefaultPic { default_pic = pic, default_win = win } =

141− let spans = spans_for_pic pic win

141+ let spans = spans_for_pic pic (region_for_window win)

142 in all ( is_attr_span_op . head ) ( elems $ row_ops spans )

143

144single_attr_single_span_stack_op_coverage :: SingleAttrSingleSpanStack -> Result

145single_attr_single_span_stack_op_coverage stack =

146 let p = pic_for_image (stack_image stack)

147 w = DebugWindow (stack_width stack) (stack_height stack)

148− spans = spans_for_pic p w

148+ spans = spans_for_pic p (region_for_window w)

149 in verify_all_spans_have_width (stack_image stack) spans (stack_width stack)

150

151main :: IO ()