mirror of
https://github.com/ilyakooo0/vty.git
synced 2024-11-30 12:28:00 +03:00
rename debug terminals to mock terminals.
This commit is contained in:
parent
89b1a3a098
commit
e6fb85e342
@ -32,11 +32,9 @@ is_set_attr expected_attr (SpanSetAttr in_attr)
|
|||||||
| in_attr == expected_attr = True
|
| in_attr == expected_attr = True
|
||||||
is_set_attr _attr _event = False
|
is_set_attr _attr _event = False
|
||||||
|
|
||||||
data DebugWindow = DebugWindow Int Int
|
data MockWindow = MockWindow Int Int
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
|
|
||||||
region_for_window :: DebugWindow -> DisplayRegion
|
region_for_window :: MockWindow -> DisplayRegion
|
||||||
region_for_window (DebugWindow w h) = DisplayRegion w h
|
region_for_window (MockWindow w h) = DisplayRegion w h
|
||||||
|
|
||||||
type TestWindow = DebugWindow
|
|
||||||
|
|
||||||
|
@ -33,7 +33,7 @@ module Graphics.Vty.Inline ( module Graphics.Vty.Inline
|
|||||||
|
|
||||||
import Graphics.Vty.Attributes
|
import Graphics.Vty.Attributes
|
||||||
import Graphics.Vty.DisplayAttributes
|
import Graphics.Vty.DisplayAttributes
|
||||||
import Graphics.Vty.Terminal.Generic
|
import Graphics.Vty.Terminal.Interface
|
||||||
|
|
||||||
import Control.Applicative
|
import Control.Applicative
|
||||||
import Control.Monad.State.Strict
|
import Control.Monad.State.Strict
|
||||||
|
@ -1,13 +1,13 @@
|
|||||||
-- | Generic Terminal interface.
|
-- | Terminal IO device.
|
||||||
--
|
--
|
||||||
-- Defines the common interface supported by all terminals.
|
-- Access to the current terminal or a specific terminal device.
|
||||||
--
|
--
|
||||||
-- See also:
|
-- See also:
|
||||||
--
|
--
|
||||||
-- 1. Graphics.Vty.Terminal: This instantiates an abtract interface to the terminal interface based
|
-- 1. Graphics.Vty.Terminal: This instantiates an abtract interface to the terminal interface based
|
||||||
-- on the TERM and COLORTERM environment variables.
|
-- on the TERM and COLORTERM environment variables.
|
||||||
--
|
--
|
||||||
-- 2. Graphics.Vty.Terminal.Generic: Defines the generic interface all terminals need to implement.
|
-- 2. Graphics.Vty.Terminal.Interface: Defines the generic interface all terminals need to implement.
|
||||||
--
|
--
|
||||||
-- 3. Graphics.Vty.Terminal.TerminfoBased: Defines a terminal instance that uses terminfo for all
|
-- 3. Graphics.Vty.Terminal.TerminfoBased: Defines a terminal instance that uses terminfo for all
|
||||||
-- control strings. No attempt is made to change the character set to UTF-8 for these terminals.
|
-- control strings. No attempt is made to change the character set to UTF-8 for these terminals.
|
||||||
@ -30,7 +30,7 @@ module Graphics.Vty.Terminal ( module Graphics.Vty.Terminal
|
|||||||
|
|
||||||
|
|
||||||
import Graphics.Vty.DisplayRegion
|
import Graphics.Vty.DisplayRegion
|
||||||
import Graphics.Vty.Terminal.Generic
|
import Graphics.Vty.Terminal.Interface
|
||||||
import Graphics.Vty.Terminal.MacOSX as MacOSX
|
import Graphics.Vty.Terminal.MacOSX as MacOSX
|
||||||
import Graphics.Vty.Terminal.XTermColor as XTermColor
|
import Graphics.Vty.Terminal.XTermColor as XTermColor
|
||||||
import Graphics.Vty.Terminal.TerminfoBased as TerminfoBased
|
import Graphics.Vty.Terminal.TerminfoBased as TerminfoBased
|
||||||
@ -42,7 +42,10 @@ import Control.Monad.Trans
|
|||||||
|
|
||||||
import Data.List ( isPrefixOf )
|
import Data.List ( isPrefixOf )
|
||||||
|
|
||||||
|
import GHC.IO.Handle
|
||||||
|
|
||||||
import System.Environment
|
import System.Environment
|
||||||
|
import System.IO
|
||||||
|
|
||||||
-- | Returns a TerminalHandle (an abstract Terminal instance) for the current terminal.
|
-- | Returns a TerminalHandle (an abstract Terminal instance) for the current terminal.
|
||||||
--
|
--
|
||||||
@ -84,23 +87,24 @@ import System.Environment
|
|||||||
terminal_handle :: ( Applicative m, MonadIO m ) => m TerminalHandle
|
terminal_handle :: ( Applicative m, MonadIO m ) => m TerminalHandle
|
||||||
terminal_handle = do
|
terminal_handle = do
|
||||||
term_type <- liftIO $ getEnv "TERM"
|
term_type <- liftIO $ getEnv "TERM"
|
||||||
|
out_handle <- liftIO $ hDuplicate stdout
|
||||||
t <- if "xterm" `isPrefixOf` term_type
|
t <- if "xterm" `isPrefixOf` term_type
|
||||||
then do
|
then do
|
||||||
maybe_terminal_app <- get_env "TERM_PROGRAM"
|
maybe_terminal_app <- get_env "TERM_PROGRAM"
|
||||||
case maybe_terminal_app of
|
case maybe_terminal_app of
|
||||||
Nothing
|
Nothing
|
||||||
-> XTermColor.terminal_instance term_type >>= new_terminal_handle
|
-> XTermColor.terminal_instance term_type out_handle >>= new_terminal_handle
|
||||||
Just v | v == "Apple_Terminal" || v == "iTerm.app"
|
Just v | v == "Apple_Terminal" || v == "iTerm.app"
|
||||||
-> do
|
-> do
|
||||||
maybe_xterm <- get_env "XTERM_VERSION"
|
maybe_xterm <- get_env "XTERM_VERSION"
|
||||||
case maybe_xterm of
|
case maybe_xterm of
|
||||||
Nothing -> MacOSX.terminal_instance v >>= new_terminal_handle
|
Nothing -> MacOSX.terminal_instance v out_handle >>= new_terminal_handle
|
||||||
Just _ -> XTermColor.terminal_instance term_type >>= new_terminal_handle
|
Just _ -> XTermColor.terminal_instance term_type out_handle >>= new_terminal_handle
|
||||||
-- Assume any other terminal that sets TERM_PROGRAM to not be an OS X terminal.app
|
-- Assume any other terminal that sets TERM_PROGRAM to not be an OS X terminal.app
|
||||||
-- like terminal?
|
-- like terminal?
|
||||||
_ -> XTermColor.terminal_instance term_type >>= new_terminal_handle
|
_ -> XTermColor.terminal_instance term_type out_handle >>= new_terminal_handle
|
||||||
-- Not an xterm-like terminal. try for generic terminfo.
|
-- Not an xterm-like terminal. try for generic terminfo.
|
||||||
else TerminfoBased.terminal_instance term_type >>= new_terminal_handle
|
else TerminfoBased.terminal_instance term_type out_handle >>= new_terminal_handle
|
||||||
return t
|
return t
|
||||||
where
|
where
|
||||||
get_env var = do
|
get_env var = do
|
||||||
|
@ -1,11 +1,11 @@
|
|||||||
-- Copyright 2009-2011 Corey O'Connor
|
-- Copyright Corey O'Connor
|
||||||
{-# LANGUAGE BangPatterns #-}
|
{-# LANGUAGE BangPatterns #-}
|
||||||
{-# LANGUAGE RankNTypes #-}
|
{-# LANGUAGE RankNTypes #-}
|
||||||
{-# LANGUAGE ScopedTypeVariables #-}
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
{-# LANGUAGE ExistentialQuantification #-}
|
{-# LANGUAGE ExistentialQuantification #-}
|
||||||
{-# LANGUAGE GADTs #-}
|
{-# LANGUAGE GADTs #-}
|
||||||
{-# LANGUAGE FlexibleContexts #-}
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
module Graphics.Vty.Terminal.Generic ( module Graphics.Vty.Terminal.Generic
|
module Graphics.Vty.Terminal.Interface ( module Graphics.Vty.Terminal.Interface
|
||||||
, OutputBuffer
|
, OutputBuffer
|
||||||
)
|
)
|
||||||
where
|
where
|
@ -14,7 +14,7 @@ module Graphics.Vty.Terminal.MacOSX ( terminal_instance
|
|||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
import Graphics.Vty.Terminal.Generic
|
import Graphics.Vty.Terminal.Interface
|
||||||
import qualified Graphics.Vty.Terminal.TerminfoBased as TerminfoBased
|
import qualified Graphics.Vty.Terminal.TerminfoBased as TerminfoBased
|
||||||
|
|
||||||
import Control.Applicative
|
import Control.Applicative
|
||||||
@ -32,11 +32,11 @@ data Term = Term
|
|||||||
-- "xterm-256color" is used.
|
-- "xterm-256color" is used.
|
||||||
--
|
--
|
||||||
-- This effects the terminfo lookup.
|
-- This effects the terminfo lookup.
|
||||||
terminal_instance :: ( Applicative m, MonadIO m ) => String -> m Term
|
terminal_instance :: ( Applicative m, MonadIO m ) => String -> Handle -> m Term
|
||||||
terminal_instance v = do
|
terminal_instance v out_handle = do
|
||||||
let base_term "iTerm.app" = "xterm-256color"
|
let base_term "iTerm.app" = "xterm-256color"
|
||||||
base_term _ = "xterm"
|
base_term _ = "xterm"
|
||||||
t <- TerminfoBased.terminal_instance (base_term v) >>= new_terminal_handle
|
t <- TerminfoBased.terminal_instance (base_term v) out_handle >>= new_terminal_handle
|
||||||
return $ Term t v
|
return $ Term t v
|
||||||
|
|
||||||
flushed_put :: MonadIO m => String -> m ()
|
flushed_put :: MonadIO m => String -> m ()
|
||||||
|
@ -1,15 +1,15 @@
|
|||||||
-- Copyright 2009-2010 Corey O'Connor
|
-- Copyright Corey O'Connor
|
||||||
{-# LANGUAGE FlexibleInstances #-}
|
{-# LANGUAGE FlexibleInstances #-}
|
||||||
{-# LANGUAGE TypeFamilies #-}
|
{-# LANGUAGE TypeFamilies #-}
|
||||||
module Graphics.Vty.Terminal.Debug ( DebugTerminal(..)
|
module Graphics.Vty.Terminal.Mock ( MockTerminal(..)
|
||||||
, DebugDisplay(..)
|
, MockDisplay(..)
|
||||||
, terminal_instance
|
, terminal_instance
|
||||||
, dehandle
|
, dehandle
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
import Graphics.Vty.DisplayRegion
|
import Graphics.Vty.DisplayRegion
|
||||||
import Graphics.Vty.Terminal.Generic
|
import Graphics.Vty.Terminal.Interface
|
||||||
|
|
||||||
import Control.Applicative
|
import Control.Applicative
|
||||||
import Control.Monad.Trans
|
import Control.Monad.Trans
|
||||||
@ -27,12 +27,12 @@ import System.IO
|
|||||||
|
|
||||||
import Unsafe.Coerce
|
import Unsafe.Coerce
|
||||||
|
|
||||||
-- | The debug display terminal produces a string representation of the requested picture. There is
|
-- | The mock display terminal produces a string representation of the requested picture. There is
|
||||||
-- *not* an isomorphism between the string representation and the picture. The string
|
-- *not* an isomorphism between the string representation and the picture. The string
|
||||||
-- representation is a simplification of the picture that is only useful in debugging VTY without
|
-- representation is a simplification of the picture that is only useful in debugging VTY without
|
||||||
-- considering terminal specific issues.
|
-- considering terminal specific issues.
|
||||||
--
|
--
|
||||||
-- The debug implementation is useful in manually determining if the sequence of terminal operations
|
-- The mock implementation is useful in manually determining if the sequence of terminal operations
|
||||||
-- matches the expected sequence. So requirement of the produced representation is simplicity in
|
-- matches the expected sequence. So requirement of the produced representation is simplicity in
|
||||||
-- parsing the text representation and determining how the picture was mapped to terminal
|
-- parsing the text representation and determining how the picture was mapped to terminal
|
||||||
-- operations.
|
-- operations.
|
||||||
@ -42,42 +42,42 @@ import Unsafe.Coerce
|
|||||||
-- class there exists a monoid that defines it's algebra. The string representation is a sequence of
|
-- class there exists a monoid that defines it's algebra. The string representation is a sequence of
|
||||||
-- identifiers where each identifier is the name of an operation in the algebra.
|
-- identifiers where each identifier is the name of an operation in the algebra.
|
||||||
|
|
||||||
data DebugTerminal = DebugTerminal
|
data MockTerminal = MockTerminal
|
||||||
{ debug_terminal_last_output :: IORef (UTF8.UTF8 BS.ByteString)
|
{ mock_terminal_last_output :: IORef (UTF8.UTF8 BS.ByteString)
|
||||||
, debug_terminal_bounds :: DisplayRegion
|
, mock_terminal_bounds :: DisplayRegion
|
||||||
}
|
}
|
||||||
|
|
||||||
instance Terminal DebugTerminal where
|
instance Terminal MockTerminal where
|
||||||
terminal_ID _t = "debug_terminal"
|
terminal_ID _t = "mock_terminal"
|
||||||
release_terminal _t = return ()
|
release_terminal _t = return ()
|
||||||
reserve_display _t = return ()
|
reserve_display _t = return ()
|
||||||
release_display _t = return ()
|
release_display _t = return ()
|
||||||
display_bounds t = return $ debug_terminal_bounds t
|
display_bounds t = return $ mock_terminal_bounds t
|
||||||
display_terminal_instance _t r c = return $ c (DebugDisplay r)
|
display_terminal_instance _t r c = return $ c (MockDisplay r)
|
||||||
output_byte_buffer t out_buffer buffer_size
|
output_byte_buffer t out_buffer buffer_size
|
||||||
= liftIO $ do
|
= liftIO $ do
|
||||||
putStrLn $ "output_byte_buffer ?? " ++ show buffer_size
|
putStrLn $ "output_byte_buffer ?? " ++ show buffer_size
|
||||||
peekArray (fromEnum buffer_size) out_buffer
|
peekArray (fromEnum buffer_size) out_buffer
|
||||||
>>= return . UTF8.fromRep . BSCore.pack
|
>>= return . UTF8.fromRep . BSCore.pack
|
||||||
>>= writeIORef (debug_terminal_last_output t)
|
>>= writeIORef (mock_terminal_last_output t)
|
||||||
|
|
||||||
output_handle _t = return stdout
|
output_handle _t = return stdout
|
||||||
|
|
||||||
data DebugDisplay = DebugDisplay
|
data MockDisplay = MockDisplay
|
||||||
{ debug_display_bounds :: DisplayRegion
|
{ mock_display_bounds :: DisplayRegion
|
||||||
}
|
}
|
||||||
|
|
||||||
terminal_instance :: ( Applicative m, MonadIO m ) => DisplayRegion -> m TerminalHandle
|
terminal_instance :: ( Applicative m, MonadIO m ) => DisplayRegion -> m TerminalHandle
|
||||||
terminal_instance r = do
|
terminal_instance r = do
|
||||||
output_ref <- liftIO $ newIORef undefined
|
output_ref <- liftIO $ newIORef undefined
|
||||||
new_terminal_handle $ DebugTerminal output_ref r
|
new_terminal_handle $ MockTerminal output_ref r
|
||||||
|
|
||||||
dehandle :: TerminalHandle -> DebugTerminal
|
dehandle :: TerminalHandle -> MockTerminal
|
||||||
dehandle (TerminalHandle t _) = unsafeCoerce t
|
dehandle (TerminalHandle t _) = unsafeCoerce t
|
||||||
|
|
||||||
instance DisplayTerminal DebugDisplay where
|
instance DisplayTerminal MockDisplay where
|
||||||
-- | Provide the current bounds of the output terminal.
|
-- | Provide the current bounds of the output terminal.
|
||||||
context_region d = debug_display_bounds d
|
context_region d = mock_display_bounds d
|
||||||
|
|
||||||
-- | Assume 16 colors
|
-- | Assume 16 colors
|
||||||
context_color_count _d = 16
|
context_color_count _d = 16
|
@ -12,7 +12,7 @@ import Data.Terminfo.Eval
|
|||||||
|
|
||||||
import Graphics.Vty.Attributes
|
import Graphics.Vty.Attributes
|
||||||
import Graphics.Vty.DisplayAttributes
|
import Graphics.Vty.DisplayAttributes
|
||||||
import Graphics.Vty.Terminal.Generic
|
import Graphics.Vty.Terminal.Interface
|
||||||
import Graphics.Vty.DisplayRegion
|
import Graphics.Vty.DisplayRegion
|
||||||
|
|
||||||
import Control.Applicative
|
import Control.Applicative
|
||||||
@ -21,7 +21,6 @@ import Control.Monad.Trans
|
|||||||
|
|
||||||
import Data.Bits ( (.&.) )
|
import Data.Bits ( (.&.) )
|
||||||
import Data.Maybe ( isJust, isNothing, fromJust )
|
import Data.Maybe ( isJust, isNothing, fromJust )
|
||||||
import Data.Word
|
|
||||||
|
|
||||||
import Foreign.C.Types ( CLong(..) )
|
import Foreign.C.Types ( CLong(..) )
|
||||||
|
|
||||||
@ -73,8 +72,8 @@ marshall_cap_to_terminal t cap_selector cap_params = do
|
|||||||
- todo: Some display attributes like underline and bold have independent string capabilities that
|
- todo: Some display attributes like underline and bold have independent string capabilities that
|
||||||
- should be used instead of the generic "sgr" string capability.
|
- should be used instead of the generic "sgr" string capability.
|
||||||
-}
|
-}
|
||||||
terminal_instance :: ( Applicative m, MonadIO m ) => String -> m Term
|
terminal_instance :: ( Applicative m, MonadIO m ) => String -> Handle -> m Term
|
||||||
terminal_instance in_ID = do
|
terminal_instance in_ID the_handle = do
|
||||||
ti <- liftIO $ Terminfo.setupTerm in_ID
|
ti <- liftIO $ Terminfo.setupTerm in_ID
|
||||||
let require_cap str
|
let require_cap str
|
||||||
= case Terminfo.getCapability ti (Terminfo.tiGetStr str) of
|
= case Terminfo.getCapability ti (Terminfo.tiGetStr str) of
|
||||||
@ -92,7 +91,6 @@ terminal_instance in_ID = do
|
|||||||
case parse_result of
|
case parse_result of
|
||||||
Left e -> fail $ show e
|
Left e -> fail $ show e
|
||||||
Right cap -> return $ Just cap
|
Right cap -> return $ Just cap
|
||||||
the_handle <- liftIO $ hDuplicate stdout
|
|
||||||
pure Term
|
pure Term
|
||||||
<*> pure in_ID
|
<*> pure in_ID
|
||||||
<*> pure ti
|
<*> pure ti
|
||||||
@ -245,6 +243,9 @@ instance DisplayTerminal DisplayContext where
|
|||||||
-- the case then the back and fore colors always need to be set if not default.
|
-- the case then the back and fore colors always need to be set if not default.
|
||||||
--
|
--
|
||||||
-- This equation implements the above logic.
|
-- This equation implements the above logic.
|
||||||
|
--
|
||||||
|
-- \todo This assumes that fewer state changes, followed by fewer bytes, is what to optimize. I
|
||||||
|
-- haven't measured this or even examined terminal implementations. *shrug*
|
||||||
serialize_set_attr d prev_attr req_attr diffs out_ptr = do
|
serialize_set_attr d prev_attr req_attr diffs out_ptr = do
|
||||||
case (fore_color_diff diffs == ColorToDefault) || (back_color_diff diffs == ColorToDefault) of
|
case (fore_color_diff diffs == ColorToDefault) || (back_color_diff diffs == ColorToDefault) of
|
||||||
-- The only way to reset either color, portably, to the default is to use either the set
|
-- The only way to reset either color, portably, to the default is to use either the set
|
||||||
|
@ -8,7 +8,7 @@ module Graphics.Vty.Terminal.XTermColor ( terminal_instance
|
|||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
import Graphics.Vty.Terminal.Generic
|
import Graphics.Vty.Terminal.Interface
|
||||||
import qualified Graphics.Vty.Terminal.TerminfoBased as TerminfoBased
|
import qualified Graphics.Vty.Terminal.TerminfoBased as TerminfoBased
|
||||||
|
|
||||||
import Control.Applicative
|
import Control.Applicative
|
||||||
@ -29,13 +29,13 @@ data XTermColor = XTermColor
|
|||||||
}
|
}
|
||||||
|
|
||||||
-- | Initialize the display to UTF-8.
|
-- | Initialize the display to UTF-8.
|
||||||
terminal_instance :: ( Applicative m, MonadIO m ) => String -> m XTermColor
|
terminal_instance :: ( Applicative m, MonadIO m ) => String -> Handle -> m XTermColor
|
||||||
terminal_instance variant = do
|
terminal_instance variant out_handle = do
|
||||||
-- If the terminal variant is xterm-color use xterm instead since, more often than not,
|
-- If the terminal variant is xterm-color use xterm instead since, more often than not,
|
||||||
-- xterm-color is broken.
|
-- xterm-color is broken.
|
||||||
let variant' = if variant == "xterm-color" then "xterm" else variant
|
let variant' = if variant == "xterm-color" then "xterm" else variant
|
||||||
flushed_put set_utf8_char_set
|
flushed_put set_utf8_char_set
|
||||||
t <- TerminfoBased.terminal_instance variant' >>= new_terminal_handle
|
t <- TerminfoBased.terminal_instance variant' out_handle >>= new_terminal_handle
|
||||||
return $ XTermColor variant' t
|
return $ XTermColor variant' t
|
||||||
|
|
||||||
-- | Output immediately followed by a flush.
|
-- | Output immediately followed by a flush.
|
||||||
|
@ -10,6 +10,7 @@
|
|||||||
module Verify ( module Verify
|
module Verify ( module Verify
|
||||||
, module Control.DeepSeq
|
, module Control.DeepSeq
|
||||||
, module Test.QuickCheck
|
, module Test.QuickCheck
|
||||||
|
, module Test.QuickCheck.Modifiers
|
||||||
, succeeded
|
, succeeded
|
||||||
, failed
|
, failed
|
||||||
, result
|
, result
|
||||||
@ -26,6 +27,7 @@ import qualified Distribution.TestSuite as TS
|
|||||||
|
|
||||||
import Test.QuickCheck hiding ( Result(..) )
|
import Test.QuickCheck hiding ( Result(..) )
|
||||||
import qualified Test.QuickCheck as QC
|
import qualified Test.QuickCheck as QC
|
||||||
|
import Test.QuickCheck.Modifiers
|
||||||
import Test.QuickCheck.Property hiding ( Result(..) )
|
import Test.QuickCheck.Property hiding ( Result(..) )
|
||||||
import qualified Test.QuickCheck.Property as Prop
|
import qualified Test.QuickCheck.Property as Prop
|
||||||
import Test.QuickCheck.Monadic ( monadicIO )
|
import Test.QuickCheck.Monadic ( monadicIO )
|
||||||
|
@ -1,7 +1,7 @@
|
|||||||
{-# LANGUAGE ScopedTypeVariables #-}
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
module Verify.Graphics.Vty.DisplayRegion ( module Verify.Graphics.Vty.DisplayRegion
|
module Verify.Graphics.Vty.DisplayRegion ( module Verify.Graphics.Vty.DisplayRegion
|
||||||
, module Graphics.Vty.DisplayRegion
|
, module Graphics.Vty.DisplayRegion
|
||||||
, DebugWindow(..)
|
, MockWindow(..)
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
@ -10,17 +10,17 @@ import Graphics.Vty.DisplayRegion
|
|||||||
|
|
||||||
import Verify
|
import Verify
|
||||||
|
|
||||||
data EmptyWindow = EmptyWindow DebugWindow
|
data EmptyWindow = EmptyWindow MockWindow
|
||||||
|
|
||||||
instance Arbitrary EmptyWindow where
|
instance Arbitrary EmptyWindow where
|
||||||
arbitrary = return $ EmptyWindow (DebugWindow (0 :: Int) (0 :: Int))
|
arbitrary = return $ EmptyWindow (MockWindow (0 :: Int) (0 :: Int))
|
||||||
|
|
||||||
instance Show EmptyWindow where
|
instance Show EmptyWindow where
|
||||||
show (EmptyWindow _) = "EmptyWindow"
|
show (EmptyWindow _) = "EmptyWindow"
|
||||||
|
|
||||||
instance Arbitrary DebugWindow where
|
instance Arbitrary MockWindow where
|
||||||
arbitrary = do
|
arbitrary = do
|
||||||
w <- choose (1,1024)
|
w <- choose (1,1024)
|
||||||
h <- choose (1,1024)
|
h <- choose (1,1024)
|
||||||
return $ DebugWindow w h
|
return $ MockWindow w h
|
||||||
|
|
||||||
|
@ -15,7 +15,7 @@ import Verify
|
|||||||
|
|
||||||
data DefaultPic = DefaultPic
|
data DefaultPic = DefaultPic
|
||||||
{ default_pic :: Picture
|
{ default_pic :: Picture
|
||||||
, default_win :: DebugWindow
|
, default_win :: MockWindow
|
||||||
, default_construct_log :: ImageConstructLog
|
, default_construct_log :: ImageConstructLog
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -26,14 +26,14 @@ instance Show DefaultPic where
|
|||||||
instance Arbitrary DefaultPic where
|
instance Arbitrary DefaultPic where
|
||||||
arbitrary = do
|
arbitrary = do
|
||||||
DefaultImage image image_construct_events <- arbitrary
|
DefaultImage image image_construct_events <- arbitrary
|
||||||
let win = DebugWindow (image_width image) (image_height image)
|
let win = MockWindow (image_width image) (image_height image)
|
||||||
return $ DefaultPic (pic_for_image image)
|
return $ DefaultPic (pic_for_image image)
|
||||||
win
|
win
|
||||||
image_construct_events
|
image_construct_events
|
||||||
|
|
||||||
data PicWithBGAttr = PicWithBGAttr
|
data PicWithBGAttr = PicWithBGAttr
|
||||||
{ with_attr_pic :: Picture
|
{ with_attr_pic :: Picture
|
||||||
, with_attr_win :: DebugWindow
|
, with_attr_win :: MockWindow
|
||||||
, with_attr_construct_log :: ImageConstructLog
|
, with_attr_construct_log :: ImageConstructLog
|
||||||
, with_attr_specified_attr :: Attr
|
, with_attr_specified_attr :: Attr
|
||||||
} deriving ( Show )
|
} deriving ( Show )
|
||||||
@ -41,7 +41,7 @@ data PicWithBGAttr = PicWithBGAttr
|
|||||||
instance Arbitrary PicWithBGAttr where
|
instance Arbitrary PicWithBGAttr where
|
||||||
arbitrary = do
|
arbitrary = do
|
||||||
DefaultImage image image_construct_events <- arbitrary
|
DefaultImage image image_construct_events <- arbitrary
|
||||||
let win = DebugWindow (image_width image) (image_height image)
|
let win = MockWindow (image_width image) (image_height image)
|
||||||
attr <- arbitrary
|
attr <- arbitrary
|
||||||
return $ PicWithBGAttr (pic_for_image image)
|
return $ PicWithBGAttr (pic_for_image image)
|
||||||
win
|
win
|
||||||
|
@ -40,14 +40,14 @@ horiz_span_image_and_zero_window_1 (SingleRowSingleAttrImage { row_image = i })
|
|||||||
horiz_span_image_and_equal_window_0 :: SingleRowSingleAttrImage -> Result
|
horiz_span_image_and_equal_window_0 :: SingleRowSingleAttrImage -> Result
|
||||||
horiz_span_image_and_equal_window_0 (SingleRowSingleAttrImage { row_image = i, expected_columns = c }) =
|
horiz_span_image_and_equal_window_0 (SingleRowSingleAttrImage { row_image = i, expected_columns = c }) =
|
||||||
let p = pic_for_image i
|
let p = pic_for_image i
|
||||||
w = DebugWindow c 1
|
w = MockWindow c 1
|
||||||
spans = spans_for_pic p (region_for_window w)
|
spans = spans_for_pic p (region_for_window w)
|
||||||
in verify_all_spans_have_width i spans c
|
in verify_all_spans_have_width i spans c
|
||||||
|
|
||||||
horiz_span_image_and_equal_window_1 :: SingleRowSingleAttrImage -> Bool
|
horiz_span_image_and_equal_window_1 :: SingleRowSingleAttrImage -> Bool
|
||||||
horiz_span_image_and_equal_window_1 (SingleRowSingleAttrImage { row_image = i, expected_columns = c }) =
|
horiz_span_image_and_equal_window_1 (SingleRowSingleAttrImage { row_image = i, expected_columns = c }) =
|
||||||
let p = pic_for_image i
|
let p = pic_for_image i
|
||||||
w = DebugWindow c 1
|
w = MockWindow c 1
|
||||||
spans = spans_for_pic p (region_for_window w)
|
spans = spans_for_pic p (region_for_window w)
|
||||||
in span_ops_effected_rows spans == 1
|
in span_ops_effected_rows spans == 1
|
||||||
|
|
||||||
@ -55,14 +55,14 @@ horiz_span_image_and_lesser_window_0 :: SingleRowSingleAttrImage -> Result
|
|||||||
horiz_span_image_and_lesser_window_0 (SingleRowSingleAttrImage { row_image = i, expected_columns = c }) =
|
horiz_span_image_and_lesser_window_0 (SingleRowSingleAttrImage { row_image = i, expected_columns = c }) =
|
||||||
let p = pic_for_image i
|
let p = pic_for_image i
|
||||||
lesser_width = c `div` 2
|
lesser_width = c `div` 2
|
||||||
w = DebugWindow lesser_width 1
|
w = MockWindow lesser_width 1
|
||||||
spans = spans_for_pic p (region_for_window w)
|
spans = spans_for_pic p (region_for_window w)
|
||||||
in verify_all_spans_have_width i spans lesser_width
|
in verify_all_spans_have_width i spans lesser_width
|
||||||
|
|
||||||
single_attr_single_span_stack_cropped_0 :: SingleAttrSingleSpanStack -> Result
|
single_attr_single_span_stack_cropped_0 :: SingleAttrSingleSpanStack -> Result
|
||||||
single_attr_single_span_stack_cropped_0 stack =
|
single_attr_single_span_stack_cropped_0 stack =
|
||||||
let p = pic_for_image (stack_image stack)
|
let p = pic_for_image (stack_image stack)
|
||||||
w = DebugWindow (stack_width stack `div` 2) (stack_height stack)
|
w = MockWindow (stack_width stack `div` 2) (stack_height stack)
|
||||||
spans = spans_for_pic p (region_for_window w)
|
spans = spans_for_pic p (region_for_window w)
|
||||||
in verify_all_spans_have_width (stack_image stack) spans (stack_width stack `div` 2)
|
in verify_all_spans_have_width (stack_image stack) spans (stack_width stack `div` 2)
|
||||||
|
|
||||||
@ -70,7 +70,7 @@ single_attr_single_span_stack_cropped_1 :: SingleAttrSingleSpanStack -> Bool
|
|||||||
single_attr_single_span_stack_cropped_1 stack =
|
single_attr_single_span_stack_cropped_1 stack =
|
||||||
let p = pic_for_image (stack_image stack)
|
let p = pic_for_image (stack_image stack)
|
||||||
expected_row_count = stack_height stack `div` 2
|
expected_row_count = stack_height stack `div` 2
|
||||||
w = DebugWindow (stack_width stack) expected_row_count
|
w = MockWindow (stack_width stack) expected_row_count
|
||||||
spans = spans_for_pic p (region_for_window w)
|
spans = spans_for_pic p (region_for_window w)
|
||||||
actual_row_count = span_ops_effected_rows spans
|
actual_row_count = span_ops_effected_rows spans
|
||||||
in expected_row_count == actual_row_count
|
in expected_row_count == actual_row_count
|
||||||
@ -78,14 +78,14 @@ single_attr_single_span_stack_cropped_1 stack =
|
|||||||
single_attr_single_span_stack_cropped_2 :: SingleAttrSingleSpanStack -> SingleAttrSingleSpanStack -> Result
|
single_attr_single_span_stack_cropped_2 :: SingleAttrSingleSpanStack -> SingleAttrSingleSpanStack -> Result
|
||||||
single_attr_single_span_stack_cropped_2 stack_0 stack_1 =
|
single_attr_single_span_stack_cropped_2 stack_0 stack_1 =
|
||||||
let p = pic_for_image (stack_image stack_0 <|> stack_image stack_1)
|
let p = pic_for_image (stack_image stack_0 <|> stack_image stack_1)
|
||||||
w = DebugWindow (stack_width stack_0) (image_height (pic_image p))
|
w = MockWindow (stack_width stack_0) (image_height (pic_image p))
|
||||||
spans = spans_for_pic p (region_for_window w)
|
spans = spans_for_pic p (region_for_window w)
|
||||||
in verify_all_spans_have_width (pic_image p) spans (stack_width stack_0)
|
in verify_all_spans_have_width (pic_image p) spans (stack_width stack_0)
|
||||||
|
|
||||||
single_attr_single_span_stack_cropped_3 :: SingleAttrSingleSpanStack -> SingleAttrSingleSpanStack -> Bool
|
single_attr_single_span_stack_cropped_3 :: SingleAttrSingleSpanStack -> SingleAttrSingleSpanStack -> Bool
|
||||||
single_attr_single_span_stack_cropped_3 stack_0 stack_1 =
|
single_attr_single_span_stack_cropped_3 stack_0 stack_1 =
|
||||||
let p = pic_for_image (stack_image stack_0 <|> stack_image stack_1)
|
let p = pic_for_image (stack_image stack_0 <|> stack_image stack_1)
|
||||||
w = DebugWindow (image_width (pic_image p)) expected_row_count
|
w = MockWindow (image_width (pic_image p)) expected_row_count
|
||||||
spans = spans_for_pic p (region_for_window w)
|
spans = spans_for_pic p (region_for_window w)
|
||||||
expected_row_count = image_height (pic_image p) `div` 2
|
expected_row_count = image_height (pic_image p) `div` 2
|
||||||
actual_row_count = span_ops_effected_rows spans
|
actual_row_count = span_ops_effected_rows spans
|
||||||
@ -94,7 +94,7 @@ single_attr_single_span_stack_cropped_3 stack_0 stack_1 =
|
|||||||
single_attr_single_span_stack_cropped_4 :: SingleAttrSingleSpanStack -> SingleAttrSingleSpanStack -> Result
|
single_attr_single_span_stack_cropped_4 :: SingleAttrSingleSpanStack -> SingleAttrSingleSpanStack -> Result
|
||||||
single_attr_single_span_stack_cropped_4 stack_0 stack_1 =
|
single_attr_single_span_stack_cropped_4 stack_0 stack_1 =
|
||||||
let p = pic_for_image (stack_image stack_0 <-> stack_image stack_1)
|
let p = pic_for_image (stack_image stack_0 <-> stack_image stack_1)
|
||||||
w = DebugWindow expected_width (image_height (pic_image p))
|
w = MockWindow expected_width (image_height (pic_image p))
|
||||||
spans = spans_for_pic p (region_for_window w)
|
spans = spans_for_pic p (region_for_window w)
|
||||||
expected_width = image_width (pic_image p) `div` 2
|
expected_width = image_width (pic_image p) `div` 2
|
||||||
in verify_all_spans_have_width (pic_image p) spans expected_width
|
in verify_all_spans_have_width (pic_image p) spans expected_width
|
||||||
@ -102,7 +102,7 @@ single_attr_single_span_stack_cropped_4 stack_0 stack_1 =
|
|||||||
single_attr_single_span_stack_cropped_5 :: SingleAttrSingleSpanStack -> SingleAttrSingleSpanStack -> Bool
|
single_attr_single_span_stack_cropped_5 :: SingleAttrSingleSpanStack -> SingleAttrSingleSpanStack -> Bool
|
||||||
single_attr_single_span_stack_cropped_5 stack_0 stack_1 =
|
single_attr_single_span_stack_cropped_5 stack_0 stack_1 =
|
||||||
let p = pic_for_image (stack_image stack_0 <-> stack_image stack_1)
|
let p = pic_for_image (stack_image stack_0 <-> stack_image stack_1)
|
||||||
w = DebugWindow (image_width (pic_image p)) (stack_height stack_0)
|
w = MockWindow (image_width (pic_image p)) (stack_height stack_0)
|
||||||
spans = spans_for_pic p (region_for_window w)
|
spans = spans_for_pic p (region_for_window w)
|
||||||
expected_row_count = stack_height stack_0
|
expected_row_count = stack_height stack_0
|
||||||
actual_row_count = span_ops_effected_rows spans
|
actual_row_count = span_ops_effected_rows spans
|
||||||
@ -113,12 +113,12 @@ horiz_span_image_and_greater_window_0 (SingleRowSingleAttrImage { row_image = i,
|
|||||||
let p = pic_for_image i
|
let p = pic_for_image i
|
||||||
-- SingleRowSingleAttrImage always has width >= 1
|
-- SingleRowSingleAttrImage always has width >= 1
|
||||||
greater_width = c * 2
|
greater_width = c * 2
|
||||||
w = DebugWindow greater_width 1
|
w = MockWindow greater_width 1
|
||||||
spans = spans_for_pic p (region_for_window w)
|
spans = spans_for_pic p (region_for_window w)
|
||||||
in verify_all_spans_have_width i spans greater_width
|
in verify_all_spans_have_width i spans greater_width
|
||||||
|
|
||||||
arb_image_is_cropped :: DefaultImage -> DebugWindow -> Bool
|
arb_image_is_cropped :: DefaultImage -> MockWindow -> Bool
|
||||||
arb_image_is_cropped (DefaultImage image _) win@(DebugWindow w h) =
|
arb_image_is_cropped (DefaultImage image _) win@(MockWindow w h) =
|
||||||
let pic = pic_for_image image
|
let pic = pic_for_image image
|
||||||
spans = spans_for_pic pic (region_for_window win)
|
spans = spans_for_pic pic (region_for_window win)
|
||||||
in ( span_ops_effected_rows spans == h ) && ( all_spans_have_width spans w )
|
in ( span_ops_effected_rows spans == h ) && ( all_spans_have_width spans w )
|
||||||
@ -144,7 +144,7 @@ first_span_op_sets_attr DefaultPic { default_pic = pic, default_win = win } =
|
|||||||
single_attr_single_span_stack_op_coverage :: SingleAttrSingleSpanStack -> Result
|
single_attr_single_span_stack_op_coverage :: SingleAttrSingleSpanStack -> Result
|
||||||
single_attr_single_span_stack_op_coverage stack =
|
single_attr_single_span_stack_op_coverage stack =
|
||||||
let p = pic_for_image (stack_image stack)
|
let p = pic_for_image (stack_image stack)
|
||||||
w = DebugWindow (stack_width stack) (stack_height stack)
|
w = MockWindow (stack_width stack) (stack_height stack)
|
||||||
spans = spans_for_pic p (region_for_window w)
|
spans = spans_for_pic p (region_for_window w)
|
||||||
in verify_all_spans_have_width (stack_image stack) spans (stack_width stack)
|
in verify_all_spans_have_width (stack_image stack) spans (stack_width stack)
|
||||||
|
|
||||||
|
@ -1,12 +1,12 @@
|
|||||||
{-# LANGUAGE ScopedTypeVariables #-}
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
module VerifyMockTerminal where
|
module VerifyTerminal where
|
||||||
|
|
||||||
import Verify.Graphics.Vty.DisplayRegion
|
import Verify.Graphics.Vty.DisplayRegion
|
||||||
import Verify.Graphics.Vty.Picture
|
import Verify.Graphics.Vty.Picture
|
||||||
import Verify.Graphics.Vty.Image
|
import Verify.Graphics.Vty.Image
|
||||||
import Verify.Graphics.Vty.Span
|
import Verify.Graphics.Vty.Span
|
||||||
import Graphics.Vty.Terminal
|
import Graphics.Vty.Terminal
|
||||||
import Graphics.Vty.Terminal.Debug
|
import Graphics.Vty.Terminal.Mock
|
||||||
|
|
||||||
import Graphics.Vty.Debug
|
import Graphics.Vty.Debug
|
||||||
|
|
||||||
@ -26,23 +26,23 @@ unit_image_unit_bounds (UnitImage _ i) = liftIOResult $ do
|
|||||||
output_picture d pic
|
output_picture d pic
|
||||||
return succeeded
|
return succeeded
|
||||||
|
|
||||||
unit_image_arb_bounds :: UnitImage -> DebugWindow -> Property
|
unit_image_arb_bounds :: UnitImage -> MockWindow -> Property
|
||||||
unit_image_arb_bounds (UnitImage _ i) (DebugWindow w h) = liftIOResult $ do
|
unit_image_arb_bounds (UnitImage _ i) (MockWindow w h) = liftIOResult $ do
|
||||||
t <- terminal_instance (DisplayRegion w h)
|
t <- terminal_instance (DisplayRegion w h)
|
||||||
d <- display_bounds t >>= display_context t
|
d <- display_bounds t >>= display_context t
|
||||||
let pic = pic_for_image i
|
let pic = pic_for_image i
|
||||||
output_picture d pic
|
output_picture d pic
|
||||||
return succeeded
|
return succeeded
|
||||||
|
|
||||||
single_T_row :: DebugWindow -> Property
|
single_T_row :: MockWindow -> Property
|
||||||
single_T_row (DebugWindow w h) = liftIOResult $ do
|
single_T_row (MockWindow w h) = liftIOResult $ do
|
||||||
t <- terminal_instance (DisplayRegion w h)
|
t <- terminal_instance (DisplayRegion w h)
|
||||||
d <- display_bounds t >>= display_context t
|
d <- display_bounds t >>= display_context t
|
||||||
-- create an image that contains just the character T repeated for a single row
|
-- create an image that contains just the character T repeated for a single row
|
||||||
let i = horiz_cat $ replicate (fromEnum w) (char def_attr 'T')
|
let i = horiz_cat $ replicate (fromEnum w) (char def_attr 'T')
|
||||||
pic = (pic_for_image i) { pic_background = Background 'B' def_attr }
|
pic = (pic_for_image i) { pic_background = Background 'B' def_attr }
|
||||||
output_picture d pic
|
output_picture d pic
|
||||||
out_bytes <- readIORef (debug_terminal_last_output $ dehandle t) >>= return . UTF8.toRep
|
out_bytes <- readIORef (mock_terminal_last_output $ dehandle t) >>= return . UTF8.toRep
|
||||||
-- The UTF8 string that represents the output bytes a single line containing the T string:
|
-- The UTF8 string that represents the output bytes a single line containing the T string:
|
||||||
let expected = "HD" ++ "MA" ++ replicate (fromEnum w) 'T'
|
let expected = "HD" ++ "MA" ++ replicate (fromEnum w) 'T'
|
||||||
-- Followed by h - 1 lines of a change to the background attribute and then the background
|
-- Followed by h - 1 lines of a change to the background attribute and then the background
|
||||||
@ -53,15 +53,15 @@ single_T_row (DebugWindow w h) = liftIOResult $ do
|
|||||||
then return $ failed { reason = "\n" ++ show out_bytes ++ "\n\n" ++ show expected_bytes }
|
then return $ failed { reason = "\n" ++ show out_bytes ++ "\n\n" ++ show expected_bytes }
|
||||||
else return succeeded
|
else return succeeded
|
||||||
|
|
||||||
many_T_rows :: DebugWindow -> Property
|
many_T_rows :: MockWindow -> Property
|
||||||
many_T_rows (DebugWindow w h) = liftIOResult $ do
|
many_T_rows (MockWindow w h) = liftIOResult $ do
|
||||||
t <- terminal_instance (DisplayRegion w h)
|
t <- terminal_instance (DisplayRegion w h)
|
||||||
d <- display_bounds t >>= display_context t
|
d <- display_bounds t >>= display_context t
|
||||||
-- create an image that contains the character 'T' repeated for all the rows
|
-- create an image that contains the character 'T' repeated for all the rows
|
||||||
let i = vert_cat $ replicate (fromEnum h) $ horiz_cat $ replicate (fromEnum w) (char def_attr 'T')
|
let i = vert_cat $ replicate (fromEnum h) $ horiz_cat $ replicate (fromEnum w) (char def_attr 'T')
|
||||||
pic = (pic_for_image i) { pic_background = Background 'B' def_attr }
|
pic = (pic_for_image i) { pic_background = Background 'B' def_attr }
|
||||||
output_picture d pic
|
output_picture d pic
|
||||||
out_bytes <- readIORef (debug_terminal_last_output $ dehandle t) >>= return . UTF8.toRep
|
out_bytes <- readIORef (mock_terminal_last_output $ dehandle t) >>= return . UTF8.toRep
|
||||||
-- The UTF8 string that represents the output bytes is h repeats of a move, 'M', followed by an
|
-- The UTF8 string that represents the output bytes is h repeats of a move, 'M', followed by an
|
||||||
-- attribute change. 'A', followed by w 'T's
|
-- attribute change. 'A', followed by w 'T's
|
||||||
let expected = "HD" ++ concat (replicate (fromEnum h) $ "MA" ++ replicate (fromEnum w) 'T')
|
let expected = "HD" ++ concat (replicate (fromEnum h) $ "MA" ++ replicate (fromEnum w) 'T')
|
||||||
@ -70,15 +70,15 @@ many_T_rows (DebugWindow w h) = liftIOResult $ do
|
|||||||
then return $ failed { reason = "\n" ++ show out_bytes ++ "\n\n" ++ show expected_bytes }
|
then return $ failed { reason = "\n" ++ show out_bytes ++ "\n\n" ++ show expected_bytes }
|
||||||
else return succeeded
|
else return succeeded
|
||||||
|
|
||||||
many_T_rows_cropped_width :: DebugWindow -> Property
|
many_T_rows_cropped_width :: MockWindow -> Property
|
||||||
many_T_rows_cropped_width (DebugWindow w h) = liftIOResult $ do
|
many_T_rows_cropped_width (MockWindow w h) = liftIOResult $ do
|
||||||
t <- terminal_instance (DisplayRegion w h)
|
t <- terminal_instance (DisplayRegion w h)
|
||||||
d <- display_bounds t >>= display_context t
|
d <- display_bounds t >>= display_context t
|
||||||
-- create an image that contains the character 'T' repeated for all the rows
|
-- create an image that contains the character 'T' repeated for all the rows
|
||||||
let i = vert_cat $ replicate (fromEnum h) $ horiz_cat $ replicate (fromEnum w * 2) (char def_attr 'T')
|
let i = vert_cat $ replicate (fromEnum h) $ horiz_cat $ replicate (fromEnum w * 2) (char def_attr 'T')
|
||||||
pic = (pic_for_image i) { pic_background = Background 'B' def_attr }
|
pic = (pic_for_image i) { pic_background = Background 'B' def_attr }
|
||||||
output_picture d pic
|
output_picture d pic
|
||||||
out_bytes <- readIORef (debug_terminal_last_output $ dehandle t) >>= return . UTF8.toRep
|
out_bytes <- readIORef (mock_terminal_last_output $ dehandle t) >>= return . UTF8.toRep
|
||||||
-- The UTF8 string that represents the output bytes is h repeats of a move, 'M', followed by an
|
-- The UTF8 string that represents the output bytes is h repeats of a move, 'M', followed by an
|
||||||
-- attribute change. 'A', followed by w 'T's
|
-- attribute change. 'A', followed by w 'T's
|
||||||
let expected = "HD" ++ concat (replicate (fromEnum h) $ "MA" ++ replicate (fromEnum w) 'T')
|
let expected = "HD" ++ concat (replicate (fromEnum h) $ "MA" ++ replicate (fromEnum w) 'T')
|
||||||
@ -87,15 +87,15 @@ many_T_rows_cropped_width (DebugWindow w h) = liftIOResult $ do
|
|||||||
then return $ failed { reason = "\n" ++ show out_bytes ++ "\n\n" ++ show expected_bytes }
|
then return $ failed { reason = "\n" ++ show out_bytes ++ "\n\n" ++ show expected_bytes }
|
||||||
else return succeeded
|
else return succeeded
|
||||||
|
|
||||||
many_T_rows_cropped_height :: DebugWindow -> Property
|
many_T_rows_cropped_height :: MockWindow -> Property
|
||||||
many_T_rows_cropped_height (DebugWindow w h) = liftIOResult $ do
|
many_T_rows_cropped_height (MockWindow w h) = liftIOResult $ do
|
||||||
t <- terminal_instance (DisplayRegion w h)
|
t <- terminal_instance (DisplayRegion w h)
|
||||||
d <- display_bounds t >>= display_context t
|
d <- display_bounds t >>= display_context t
|
||||||
-- create an image that contains the character 'T' repeated for all the rows
|
-- create an image that contains the character 'T' repeated for all the rows
|
||||||
let i = vert_cat $ replicate (fromEnum h * 2) $ horiz_cat $ replicate (fromEnum w) (char def_attr 'T')
|
let i = vert_cat $ replicate (fromEnum h * 2) $ horiz_cat $ replicate (fromEnum w) (char def_attr 'T')
|
||||||
pic = (pic_for_image i) { pic_background = Background 'B' def_attr }
|
pic = (pic_for_image i) { pic_background = Background 'B' def_attr }
|
||||||
output_picture d pic
|
output_picture d pic
|
||||||
out_bytes <- readIORef (debug_terminal_last_output $ dehandle t) >>= return . UTF8.toRep
|
out_bytes <- readIORef (mock_terminal_last_output $ dehandle t) >>= return . UTF8.toRep
|
||||||
-- The UTF8 string that represents the output bytes is h repeats of a move, 'M', followed by an
|
-- The UTF8 string that represents the output bytes is h repeats of a move, 'M', followed by an
|
||||||
-- attribute change. 'A', followed by w count 'T's
|
-- attribute change. 'A', followed by w count 'T's
|
||||||
let expected = "HD" ++ concat (replicate (fromEnum h) $ "MA" ++ replicate (fromEnum w) 'T')
|
let expected = "HD" ++ concat (replicate (fromEnum h) $ "MA" ++ replicate (fromEnum w) 'T')
|
@ -74,8 +74,8 @@ library
|
|||||||
Graphics.Vty.Image.Internal
|
Graphics.Vty.Image.Internal
|
||||||
Graphics.Vty.PictureToSpans
|
Graphics.Vty.PictureToSpans
|
||||||
Graphics.Vty.Span
|
Graphics.Vty.Span
|
||||||
Graphics.Vty.Terminal.Debug
|
Graphics.Vty.Terminal.Mock
|
||||||
Graphics.Vty.Terminal.Generic
|
Graphics.Vty.Terminal.Interface
|
||||||
Graphics.Vty.Terminal.MacOSX
|
Graphics.Vty.Terminal.MacOSX
|
||||||
Graphics.Vty.Terminal.XTermColor
|
Graphics.Vty.Terminal.XTermColor
|
||||||
Graphics.Vty.Terminal.TerminfoBased
|
Graphics.Vty.Terminal.TerminfoBased
|
||||||
@ -119,14 +119,14 @@ test-suite verify-attribute-ops
|
|||||||
vector >= 0.7
|
vector >= 0.7
|
||||||
|
|
||||||
|
|
||||||
test-suite verify-using-mock-terminal
|
test-suite verify-terminal
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
||||||
type: detailed-0.9
|
type: detailed-0.9
|
||||||
|
|
||||||
hs-source-dirs: test
|
hs-source-dirs: test
|
||||||
|
|
||||||
test-module: VerifyMockTerminal
|
test-module: VerifyTerminal
|
||||||
|
|
||||||
other-modules: Verify
|
other-modules: Verify
|
||||||
Verify.Graphics.Vty.Attributes
|
Verify.Graphics.Vty.Attributes
|
||||||
|
Loading…
Reference in New Issue
Block a user