ilyakooo0/vty
1
0
Fork 0
mirror of https://github.com/ilyakooo0/vty.git synced 2024-10-04 11:17:08 +03:00
Code Issues Projects Releases Wiki Activity

rename current_terminal to output_for_current_terminal etc. plus doc fixups

Browse Source
This commit is contained in:
Corey O'Connor 2013-12-21 16:02:51 -08:00
parent bdc4be9b9d
commit e994b3b5dc
10 changed files with 133 additions and 118 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

65
src/Graphics/Vty.hs
View File

@ -21,7 +21,7 @@
--
-- - <http://www.unixwiz.net/techtips/termios-vmin-vtime.html>
--
-- - <<http://vt100.net/docs/vt100-ug/chapter3.html vt100 control sequences>
-- - <http://vt100.net/docs/vt100-ug/chapter3.html vt100 control sequences>
module Graphics.Vty ( Vty(..)
, mkVty
, mkVtyEscDelay
@ -46,34 +46,31 @@ import Data.IORef
import qualified System.Console.Terminfo as Terminfo
-- | The main object. At most one should be created.
-- An alternative is to use unsafePerformIO to automatically create a singleton Vty instance when
-- required.
--
-- The use of Vty typically follows this process:
--
-- 0. initialize vty
--
-- 1. use the update equation of Vty to display a picture
--
-- 2. repeat
--
-- 3. shutdown vty.
--
-- An alternative to tracking the Vty instance is to use 'withVty' in "Graphics.Vty.Inline.Unsafe".
--
-- This does not assure any thread safety. In theory, as long as an update action is not executed
-- when another update action is already then it's safe to call this on multiple threads.
--
-- \todo Remove explicit `shutdown` requirement.
data Vty = Vty
{ -- | Outputs the given Picture. Equivalent to output_picture applied to a display context
-- implicitly managed by Vty.
update :: Picture -> IO ()
-- | Get one Event object, blocking if necessary.
, next_event :: IO Event
-- | The terminal device interface. See `Interface`
--
-- The use of Vty typically follows this process:
--
-- 0. initialize vty
--
-- 1. use the update equation of Vty to display a picture
--
-- 2. repeat
--
-- 3. shutdown vty.
--
-- todo: provide a similar abstraction to Graphics.Vty.Output for input. Use haskeline's
-- input backend for implementation.
--
-- todo: remove explicit `shutdown` requirement.
, terminal :: Output
-- | The output interface. See `Output`
, output_iface :: Output
-- | Refresh the display. Normally the library takes care of refreshing. Nonetheless, some
-- other program might output to the terminal and mess the display. In that case the user
-- might want to force a refresh.
@ -95,42 +92,42 @@ mkVty = mkVtyEscDelay defaultEscDelay
mkVtyEscDelay :: Int -> IO Vty
mkVtyEscDelay escDelay = do
term_info <- Terminfo.setupTermFromEnv
t <- current_terminal
t <- output_for_current_terminal
reserve_display t
(kvar, endi) <- initTermInput escDelay term_info
intMkVty kvar ( endi >> release_display t >> release_terminal t ) t
intMkVty :: IO Event -> IO () -> Output -> IO Vty
intMkVty kvar fend t = do
intMkVty kvar fend out = do
last_pic_ref <- newIORef Nothing
last_update_ref <- newIORef Nothing
let inner_update in_pic = do
b@(w,h) <- display_bounds t
b@(w,h) <- display_bounds out
let cursor = pic_cursor in_pic
in_pic' = case cursor of
Cursor x y ->
let
x' = case x of
_ | x >= 0x80000000 -> 0
| x >= w -> w - 1
| otherwise -> x
_ | x < 0 -> 0
| x >= w -> w - 1
| otherwise -> x
y' = case y of
_ | y >= 0x80000000 -> 0
| y >= h -> h - 1
| otherwise -> y
_ | y < 0 -> 0
| y >= h -> h - 1
| otherwise -> y
in in_pic { pic_cursor = Cursor x' y' }
_ -> in_pic
mlast_update <- readIORef last_update_ref
update_data <- case mlast_update of
Nothing -> do
dc <- display_context t b
dc <- display_context out b
output_picture dc in_pic'
return (b, dc)
Just (last_bounds, last_context) -> do
if b /= last_bounds
then do
dc <- display_context t b
dc <- display_context out b
output_picture dc in_pic'
return (b, dc)
else do
@ -146,14 +143,14 @@ intMkVty kvar fend t = do
let gkey = do k <- kvar
case k of
(EvResize _ _) -> inner_refresh
>> display_bounds t
(EvResize _ _) -> inner_refresh
>> display_bounds out
>>= return . (\(w,h)-> EvResize w h)
_ -> return k
return $ Vty { update = inner_update
, next_event = gkey
, terminal = t
, output_iface = out
, refresh = inner_refresh
, shutdown = fend
}

74
src/Graphics/Vty/Attributes.hs
View File

@ -3,7 +3,54 @@
{-# LANGUAGE RankNTypes #-}
-- | Display attributes
--
-- For efficiency, this could be encoded into a single 32 bit word. The 32 bit word is first divided
-- Typically the values 'def_attr' or 'current_attr' are modified to form attributes:
--
-- @
-- def_attr `with_fore_color` red
-- @
--
-- Is the attribute that will set the foreground color to red and the background color to the
-- default.
--
-- This can then be used to build an image wiht a red foreground like so:
--
-- @
-- string (def_attr `with_fore_color` red) "this text will be red"
-- @
--
-- The default attributes set by 'def_attr' have a presentation determined by the terminal. This is
-- not something VTY can control. The user is free to define the color scheme of the terminal as
-- they see fit. Up to the limits of the terminal anyways.
--
-- The value 'current_attr' will keep the attributes of whatever was output previously.
--
-- \todo This API is very verbose IMO. I'd like something more succinct.
module Graphics.Vty.Attributes ( module Graphics.Vty.Attributes
, module Graphics.Vty.Attributes.Color
, module Graphics.Vty.Attributes.Color240
)
where
import Data.Bits
import Data.Monoid
import Data.Word
import Graphics.Vty.Attributes.Color
import Graphics.Vty.Attributes.Color240
-- | A display attribute defines the Color and Style of all the characters rendered after the
-- attribute is applied.
--
-- At most 256 colors, picked from a 240 and 16 color palette, are possible for the background and
-- foreground. The 240 colors and 16 colors are points in different palettes. See Color for more
-- information.
data Attr = Attr
{ attr_style :: !(MaybeDefault Style)
, attr_fore_color :: !(MaybeDefault Color)
, attr_back_color :: !(MaybeDefault Color)
} deriving ( Eq, Show )
-- This could be encoded into a single 32 bit word. The 32 bit word is first divided
-- into 4 groups of 8 bits where: The first group codes what action should be taken with regards to
-- the other groups.
-- XXYYZZ__
@ -33,31 +80,6 @@
--
-- Then the foreground color encoded into 8 bits.
-- Then the background color encoded into 8 bits.
--
module Graphics.Vty.Attributes ( module Graphics.Vty.Attributes
, module Graphics.Vty.Attributes.Color
, module Graphics.Vty.Attributes.Color240
)
where
import Data.Bits
import Data.Monoid
import Data.Word
import Graphics.Vty.Attributes.Color
import Graphics.Vty.Attributes.Color240
-- | A display attribute defines the Color and Style of all the characters rendered after the
-- attribute is applied.
--
-- At most 256 colors, picked from a 240 and 16 color palette, are possible for the background and
-- foreground. The 240 colors and 16 colors are points in different palettes. See Color for more
-- information.
data Attr = Attr
{ attr_style :: !(MaybeDefault Style)
, attr_fore_color :: !(MaybeDefault Color)
, attr_back_color :: !(MaybeDefault Color)
} deriving ( Eq, Show )
instance Monoid Attr where
mempty = Attr mempty mempty mempty

23
src/Graphics/Vty/Inline.hs
View File

@ -80,22 +80,22 @@ default_all = put def_attr
--
-- This does not flush the terminal.
put_attr_change :: ( Applicative m, MonadIO m ) => Output -> InlineM () -> m ()
put_attr_change t c = liftIO $ do
bounds <- display_bounds t
dc <- display_context t bounds
mfattr <- prev_fattr <$> readIORef (assumed_state_ref t)
put_attr_change out c = liftIO $ do
bounds <- display_bounds out
dc <- display_context out bounds
mfattr <- prev_fattr <$> readIORef (assumed_state_ref out)
fattr <- case mfattr of
Nothing -> do
liftIO $ send_to_terminal t (default_attr_required_bytes dc) (serialize_default_attr dc)
liftIO $ send_to_terminal out (default_attr_required_bytes dc) (serialize_default_attr dc)
return $ FixedAttr default_style_mask Nothing Nothing
Just v -> return v
let attr = execState c current_attr
attr' = limit_attr_for_display t attr
attr' = limit_attr_for_display out attr
fattr' = fix_display_attr fattr attr'
diffs = display_attr_diffs fattr fattr'
send_to_terminal t (attr_required_bytes dc fattr attr' diffs)
(serialize_set_attr dc fattr attr' diffs)
modifyIORef (assumed_state_ref t) $ \s -> s { prev_fattr = Just fattr' }
send_to_terminal out (attr_required_bytes dc fattr attr' diffs)
(serialize_set_attr dc fattr attr' diffs)
modifyIORef (assumed_state_ref out) $ \s -> s { prev_fattr = Just fattr' }
inline_hack dc
-- | 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
-- This will flush the terminal output.
put_attr_change_ :: ( Applicative m, MonadIO m ) => InlineM () -> m ()
put_attr_change_ c = liftIO $ do
t <- withVty $ return . terminal
out <- withVty $ return . output_iface
hFlush stdout
put_attr_change t c
put_attr_change out c
hFlush stdout

2
src/Graphics/Vty/Inline/Unsafe.hs
View File

@ -10,6 +10,8 @@ global_vty :: IORef (Maybe Vty)
{-# NOINLINE global_vty #-}
global_vty = unsafePerformIO $ newIORef Nothing
-- | This will create a Vty instance using 'mkVty' and execute an IO action provided that instance.
-- The created Vty instance will be stored to the unsafe 'IORef' 'global_vty'.
withVty :: (Vty -> IO b) -> IO b
withVty f = do
mvty <- readIORef global_vty

42
src/Graphics/Vty/Input.hs
View File

@ -1,24 +1,5 @@
-- | Right, I'm mostly guessing on these details. So, as far as I can figure:
--
-- There are two input modes:
-- 1. 7 bit
-- 2. 8 bit
--
-- Which is better? Well, depends on if you want to enter Unicode as UTF-8 or not.
--
-- * 7 bit mode: UTF-8 can be input unambiguiously.
-- * 8 bit mode: UTF-8 cannot be input. Does not require an escape delay.
--
-- vty uses 7 bit mode.
--
-- To differentiate between ESC and control keys that contain ESC:
-- vty using the timing of the input to differentiate.
-- This, I best I can figure, is what VMIN and VTIME are supposed to be for.
-- For some reason, I don't yet know, vty implements the timing in the library.
-- I'm not sure if this is an advantage or not!
--
-- By default, the escape delay is 10000 microseconds. Which is assumed to be well above the
-- sampling rate required to detect a keyup for a person typing 200 wpm.
-- | The input layer for VTY. This provides methods for initializing an 'Input' structure which can
-- then be used to read 'Event's from the terminal.
module Graphics.Vty.Input ( Key(..)
, Modifier(..)
, Button(..)
@ -40,6 +21,25 @@ import System.Posix.Signals.Exts
import System.Posix.Terminal
import System.Posix.IO (stdInput)
-- Right, I'm mostly guessing on these details. So, as far as I can figure:
--
-- There are two input modes:
-- 1. 7 bit
-- 2. 8 bit
--
-- Which is better? Well, depends on if you want to enter Unicode as UTF-8 or not.
--
-- * 7 bit mode: UTF-8 can be input unambiguiously.
-- * 8 bit mode: UTF-8 cannot be input. Does not require an escape delay.
--
-- vty uses 7 bit mode.
--
-- To differentiate between ESC and control keys that contain ESC:
-- vty using the timing of the input to differentiate.
-- This, I best I can figure, is what VMIN and VTIME are supposed to be for.
-- For some reason, I don't yet know, vty implements the timing in the library.
-- I'm not sure if this is an advantage or not!
-- | By default, the escape delay is 10000 microseconds. Which is assumed to be well above the
-- sampling rate required to detect a keyup for a person typing 200 wpm.
defaultEscDelay :: Int

33
src/Graphics/Vty/Output.hs
View File

@ -43,13 +43,13 @@ import GHC.IO.Handle
import System.Environment
import System.IO
-- | Returns a `Output` for the current terminal.
-- | Returns a `Output` for the current terminal as determined by TERM.
--
-- The specific Output implementation used is hidden from the API user. All terminal
-- implementations are assumed to perform more, or less, the same. Currently all implementations use
-- terminfo for at least some terminal specific information. This is why platforms without terminfo
-- are not supported. However, as mentioned before, any specifics about it being based on terminfo
-- are hidden from the API user. If a terminal implementation is developed for a terminal for a
-- The specific Output implementation used is hidden from the API user. All terminal implementations
-- are assumed to perform more, or less, the same. Currently all implementations use terminfo for at
-- least some terminal specific information. This is why platforms without terminfo are not
-- supported. However, as mentioned before, any specifics about it being based on terminfo are
-- hidden from the API user. If a terminal implementation is developed for a terminal for a
-- platform without terminfo support then Vty should work as expected on that terminal.
--
-- Selection of a terminal is done as follows:
@ -61,11 +61,6 @@ import System.IO
--
-- * for any other TERM value TerminfoBased is used.
--
--
-- The terminal has to be determined dynamically at runtime. To satisfy this requirement all
-- terminals instances are lifted into an abstract terminal handle via existential qualification.
-- This implies that the only equations that can used are those in the terminal class.
--
-- To differentiate between Mac OS X terminals this uses the TERM_PROGRAM environment variable.
-- However, an xterm started by Terminal or iTerm *also* has TERM_PROGRAM defined since the
-- environment variable is not reset/cleared by xterm. However a Terminal.app or iTerm.app started
@ -73,19 +68,19 @@ import System.IO
-- environment variables (I think?) this assumes that XTERM_VERSION will never be set for a true
-- Terminal.app or iTerm.app session.
--
-- The file descriptor used for output will a be a duplicate of the current stdout file descriptor.
--
-- The file descriptor used for output will a duplicate of the current stdout file descriptor.
--
-- todo: add an implementation for windows that does not depend on terminfo. Should be installable
-- \todo add an implementation for windows that does not depend on terminfo. Should be installable
-- with only what is provided in the haskell platform. Use ansi-terminal
current_terminal :: ( Applicative m, MonadIO m ) => m Output
current_terminal = do
output_for_current_terminal :: ( Applicative m, MonadIO m ) => m Output
output_for_current_terminal = do
term_type <- liftIO $ getEnv "TERM"
out_handle <- liftIO $ hDuplicate stdout
terminal_with_name_and_io term_type out_handle
output_for_name_and_io term_type out_handle
terminal_with_name_and_io :: (Applicative m, MonadIO m) => String -> Handle -> m Output
terminal_with_name_and_io term_type out_handle = do
-- | gives an output method structure for a terminal with the given name and the given 'Handle'.
output_for_name_and_io :: (Applicative m, MonadIO m) => String -> Handle -> m Output
output_for_name_and_io term_type out_handle = do
t <- if "xterm" `isPrefixOf` term_type
then do
maybe_terminal_app <- get_env "TERM_PROGRAM"

5
src/Graphics/Vty/PictureToSpans.hs
View File

@ -177,7 +177,7 @@ swap_skips_for_char_span w c a = Vector.map f
--
-- Crops to the given display region.
--
-- TODO: I'm pretty sure there is an algorithm that does not require a mutable buffer.
-- \todo I'm pretty sure there is an algorithm that does not require a mutable buffer.
build_spans :: Image -> DisplayRegion -> ST s (MRowOps s)
build_spans image out_region = do
-- First we create a mutable vector for each rows output operations.
@ -228,7 +228,7 @@ is_out_of_bounds i s
-- implementations are odd. They pass the current tests but something seems terribly wrong about all
-- this.
--
-- TODO: prove this cannot be called in an out of bounds case.
-- \todo prove this cannot be called in an out of bounds case.
add_maybe_clipped :: forall s . Image -> BlitM s ()
add_maybe_clipped EmptyImage = return ()
add_maybe_clipped (HorizText a text_str ow _cw) = do
@ -342,4 +342,3 @@ snoc_op !op !row = do
when (span_ops_effected_columns ops' > region_width the_region)
$ fail $ "row " ++ show row ++ " now exceeds region width"
MVector.write the_mrow_ops row ops'

3
src/Graphics/Vty/Span.hs
View File

@ -63,7 +63,8 @@ split_ops_at in_w in_ops = split_ops_at' in_w in_ops
split_ops_at' 0 ops = (Vector.empty, ops)
split_ops_at' remaining_columns ops = case Vector.head ops of
t@(TextSpan {}) -> if remaining_columns >= text_span_output_width t
then let (pre,post) = split_ops_at' (remaining_columns - text_span_output_width t) (Vector.tail ops)
then let (pre,post) = split_ops_at' (remaining_columns - text_span_output_width t)
(Vector.tail ops)
in (Vector.cons t pre, post)
else let pre_txt = clip_text (text_span_text t) 0 remaining_columns
pre_op = TextSpan { text_span_attr = text_span_attr t

2
test/VerifyOutput.hs
View File

@ -46,7 +46,7 @@ smoke_test_term_mac term_name i = liftIOResult $ do
smoke_test_term :: String -> Image -> IO Result
smoke_test_term term_name i = do
null_out <- openFile "/dev/null" WriteMode
t <- terminal_with_name_and_io term_name null_out
t <- output_for_name_and_io term_name null_out
putStrLn $ "context color count: " ++ show (context_color_count t)
reserve_display t
dc <- display_context t (100,100)

2
test/VerifyUsingMockInput.hs
View File

@ -87,7 +87,7 @@ compare_events input_spec expected_events out_events = compare_events' expected_
where
compare_events' [] [] = return True
compare_events' [] out_events' = do
printf "extra events %s\n" (show out_events) :: IO ()
printf "extra events %s\n" (show out_events') :: IO ()
return False
compare_events' expected_events' [] = do
printf "events %s were not produced for input %s\n" (show expected_events') (show input_spec) :: IO ()