e994b3b · vty · git.iko.soy

git.iko.soy/vty

on master help sign in

rename current_terminal to output_for_current_terminal etc. plus doc fixups

e994b3bCorey O'Connor13 years ago

src/Graphics/Vty.hs+31−34

compare with master

unifiedsplit

@@ -21,7 +21,7 @@

21--

22-- - <http://www.unixwiz.net/techtips/termios-vmin-vtime.html>

23--

24−-- - <<http://vt100.net/docs/vt100-ug/chapter3.html vt100 control sequences>

24+-- - <http://vt100.net/docs/vt100-ug/chapter3.html vt100 control sequences>

25module Graphics.Vty ( Vty(..)

26 , mkVty

27 , mkVtyEscDelay

@@ -46,34 +46,31 @@ import Data.IORef

46import qualified System.Console.Terminfo as Terminfo

48-- | The main object. At most one should be created.

49−-- An alternative is to use unsafePerformIO to automatically create a singleton Vty instance when

49+--

50−-- required.

50+-- The use of Vty typically follows this process:

51+--

52+-- 0. initialize vty

53+--

54+-- 1. use the update equation of Vty to display a picture

55+--

56+-- 2. repeat

57+--

58+-- 3. shutdown vty.

59+--

60+-- An alternative to tracking the Vty instance is to use 'withVty' in "Graphics.Vty.Inline.Unsafe".

51--

61--

52-- This does not assure any thread safety. In theory, as long as an update action is not executed

62-- This does not assure any thread safety. In theory, as long as an update action is not executed

53-- when another update action is already then it's safe to call this on multiple threads.

63-- when another update action is already then it's safe to call this on multiple threads.

64+--

65+-- \todo Remove explicit `shutdown` requirement.

54data Vty = Vty

66data Vty = Vty

55 { -- | Outputs the given Picture. Equivalent to output_picture applied to a display context

67 { -- | Outputs the given Picture. Equivalent to output_picture applied to a display context

56 -- implicitly managed by Vty.

68 -- implicitly managed by Vty.

57 update :: Picture -> IO ()

69 update :: Picture -> IO ()

58 -- | Get one Event object, blocking if necessary.

70 -- | Get one Event object, blocking if necessary.

59 , next_event :: IO Event

71 , next_event :: IO Event

60− -- | The terminal device interface. See `Interface`

72+ -- | The output interface. See `Output`

61− --

73+ , output_iface :: Output

62− -- The use of Vty typically follows this process:

63− --

64− -- 0. initialize vty

65− --

66− -- 1. use the update equation of Vty to display a picture

67− --

68− -- 2. repeat

69− --

70− -- 3. shutdown vty.

71− --

72− -- todo: provide a similar abstraction to Graphics.Vty.Output for input. Use haskeline's

73− -- input backend for implementation.

74− --

75− -- todo: remove explicit `shutdown` requirement.

76− , terminal :: Output

77 -- | Refresh the display. Normally the library takes care of refreshing. Nonetheless, some

74 -- | Refresh the display. Normally the library takes care of refreshing. Nonetheless, some

78 -- other program might output to the terminal and mess the display. In that case the user

75 -- other program might output to the terminal and mess the display. In that case the user

79 -- might want to force a refresh.

76 -- might want to force a refresh.

@@ -95,42 +92,42 @@ mkVty = mkVtyEscDelay defaultEscDelay

95mkVtyEscDelay :: Int -> IO Vty

92mkVtyEscDelay :: Int -> IO Vty

96mkVtyEscDelay escDelay = do

93mkVtyEscDelay escDelay = do

97 term_info <- Terminfo.setupTermFromEnv

94 term_info <- Terminfo.setupTermFromEnv

98− t <- current_terminal

95+ t <- output_for_current_terminal

99 reserve_display t

96 reserve_display t

100 (kvar, endi) <- initTermInput escDelay term_info

97 (kvar, endi) <- initTermInput escDelay term_info

101 intMkVty kvar ( endi >> release_display t >> release_terminal t ) t

98 intMkVty kvar ( endi >> release_display t >> release_terminal t ) t

102

103intMkVty :: IO Event -> IO () -> Output -> IO Vty

100intMkVty :: IO Event -> IO () -> Output -> IO Vty

104−intMkVty kvar fend t = do

101+intMkVty kvar fend out = do

105 last_pic_ref <- newIORef Nothing

102 last_pic_ref <- newIORef Nothing

106 last_update_ref <- newIORef Nothing

103 last_update_ref <- newIORef Nothing

107

104

108 let inner_update in_pic = do

105 let inner_update in_pic = do

109− b@(w,h) <- display_bounds t

106+ b@(w,h) <- display_bounds out

110 let cursor = pic_cursor in_pic

107 let cursor = pic_cursor in_pic

111 in_pic' = case cursor of

108 in_pic' = case cursor of

112 Cursor x y ->

109 Cursor x y ->

113 let

110 let

114 x' = case x of

111 x' = case x of

115− _ | x >= 0x80000000 -> 0

112+ _ | x < 0 -> 0

116− | x >= w -> w - 1

113+ | x >= w -> w - 1

117− | otherwise -> x

114+ | otherwise -> x

118 y' = case y of

115 y' = case y of

119− _ | y >= 0x80000000 -> 0

116+ _ | y < 0 -> 0

120− | y >= h -> h - 1

117+ | y >= h -> h - 1

121− | otherwise -> y

118+ | otherwise -> y

122 in in_pic { pic_cursor = Cursor x' y' }

119 in in_pic { pic_cursor = Cursor x' y' }

123 _ -> in_pic

120 _ -> in_pic

124 mlast_update <- readIORef last_update_ref

121 mlast_update <- readIORef last_update_ref

125 update_data <- case mlast_update of

122 update_data <- case mlast_update of

126 Nothing -> do

123 Nothing -> do

127− dc <- display_context t b

124+ dc <- display_context out b

128 output_picture dc in_pic'

125 output_picture dc in_pic'

129 return (b, dc)

126 return (b, dc)

130 Just (last_bounds, last_context) -> do

127 Just (last_bounds, last_context) -> do

131 if b /= last_bounds

128 if b /= last_bounds

132 then do

129 then do

133− dc <- display_context t b

130+ dc <- display_context out b

134 output_picture dc in_pic'

131 output_picture dc in_pic'

135 return (b, dc)

132 return (b, dc)

136 else do

133 else do

@@ -146,14 +143,14 @@ intMkVty kvar fend t = do

146

143

147 let gkey = do k <- kvar

144 let gkey = do k <- kvar

148 case k of

145 case k of

149− (EvResize _ _) -> inner_refresh

146+ (EvResize _ _) -> inner_refresh

150− >> display_bounds t

147+ >> display_bounds out

151 >>= return . (\(w,h)-> EvResize w h)

148 >>= return . (\(w,h)-> EvResize w h)

152 _ -> return k

149 _ -> return k

153

150

154 return $ Vty { update = inner_update

151 return $ Vty { update = inner_update

155 , next_event = gkey

152 , next_event = gkey

156− , terminal = t

153+ , output_iface = out

157 , refresh = inner_refresh

154 , refresh = inner_refresh

158 , shutdown = fend

155 , shutdown = fend

159 }

156 }

src/Graphics/Vty/Attributes.hs+48−26

@@ -3,7 +3,54 @@

3{-# LANGUAGE RankNTypes #-}

4-- | Display attributes

5--

6+-- Typically the values 'def_attr' or 'current_attr' are modified to form attributes:

7+--

8+-- @

9+-- def_attr `with_fore_color` red

10+-- @

11+--

12+-- Is the attribute that will set the foreground color to red and the background color to the

13+-- default.

14+--

15+-- This can then be used to build an image wiht a red foreground like so:

16+--

17+-- @

18+-- string (def_attr `with_fore_color` red) "this text will be red"

19+-- @

20+--

21+-- The default attributes set by 'def_attr' have a presentation determined by the terminal. This is

22+-- not something VTY can control. The user is free to define the color scheme of the terminal as

23+-- they see fit. Up to the limits of the terminal anyways.

24+--

25+-- The value 'current_attr' will keep the attributes of whatever was output previously.

26+--

27+-- \todo This API is very verbose IMO. I'd like something more succinct.

28+module Graphics.Vty.Attributes ( module Graphics.Vty.Attributes

29+ , module Graphics.Vty.Attributes.Color

30+ , module Graphics.Vty.Attributes.Color240

31+ )

32+ where

33+

34+import Data.Bits

35+import Data.Monoid

36+import Data.Word

37+

38+import Graphics.Vty.Attributes.Color

39+import Graphics.Vty.Attributes.Color240

40+

41+-- | A display attribute defines the Color and Style of all the characters rendered after the

42+-- attribute is applied.

43+--

44+-- At most 256 colors, picked from a 240 and 16 color palette, are possible for the background and

45+-- foreground. The 240 colors and 16 colors are points in different palettes. See Color for more

46+-- information.

47+data Attr = Attr

48+ { attr_style :: !(MaybeDefault Style)

49+ , attr_fore_color :: !(MaybeDefault Color)

50+ , attr_back_color :: !(MaybeDefault Color)

51+ } deriving ( Eq, Show )

52+

6−-- For efficiency, this could be encoded into a single 32 bit word. The 32 bit word is first divided

53+-- This could be encoded into a single 32 bit word. The 32 bit word is first divided

7-- into 4 groups of 8 bits where: The first group codes what action should be taken with regards to

54-- into 4 groups of 8 bits where: The first group codes what action should be taken with regards to

8-- the other groups.

55-- the other groups.

9-- XXYYZZ__

56-- XXYYZZ__

@@ -33,31 +80,6 @@

33--

80--

34-- Then the foreground color encoded into 8 bits.

81-- Then the foreground color encoded into 8 bits.

35-- Then the background color encoded into 8 bits.

82-- Then the background color encoded into 8 bits.

36−--

37−module Graphics.Vty.Attributes ( module Graphics.Vty.Attributes

38− , module Graphics.Vty.Attributes.Color

39− , module Graphics.Vty.Attributes.Color240

40− )

41− where

42−

43−import Data.Bits

44−import Data.Monoid

45−import Data.Word

46−

47−import Graphics.Vty.Attributes.Color

48−import Graphics.Vty.Attributes.Color240

49−

50−-- | A display attribute defines the Color and Style of all the characters rendered after the

51−-- attribute is applied.

52−--

53−-- At most 256 colors, picked from a 240 and 16 color palette, are possible for the background and

54−-- foreground. The 240 colors and 16 colors are points in different palettes. See Color for more

55−-- information.

56−data Attr = Attr

57− { attr_style :: !(MaybeDefault Style)

58− , attr_fore_color :: !(MaybeDefault Color)

59− , attr_back_color :: !(MaybeDefault Color)

60− } deriving ( Eq, Show )

62instance Monoid Attr where

84instance Monoid Attr where

63 mempty = Attr mempty mempty mempty

85 mempty = Attr mempty mempty mempty

src/Graphics/Vty/Inline.hs+11−12

@@ -80,22 +80,22 @@ default_all = put def_attr

80--

81-- This does not flush the terminal.

82put_attr_change :: ( Applicative m, MonadIO m ) => Output -> InlineM () -> m ()

83−put_attr_change t c = liftIO $ do

83+put_attr_change out c = liftIO $ do

84− bounds <- display_bounds t

84+ bounds <- display_bounds out

85− dc <- display_context t bounds

85+ dc <- display_context out bounds

86− mfattr <- prev_fattr <$> readIORef (assumed_state_ref t)

86+ mfattr <- prev_fattr <$> readIORef (assumed_state_ref out)

87 fattr <- case mfattr of

88 Nothing -> do

89− liftIO $ send_to_terminal t (default_attr_required_bytes dc) (serialize_default_attr dc)

89+ liftIO $ send_to_terminal out (default_attr_required_bytes dc) (serialize_default_attr dc)

90 return $ FixedAttr default_style_mask Nothing Nothing

91 Just v -> return v

92 let attr = execState c current_attr

93− attr' = limit_attr_for_display t attr

93+ attr' = limit_attr_for_display out attr

94 fattr' = fix_display_attr fattr attr'

95 diffs = display_attr_diffs fattr fattr'

96− send_to_terminal t (attr_required_bytes dc fattr attr' diffs)

96+ send_to_terminal out (attr_required_bytes dc fattr attr' diffs)

97− (serialize_set_attr dc fattr attr' diffs)

97+ (serialize_set_attr dc fattr attr' diffs)

98− modifyIORef (assumed_state_ref t) $ \s -> s { prev_fattr = Just fattr' }

98+ modifyIORef (assumed_state_ref out) $ \s -> s { prev_fattr = Just fattr' }

99 inline_hack dc

100

101-- | Apply the provided display attributes changes to the terminal that was current at the time this

@@ -104,8 +104,7 @@ put_attr_change t c = liftIO $ do

104-- This will flush the terminal output.

105put_attr_change_ :: ( Applicative m, MonadIO m ) => InlineM () -> m ()

106put_attr_change_ c = liftIO $ do

107− t <- withVty $ return . terminal

107+ out <- withVty $ return . output_iface

108 hFlush stdout

109− put_attr_change t c

109+ put_attr_change out c

110 hFlush stdout

111−

src/Graphics/Vty/Inline/Unsafe.hs+2

@@ -10,6 +10,8 @@ global_vty :: IORef (Maybe Vty)

10{-# NOINLINE global_vty #-}

11global_vty = unsafePerformIO $ newIORef Nothing

13+-- | This will create a Vty instance using 'mkVty' and execute an IO action provided that instance.

14+-- The created Vty instance will be stored to the unsafe 'IORef' 'global_vty'.

13withVty :: (Vty -> IO b) -> IO b

15withVty :: (Vty -> IO b) -> IO b

14withVty f = do

16withVty f = do

15 mvty <- readIORef global_vty

17 mvty <- readIORef global_vty

src/Graphics/Vty/Input.hs+21−21

@@ -1,24 +1,5 @@

1−-- | Right, I'm mostly guessing on these details. So, as far as I can figure:

1+-- | The input layer for VTY. This provides methods for initializing an 'Input' structure which can

2−--

2+-- then be used to read 'Event's from the terminal.

3−-- There are two input modes:

4−-- 1. 7 bit

5−-- 2. 8 bit

6−--

7−-- Which is better? Well, depends on if you want to enter Unicode as UTF-8 or not.

8−--

9−-- * 7 bit mode: UTF-8 can be input unambiguiously.

10−-- * 8 bit mode: UTF-8 cannot be input. Does not require an escape delay.

11−--

12−-- vty uses 7 bit mode.

13−--

14−-- To differentiate between ESC and control keys that contain ESC:

15−-- vty using the timing of the input to differentiate.

16−-- This, I best I can figure, is what VMIN and VTIME are supposed to be for.

17−-- For some reason, I don't yet know, vty implements the timing in the library.

18−-- I'm not sure if this is an advantage or not!

19−--

20−-- By default, the escape delay is 10000 microseconds. Which is assumed to be well above the

21−-- sampling rate required to detect a keyup for a person typing 200 wpm.

22module Graphics.Vty.Input ( Key(..)

3module Graphics.Vty.Input ( Key(..)

23 , Modifier(..)

4 , Modifier(..)

24 , Button(..)

5 , Button(..)

@@ -40,6 +21,25 @@ import System.Posix.Signals.Exts

40import System.Posix.Terminal

21import System.Posix.Terminal

41import System.Posix.IO (stdInput)

22import System.Posix.IO (stdInput)

24+-- Right, I'm mostly guessing on these details. So, as far as I can figure:

25+--

26+-- There are two input modes:

27+-- 1. 7 bit

28+-- 2. 8 bit

29+--

30+-- Which is better? Well, depends on if you want to enter Unicode as UTF-8 or not.

31+--

32+-- * 7 bit mode: UTF-8 can be input unambiguiously.

33+-- * 8 bit mode: UTF-8 cannot be input. Does not require an escape delay.

34+--

35+-- vty uses 7 bit mode.

36+--

37+-- To differentiate between ESC and control keys that contain ESC:

38+-- vty using the timing of the input to differentiate.

39+-- This, I best I can figure, is what VMIN and VTIME are supposed to be for.

40+-- For some reason, I don't yet know, vty implements the timing in the library.

41+-- I'm not sure if this is an advantage or not!

42+

43-- | By default, the escape delay is 10000 microseconds. Which is assumed to be well above the

44-- sampling rate required to detect a keyup for a person typing 200 wpm.

45defaultEscDelay :: Int

src/Graphics/Vty/Output.hs+14−19

@@ -43,13 +43,13 @@ import GHC.IO.Handle

43import System.Environment

44import System.IO

46−-- | Returns a `Output` for the current terminal.

46+-- | Returns a `Output` for the current terminal as determined by TERM.

47--

48−-- The specific Output implementation used is hidden from the API user. All terminal

48+-- The specific Output implementation used is hidden from the API user. All terminal implementations

49−-- implementations are assumed to perform more, or less, the same. Currently all implementations use

49+-- are assumed to perform more, or less, the same. Currently all implementations use terminfo for at

50−-- terminfo for at least some terminal specific information. This is why platforms without terminfo

50+-- least some terminal specific information. This is why platforms without terminfo are not

51−-- are not supported. However, as mentioned before, any specifics about it being based on terminfo

51+-- supported. However, as mentioned before, any specifics about it being based on terminfo are

52−-- are hidden from the API user. If a terminal implementation is developed for a terminal for a

52+-- hidden from the API user. If a terminal implementation is developed for a terminal for a

53-- platform without terminfo support then Vty should work as expected on that terminal.

54--

55-- Selection of a terminal is done as follows:

@@ -61,11 +61,6 @@ import System.IO

61--

62-- * for any other TERM value TerminfoBased is used.

63--

64−--

65−-- The terminal has to be determined dynamically at runtime. To satisfy this requirement all

66−-- terminals instances are lifted into an abstract terminal handle via existential qualification.

67−-- This implies that the only equations that can used are those in the terminal class.

68−--

69-- To differentiate between Mac OS X terminals this uses the TERM_PROGRAM environment variable.

64-- To differentiate between Mac OS X terminals this uses the TERM_PROGRAM environment variable.

70-- However, an xterm started by Terminal or iTerm *also* has TERM_PROGRAM defined since the

65-- However, an xterm started by Terminal or iTerm *also* has TERM_PROGRAM defined since the

71-- environment variable is not reset/cleared by xterm. However a Terminal.app or iTerm.app started

66-- environment variable is not reset/cleared by xterm. However a Terminal.app or iTerm.app started

@@ -73,19 +68,19 @@ import System.IO

73-- environment variables (I think?) this assumes that XTERM_VERSION will never be set for a true

68-- environment variables (I think?) this assumes that XTERM_VERSION will never be set for a true

74-- Terminal.app or iTerm.app session.

69-- Terminal.app or iTerm.app session.

75--

70--

71+-- The file descriptor used for output will a be a duplicate of the current stdout file descriptor.

76--

72--

77−-- The file descriptor used for output will a duplicate of the current stdout file descriptor.

78−--

79−-- todo: add an implementation for windows that does not depend on terminfo. Should be installable

73+-- \todo add an implementation for windows that does not depend on terminfo. Should be installable

80-- with only what is provided in the haskell platform. Use ansi-terminal

74-- with only what is provided in the haskell platform. Use ansi-terminal

81−current_terminal :: ( Applicative m, MonadIO m ) => m Output

75+output_for_current_terminal :: ( Applicative m, MonadIO m ) => m Output

82−current_terminal = do

76+output_for_current_terminal = do

83 term_type <- liftIO $ getEnv "TERM"

77 term_type <- liftIO $ getEnv "TERM"

84 out_handle <- liftIO $ hDuplicate stdout

78 out_handle <- liftIO $ hDuplicate stdout

85− terminal_with_name_and_io term_type out_handle

79+ output_for_name_and_io term_type out_handle

81+-- | gives an output method structure for a terminal with the given name and the given 'Handle'.

87−terminal_with_name_and_io :: (Applicative m, MonadIO m) => String -> Handle -> m Output

82+output_for_name_and_io :: (Applicative m, MonadIO m) => String -> Handle -> m Output

88−terminal_with_name_and_io term_type out_handle = do

83+output_for_name_and_io term_type out_handle = do

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

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

90 then do

85 then do

91 maybe_terminal_app <- get_env "TERM_PROGRAM"

86 maybe_terminal_app <- get_env "TERM_PROGRAM"

src/Graphics/Vty/PictureToSpans.hs+2−3

@@ -177,7 +177,7 @@ swap_skips_for_char_span w c a = Vector.map f

177--

178-- Crops to the given display region.

179--

180−-- TODO: I'm pretty sure there is an algorithm that does not require a mutable buffer.

180+-- \todo I'm pretty sure there is an algorithm that does not require a mutable buffer.

181build_spans :: Image -> DisplayRegion -> ST s (MRowOps s)

182build_spans image out_region = do

183 -- First we create a mutable vector for each rows output operations.

@@ -228,7 +228,7 @@ is_out_of_bounds i s

228-- implementations are odd. They pass the current tests but something seems terribly wrong about all

229-- this.

230--

231−-- TODO: prove this cannot be called in an out of bounds case.

231+-- \todo prove this cannot be called in an out of bounds case.

232add_maybe_clipped :: forall s . Image -> BlitM s ()

233add_maybe_clipped EmptyImage = return ()

234add_maybe_clipped (HorizText a text_str ow _cw) = do

@@ -342,4 +342,3 @@ snoc_op !op !row = do

342 when (span_ops_effected_columns ops' > region_width the_region)

343 $ fail $ "row " ++ show row ++ " now exceeds region width"

344 MVector.write the_mrow_ops row ops'

345−

src/Graphics/Vty/Span.hs+2−1

@@ -63,7 +63,8 @@ split_ops_at in_w in_ops = split_ops_at' in_w in_ops

63 split_ops_at' 0 ops = (Vector.empty, ops)

64 split_ops_at' remaining_columns ops = case Vector.head ops of

65 t@(TextSpan {}) -> if remaining_columns >= text_span_output_width t

66− then let (pre,post) = split_ops_at' (remaining_columns - text_span_output_width t) (Vector.tail ops)

66+ then let (pre,post) = split_ops_at' (remaining_columns - text_span_output_width t)

67+ (Vector.tail ops)

67 in (Vector.cons t pre, post)

68 in (Vector.cons t pre, post)

68 else let pre_txt = clip_text (text_span_text t) 0 remaining_columns

69 else let pre_txt = clip_text (text_span_text t) 0 remaining_columns

69 pre_op = TextSpan { text_span_attr = text_span_attr t

70 pre_op = TextSpan { text_span_attr = text_span_attr t

test/VerifyOutput.hs+1−1

@@ -46,7 +46,7 @@ smoke_test_term_mac term_name i = liftIOResult $ do

46smoke_test_term :: String -> Image -> IO Result

47smoke_test_term term_name i = do

48 null_out <- openFile "/dev/null" WriteMode

49− t <- terminal_with_name_and_io term_name null_out

49+ t <- output_for_name_and_io term_name null_out

50 putStrLn $ "context color count: " ++ show (context_color_count t)

51 reserve_display t

52 dc <- display_context t (100,100)

test/VerifyUsingMockInput.hs+1−1

@@ -87,7 +87,7 @@ compare_events input_spec expected_events out_events = compare_events' expected_

87 where

88 compare_events' [] [] = return True

89 compare_events' [] out_events' = do

90− printf "extra events %s\n" (show out_events) :: IO ()

90+ printf "extra events %s\n" (show out_events') :: IO ()

91 return False

92 compare_events' expected_events' [] = do

93 printf "events %s were not produced for input %s\n" (show expected_events') (show input_spec) :: IO ()