cd6747c · vty · git.iko.soy

git.iko.soy/vty

on master help sign in

compiling again. fails testing tho

cd6747cCorey O'Connor13 years ago

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

compare with master

unifiedsplit

@@ -66,11 +66,11 @@ apply_param_ops cap params = foldl apply_param_op params (param_ops cap)

66apply_param_op :: [CapParam] -> ParamOp -> [CapParam]

67apply_param_op params IncFirstTwo = map (+ 1) params

69−cap_expression_required_bytes :: CapExpression -> [CapParam] -> Word

69+cap_expression_required_bytes :: CapExpression -> [CapParam] -> Int

70cap_expression_required_bytes cap params =

71 let params' = apply_param_ops cap params

72 s_0 = EvalState [] cap params'

73− in fst $! runIdentity $! runStateT ( cap_ops_required_bytes $! cap_ops cap ) s_0

73+ in fromEnum $! fst $! runIdentity $! runStateT ( cap_ops_required_bytes $! cap_ops cap ) s_0

75cap_ops_required_bytes :: CapOps -> Eval Word

76cap_ops_required_bytes ops = do

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

@@ -13,15 +13,15 @@ import Graphics.Vty.DisplayRegion

13import qualified Data.Vector as Vector

14import Data.Word

16−row_ops_effected_columns :: DisplayOps -> [Word]

16+row_ops_effected_columns :: DisplayOps -> [Int]

17row_ops_effected_columns spans

18 = Vector.toList $ Vector.map span_ops_effected_columns $ display_ops spans

20−all_spans_have_width :: DisplayOps -> Word -> Bool

20+all_spans_have_width :: DisplayOps -> Int -> Bool

21all_spans_have_width spans expected

22 = all (== expected) $ Vector.toList $ Vector.map span_ops_effected_columns $ display_ops spans

24−span_ops_effected_rows :: DisplayOps -> Word

24+span_ops_effected_rows :: DisplayOps -> Int

25span_ops_effected_rows (DisplayOps _ the_row_ops)

26 = toEnum $ length (filter (not . null . Vector.toList) (Vector.toList the_row_ops))

@@ -33,7 +33,7 @@ is_set_attr expected_attr (SpanSetAttr in_attr)

33 | in_attr == expected_attr = True

34is_set_attr _attr _event = False

36−data DebugWindow = DebugWindow Word Word

36+data DebugWindow = DebugWindow Int Int

37 deriving (Show, Eq)

39region_for_window :: DebugWindow -> DisplayRegion

src/Graphics/Vty/DisplayRegion.hs+2−2

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

7-- | Region of the terminal that vty will output to. Units are columns not characters.

8data DisplayRegion = DisplayRegion

9− { region_width :: !Word

9+ { region_width :: !Int

10− , region_height :: !Word

10+ , region_height :: !Int

11 } deriving ( Show, Eq )

src/Graphics/Vty/Picture.hs+1−1

@@ -68,7 +68,7 @@ pic_for_image i = Picture

68-- output region. In this case the cursor will not be shown.

69data Cursor =

70 NoCursor

71− | Cursor Word Word

71+ | Cursor Int Int

73instance NFData Cursor where

74 rnf NoCursor = ()

src/Graphics/Vty/Span.hs+69−44

@@ -1,3 +1,4 @@

1+{-# LANGUAGE RankNTypes #-}

1-- Copyright Corey O'Connor

2-- Copyright Corey O'Connor

2{-# LANGUAGE TemplateHaskell #-}

3{-# LANGUAGE TemplateHaskell #-}

3{-# LANGUAGE BangPatterns #-}

4{-# LANGUAGE BangPatterns #-}

@@ -25,6 +26,7 @@ import Graphics.Vty.Picture

25import Graphics.Vty.DisplayRegion

26import Graphics.Vty.DisplayRegion

26import Graphics.Text.Width

27import Graphics.Text.Width

29+import Control.Applicative

28import Control.Lens

30import Control.Lens

29import Control.Monad ( forM_ )

31import Control.Monad ( forM_ )

30import Control.Monad.Reader

32import Control.Monad.Reader

@@ -38,9 +40,12 @@ import qualified Data.Vector as Vector hiding ( take, replicate )

38import Data.Vector.Mutable ( MVector(..))

40import Data.Vector.Mutable ( MVector(..))

39import qualified Data.Vector.Mutable as Vector

41import qualified Data.Vector.Mutable as Vector

43+import qualified Data.ByteString as BS

41import qualified Data.ByteString.Lazy as BL

44import qualified Data.ByteString.Lazy as BL

42−import qualified Data.ByteString.Lazy.Internal as BLInt

45+import qualified Data.ByteString.Lazy.Internal as BL

43import qualified Data.Foldable as Foldable

46import qualified Data.Foldable as Foldable

47+import qualified Data.Text as T

48+import qualified Data.Text.Encoding as T

44import qualified Data.Text.Lazy as TL

49import qualified Data.Text.Lazy as TL

45import qualified Data.Text.Lazy.Encoding as TL

50import qualified Data.Text.Lazy.Encoding as TL

46import Data.Word

51import Data.Word

@@ -58,7 +63,7 @@ data SpanOp =

58 -- | a span of UTF-8 text occupies a specific number of screen space columns. A single UTF

63 -- | a span of UTF-8 text occupies a specific number of screen space columns. A single UTF

59 -- character does not necessarially represent 1 colunm. See Codec.Binary.UTF8.Width

64 -- character does not necessarially represent 1 colunm. See Codec.Binary.UTF8.Width

60 -- TextSpan [output width in columns] [number of characters] [data]

65 -- TextSpan [output width in columns] [number of characters] [data]

61− | TextSpan !Int !Int BL.ByteString

66+ | TextSpan !Int !Int BS.ByteString

62 deriving Eq

67 deriving Eq

64-- | vector of span operations. executed in succession. This represents the operations required to

69-- | vector of span operations. executed in succession. This represents the operations required to

@@ -67,7 +72,6 @@ data SpanOp =

67-- color is changed.

72-- color is changed.

68type SpanOps = Vector SpanOp

73type SpanOps = Vector SpanOp

70−

71data DisplayOps = DisplayOps

75data DisplayOps = DisplayOps

72 { effected_region :: DisplayRegion

76 { effected_region :: DisplayRegion

73 , display_ops :: RowOps

77 , display_ops :: RowOps

@@ -91,7 +95,8 @@ instance Show SpanOp where

91-- transform plus clip. More or less.

95-- transform plus clip. More or less.

92data BlitState = BlitState

96data BlitState = BlitState

93 -- we always snoc to the operation vectors. Thus the column_offset = length of row at row_offset

97 -- we always snoc to the operation vectors. Thus the column_offset = length of row at row_offset

98+ { _column_offset :: Int

94− { _row_offset :: Int

99+ , _row_offset :: Int

95 -- clip coordinate space is in image space. Which means it's >= 0 and < image_width.

100 -- clip coordinate space is in image space. Which means it's >= 0 and < image_width.

96 , _skip_columns :: Int

101 , _skip_columns :: Int

97 -- >= 0 and < image_height

102 -- >= 0 and < image_height

@@ -117,15 +122,15 @@ makeLenses ''BlitEnv

117type BlitM s a = ReaderT (BlitEnv s) (StateT BlitState (ST s)) a

122type BlitM s a = ReaderT (BlitEnv s) (StateT BlitState (ST s)) a

118

123

119-- | Number of columns the DisplayOps are defined for

124-- | Number of columns the DisplayOps are defined for

120−span_ops_columns :: DisplayOps -> Word

125+span_ops_columns :: DisplayOps -> Int

121span_ops_columns ops = region_width $ effected_region ops

126span_ops_columns ops = region_width $ effected_region ops

122

127

123-- | Number of rows the DisplayOps are defined for

128-- | Number of rows the DisplayOps are defined for

124−span_ops_rows :: DisplayOps -> Word

129+span_ops_rows :: DisplayOps -> Int

125span_ops_rows ops = region_height $ effected_region ops

130span_ops_rows ops = region_height $ effected_region ops

126

131

127-- | The number of columns a SpanOps effects.

132-- | The number of columns a SpanOps effects.

128−span_ops_effected_columns :: SpanOps -> Word

133+span_ops_effected_columns :: SpanOps -> Int

129span_ops_effected_columns in_ops = Vector.foldl' span_ops_effected_columns' 0 in_ops

134span_ops_effected_columns in_ops = Vector.foldl' span_ops_effected_columns' 0 in_ops

130 where

135 where

131 span_ops_effected_columns' t (TextSpan w _ _ ) = t + w

136 span_ops_effected_columns' t (TextSpan w _ _ ) = t + w

@@ -139,7 +144,7 @@ span_op_has_width _ = Nothing

139-- | returns the number of columns to the character at the given position in the span op

144-- | returns the number of columns to the character at the given position in the span op

140columns_to_char_offset :: Int -> SpanOp -> Int

145columns_to_char_offset :: Int -> SpanOp -> Int

141columns_to_char_offset cx (TextSpan _ _ utf8_str) =

146columns_to_char_offset cx (TextSpan _ _ utf8_str) =

142− let str = TL.unpack (TL.decodeUtf8 utf8_str)

147+ let str = T.unpack (T.decodeUtf8 utf8_str)

143 in wcswidth (take cx str)

148 in wcswidth (take cx str)

144columns_to_char_offset _cx _ = error "columns_to_char_offset applied to span op without width"

149columns_to_char_offset _cx _ = error "columns_to_char_offset applied to span op without width"

145

150

@@ -166,24 +171,18 @@ build_spans pic region = do

166 --

171 --

167 -- The images are made into span operations from left to right. It's possible that this could

172 -- The images are made into span operations from left to right. It's possible that this could

168 -- easily be made to assure top to bottom output as well.

173 -- easily be made to assure top to bottom output as well.

169− if region_height region > 0

174+ when (region_height region > 0 && region_width region > 0) $ do

170− then do

171− -- The ops builder recursively descends the image and outputs span ops that would

175+ -- The ops builder recursively descends the image and outputs span ops that would

172− -- display that image. The number of columns remaining in this row before exceeding the

176+ -- display that image. The number of columns remaining in this row before exceeding the

173− -- bounds is also provided. This is used to clip the span ops produced to the display.

177+ -- bounds is also provided. This is used to clip the span ops produced to the display.

174− -- The skip dimensions provided do....???

178+ let full_build = do

175− _ <- runStateT (runReaderT (start_image_build $ pic_image pic)

179+ start_image_build $ pic_image pic

176− (BlitEnv (pic_background pic) region mrow_ops)

177− )

178− (BlitState 0 0 0 0 (region_width region) (region_height region))

179− -- Fill in any unspecified columns with the background pattern.

180+ -- Fill in any unspecified columns with the background pattern.

180− -- todo: If there is no background pattern defined then skip

181− forM_ [0 .. (region_height region - 1)] $! \row -> do

181+ forM_ [0 .. (region_height region - 1)] add_row_completion

182− end_x <- Vector.read mrow_ops row >>= return . span_ops_effected_columns

182+ init_env = BlitEnv (pic_background pic) region mrow_ops

183− if end_x < region_width region

183+ init_state = BlitState 0 0 0 0 (region_width region) (region_height region)

184− then snoc_bg_fill mrow_ops (pic_background pic) (region_width region - end_x) row

184+ _ <- runStateT (runReaderT full_build init_env) init_state

185− else return ()

186− else return ()

185+ return ()

187 return mrow_ops

186 return mrow_ops

188

187

189-- | Add the operations required to build a given image to the current set of row operations

188-- | Add the operations required to build a given image to the current set of row operations

@@ -191,14 +190,12 @@ build_spans pic region = do

191start_image_build :: Image -> BlitM s ()

190start_image_build :: Image -> BlitM s ()

192start_image_build image = do

191start_image_build image = do

193 out_of_bounds <- is_out_of_bounds image <$> get

192 out_of_bounds <- is_out_of_bounds image <$> get

194− if out_of_bounds

195− then return (0,0)

196− else add_maybe_clipped image

193+ when (not out_of_bounds) $ add_maybe_clipped image

197

194

198is_out_of_bounds :: Image -> BlitState -> Bool

195is_out_of_bounds :: Image -> BlitState -> Bool

199is_out_of_bounds image s

196is_out_of_bounds image s

200 | s ^. remaining_columns <= 0 = True

197 | s ^. remaining_columns <= 0 = True

201− | s ^. remain_rows <= 0 = True

198+ | s ^. remaining_rows <= 0 = True

202 | otherwise = False

199 | otherwise = False

203

200

204-- TODO: prove skip_columns, skip_rows == 0

201-- TODO: prove skip_columns, skip_rows == 0

@@ -206,7 +203,7 @@ is_out_of_bounds image s

206-- TODO: prove remaining_rows >= image_height

203-- TODO: prove remaining_rows >= image_height

207add_unclipped :: Image -> BlitM s ()

204add_unclipped :: Image -> BlitM s ()

208add_unclipped EmptyImage = return ()

205add_unclipped EmptyImage = return ()

209−add_unclipped (HorizText text_str _ow _cw) = do

206+add_unclipped (HorizText a text_str _ow _cw) = do

210 use row_offset >>= snoc_op (AttributeChange a)

207 use row_offset >>= snoc_op (AttributeChange a)

211 add_unclipped_text text_str

208 add_unclipped_text text_str

212add_unclipped (HorizJoin part_left part_right _ow _oh) = do

209add_unclipped (HorizJoin part_left part_right _ow _oh) = do

@@ -224,8 +221,10 @@ add_unclipped (VertJoin part_top part_bottom _ow _oh) = do

224add_unclipped (BGFill ow oh) = do

221add_unclipped (BGFill ow oh) = do

225 Background c a <- view bg

222 Background c a <- view bg

226 y <- use row_offset

223 y <- use row_offset

227− let op = TextSpan ow ow (TL.replicate (fromIntegral ow) c)

224+ let op = TextSpan ow ow (T.encodeUtf8 $ T.replicate (fromIntegral ow) (T.singleton c))

228− forM_ [y..y+oh] $ snoc_op op

225+ forM_ [y..y+oh] $ \row -> do

226+ snoc_op (AttributeChange a) row

227+ snoc_op op row

229-- TODO: we know it's clipped actually, the equations that are exposed that introduce a

228-- TODO: we know it's clipped actually, the equations that are exposed that introduce a

230-- Crop all assure the image exceeds the crop in the relevant direction.

229-- Crop all assure the image exceeds the crop in the relevant direction.

231add_unclipped CropRight {cropped_image, output_width} = do

230add_unclipped CropRight {cropped_image, output_width} = do

@@ -242,9 +241,9 @@ add_unclipped CropTop {cropped_image, top_skip} = do

242 add_maybe_clipped cropped_image

241 add_maybe_clipped cropped_image

243

242

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

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

245−add_maybe_clipped :: Image -> BlitM s ()

244+add_maybe_clipped :: forall s . Image -> BlitM s ()

246add_maybe_clipped EmptyImage = return ()

245add_maybe_clipped EmptyImage = return ()

247−add_maybe_clipped (HorizText text_str ow _cw) = do

246+add_maybe_clipped (HorizText a text_str ow _cw) = do

248 -- TODO: assumption that text spans are only 1 row high.

247 -- TODO: assumption that text spans are only 1 row high.

249 s <- use skip_rows

248 s <- use skip_rows

250 when (s < 1) $ do

249 when (s < 1) $ do

@@ -254,7 +253,7 @@ add_maybe_clipped (HorizText text_str ow _cw) = do

254 let left_clipped = left_clip > 0

253 let left_clipped = left_clip > 0

255 right_clipped = (ow - left_clip) > right_clip

254 right_clipped = (ow - left_clip) > right_clip

256 if left_clipped || right_clipped

255 if left_clipped || right_clipped

257− then let text_str' = clip_text left_clip right_clip

256+ then let text_str' = clip_text text_str left_clip right_clip

258 in add_unclipped_text text_str'

257 in add_unclipped_text text_str'

259 else add_unclipped_text text_str

258 else add_unclipped_text text_str

260add_maybe_clipped (VertJoin top_image bottom_image _ow oh) = do

259add_maybe_clipped (VertJoin top_image bottom_image _ow oh) = do

@@ -264,15 +263,15 @@ add_maybe_clipped (VertJoin top_image bottom_image _ow oh) = do

264 bottom_image

263 bottom_image

265 oh

264 oh

266add_maybe_clipped (HorizJoin left_image right_image ow _oh) = do

265add_maybe_clipped (HorizJoin left_image right_image ow _oh) = do

267− add_maybe_clipped_join "horiz_join" skip_columns remaining_columns devoid

266+ add_maybe_clipped_join "horiz_join" skip_columns remaining_columns column_offset

268 (image_width right_image)

267 (image_width right_image)

269 left_image

268 left_image

270 right_image

269 right_image

271 ow

270 ow

272add_maybe_clipped BGFill {output_width, output_height} = do

271add_maybe_clipped BGFill {output_width, output_height} = do

273 s <- get

272 s <- get

274− let output_width' = min (output_width - s.^skip_columns) s.^remaining_columns

273+ let output_width' = min (output_width - s^.skip_columns) (s^.remaining_columns)

275− output_height' = min (output_height - s.^skip_rows ) s.^remaining_rows

274+ output_height' = min (output_height - s^.skip_rows ) (s^.remaining_rows)

276 add_unclipped (BGFill output_width' output_height')

275 add_unclipped (BGFill output_width' output_height')

277add_maybe_clipped CropRight {cropped_image, output_width} = do

276add_maybe_clipped CropRight {cropped_image, output_width} = do

278 remaining_columns .= output_width

277 remaining_columns .= output_width

@@ -287,6 +286,15 @@ add_maybe_clipped CropTop {cropped_image, top_skip} = do

287 skip_rows += top_skip

286 skip_rows += top_skip

288 add_maybe_clipped cropped_image

287 add_maybe_clipped cropped_image

289

288

289+add_maybe_clipped_join :: forall s . String

290+ -> Lens BlitState BlitState Int Int

291+ -> Lens BlitState BlitState Int Int

292+ -> Lens BlitState BlitState Int Int

293+ -> Int

294+ -> Image

295+ -> Image

296+ -> Int

297+ -> BlitM s ()

290add_maybe_clipped_join name skip remaining offset i0_dim i0 i1 size = do

298add_maybe_clipped_join name skip remaining offset i0_dim i0 i1 size = do

291 state <- get

299 state <- get

292 when (state^.remaining == 0) $ fail $ name ++ " with remaining == 0"

300 when (state^.remaining == 0) $ fail $ name ++ " with remaining == 0"

@@ -313,7 +321,7 @@ add_maybe_clipped_join name skip remaining offset i0_dim i0 i1 size = do

313-- TODO: represent display strings containing chars that are not 1 column chars as a separate

321-- TODO: represent display strings containing chars that are not 1 column chars as a separate

314-- display string value?

322-- display string value?

315-- TODO: assumes max column width is 2

323-- TODO: assumes max column width is 2

316−clip_text :: DisplayString -> Int -> Int -> DisplayString

324+clip_text :: DisplayText -> Int -> Int -> DisplayText

317clip_text txt left_skip right_clip =

325clip_text txt left_skip right_clip =

318 -- CPS would clarify this I think

326 -- CPS would clarify this I think

319 let (to_drop,pad_prefix) = clip_for_char_width left_skip txt 0

327 let (to_drop,pad_prefix) = clip_for_char_width left_skip txt 0

@@ -324,21 +332,38 @@ clip_text txt left_skip right_clip =

324 clip_for_char_width w t n

332 clip_for_char_width w t n

325 | w < cw = (n, True)

333 | w < cw = (n, True)

326 | w == cw = (n+1, False)

334 | w == cw = (n+1, False)

327− | w > cw = clip_for_char_width (w - cw) (TL.rest t) (n + 1)

335+ | w > cw = clip_for_char_width (w - cw) (TL.tail t) (n + 1)

328 where cw = safe_wcwidth (TL.head t)

336 where cw = safe_wcwidth (TL.head t)

329 in txt''

337 in txt''

330

338

331−add_unclipped_text :: DisplayString -> BlitM ()

339+add_unclipped_text :: DisplayText -> BlitM s ()

332add_unclipped_text txt = do

340add_unclipped_text txt = do

333− let op = TextSpan used_display_columns (TL.length txt) (TL.encodeUtf8 txt)

341+ let op = TextSpan used_display_columns

342+ (fromIntegral $ TL.length txt)

343+ (T.encodeUtf8 $ TL.toStrict txt)

334 used_display_columns = wcswidth $ TL.unpack txt

344 used_display_columns = wcswidth $ TL.unpack txt

335 use row_offset >>= snoc_op op

345 use row_offset >>= snoc_op op

336

346

347+-- todo: If there is no background pattern defined then skip to next line.

348+-- todo: assumes background character is 1 column

349+add_row_completion :: Int -> BlitM s ()

350+add_row_completion row = do

351+ all_row_ops <- view mrow_ops

352+ Background c a <- view bg

353+ display_region <- view region

354+ row_ops <- lift $ lift $ Vector.read all_row_ops row

355+ let end_x = span_ops_effected_columns row_ops

356+ when (end_x < region_width display_region) $ do

357+ let ow = region_width display_region - end_x

358+ op = TextSpan ow ow (T.encodeUtf8 $ T.replicate (fromIntegral ow) (T.singleton c))

359+ snoc_op (AttributeChange a) row

360+ snoc_op op row

361+

337-- | snocs the operation to the operations for the given row.

362-- | snocs the operation to the operations for the given row.

338snoc_op :: SpanOp -> Int -> BlitM s ()

363snoc_op :: SpanOp -> Int -> BlitM s ()

339snoc_op !op !row = do

364snoc_op !op !row = do

340 the_mrow_ops <- view mrow_ops

365 the_mrow_ops <- view mrow_ops

341− lift $ do

366+ lift $ lift $ do

342 ops <- Vector.read the_mrow_ops row

367 ops <- Vector.read the_mrow_ops row

343 let ops' = Vector.snoc ops op

368 let ops' = Vector.snoc ops op

344 Vector.write the_mrow_ops row ops'

369 Vector.write the_mrow_ops row ops'

src/Graphics/Vty/Terminal.hs+6−3

@@ -29,6 +29,7 @@ module Graphics.Vty.Terminal ( module Graphics.Vty.Terminal

29 where

32+import Graphics.Vty.DisplayRegion

32import Graphics.Vty.Terminal.Generic

33import Graphics.Vty.Terminal.Generic

33import Graphics.Vty.Terminal.MacOSX as MacOSX

34import Graphics.Vty.Terminal.MacOSX as MacOSX

34import Graphics.Vty.Terminal.XTermColor as XTermColor

35import Graphics.Vty.Terminal.XTermColor as XTermColor

@@ -36,6 +37,7 @@ import Graphics.Vty.Terminal.TerminfoBased as TerminfoBased

37import Control.Applicative

38import Control.Applicative

38import Control.Exception ( SomeException, try )

39import Control.Exception ( SomeException, try )

40+import Control.Monad

39import Control.Monad.Trans

41import Control.Monad.Trans

41import Data.List ( isPrefixOf )

43import Data.List ( isPrefixOf )

@@ -115,11 +117,12 @@ terminal_handle = do

115--

117--

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

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

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

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

118−set_cursor_pos :: MonadIO m => TerminalHandle -> Word -> Word -> m ()

120+set_cursor_pos :: MonadIO m => TerminalHandle -> Int -> Int -> m ()

119set_cursor_pos t x y = do

121set_cursor_pos t x y = do

120 bounds <- display_bounds t

122 bounds <- display_bounds t

123+ when (x >= 0 && x < region_width bounds && y >= 0 && y < region_height bounds) $ do

121− d <- display_context t bounds

124+ d <- display_context t bounds

122− liftIO $ marshall_to_terminal t (move_cursor_required_bytes d x y) (serialize_move_cursor d x y)

125+ liftIO $ marshall_to_terminal t (move_cursor_required_bytes d x y) (serialize_move_cursor d x y)

123

126

124-- | Hides the cursor

127-- | Hides the cursor

125hide_cursor :: MonadIO m => TerminalHandle -> m ()

128hide_cursor :: MonadIO m => TerminalHandle -> m ()

src/Graphics/Vty/Terminal/Generic.hs+23−24

@@ -21,9 +21,8 @@ import Graphics.Vty.DisplayAttributes

21import Control.Monad ( liftM )

22import Control.Monad.Trans

24−import qualified Data.ByteString.Internal as BSCore

24+import qualified Data.ByteString.Internal as BS

25import Data.IORef

26−import Data.String.UTF8 hiding ( foldl )

27import qualified Data.Vector as Vector

26import qualified Data.Vector as Vector

29import System.IO

28import System.IO

@@ -84,7 +83,7 @@ class Terminal t where

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

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

86 -- end_ptr - start_ptr

85 -- end_ptr - start_ptr

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

86+ output_byte_buffer :: t -> OutputBuffer -> Int -> IO ()

89 -- | Handle of output device

88 -- | Handle of output device

90 output_handle :: t -> IO Handle

89 output_handle :: t -> IO Handle

@@ -122,17 +121,17 @@ class DisplayTerminal d where

122 context_region :: d -> DisplayRegion

121 context_region :: d -> DisplayRegion

123

122

124 -- | Maximum number of colors supported by the context.

123 -- | Maximum number of colors supported by the context.

125− context_color_count :: d -> Word

124+ context_color_count :: d -> Int

126

125

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

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

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

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

129− move_cursor_required_bytes :: d -> Word -> Word -> Word

128+ move_cursor_required_bytes :: d -> Int -> Int -> Int

130− serialize_move_cursor :: MonadIO m => d -> Word -> Word -> OutputBuffer -> m OutputBuffer

129+ serialize_move_cursor :: MonadIO m => d -> Int -> Int -> OutputBuffer -> m OutputBuffer

131

130

132− show_cursor_required_bytes :: d -> Word

131+ show_cursor_required_bytes :: d -> Int

133 serialize_show_cursor :: MonadIO m => d -> OutputBuffer -> m OutputBuffer

132 serialize_show_cursor :: MonadIO m => d -> OutputBuffer -> m OutputBuffer

134

133

135− hide_cursor_required_bytes :: d -> Word

134+ hide_cursor_required_bytes :: d -> Int

136 serialize_hide_cursor :: MonadIO m => d -> OutputBuffer -> m OutputBuffer

135 serialize_hide_cursor :: MonadIO m => d -> OutputBuffer -> m OutputBuffer

137

136

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

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

@@ -146,11 +145,11 @@ class DisplayTerminal d where

146 -- attributes. In order to support this the currently applied display attributes are required.

145 -- attributes. In order to support this the currently applied display attributes are required.

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

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

148 -- display attributes.

147 -- display attributes.

149− attr_required_bytes :: d -> FixedAttr -> Attr -> DisplayAttrDiff -> Word

148+ attr_required_bytes :: d -> FixedAttr -> Attr -> DisplayAttrDiff -> Int

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

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

151

150

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

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

153− default_attr_required_bytes :: d -> Word

152+ default_attr_required_bytes :: d -> Int

154 serialize_default_attr :: MonadIO m => d -> OutputBuffer -> m OutputBuffer

153 serialize_default_attr :: MonadIO m => d -> OutputBuffer -> m OutputBuffer

155

154

156 -- | See Graphics.Vty.Terminal.XTermColor.inline_hack

155 -- | See Graphics.Vty.Terminal.XTermColor.inline_hack

@@ -174,18 +173,18 @@ instance DisplayTerminal DisplayHandle where

174 inline_hack (DisplayHandle d _ _) = inline_hack d

173 inline_hack (DisplayHandle d _ _) = inline_hack d

175

174

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

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

177−utf8_text_required_bytes :: UTF8 BSCore.ByteString -> Word

176+utf8_text_required_bytes :: BS.ByteString -> Int

178utf8_text_required_bytes str =

177utf8_text_required_bytes str =

179− let (_, _, src_bytes_length) = BSCore.toForeignPtr (toRep str)

178+ let (_, _, src_bytes_length) = BS.toForeignPtr str

180− in toEnum src_bytes_length

179+ in src_bytes_length

181

180

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

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

183−serialize_utf8_text :: MonadIO m => UTF8 BSCore.ByteString -> OutputBuffer -> m OutputBuffer

182+serialize_utf8_text :: MonadIO m => BS.ByteString -> OutputBuffer -> m OutputBuffer

184−serialize_utf8_text str dest_ptr =

183+serialize_utf8_text str dest_ptr =

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

184+ let (src_fptr, src_ptr_offset, src_bytes_length) = BS.toForeignPtr str

186 in liftIO $ withForeignPtr src_fptr $ \src_ptr -> do

185 in liftIO $ withForeignPtr src_fptr $ \src_ptr -> do

187 let src_ptr' = src_ptr `plusPtr` src_ptr_offset

186 let src_ptr' = src_ptr `plusPtr` src_ptr_offset

188− BSCore.memcpy dest_ptr src_ptr' (toEnum src_bytes_length)

187+ BS.memcpy dest_ptr src_ptr' (toEnum src_bytes_length)

189 return (dest_ptr `plusPtr` src_bytes_length)

188 return (dest_ptr `plusPtr` src_bytes_length)

190

189

191

190

@@ -255,7 +254,7 @@ output_picture (DisplayHandle d t s) pic = do

255 liftIO $ writeIORef (previous_output_ref s) (Just ops)

254 liftIO $ writeIORef (previous_output_ref s) (Just ops)

256 return ()

255 return ()

257

256

258−required_bytes :: DisplayTerminal d => d -> FixedAttr -> [Bool] -> DisplayOps -> Word

257+required_bytes :: DisplayTerminal d => d -> FixedAttr -> [Bool] -> DisplayOps -> Int

259required_bytes d in_fattr diffs ops =

258required_bytes d in_fattr diffs ops =

260 let (_, n, _, _) = Vector.foldl' required_bytes' (0, 0, in_fattr, diffs) ( display_ops ops )

259 let (_, n, _, _) = Vector.foldl' required_bytes' (0, 0, in_fattr, diffs) ( display_ops ops )

261 in n

260 in n

@@ -268,7 +267,7 @@ required_bytes d in_fattr diffs ops =

268 required_bytes' (_y, _current_sum, _fattr, [] ) _span_ops

267 required_bytes' (_y, _current_sum, _fattr, [] ) _span_ops

269 = error "shouldn't be possible"

268 = error "shouldn't be possible"

270

269

271−span_ops_required_bytes :: DisplayTerminal d => d -> Word -> FixedAttr -> SpanOps -> (Word, FixedAttr)

270+span_ops_required_bytes :: DisplayTerminal d => d -> Int -> FixedAttr -> SpanOps -> (Int, FixedAttr)

272span_ops_required_bytes d y in_fattr span_ops =

271span_ops_required_bytes d y in_fattr span_ops =

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

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

274 let header_required_bytes = move_cursor_required_bytes d 0 y

273 let header_required_bytes = move_cursor_required_bytes d 0 y

@@ -279,7 +278,7 @@ span_ops_required_bytes d y in_fattr span_ops =

279 (header_required_bytes, in_fattr)

278 (header_required_bytes, in_fattr)

280 span_ops

279 span_ops

281

280

282−span_op_required_bytes :: DisplayTerminal d => d -> FixedAttr -> SpanOp -> (Word, FixedAttr)

281+span_op_required_bytes :: DisplayTerminal d => d -> FixedAttr -> SpanOp -> (Int, FixedAttr)

283span_op_required_bytes d fattr (AttributeChange attr) =

282span_op_required_bytes d fattr (AttributeChange attr) =

284 let attr' = limit_attr_for_display d attr

283 let attr' = limit_attr_for_display d attr

285 diffs = display_attr_diffs fattr fattr'

284 diffs = display_attr_diffs fattr fattr'

@@ -311,7 +310,7 @@ serialize_output_ops d start_ptr in_fattr diffs ops = do

311

310

312serialize_span_ops :: ( MonadIO m, DisplayTerminal d )

311serialize_span_ops :: ( MonadIO m, DisplayTerminal d )

313 => d

312 => d

314− -> Word

313+ -> Int

315 -> OutputBuffer

314 -> OutputBuffer

316 -> FixedAttr

315 -> FixedAttr

317 -> SpanOps

316 -> SpanOps

@@ -341,7 +340,7 @@ serialize_span_op _d (TextSpan _ _ str) out_ptr fattr = do

341 return (out_ptr', fattr)

340 return (out_ptr', fattr)

342

341

343marshall_to_terminal :: ( Terminal t )

342marshall_to_terminal :: ( Terminal t )

344− => t -> Word -> (Ptr Word8 -> IO (Ptr Word8)) -> IO ()

343+ => t -> Int -> (Ptr Word8 -> IO (Ptr Word8)) -> IO ()

345marshall_to_terminal t c f = do

344marshall_to_terminal t c f = do

346 start_ptr <- mallocBytes (fromEnum c)

345 start_ptr <- mallocBytes (fromEnum c)

347 --

346 --

@@ -357,7 +356,7 @@ marshall_to_terminal t c f = do

357-- | The cursor position is given in X,Y character offsets. Due to multi-column characters this

356-- | The cursor position is given in X,Y character offsets. Due to multi-column characters this

358-- needs to be translated to column, row positions.

357-- needs to be translated to column, row positions.

359data CursorOutputMap = CursorOutputMap

358data CursorOutputMap = CursorOutputMap

360− { char_to_output_pos :: (Word, Word) -> (Word, Word)

359+ { char_to_output_pos :: (Int, Int) -> (Int, Int)

361 }

360 }

362

361

363cursor_output_map :: DisplayOps -> Cursor -> CursorOutputMap

362cursor_output_map :: DisplayOps -> Cursor -> CursorOutputMap

@@ -365,7 +364,7 @@ cursor_output_map span_ops _cursor = CursorOutputMap

365 { char_to_output_pos = \(cx, cy) -> (cursor_column_offset span_ops cx cy, cy)

364 { char_to_output_pos = \(cx, cy) -> (cursor_column_offset span_ops cx cy, cy)

366 }

365 }

367

366

368−cursor_column_offset :: DisplayOps -> Word -> Word -> Word

367+cursor_column_offset :: DisplayOps -> Int -> Int -> Int

369cursor_column_offset span_ops cx cy =

368cursor_column_offset span_ops cx cy =

370 let cursor_row_ops = Vector.unsafeIndex (display_ops span_ops) (fromEnum cy)

369 let cursor_row_ops = Vector.unsafeIndex (display_ops span_ops) (fromEnum cy)

371 (out_offset, _, _)

370 (out_offset, _, _)

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

@@ -192,7 +192,7 @@ get_window_size = do

192data DisplayContext = DisplayContext

193 { bounds :: DisplayRegion

194 , term :: Term

195− , supported_colors :: Word

195+ , supported_colors :: Int

196 }

197

198instance DisplayTerminal DisplayContext where

@@ -201,9 +201,9 @@ instance DisplayTerminal DisplayContext where

201 context_color_count d = supported_colors d

202

203 move_cursor_required_bytes d x y

204− = cap_expression_required_bytes (cup $ term d) [y, x]

204+ = cap_expression_required_bytes (cup $ term d) [toEnum y, toEnum x]

205 serialize_move_cursor d x y out_ptr

206− = liftIO $ serialize_cap_expression (cup $ term d) [y, x] out_ptr

206+ = liftIO $ serialize_cap_expression (cup $ term d) [toEnum y, toEnum x] out_ptr

207

208 show_cursor_required_bytes d

209 = cap_expression_required_bytes (cnorm $ term d) []

@@ -300,12 +300,12 @@ instance DisplayTerminal DisplayContext where

300 set_colors ptr = do

301 ptr' <- case fixed_fore_color attr of

302 Just c -> liftIO $ serialize_cap_expression ( set_fore_color $ term d )

303− [ ansi_color_index c ]

303+ [ toEnum $ ansi_color_index c ]

304 ptr

305 Nothing -> return ptr

306 ptr'' <- case fixed_back_color attr of

307 Just c -> liftIO $ serialize_cap_expression ( set_back_color $ term d )

308− [ ansi_color_index c ]

308+ [ toEnum $ ansi_color_index c ]

309 ptr'

310 Nothing -> return ptr'

311 return ptr''

@@ -315,7 +315,7 @@ instance DisplayTerminal DisplayContext where

315 = fail "ColorToDefault is not a possible case for apply_color_diffs"

316 apply_color_diff f ( SetColor c ) ptr

317 = liftIO $ serialize_cap_expression ( f $ term d )

318− [ ansi_color_index c ]

318+ [ toEnum $ ansi_color_index c ]

319 ptr

320

321 default_attr_required_bytes d

@@ -328,9 +328,9 @@ instance DisplayTerminal DisplayContext where

328--

329-- This takes a Color which clearly identifies which pallete to use and computes the index

330-- into the full 256 color pallete.

331−ansi_color_index :: Color -> Word

331+ansi_color_index :: Color -> Int

332−ansi_color_index (ISOColor v) = toEnum $ fromEnum v

332+ansi_color_index (ISOColor v) = fromEnum v

333−ansi_color_index (Color240 v) = 16 + ( toEnum $ fromEnum v )

333+ansi_color_index (Color240 v) = 16 + fromEnum v

334

335{- | The sequence of terminfo caps to apply a given style are determined according to these rules.

336 -

src/Graphics/Vty/Terminal/XTermColor.hs+3−2

@@ -14,7 +14,8 @@ import qualified Graphics.Vty.Terminal.TerminfoBased as TerminfoBased

14import Control.Applicative

15import Control.Monad.Trans

17−import qualified Data.String.UTF8 as UTF8

17+import qualified Data.Text as T

18+import qualified Data.Text.Encoding as T

19import System.IO

20import System.IO

@@ -103,7 +104,7 @@ instance DisplayTerminal DisplayContext where

103 inline_hack d = do

104 inline_hack d = do

104 let t = case super_display d of

105 let t = case super_display d of

105 DisplayHandle _ t_ _ -> t_

106 DisplayHandle _ t_ _ -> t_

106− let s_utf8 = UTF8.fromString "\ESC[K"

107+ let s_utf8 = T.encodeUtf8 $ T.pack "\ESC[K"

107 liftIO $ marshall_to_terminal t ( utf8_text_required_bytes s_utf8)

108 liftIO $ marshall_to_terminal t ( utf8_text_required_bytes s_utf8)

108 ( serialize_utf8_text s_utf8 )

109 ( serialize_utf8_text s_utf8 )

109

110

test/BenchVerticalScroll.hs+10−10

@@ -21,21 +21,21 @@ bench_0 = do

21run vt = mapM_ (\p -> update vt p) . benchgen =<< display_bounds (terminal vt)

23-- Currently, we just do scrolling.

24−takem :: (a -> Word) -> Word -> [a] -> ([a],[a])

24+takem :: (a -> Int) -> Int -> [a] -> ([a],[a])

25takem len n [] = ([],[])

26takem len n (x:xs) | lx > n = ([], x:xs)

27 | True = let (tk,dp) = takem len (n - lx) xs in (x:tk,dp)

28 where lx = len x

30−fold :: (a -> Word) -> [Word] -> [a] -> [[a]]

30+fold :: (a -> Int) -> [Int] -> [a] -> [[a]]

31fold len [] xs = []

32fold len (ll:lls) xs = let (tk,dp) = takem len ll xs in tk : fold len lls dp

34−lengths :: Word -> StdGen -> [Word]

34+lengths :: Int -> StdGen -> [Int]

35−lengths ml g =

35+lengths ml g =

36− let (x,g2) = randomR (0,fromEnum ml) g

36+ let (x,g2) = randomR (0,ml) g

37− (y,g3) = randomR (0,x) g2

37+ (y,g3) = randomR (0,x) g2

38− in (toEnum y) : lengths ml g3

38+ in y : lengths ml g3

40nums :: StdGen -> [(Attr, String)]

41nums g = let (x,g2) = (random g :: (Int, StdGen))

@@ -44,12 +44,12 @@ nums g = let (x,g2) = (random g :: (Int, StdGen))

44 , shows x " "

45 ) : nums g3

47−pad :: Word -> Image -> Image

47+pad :: Int -> Image -> Image

48pad ml img = img <|> char_fill def_attr ' ' (ml - image_width img) 1

50−clines :: StdGen -> Word -> [Image]

50+clines :: StdGen -> Int -> [Image]

51clines g maxll = map (pad maxll . horiz_cat . map (uncurry string))

52− $ fold (toEnum . length . snd) (lengths maxll g1) (nums g2)

52+ $ fold (length . snd) (lengths maxll g1) (nums g2)

53 where (g1,g2) = split g

55benchgen :: DisplayRegion -> [Picture]

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

@@ -51,7 +51,7 @@ instance Arbitrary SingleRowSingleAttrImage where

51 -- The text must contain at least one character. Otherwise the image simplifies to the

52 -- IdImage which has a height of 0. If this is to represent a single row then the height

53 -- must be 1

54− single_column_row_text <- resize 128 (listOf1 arbitrary)

54+ single_column_row_text <- Verify.resize 128 (listOf1 arbitrary)

55 a <- arbitrary

56 return $ SingleRowSingleAttrImage

57 a

@@ -81,7 +81,7 @@ data SingleAttrSingleSpanStack = SingleAttrSingleSpanStack

82instance Arbitrary SingleAttrSingleSpanStack where

83 arbitrary = do

84− image_list <- resize 128 (listOf1 arbitrary)

84+ image_list <- Verify.resize 128 (listOf1 arbitrary)

85 let image = vert_cat [ i | SingleRowSingleAttrImage { row_image = i } <- image_list ]

86 return $ SingleAttrSingleSpanStack

87 image