ilyakooo0/vty
1
0
Fork 0
mirror of https://github.com/ilyakooo0/vty.git synced 2024-12-02 08:53:43 +03:00
Code Issues Projects Releases Wiki Activity

Merge branches 'dev/fix-translate' and 'dev/add-cropped-images' into dev/integration

Browse Source 
* dev/fix-translate:
  Return the new number of columns to skip as well
  Fix indentation
  Return the number of rows to skip after rendering
  Clean up show instance for Translation
  Fix drawing to incorporate translation
  Proper image size of a translation

* dev/add-cropped-images:
  Modify dimensions when padding a padded image
  Just modify dimensions when cropping pads or crops
  Use Word instead of Int for the dimension type
  Add padded image ctor and related code
  Use the proper index for the height
  Improve show instance for ImageCrop
  Add operation for cropping an image to size

Conflicts:
	src/Graphics/Vty/Image.hs
	src/Graphics/Vty/Span.hs
This commit is contained in:
Ben Boeckel 2011-04-02 12:32:31 -04:00
commit a5235e4516
3 changed files with 126 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
src/Graphics/Vty/Image.hs
View File

@ -19,6 +19,8 @@ module Graphics.Vty.Image ( Image(..)
, char_fill
, empty_image
, translate
, crop
, pad
-- | The possible display attributes used in constructing an `Image`.
, module Graphics.Vty.Attributes
)
@ -99,6 +101,10 @@ data Image =
-- 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 +117,11 @@ instance Show Image where
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 +212,9 @@ image_width HorizJoin { output_width = w } = w
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 +223,9 @@ image_height HorizJoin { output_height = r } = r
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.
--
@ -328,3 +342,15 @@ empty_image = EmptyImage
translate :: (Int, Int) -> Image -> Image
translate v i = Translation v i
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
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

2
src/Graphics/Vty/Picture.hs
View File

@ -16,6 +16,8 @@ module Graphics.Vty.Picture ( module Graphics.Vty.Picture
, char_fill
, empty_image
, translate
, crop
, pad
-- | The possible display attributes used in constructing an `Image`.
, module Graphics.Vty.Attributes
)

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

@ -24,6 +24,7 @@ import Data.Array.ST
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 @@ build_spans pic region = do
-- 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 @@ build_spans pic region = do
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 @@ snoc_text_span a text_str ow cw mrow_ops y remaining_columns = do
-- 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