e0b2037 · vty · git.iko.soy

git.iko.soy/vty

Renamed IdImage to EmptyImage. Start of translation.

Ignore-this: 9f6add75a48984990a92b873159ebec3 darcs-hash:20091008033252-f0a0d-9cbddd2773b8d07099541731e5949ad347a28923.gz

commite0b20372f638dc1a47bb370291ddb705e7a2d8a5 authorcoreyoconnor <coreyoconnor@gmail.com> dateWed 7 Oct 2009, 20:32 (17 years ago) parent7414e11

7 files changed+84−46

compare with master

unifiedsplit

docs/vty_4_development.txt+1 src/Data/Terminfo/Eval.hs+3−4 src/Data/Terminfo/Parse.hs+49−18 src/Graphics/Vty/Image.hs+26−20 src/Graphics/Vty/Picture.hs−1 src/Graphics/Vty/Span.hs+2−1 vty.cabal+3−2

docs/vty_4_development.txt+1

@@ -87,3 +87,4 @@ I used a very simple Makefile to manage the execution of tests. The usage follow

8787 directory.

8888Nothing fancy, but enough.

8989

90+

src/Data/Terminfo/Eval.hs+3−4

@@ -1,5 +1,4 @@

11{-# LANGUAGE RecordWildCards #-}

2−{-# LANGUAGE TypeFamilies #-}

32{-# LANGUAGE FlexibleContexts #-}

43{-# LANGUAGE NoMonomorphismRestriction #-}

54{-# LANGUAGE NamedFieldPuns #-}

@@ -27,18 +26,18 @@ import Data.Word

2726type Eval a = ReaderT (CapExpression,[CapParam]) (State [CapParam]) a

2827type EvalIO a = ReaderT (CapExpression,[CapParam]) (StateT [CapParam] IO) a

2928

30−pop :: (StateType m ~ [CapParam], MonadState m) => m CapParam

29+pop :: MonadState [CapParam] m => m CapParam

3130pop = do

3231 v : stack <- get

3332 put stack

3433 return v

3534

36−read_param :: (EnvType m ~ (CapExpression, [CapParam]), MonadReader m) => Word -> m CapParam

35+read_param :: MonadReader (CapExpression, [CapParam]) m => Word -> m CapParam

3736read_param pn = do

3837 (_,params) <- ask

3938 return $ genericIndex params pn

4039

41−push :: (StateType m ~ [CapParam], MonadState m) => CapParam -> m ()

40+push :: MonadState [CapParam] m => CapParam -> m ()

4241push v = do

4342 stack <-get

4443 put (v : stack)

src/Data/Terminfo/Parse.hs+49−18

@@ -1,22 +1,19 @@

1+{-# LANGUAGE BangPatterns #-}

12{-# LANGUAGE FlexibleContexts #-}

23{-# LANGUAGE NoMonomorphismRestriction #-}

34{-# LANGUAGE NamedFieldPuns #-}

45module Data.Terminfo.Parse ( module Data.Terminfo.Parse

5− , Text.Parsec.ParseError

6+ , Text.ParserCombinators.Parsec.ParseError

67 )

78 where

910import Control.Monad ( liftM )

10−import Control.Monad.ST.Strict

1111

1212import Data.Array.Unboxed

13−import Data.Array.ST

1413import Data.Monoid

1514import Data.Word

1615

17−import Numeric

18−

19−import Text.Parsec

16+import Text.ParserCombinators.Parsec

2017

2118type BytesLength = Word8

2219type BytesOffset = Word8

@@ -46,6 +43,7 @@ data CapOp =

4643 , conditional_parts :: [(CapOps, CapOps)]

4744 }

4845 | BitwiseOr

46+ | CompareEq

4947 | LiteralInt Int

5048 deriving ( Show )

5149

@@ -55,15 +53,15 @@ data ParamOp =

5553 deriving ( Show )

5654

5755parse_cap_expression :: String -> Either ParseError CapExpression

58−parse_cap_expression cap_string = runST $ do

59− v <- runParserT cap_expression_parser

56+parse_cap_expression cap_string =

57+ let v = runParser cap_expression_parser

6058 initial_build_state

6159 "terminfo cap"

6260 cap_string

63− case v of

64− Left error -> return $ Left error

61+ in case v of

62+ Left e -> Left e

6563 Right build_results ->

66− return $ Right $ CapExpression

64+ Right $ CapExpression

6765 { cap_ops = out_cap_ops build_results

6866 -- The cap bytes are the lower 8 bits of the input string's characters.

6967 -- \todo Verify the input string actually contains an 8bit byte per character.

@@ -74,21 +72,27 @@ parse_cap_expression cap_string = runST $ do

7472 , param_ops = out_param_ops build_results

7573 }

7674

75+type CapParser a = GenParser Char BuildState a

76+

77+cap_expression_parser :: CapParser BuildResults

7778cap_expression_parser = do

7879 rs <- many $ param_escape_parser <|> bytes_op_parser

7980 return $ mconcat rs

8081

82+param_escape_parser :: CapParser BuildResults

8183param_escape_parser = do

8284 char '%'

8385 inc_offset 1

8486 literal_percent_parser <|> param_op_parser

8587

88+literal_percent_parser :: CapParser BuildResults

8689literal_percent_parser = do

8790 char '%'

8891 start_offset <- getState >>= return . next_offset

8992 inc_offset 1

9093 return $ BuildResults 0 [Bytes (start_offset, 1)] []

9194

95+param_op_parser :: CapParser BuildResults

9296param_op_parser

9397 = increment_op_parser

9498 <|> push_op_parser

@@ -96,23 +100,28 @@ param_op_parser

96100 <|> conditional_op_parser

97101 <|> bitwise_op_parser

98102 <|> literal_int_op_parser

103+ <|> compare_op_parser

99104

105+increment_op_parser :: CapParser BuildResults

100106increment_op_parser = do

101107 char 'i'

102108 inc_offset 1

103109 return $ BuildResults 0 [] [ IncFirstTwo ]

104110

111+push_op_parser :: CapParser BuildResults

105112push_op_parser = do

106113 char 'p'

107114 param_n <- digit >>= return . (\d -> read [d])

108115 inc_offset 2

109116 return $ BuildResults param_n [ PushParam $ param_n - 1 ] []

110117

118+dec_out_parser :: CapParser BuildResults

111119dec_out_parser = do

112120 char 'd'

113121 inc_offset 1

114122 return $ BuildResults 0 [ DecOut ] []

115123

124+conditional_op_parser :: CapParser BuildResults

116125conditional_op_parser = do

117126 char '?'

118127 inc_offset 1

@@ -122,7 +131,9 @@ conditional_op_parser = do

122131 true_part <- many_expr $ choice [ try $ lookAhead conditional_end_parser

123132 , conditional_false_parser

124133 ]

125− false_part <- many_expr $ lookAhead conditional_end_parser

134+ false_part <- many_expr $ choice [ try $ lookAhead conditional_end_parser

135+ , conditional_true_parser

136+ ]

126137 return ( true_part, false_part )

127138 )

128139 conditional_end_parser

@@ -140,9 +151,9 @@ conditional_op_parser = do

140151

141152 let true_param_ops = mconcat $ map out_param_ops true_parts

142153 false_param_ops = mconcat $ map out_param_ops false_parts

143− param_ops = mconcat [cond_param_ops, true_param_ops, false_param_ops]

154+ p_ops = mconcat [cond_param_ops, true_param_ops, false_param_ops]

144155

145− return $ BuildResults n'' [ Conditional cond cond_parts ] param_ops

156+ return $ BuildResults n'' [ Conditional cond cond_parts ] p_ops

146157

147158 where

148159 many_p p end = choice

@@ -153,26 +164,32 @@ conditional_op_parser = do

153164 ]

154165 many_expr end = liftM mconcat $ many_p ( param_escape_parser <|> bytes_op_parser ) end

155166

167+conditional_true_parser :: CapParser ()

156168conditional_true_parser = do

157169 string "%t"

158170 inc_offset 2

159171

172+conditional_false_parser :: CapParser ()

160173conditional_false_parser = do

161174 string "%e"

162175 inc_offset 2

163176

177+conditional_end_parser :: CapParser ()

164178conditional_end_parser = do

165179 string "%;"

166180 inc_offset 2

167181

182+bitwise_op_parser :: CapParser BuildResults

168183bitwise_op_parser = do

169184 bitwise_or_parser

170185

186+bitwise_or_parser :: CapParser BuildResults

171187bitwise_or_parser = do

172188 char '|'

173189 inc_offset 1

174190 return $ BuildResults 0 [ BitwiseOr ] [ ]

175191

192+literal_int_op_parser :: CapParser BuildResults

176193literal_int_op_parser = do

177194 char '{'

178195 inc_offset 1

@@ -183,19 +200,33 @@ literal_int_op_parser = do

183200 inc_offset 1

184201 return $ BuildResults 0 [ LiteralInt n ] [ ]

185202

203+compare_op_parser :: CapParser BuildResults

204+compare_op_parser = do

205+ char '='

206+ inc_offset 1

207+ return $ BuildResults 0 [ CompareEq ] [ ]

208+

209+bytes_op_parser :: CapParser BuildResults

186210bytes_op_parser = do

187211 bytes <- many1 $ satisfy (/= '%')

188212 start_offset <- getState >>= return . next_offset

189− let !count = toEnum $ length bytes

190− modifyState $ \s -> s { next_offset = start_offset + count }

191− return $ BuildResults 0 [Bytes (start_offset, count)] []

213+ let !c = toEnum $ length bytes

214+ !s <- getState

215+ let s' = s { next_offset = start_offset + c }

216+ setState s'

217+ return $ BuildResults 0 [Bytes (start_offset, c)] []

192218

193219data BuildState = BuildState

194220 { next_offset :: Word8

195221 }

196222

197−inc_offset n = modifyState $ \s -> s { next_offset = next_offset s + n }

223+inc_offset :: Word8 -> CapParser ()

224+inc_offset n = do

225+ s <- getState

226+ let s' = s { next_offset = next_offset s + n }

227+ setState s'

198228

229+initial_build_state :: BuildState

199230initial_build_state = BuildState 0

200231

201232data BuildResults = BuildResults

src/Graphics/Vty/Image.hs+26−20

@@ -20,6 +20,7 @@ module Graphics.Vty.Image ( Image(..)

2020 , utf8_bytestring

2121 , char_fill

2222 , empty_image

23+ , translate

2324 -- | The possible display attributes used in constructing an `Image`.

2425 , module Graphics.Vty.Attributes

2526 )

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

3132

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

3334

35+import Data.AffineSpace

3436import qualified Data.ByteString as BS

3537import Data.Monoid

3638import qualified Data.Sequence as Seq

@@ -94,11 +96,12 @@ data Image =

9496 , output_height :: !Word -- >= 1

9597 }

9698 -- The combining operators identity constant.

97− -- IdImage <|> a = a

98− -- IdImage <-> a = a

99+ -- EmptyImage <|> a = a

100+ -- EmptyImage <-> a = a

99101 --

100− -- Any image of zero size equals the identity image.

101− | IdImage

102+ -- Any image of zero size equals the empty image.

103+ | EmptyImage

104+ | Translation (Int, Int) Image

102105 deriving Eq

103106

104107instance Show Image where

@@ -110,7 +113,7 @@ instance Show Image where

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

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

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

113− show ( IdImage ) = "IdImage"

116+ show ( EmptyImage ) = "EmptyImage"

114117

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

116119-- the images.

@@ -118,18 +121,18 @@ instance Monoid Image where

118121 mempty = empty_image

119122 mappend = (<->)

120123

121−-- A horizontal text image of 0 characters in width simplifies to the IdImage

124+-- A horizontal text image of 0 characters in width simplifies to the EmptyImage

122125horiz_text :: Attr -> StringSeq -> Word -> Image

123126horiz_text a txt ow

124− | ow == 0 = IdImage

127+ | ow == 0 = EmptyImage

125128 | otherwise = HorizText a txt (toEnum $ Seq.length txt) ow

126129

127130horiz_join :: Image -> Image -> Word -> Word -> Image

128131horiz_join i_0 i_1 w h

129− -- A horiz join of two 0 width images simplifies to the IdImage

130− | w == 0 = IdImage

132+ -- A horiz join of two 0 width images simplifies to the EmptyImage

133+ | w == 0 = EmptyImage

131134 -- A horizontal join where either part is 0 columns in width simplifies to the other part.

132− -- This covers the case where one part is the IdImage.

135+ -- This covers the case where one part is the EmptyImage.

133136 | image_width i_0 == 0 = i_1

134137 | image_width i_1 == 0 = i_0

135138 -- If the images are of the same height then no BG padding is required

@@ -157,10 +160,10 @@ horiz_join _ _ _ _ = error "horiz_join applied to undefined values."

157160

158161vert_join :: Image -> Image -> Word -> Word -> Image

159162vert_join i_0 i_1 w h

160− -- A vertical join of two 0 height images simplifies to the IdImage

161− | h == 0 = IdImage

163+ -- A vertical join of two 0 height images simplifies to the EmptyImage

164+ | h == 0 = EmptyImage

162165 -- A vertical join where either part is 0 rows in height simplifies to the other part.

163− -- This covers the case where one part is the IdImage

166+ -- This covers the case where one part is the EmptyImage

164167 | image_height i_0 == 0 = i_1

165168 | image_height i_1 == 0 = i_0

166169 -- If the images are of the same height then no background padding is required

@@ -189,8 +192,8 @@ vert_join _ _ _ _ = error "vert_join applied to undefined values."

189192-- | An area of the picture's bacground (See Background) of w columns and h rows.

190193background_fill :: Word -> Word -> Image

191194background_fill w h

192− | w == 0 = IdImage

193− | h == 0 = IdImage

195+ | w == 0 = EmptyImage

196+ | h == 0 = EmptyImage

194197 | otherwise = BGFill w h

195198

196199-- | The width of an Image. This is the number display columns the image will occupy.

@@ -199,7 +202,7 @@ image_width HorizText { output_width = w } = w

199202image_width HorizJoin { output_width = w } = w

200203image_width VertJoin { output_width = w } = w

201204image_width BGFill { output_width = w } = w

202−image_width IdImage = 0

205+image_width EmptyImage = 0

203206

204207-- | The height of an Image. This is the number of display rows the image will occupy.

205208image_height :: Image -> Word

@@ -207,7 +210,7 @@ image_height HorizText {} = 1

207210image_height HorizJoin { output_height = r } = r

208211image_height VertJoin { output_height = r } = r

209212image_height BGFill { output_height = r } = r

210−image_height IdImage = 0

213+image_height EmptyImage = 0

211214

212215-- | Combines two images side by side.

213216--

@@ -257,14 +260,14 @@ im_t <-> im_b

257260

258261-- | Compose any number of images horizontally.

259262horiz_cat :: [Image] -> Image

260−horiz_cat = foldr (<|>) IdImage

263+horiz_cat = foldr (<|>) EmptyImage

261264

262265horzcat :: [Image] -> Image

263266horzcat = horiz_cat

264267

265268-- | Compose any number of images vertically.

266269vert_cat :: [Image] -> Image

267−vert_cat = foldr (<->) IdImage

270+vert_cat = foldr (<->) EmptyImage

268271

269272vertcat :: [Image] -> Image

270273vertcat = vert_cat

@@ -325,5 +328,8 @@ char_fill !a !c w h =

325328-- | The empty image. Useful for fold combinators. These occupy no space nor define any display

326329-- attributes.

327330empty_image :: Image

328−empty_image = IdImage

331+empty_image = EmptyImage

332+

333+translate :: Image -> (Int, Int) -> Image

334+translate i v = Translation v i

329335

src/Graphics/Vty/Picture.hs−1

@@ -1,5 +1,4 @@

2−{-# LANGUAGE NamedFieldPuns #-}

32module Graphics.Vty.Picture ( module Graphics.Vty.Picture

43 , image_width

54 , image_height

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

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

123123 | remaining_columns == 0 = return ()

124124 | y >= region_height region = return ()

125125 | otherwise = case image of

126− IdImage -> return ()

126+ EmptyImage -> return ()

127127 -- The width provided is the number of columns this text span will occupy when displayed.

128128 -- if this is greater than the number of remaining columsn the output has to be produced a

129129 -- character at a time.

@@ -147,6 +147,7 @@ ops_for_row mrow_ops bg region image y remaining_columns

147147 then remaining_columns

148148 else width

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

150+ Translation v i -> return ()

150151

151152snoc_text_span :: (Foldable.Foldable t)

152153 => Attr

vty.cabal+3−2

@@ -26,10 +26,11 @@ Description:

2626Build-Depends: base >= 4 && < 5, bytestring, containers, unix, uvector

2727Build-Depends: terminfo >= 0.2 && < 0.3

2828Build-Depends: utf8-string >= 0.3 && < 0.4

29−Build-Depends: transformers, monads-tf

29+Build-Depends: mtl >= 1.1.0.0 && < 1.2

3030Build-Depends: ghc-prim

3131Build-Depends: array

32−Build-Depends: parsec >= 3 && < 4

32+Build-Depends: parsec >= 2 && < 4

33+Build-Depends: vector-space >= 0.5 && < 0.6

3334Build-Type: Simple

3435Data-Files: README, TODO

3536Exposed-Modules: Graphics.Vty