vty 4.6.0.6 → 4.7.0.0
raw patch · 8 files changed
+145/−49 lines, 8 files
Files
- README +3/−1
- src/Graphics/Vty/Image.hs +37/−3
- src/Graphics/Vty/Picture.hs +2/−0
- src/Graphics/Vty/Span.hs +95/−41
- src/Graphics/Vty/Terminal/Generic.hs +2/−1
- test/HereDoc.hs +1/−1
- test/Verify.hs +1/−0
- vty.cabal +4/−2
README view
@@ -40,7 +40,9 @@ * Uses the TIOCGWINSZ ioctl to find the current window size, which appears to be limited to Linux and *BSD. -darcs get --tag=vty-4.0.0.1 http://code.haskell.org/vty/+Project is hosted on github.com: https://github.com/coreyoconnor/vty++git clone git://github.com/coreyoconnor/vty.git To compile the demonstration program: ghc --make test/Test.hs gwinsz.c
src/Graphics/Vty/Image.hs view
@@ -19,6 +19,12 @@ , char_fill , empty_image , translate+ , safe_wcwidth+ , safe_wcswidth+ , wcwidth+ , wcswidth+ , crop+ , pad -- | The possible display attributes used in constructing an `Image`. , module Graphics.Vty.Attributes )@@ -99,6 +105,10 @@ -- Any image of zero size equals the empty image. | EmptyImage | Translation (Int, Int) Image+ -- Crop an image to a size+ | ImageCrop (Word, Word) Image+ -- Pad an image up to a size+ | ImagePad (Word, Word) Image deriving Eq instance Show Image where@@ -111,7 +121,11 @@ show ( VertJoin { part_top = t, part_bottom = b, output_width = c, output_height = r } ) = "VertJoin (" ++ show c ++ ", " ++ show r ++ ") ( " ++ show t ++ " ) <-> ( " ++ show b ++ " )" show ( Translation offset i )- = "Translation ( " ++ show offset ++ ", " ++ show i ++ " )"+ = "Translation " ++ show offset ++ " ( " ++ show i ++ " )"+ show ( ImageCrop size i )+ = "ImageCrop " ++ show size ++ " ( " ++ show i ++ " )"+ show ( ImagePad size i )+ = "ImagePad " ++ show size ++ " ( " ++ show i ++ " )" show ( EmptyImage ) = "EmptyImage" -- | Currently append in the Monoid instance is equivalent to <->. Future versions will just stack@@ -202,7 +216,9 @@ image_width VertJoin { output_width = w } = w image_width BGFill { output_width = w } = w image_width EmptyImage = 0-image_width ( Translation _v i ) = image_width i+image_width ( Translation v i ) = toEnum $ max 0 $ (fst v +) $ fromEnum $ image_width i+image_width ( ImageCrop v i ) = min (image_width i) $ fst v+image_width ( ImagePad v i ) = max (image_width i) $ fst v -- | The height of an Image. This is the number of display rows the image will occupy. image_height :: Image -> Word@@ -211,7 +227,9 @@ image_height VertJoin { output_height = r } = r image_height BGFill { output_height = r } = r image_height EmptyImage = 0-image_height ( Translation _v i ) = image_height i+image_height ( Translation v i ) = toEnum $ max 0 $ (snd v +) $ fromEnum $ image_height i+image_height ( ImageCrop v i ) = min (image_height i) $ snd v+image_height ( ImagePad v i ) = max (image_height i) $ snd v -- | Combines two images side by side. --@@ -325,6 +343,22 @@ empty_image :: Image empty_image = EmptyImage +-- | Apply the given offset to the image. translate :: (Int, Int) -> Image -> Image translate v i = Translation v i++-- | Ensure an image is no larger than the provided size. If the image is larger then crop.+crop :: (Word, Word) -> Image -> Image+crop (0,_) _ = EmptyImage+crop (_,0) _ = EmptyImage+crop v (ImageCrop _size i) = ImagePad (min (fst v) (fst _size), min (snd v) (snd _size)) i+crop v (ImagePad _size i) = ImagePad (min (fst v) (fst _size), min (snd v) (snd _size)) i+crop v i = ImagePad v i++-- | Ensure an image is at least the provided size. If the image is smaler then pad.+pad :: (Word, Word) -> Image -> Image+pad (0,_) _ = EmptyImage+pad (_,0) _ = EmptyImage+pad v (ImagePad _size i) = ImagePad (max (fst v) (fst _size), max (snd v) (snd _size)) i+pad v i = ImagePad v i
src/Graphics/Vty/Picture.hs view
@@ -16,6 +16,8 @@ , char_fill , empty_image , translate+ , crop+ , pad -- | The possible display attributes used in constructing an `Image`. , module Graphics.Vty.Attributes )
src/Graphics/Vty/Span.hs view
@@ -24,6 +24,7 @@ import qualified Data.ByteString as B import qualified Data.ByteString.Internal as BInt import qualified Data.Foldable as Foldable+import Data.List import Data.Word import qualified Data.ByteString.UTF8 as BSUTF8 import qualified Data.String.UTF8 as UTF8@@ -110,7 +111,7 @@ -- The ops builder recursively descends the image and outputs span ops that would -- display that image. The number of columns remaining in this row before exceeding the -- bounds is also provided. This is used to clip the span ops produced.- ops_for_row mrow_ops (pic_background pic) region (pic_image pic) 0 (region_width region)+ _ <- ops_for_row mrow_ops (pic_background pic) region (pic_image pic) (0,0) 0 (region_width region) -- Fill in any unspecified columns with the background pattern. forM_ [0 .. region_height region - 1] $ \row -> do end_x <- readSTArray mrow_ops row >>= return . span_ops_effected_columns@@ -122,61 +123,105 @@ type MRowOps s = STArray s Word SpanOps -ops_for_row :: MRowOps s -> Background -> DisplayRegion -> Image -> Word -> Word -> ST s ()-ops_for_row mrow_ops bg region image y remaining_columns- | remaining_columns == 0 = return ()- | y >= region_height region = return ()+ops_for_row :: MRowOps s -> Background -> DisplayRegion -> Image -> (Word, Word) -> Word -> Word -> ST s (Word, Word)+ops_for_row mrow_ops bg region image skip_dim@(skip_row,skip_col) y remaining_columns+ | remaining_columns == 0 = return skip_dim+ | y >= region_height region = return skip_dim | otherwise = case image of- EmptyImage -> return ()+ EmptyImage -> return skip_dim -- The width provided is the number of columns this text span will occupy when displayed. -- if this is greater than the number of remaining columsn the output has to be produced a -- character at a time.- HorizText a text_str ow cw -> do- snoc_text_span a text_str ow cw mrow_ops y remaining_columns+ HorizText a text_str _ _ -> do+ if skip_row > 0+ then return (skip_row - 1, skip_col)+ else do+ skip_col' <- snoc_text_span a text_str mrow_ops skip_col y remaining_columns+ return (skip_row, skip_col') VertJoin t b _ _ -> do- ops_for_row mrow_ops bg region t y remaining_columns- ops_for_row mrow_ops bg region b (y + image_height t) remaining_columns+ (skip_row',skip_col') <- ops_for_row mrow_ops bg region t skip_dim y remaining_columns+ (skip_row'',skip_col'') <- ops_for_row mrow_ops bg region b (skip_row', skip_col) (y + image_height t - (skip_row - skip_row')) remaining_columns+ return (skip_row'', min skip_col' skip_col'') HorizJoin l r _ _ -> do- ops_for_row mrow_ops bg region l y remaining_columns+ (skip_row',skip_col') <- ops_for_row mrow_ops bg region l skip_dim y remaining_columns -- Don't output the right part unless there is at least a single column left after -- outputting the left part.- if image_width l < remaining_columns- then ops_for_row mrow_ops bg region r y (remaining_columns - image_width l)- else return ()+ if image_width l - (skip_col - skip_col') > remaining_columns+ then return (skip_row,skip_col')+ else do+ (skip_row'',skip_col'') <- ops_for_row mrow_ops bg region r (skip_row, skip_col') y (remaining_columns - image_width l + (skip_col - skip_col'))+ return (min skip_row' skip_row'', skip_col'') BGFill width height -> do- let actual_height = if y + height > region_height region - then region_height region - y- else height- actual_width = if width > remaining_columns- then remaining_columns- else width+ let min_height = if y + height > region_height region+ then region_height region - y+ else height+ min_width = if width > remaining_columns+ then remaining_columns+ else width+ actual_height = if skip_row > min_height+ then 0+ else min_height - skip_row+ actual_width = if skip_col > min_width+ then 0+ else min_width - skip_col forM_ [y .. y + actual_height - 1] $ \y' -> snoc_bg_fill mrow_ops bg actual_width y'- Translation _offset i -> ops_for_row mrow_ops bg region i y remaining_columns+ let skip_row' = if actual_height > skip_row+ then 0+ else skip_row - min_height+ skip_col' = if actual_width > skip_col+ then 0+ else skip_col - min_width+ return (skip_row',skip_col')+ Translation (dx,dy) i -> do+ if dx < 0+ -- Translation left+ -- Extract the delta and add it to skip_col.+ then ops_for_row mrow_ops bg region (translate (0, dy) i) (skip_row, skip_col + dw) y remaining_columns+ -- Translation right+ else if dy < 0+ -- Translation up+ -- Extract the delta and add it to skip_row.+ then ops_for_row mrow_ops bg region (translate (dx, 0) i) (skip_row + dh, skip_col) y remaining_columns+ -- Translation down+ -- Pad the start of lines and above the image with a+ -- background_fill image.+ else ops_for_row mrow_ops bg region (background_fill ow dh <-> (background_fill dw ih <|> i)) skip_dim y remaining_columns+ where+ dw = toEnum $ abs dx+ dh = toEnum $ abs dy+ ow = image_width image+ ih = image_height i+ ImageCrop (max_w,max_h) i ->+ if y >= max_h+ then return skip_dim+ else ops_for_row mrow_ops bg region i skip_dim y (min remaining_columns max_w)+ ImagePad (min_w,min_h) i -> do+ let hpad = if image_width i < min_w+ then background_fill (min_w - image_width i) (image_height i)+ else empty_image+ let vpad = if image_height i < min_h+ then background_fill (image_width i) (min_h - image_height i)+ else empty_image+ ops_for_row mrow_ops bg region ((i <|> hpad) <-> vpad) skip_dim y remaining_columns snoc_text_span :: (Foldable.Foldable t) => Attr -> t Char - -> Word -- width of text span in output display columns- -> Word -- width of text span in characters -> MRowOps s -> Word -> Word - -> ST s ()-snoc_text_span a text_str ow cw mrow_ops y remaining_columns = do- if ow > remaining_columns- then do- snoc_op mrow_ops y $ AttributeChange a- let (ow', cw', txt) = Foldable.foldl' - build_cropped_txt- ( 0, 0, B.empty )- text_str- snoc_op mrow_ops y $ TextSpan ow' cw' (UTF8.fromRep txt)- else do- snoc_op mrow_ops y $ AttributeChange a- let utf8_bs = ({-# SCC "BSUTF8.fromString" #-} BSUTF8.fromString) $ Foldable.foldMap (\c -> [c]) text_str- snoc_op mrow_ops y $ TextSpan ow cw (UTF8.fromRep utf8_bs)+ -> Word + -> ST s Word+snoc_text_span a text_str mrow_ops skip_col y remaining_columns = do+ snoc_op mrow_ops y $ AttributeChange a+ let (ow', dw', cw', txt) = Foldable.foldl'+ build_cropped_txt+ ( 0, 0, 0, B.empty )+ text_str+ snoc_op mrow_ops y $ TextSpan ow' cw' (UTF8.fromRep txt)+ return $ skip_col - dw' where- build_cropped_txt (ow', char_count', b0) c = {-# SCC "build_cropped_txt" #-}+ build_cropped_txt (ow', dw', char_count', b0) c = {-# SCC "build_cropped_txt" #-} let w = wcwidth c -- Characters with unknown widths occupy 1 column. -- @@ -185,9 +230,18 @@ -- the character. If so then this replacement process may need to be implemented -- manually for consistent behavior across terminals. w' = toEnum $ if w < 0 then 1 else w- in if (w' + ow') > remaining_columns- then ( ow', char_count', b0 )- else ( ow' + w', char_count' + 1, B.append b0 $ B.pack $ encode [c] )+ in if dw' == skip_col+ then if ow' == remaining_columns+ then ( ow', dw', char_count', b0 )+ else if (w' + ow') > remaining_columns+ then ( remaining_columns, dw', char_count' + ooverflow, B.append b0 $ B.pack $ encode $ genericReplicate ooverflow '…' )+ else ( ow' + w', dw', char_count' + 1, B.append b0 $ B.pack $ encode [c] )+ else if (w' + dw') > skip_col+ then ( doverflow, skip_col, doverflow, B.append b0 $ B.pack $ encode $ genericReplicate doverflow '…' )+ else ( ow', w' + dw', char_count', b0 )+ where+ doverflow = skip_col - dw'+ ooverflow = remaining_columns - ow' snoc_bg_fill :: MRowOps s -> Background -> Word -> Word -> ST s () snoc_bg_fill _row_ops _bg 0 _row
src/Graphics/Vty/Terminal/Generic.hs view
@@ -1,4 +1,5 @@--- Copyright 2009-2010 Corey O'Connor+-- Copyright 2009-2011 Corey O'Connor+{-# LANGUAGE BangPatterns #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ExistentialQuantification #-}
test/HereDoc.hs view
@@ -10,5 +10,5 @@ import Language.Haskell.TH.Lib heredoc :: QuasiQuoter-heredoc = QuasiQuoter (litE . stringL) (litP . stringL)+heredoc = QuasiQuoter (litE . stringL) (litP . stringL) undefined undefined
test/Verify.hs view
@@ -84,3 +84,4 @@ instance Arbitrary Word where arbitrary = choose (0, 1024) >>= return . toEnum+
vty.cabal view
@@ -1,5 +1,5 @@ Name: vty-Version: 4.6.0.6+Version: 4.7.0.0 License: BSD3 License-file: LICENSE Author: Stefan O'Rear, Corey O'Connor@@ -20,7 +20,9 @@ Notable infelicities: Sometimes poor efficiency; Assumes UTF-8 character encoding support by the terminal; .- You can 'git' it from <git://github.com/coreyoconnor/vty.git>+ Project is hosted on github.com: https://github.com/coreyoconnor/vty+ .+ git clone git://github.com/coreyoconnor/vty.git . © 2006-2007 Stefan O'Rear; BSD3 license. .