033acfa · vty · git.iko.soy

src/Data/Marshalling.hs−1

compare with master

unifiedsplit

@@ -16,7 +16,6 @@ import Data.Word

16import Foreign.Ptr

17import Foreign.ForeignPtr

18import Foreign.Marshal

19−import Foreign.Marshal.Array

20import Foreign.Storable

19import Foreign.Storable

21

20

22type OutputBuffer = Ptr Word8

21type OutputBuffer = Ptr Word8

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

@@ -19,20 +19,13 @@ import Data.ByteString.Internal ( memcpy )

19import Data.Marshalling

20import Data.Terminfo.Parse

21

22−import Control.DeepSeq

23import Control.Monad.Identity

22import Control.Monad.Identity

24import Control.Monad.State.Strict

23import Control.Monad.State.Strict

25−import Control.Monad.Trans

26

24

27−import Data.Array.Unboxed

28import Data.Bits ( (.|.), (.&.), xor )

25import Data.Bits ( (.|.), (.&.), xor )

29import Data.List

26import Data.List

30

27

31−import Foreign.C.Types

32−import Foreign.Ptr

33−

34import GHC.Prim

28import GHC.Prim

35−import GHC.Types

36import GHC.Word

29import GHC.Word

37

30

38data EvalState = EvalState

31data EvalState = EvalState

@@ -56,7 +49,7 @@ pop = do

56{-# SPECIALIZE read_param :: Word -> EvalT IO CapParam #-}

49{-# SPECIALIZE read_param :: Word -> EvalT IO CapParam #-}

57read_param :: Monad m => Word -> EvalT m CapParam

50read_param :: Monad m => Word -> EvalT m CapParam

58read_param pn = do

51read_param pn = do

59− EvalState _ _ !params <- get

52+ !params <- get >>= return . eval_params

60 return $! genericIndex params pn

53 return $! genericIndex params pn

61

54

62{-# SPECIALIZE push :: CapParam -> EvalT IO () #-}

55{-# SPECIALIZE push :: CapParam -> EvalT IO () #-}

@@ -169,7 +162,7 @@ serialize_cap_ops out_ptr ops = foldM serialize_cap_op out_ptr ops

169

162

170serialize_cap_op :: OutputBuffer -> CapOp -> EvalT IO OutputBuffer

163serialize_cap_op :: OutputBuffer -> CapOp -> EvalT IO OutputBuffer

171serialize_cap_op !out_ptr ( Bytes !offset !byte_count !next_offset ) = do

164serialize_cap_op !out_ptr ( Bytes !offset !byte_count !next_offset ) = do

172− EvalState _ !cap _ <- get

165+ !cap <- get >>= return . eval_expression

173 let ( !start_ptr, _ ) = cap_bytes cap

166 let ( !start_ptr, _ ) = cap_bytes cap

174 !src_ptr = start_ptr `plusPtr` offset

167 !src_ptr = start_ptr `plusPtr` offset

175 !out_ptr' = out_ptr `plusPtr` next_offset

168 !out_ptr' = out_ptr `plusPtr` next_offset

src/Data/Terminfo/Parse.hs+22−10

@@ -12,9 +12,8 @@ module Data.Terminfo.Parse ( module Data.Terminfo.Parse

12import Control.Applicative ( Applicative(..), pure, (<*>) )

13import Control.Monad ( liftM )

14import Control.Monad.Trans

15−import Control.Parallel.Strategies

15+import Control.DeepSeq

16

17−import Data.Array.Unboxed

18import Data.Monoid

17import Data.Monoid

19import Data.Word

18import Data.Word

20

19

@@ -35,8 +34,8 @@ data CapExpression = CapExpression

35 }

34 }

36

35

37instance NFData CapExpression where

36instance NFData CapExpression where

38− rnf (CapExpression ops !_bytes !_str !_c !_p_ops)

37+ rnf (CapExpression ops !_bytes !str !c !p_ops)

39− = rnf ops

38+ = rnf ops `seq` rnf str `seq` rnf c `seq` rnf p_ops

40

39

41type CapParam = Word

40type CapParam = Word

42

41

@@ -59,17 +58,29 @@ data CapOp =

59 deriving ( Show )

58 deriving ( Show )

60

59

61instance NFData CapOp where

60instance NFData CapOp where

62− rnf ( Bytes offset count next_offset ) = rnf offset

61+ rnf (Bytes offset _count next_offset) = rnf offset `seq` rnf next_offset

63− rnf (PushParam !_pn) = ()

62+ rnf (PushParam pn) = rnf pn

64− rnf (PushValue !_v) = ()

63+ rnf (PushValue v) = rnf v

65− rnf (Conditional c_expr c_parts) = rnf c_expr >| rnf c_parts

64+ rnf (Conditional c_expr c_parts) = rnf c_expr `seq` rnf c_parts

66− rnf _ = ()

65+ rnf BitwiseOr = ()

66+ rnf BitwiseXOr = ()

67+ rnf BitwiseAnd = ()

68+ rnf ArithPlus = ()

69+ rnf ArithMinus = ()

70+ rnf CompareEq = ()

71+ rnf CompareLt = ()

72+ rnf CompareGt = ()

73+ rnf DecOut = ()

74+ rnf CharOut = ()

67

75

68type ParamOps = [ParamOp]

76type ParamOps = [ParamOp]

69data ParamOp =

77data ParamOp =

70 IncFirstTwo

78 IncFirstTwo

71 deriving ( Show )

79 deriving ( Show )

72

80

81+instance NFData ParamOp where

82+ rnf IncFirstTwo = ()

83+

73parse_cap_expression :: ( Applicative m

84parse_cap_expression :: ( Applicative m

74 , MonadIO m

85 , MonadIO m

75 )

86 )

@@ -84,6 +95,7 @@ parse_cap_expression cap_string =

84 Left e -> return $ Left e

95 Left e -> return $ Left e

85 Right build_results -> pure Right <*> construct_cap_expression cap_string build_results

96 Right build_results -> pure Right <*> construct_cap_expression cap_string build_results

86

97

98+construct_cap_expression :: MonadIO m => [Char] -> BuildResults -> m CapExpression

87construct_cap_expression cap_string build_results = do

99construct_cap_expression cap_string build_results = do

88 byte_array <- liftIO $ newArray (map ( toEnum . fromEnum ) cap_string )

100 byte_array <- liftIO $ newArray (map ( toEnum . fromEnum ) cap_string )

89 let expr = CapExpression

101 let expr = CapExpression

@@ -95,7 +107,7 @@ construct_cap_expression cap_string build_results = do

95 , param_count = out_param_count build_results

107 , param_count = out_param_count build_results

96 , param_ops = out_param_ops build_results

108 , param_ops = out_param_ops build_results

97 }

109 }

98− return (demanding expr (rnf expr))

110+ return $! rnf expr `seq` expr

99

111

100type CapParser a = GenParser Char BuildState a

112type CapParser a = GenParser Char BuildState a

101

113

src/Graphics/Vty.hs−3

@@ -27,10 +27,7 @@ import Graphics.Vty.LLInput

27

28import Data.IORef

29

30−import Data.Maybe ( maybe )

31−

32import qualified System.Console.Terminfo as Terminfo

30import qualified System.Console.Terminfo as Terminfo

33−import System.IO

34

31

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

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

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

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

src/Graphics/Vty/DisplayAttributes.hs+1

@@ -42,6 +42,7 @@ instance Monoid DisplayAttrDiff where

42simplify_style_diffs :: [ StyleStateChange ] -> [ StyleStateChange ] -> [ StyleStateChange ]

43simplify_style_diffs cs_0 cs_1 = cs_0 `mappend` cs_1

44

45+simplify_color_diffs :: DisplayColorDiff -> DisplayColorDiff -> DisplayColorDiff

45simplify_color_diffs _cd ColorToDefault = ColorToDefault

46simplify_color_diffs _cd ColorToDefault = ColorToDefault

46simplify_color_diffs cd NoColorChange = cd

47simplify_color_diffs cd NoColorChange = cd

47simplify_color_diffs _cd ( SetColor !c ) = SetColor c

48simplify_color_diffs _cd ( SetColor !c ) = SetColor c

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

@@ -30,7 +30,6 @@ import Codec.Binary.UTF8.Width

30

31import Codec.Binary.UTF8.String ( decode )

32

33−import Data.AffineSpace

34import qualified Data.ByteString as BS

33import qualified Data.ByteString as BS

35import Data.Monoid

34import Data.Monoid

36import qualified Data.Sequence as Seq

35import qualified Data.Sequence as Seq

@@ -111,6 +110,8 @@ instance Show Image where

111 = "HorizJoin " ++ show c ++ " ( " ++ show l ++ " <|> " ++ show r ++ " )"

110 = "HorizJoin " ++ show c ++ " ( " ++ show l ++ " <|> " ++ show r ++ " )"

112 show ( VertJoin { part_top = t, part_bottom = b, output_width = c, output_height = r } )

111 show ( VertJoin { part_top = t, part_bottom = b, output_width = c, output_height = r } )

113 = "VertJoin (" ++ show c ++ ", " ++ show r ++ ") ( " ++ show t ++ " ) <-> ( " ++ show b ++ " )"

112 = "VertJoin (" ++ show c ++ ", " ++ show r ++ ") ( " ++ show t ++ " ) <-> ( " ++ show b ++ " )"

113+ show ( Translation offset i )

114+ = "Translation ( " ++ show offset ++ ", " ++ show i ++ " )"

114 show ( EmptyImage ) = "EmptyImage"

115 show ( EmptyImage ) = "EmptyImage"

115

116

116-- | Currently append in the Monoid instance is equivalent to <->. Future versions will just stack

117-- | Currently append in the Monoid instance is equivalent to <->. Future versions will just stack

src/Graphics/Vty/Inline.hs−1

@@ -9,7 +9,6 @@ import Graphics.Vty.Terminal.Generic

9

10import Control.Applicative

11import Control.Monad.State.Strict

12−import Control.Monad.Trans

13

12

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

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

15import qualified Data.String.UTF8 as UTF8

14import qualified Data.String.UTF8 as UTF8

src/Graphics/Vty/LLInput.hs+6−7

@@ -26,7 +26,6 @@ import Control.Exception

26import System.Console.Terminfo

27

28import System.Posix.Signals.Exts

29−import System.Posix.Signals

30import System.Posix.Terminal

29import System.Posix.Terminal

31import System.Posix.IO ( stdInput

30import System.Posix.IO ( stdInput

32 ,fdRead

31 ,fdRead

@@ -88,13 +87,13 @@ initTermInput escDelay terminal = do

88 setFdOption stdInput NonBlockingRead False

87 setFdOption stdInput NonBlockingRead False

89 threadWaitRead stdInput

88 threadWaitRead stdInput

90 setFdOption stdInput NonBlockingRead True

89 setFdOption stdInput NonBlockingRead True

91− try readAll :: IO (Either IOException ())

90+ _ <- try readAll :: IO (Either IOException ())

92 when (escDelay == 0) finishAtomicInput

91 when (escDelay == 0) finishAtomicInput

93 loop

92 loop

94 readAll = do

93 readAll = do

95 (bytes, bytes_read) <- fdRead stdInput 1

94 (bytes, bytes_read) <- fdRead stdInput 1

96 when (bytes_read > 0) $ do

95 when (bytes_read > 0) $ do

97− tryPutMVar hadInput () -- signal input

96+ _ <- tryPutMVar hadInput () -- signal input

98 writeChan inputChannel (head bytes)

97 writeChan inputChannel (head bytes)

99 readAll

98 readAll

100 -- | If there is no input for some time, this thread puts '\xFFFE' in the

99 -- | If there is no input for some time, this thread puts '\xFFFE' in the

@@ -212,13 +211,13 @@ initTermInput escDelay terminal = do

212 let pokeIO = (Catch $ do let e = error "(getsize in input layer)"

211 let pokeIO = (Catch $ do let e = error "(getsize in input layer)"

213 setTerminalAttributes stdInput nattr Immediately

212 setTerminalAttributes stdInput nattr Immediately

214 writeChan eventChannel (EvResize e e))

213 writeChan eventChannel (EvResize e e))

215− installHandler windowChange pokeIO Nothing

214+ _ <- installHandler windowChange pokeIO Nothing

216− installHandler continueProcess pokeIO Nothing

215+ _ <- installHandler continueProcess pokeIO Nothing

217 let uninit = do killThread eventThreadId

216 let uninit = do killThread eventThreadId

218 killThread inputThreadId

217 killThread inputThreadId

219 killThread noInputThreadId

218 killThread noInputThreadId

220− installHandler windowChange Ignore Nothing

219+ _ <- installHandler windowChange Ignore Nothing

221− installHandler continueProcess Ignore Nothing

220+ _ <- installHandler continueProcess Ignore Nothing

222 setTerminalAttributes stdInput oattr Immediately

221 setTerminalAttributes stdInput oattr Immediately

223 return (readChan eventChannel, uninit)

222 return (readChan eventChannel, uninit)

224

223

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

@@ -24,8 +24,6 @@ import Data.Array.ST

24import qualified Data.ByteString as B

25import qualified Data.ByteString.Internal as BInt

26import qualified Data.Foldable as Foldable

27−import Data.Function

28−import Data.List

29import Data.Word

27import Data.Word

30import qualified Data.ByteString.UTF8 as BSUTF8

28import qualified Data.ByteString.UTF8 as BSUTF8

31import qualified Data.String.UTF8 as UTF8

29import qualified Data.String.UTF8 as UTF8

@@ -153,7 +151,7 @@ ops_for_row mrow_ops bg region image y remaining_columns

153 then remaining_columns

151 then remaining_columns

154 else width

152 else width

155 forM_ [y .. y + actual_height - 1] $ \y' -> snoc_bg_fill mrow_ops bg actual_width y'

153 forM_ [y .. y + actual_height - 1] $ \y' -> snoc_bg_fill mrow_ops bg actual_width y'

156− Translation v i -> ops_for_row mrow_ops bg region i y remaining_columns

154+ Translation _offset i -> ops_for_row mrow_ops bg region i y remaining_columns

157

155

158snoc_text_span :: (Foldable.Foldable t)

156snoc_text_span :: (Foldable.Foldable t)

159 => Attr

157 => Attr

src/Graphics/Vty/Terminal.hs−1

@@ -32,7 +32,6 @@ import Control.Applicative

32import Control.Exception ( SomeException, try )

33import Control.Monad.Trans

34

35−import Data.Either

36import Data.List ( isPrefixOf )

35import Data.List ( isPrefixOf )

37import Data.Word

36import Data.Word

38

37

src/Graphics/Vty/Terminal/Generic.hs−1

@@ -24,7 +24,6 @@ import Data.Array

24import qualified Data.ByteString.Internal as BSCore

25import Data.Foldable

26import Data.IORef

27−import Data.Word

28import Data.String.UTF8 hiding ( foldl )

27import Data.String.UTF8 hiding ( foldl )

29

28

30data TerminalHandle where

29data TerminalHandle where

src/Graphics/Vty/Terminal/TerminfoBased.hs+4−4

@@ -93,7 +93,7 @@ terminal_instance in_ID = do

93 case parse_result of

94 Left e -> fail $ show e

95 Right cap -> return $ Just cap

96− term_fd <- liftIO $ dup stdOutput

96+ the_fd <- liftIO $ dup stdOutput

97 pure Term

98 <*> pure in_ID

99 <*> pure ti

@@ -107,7 +107,7 @@ terminal_instance in_ID = do

107 <*> require_cap "sgr0"

108 <*> require_cap "clear"

109 <*> current_display_attr_caps ti

110− <*> pure term_fd

110+ <*> pure the_fd

111

112current_display_attr_caps :: ( Applicative m, MonadIO m )

113 => Terminfo.Terminal

@@ -186,8 +186,8 @@ foreign import ccall unsafe "output_buffer.h stdout_output_buffer" c_output_byte

186 :: CInt -> Ptr Word8 -> CSize -> IO ()

187foreign import ccall "gwinsz.h c_get_window_size" c_get_window_size

188 :: IO CLong

189−foreign import ccall "fdatasync" c_fdatasync

189+-- foreign import ccall "fdatasync" c_fdatasync

190− :: CInt -> IO CInt

190+-- :: CInt -> IO CInt

191

192get_window_size :: IO (Int,Int)

193get_window_size = do