vty-examples 5.4.0 → 5.5.0
raw patch · 12 files changed
+723/−4 lines, 12 filessetup-changed
Files
- BenchImageFuzz.hs +31/−0
- BenchNoDiffOpt.hs +39/−0
- BenchRenderChar.hs +40/−0
- BenchVerticalScroll.hs +61/−0
- LICENSE +31/−0
- Setup.hs +0/−2
- Setup.lhs +3/−0
- Verify.hs +100/−0
- Verify/Data/Terminfo/Parse.hs +112/−0
- Verify/Graphics/Vty/Attributes.hs +73/−0
- Verify/Graphics/Vty/Image.hs +218/−0
- vty-examples.cabal +15/−2
+ BenchImageFuzz.hs view
@@ -0,0 +1,31 @@+module BenchImageFuzz where+import Graphics.Vty+import Graphics.Vty.Debug++import Verify.Graphics.Vty.Image+import Verify++import Control.Applicative+import Control.Monad++import Data.Default (def)++import System.Random++rand :: Arbitrary a => IO a+rand = head <$> sample' arbitrary++randomImage :: IO Image+randomImage = rand++randomPicture = picForImage <$> randomImage++bench0 = do+ vty <- mkVty def+ (w,h) <- displayBounds $ outputIface vty+ let pictures = replicateM 3000 randomPicture+ bench ps = do+ forM ps (update vty)+ shutdown vty+ return $ Bench pictures bench+
+ BenchNoDiffOpt.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE BangPatterns #-}+module BenchNoDiffOpt where++{-# LANGUAGE BangPatterns #-}+import Graphics.Vty+import Verify++import Control.Concurrent( threadDelay )+import Control.Monad( liftM2 )++import qualified Data.ByteString.Char8 as B+import Data.Default (def)+import Data.List++import System.Environment( getArgs )+import System.IO+import System.Random++bench0 = do + let fixedGen = mkStdGen 0+ setStdGen fixedGen+ vty <- mkVty def+ (w,h) <- displayBounds $ outputIface vty+ let images = return $ (image0, image1)+ image0 = charFill defAttr 'X' w h+ image1 = charFill defAttr '0' w h+ bench d = do+ flipOut vty 300 image0 image1+ shutdown vty+ return $ Bench images bench++flipOut vty n image0 image1 = + let !pLeft = picForImage image0+ !pRight = picForImage image1+ wLeft 0 = return ()+ wLeft n = update vty pLeft >> wRight (n-1)+ wRight 0 = return ()+ wRight n = update vty pRight >> wLeft (n-1)+ in wLeft n
+ BenchRenderChar.hs view
@@ -0,0 +1,40 @@+{- benchmarks composing images using the renderChar operation.+ - This is what Yi uses in Yi.UI.Vty.drawText. Ideally a sequence of renderChar images horizontally+ - composed should provide no worse performance than a fill render op.+ -}+module BenchRenderChar where++import Graphics.Vty+import Verify++import Control.Monad ( forM_ )++import Data.Default (def)++bench0 = do+ vty <- mkVty def+ (w,h) <- displayBounds $ outputIface vty+ let testChars = return $ take 500 $ cycle $ [ c | c <- ['a'..'z']]+ bench d = do+ forM_ d $ \testChar -> do+ let testImage = testImageUsingChar testChar w h+ outPic = picForImage testImage+ update vty outPic+ shutdown vty+ return $ Bench testChars bench++testImageUsingChar c w h + = vertCat $ replicate (fromIntegral h)+ $ horizCat $ map (char defAttr) (replicate (fromIntegral w) c)++bench1 = do+ vty <- mkVty def+ (w,h) <- displayBounds $ outputIface vty+ let testChars = return $ take 500 $ cycle $ [ c | c <- ['a'..'z']]+ bench d = do+ forM_ d $ \testChar -> do+ let testImage = charFill defAttr testChar w h+ outPic = picForImage testImage+ update vty outPic+ shutdown vty+ return $ Bench testChars bench
+ BenchVerticalScroll.hs view
@@ -0,0 +1,61 @@+module BenchVerticalScroll where++import Graphics.Vty hiding ( pad )+import Verify++import Control.Concurrent( threadDelay )+import Control.Monad( liftM2 )++import Data.Default (def)+import Data.List+import Data.Word++import System.Environment( getArgs )+import System.IO+import System.Random++bench0 = do + let fixedGen = mkStdGen 0+ setStdGen fixedGen+ return $ Bench (return ()) (\() -> mkVty def >>= liftM2 (>>) run shutdown)++run vt = mapM_ (\p -> update vt p) . benchgen =<< displayBounds (outputIface vt)++-- Currently, we just do scrolling.+takem :: (a -> Int) -> Int -> [a] -> ([a],[a])+takem len n [] = ([],[])+takem len n (x:xs) | lx > n = ([], x:xs)+ | True = let (tk,dp) = takem len (n - lx) xs in (x:tk,dp)+ where lx = len x++fold :: (a -> Int) -> [Int] -> [a] -> [[a]]+fold len [] xs = []+fold len (ll:lls) xs = let (tk,dp) = takem len ll xs in tk : fold len lls dp++lengths :: Int -> StdGen -> [Int]+lengths ml g =+ let (x,g2) = randomR (0,ml) g+ (y,g3) = randomR (0,x) g2+ in y : lengths ml g3++nums :: StdGen -> [(Attr, String)]+nums g = let (x,g2) = (random g :: (Int, StdGen))+ (c,g3) = random g2+ in ( if c then defAttr `withForeColor` red else defAttr+ , shows x " "+ ) : nums g3++pad :: Int -> Image -> Image+pad ml img = img <|> charFill defAttr ' ' (ml - imageWidth img) 1++clines :: StdGen -> Int -> [Image]+clines g maxll = map (pad maxll . horizCat . map (uncurry string)) + $ fold (length . snd) (lengths maxll g1) (nums g2)+ where (g1,g2) = split g++benchgen :: DisplayRegion -> [Picture]+benchgen (w,h) + = take 2000 $ map ((\i -> picForImage i) . vertCat . take (fromEnum h))+ $ tails+ $ clines (mkStdGen 80) w+
+ LICENSE view
@@ -0,0 +1,31 @@+Copyright Stefan O'Rear 2006, Corey O'Connor 2008, Corey O'Connor 2009++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Stefan O'Rear nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+
− Setup.hs
@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain
+ Setup.lhs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ Verify.hs view
@@ -0,0 +1,100 @@+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE DisambiguateRecordFields #-}+{-# LANGUAGE NamedFieldPuns #-}+module Verify ( module Verify+ , module Control.Applicative+ , module Control.DeepSeq+ , module Control.Exception+ , module Control.Monad+ , module Test.QuickCheck+ , module Test.QuickCheck.Modifiers+ , module Text.Printf+ , succeeded+ , failed+ , monadicIO+ , liftIO+ , liftBool+ , Test(..)+ , Prop.Result(..)+ )+ where++import Control.Exception ( bracket, try, SomeException(..) )++import Distribution.TestSuite hiding ( Result(..) )+import qualified Distribution.TestSuite as TS++import Test.QuickCheck hiding ( Result(..) )+import qualified Test.QuickCheck as QC+import Test.QuickCheck.Modifiers+import Test.QuickCheck.Property hiding ( Result(..) )+import qualified Test.QuickCheck.Property as Prop+import Test.QuickCheck.Monadic ( monadicIO ) ++import Text.Printf++import qualified Codec.Binary.UTF8.String as UTF8++import Control.Applicative hiding ( (<|>) )+import Control.DeepSeq+import Control.Monad ( forM, mapM, mapM_, forM_ )+import Control.Monad.State.Strict++import Numeric ( showHex )++verify :: Testable t => String -> t -> Test+verify testName p = Test $ TestInstance+ { name = testName+ , run = do+ qcResult <- quickCheckWithResult (stdArgs {chatty = False}) p+ case qcResult of+ QC.Success {..} -> return $ Finished TS.Pass+ QC.Failure {numShrinks,reason} -> return $ Finished+ $ TS.Fail $ "After " + ++ show numShrinks ++ " shrinks determined failure to be: "+ ++ show reason+ _ -> return $ Finished $ TS.Fail "TODO(corey): add failure message"+ , tags = []+ , options = []+ , setOption = \_ _ -> Left "no options supported"+ }++data SingleColumnChar = SingleColumnChar Char+ deriving (Show, Eq)++instance Arbitrary SingleColumnChar where+ arbitrary = elements $ map SingleColumnChar [toEnum 0x21 .. toEnum 0x7E]++data DoubleColumnChar = DoubleColumnChar Char+ deriving (Eq)++instance Show DoubleColumnChar where+ show (DoubleColumnChar c) = "(0x" ++ showHex (fromEnum c) "" ++ ") ->" ++ UTF8.encodeString [c]++instance Arbitrary DoubleColumnChar where+ arbitrary = elements $ map DoubleColumnChar $+ [ toEnum 0x3040 .. toEnum 0x3098 ]+ ++ [ toEnum 0x309B .. toEnum 0xA4CF ]++liftIOResult :: Testable prop => IO prop -> Property+liftIOResult = ioProperty++#if __GLASGOW_HASKELL__ <= 701+instance Random Word where+ random g = + let (i :: Int, g') = random g+ in (toEnum i, g')+ randomR (l,h) g =+ let (i :: Int, g') = randomR (fromEnum l,fromEnum h) g+ in (toEnum i, g')+#endif++data Bench where+ Bench :: forall v . NFData v => IO v -> (v -> IO ()) -> Bench+
+ Verify/Data/Terminfo/Parse.hs view
@@ -0,0 +1,112 @@+module Verify.Data.Terminfo.Parse ( module Verify.Data.Terminfo.Parse+ , module Data.Terminfo.Parse+ )+ where++import Data.Terminfo.Parse+import Data.Terminfo.Eval+import Verify++import Data.Word+import qualified Data.Vector.Unboxed as Vector++import Numeric++hexDump :: [Word8] -> String+hexDump bytes = foldr (\b s -> showHex b s) "" bytes++data NonParamCapString = NonParamCapString String+ deriving Show++instance Arbitrary NonParamCapString where+ arbitrary + = ( do+ s <- listOf1 $ (choose (0, 255) >>= return . toEnum) `suchThat` (/= '%')+ return $ NonParamCapString s+ ) `suchThat` ( \(NonParamCapString str) -> length str < 255 ) ++data LiteralPercentCap = LiteralPercentCap String [Word8]+ deriving ( Show )++instance Arbitrary LiteralPercentCap where+ arbitrary + = ( do+ NonParamCapString s <- arbitrary+ (s', bytes) <- insertEscapeOp "%" [toEnum $ fromEnum '%'] s+ return $ LiteralPercentCap s' bytes+ ) `suchThat` ( \(LiteralPercentCap str _) -> length str < 255 ) ++data IncFirstTwoCap = IncFirstTwoCap String [Word8]+ deriving ( Show )++instance Arbitrary IncFirstTwoCap where+ arbitrary+ = ( do+ NonParamCapString s <- arbitrary+ (s', bytes) <- insertEscapeOp "i" [] s+ return $ IncFirstTwoCap s' bytes+ ) `suchThat` ( \(IncFirstTwoCap str _) -> length str < 255 ) ++data PushParamCap = PushParamCap String Int [Word8]+ deriving ( Show )++instance Arbitrary PushParamCap where+ arbitrary+ = ( do+ NonParamCapString s <- arbitrary+ n <- choose (1,9)+ (s', bytes) <- insertEscapeOp ("p" ++ show n) [] s+ return $ PushParamCap s' n bytes+ ) `suchThat` ( \(PushParamCap str _ _) -> length str < 255 ) ++data DecPrintCap = DecPrintCap String Int [Word8]+ deriving ( Show )++instance Arbitrary DecPrintCap where+ arbitrary+ = ( do+ NonParamCapString s <- arbitrary+ n <- choose (1,9)+ (s', bytes) <- insertEscapeOp ("p" ++ show n ++ "%d") [] s+ return $ DecPrintCap s' n bytes+ ) `suchThat` ( \(DecPrintCap str _ _) -> length str < 255 ) ++insertEscapeOp opStr replBytes s = do+ insertPoints <- listOf1 $ elements [0 .. length s - 1]+ let s' = f s ('%' : opStr)+ remainingBytes = f (map (toEnum . fromEnum) s) replBytes+ f inVs out_v = concat [ vs+ | vi <- zip inVs [0 .. length s - 1]+ , let vs = fst vi : ( if snd vi `elem` insertPoints+ then out_v+ else []+ )+ ]+ return (s', remainingBytes)++isBytesOp :: CapOp -> Bool+isBytesOp (Bytes {}) = True+-- isBytesOp _ = False++bytesForRange cap offset count+ = Vector.toList $ Vector.take count $ Vector.drop offset $ capBytes cap++collectBytes :: CapExpression -> [Word8]+collectBytes e = concat [ bytes + | Bytes offset count <- capOps e+ , let bytes = bytesForRange e offset count+ ]+ ++verifyBytesEqual :: [Word8] -> [Word8] -> Result+verifyBytesEqual outBytes expectedBytes + = if outBytes == expectedBytes+ then succeeded+ else failed + { reason = "outBytes [" + ++ hexDump outBytes+ ++ "] /= expectedBytes ["+ ++ hexDump expectedBytes+ ++ "]"+ }+
+ Verify/Graphics/Vty/Attributes.hs view
@@ -0,0 +1,73 @@+module Verify.Graphics.Vty.Attributes ( module Verify.Graphics.Vty.Attributes+ , module Graphics.Vty.Attributes+ )+ where++import Graphics.Vty.Attributes+import Verify++import Data.List ( delete )++allColors :: [Color]+allColors =+ [ black+ , red+ , green+ , yellow+ , blue+ , magenta+ , cyan+ , white+ , brightBlack+ , brightRed+ , brightGreen+ , brightYellow+ , brightBlue+ , brightMagenta+ , brightCyan+ , brightWhite+ ] ++ map Color240 [0..239]++allStyles :: [Style]+allStyles =+ [ standout+ , underline+ , reverseVideo+ , blink+ , dim+ , bold+ ]++-- Limit the possible attributes to just a few for now.+possibleAttrMods :: [ AttrOp ]+possibleAttrMods = + [ idOp + ] ++ map setForeColorOp allColors+ ++ map setBackColorOp allColors+ ++ map setStyleOp allStyles++instance Arbitrary Attr where+ arbitrary = elements possibleAttrMods >>= return . flip applyOp defAttr++data DiffAttr = DiffAttr Attr Attr++instance Arbitrary DiffAttr where+ arbitrary = do+ op0 <- elements possibleAttrMods+ let possibleAttrMods' = delete op0 possibleAttrMods+ op1 <- elements possibleAttrMods'+ return $ DiffAttr (applyOp op0 defAttr) (applyOp op1 defAttr)++data AttrOp = AttrOp String (Attr -> Attr)++instance Eq AttrOp where+ AttrOp n0 _ == AttrOp n1 _ = n0 == n1++setStyleOp s = AttrOp "set_style" (flip withStyle s)+setForeColorOp c = AttrOp "set_fore_color" (flip withForeColor c)+setBackColorOp c = AttrOp "set_back_color" (flip withBackColor c)+idOp = AttrOp "id" id++applyOp :: AttrOp -> Attr -> Attr+applyOp (AttrOp _ f) a = f a+
+ Verify/Graphics/Vty/Image.hs view
@@ -0,0 +1,218 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE DisambiguateRecordFields #-}+module Verify.Graphics.Vty.Image ( module Verify.Graphics.Vty.Image+ , module Graphics.Vty.Image+ )+ where++import Verify.Graphics.Vty.Attributes+import Graphics.Vty.Image+import Graphics.Vty.Image.Internal++import Verify++data UnitImage = UnitImage Char Image++instance Arbitrary UnitImage where+ arbitrary = do+ SingleColumnChar c <- arbitrary+ a <- arbitrary+ return $ UnitImage c (char a c)++instance Show UnitImage where+ show (UnitImage c _) = "UnitImage " ++ show c++data DefaultImage = DefaultImage Image++instance Show DefaultImage where+ show (DefaultImage i) + = "DefaultImage (" ++ show i ++ ") " ++ show (imageWidth i, imageHeight i)++instance Arbitrary DefaultImage where+ arbitrary = do+ i <- return $ char defAttr 'X'+ return $ DefaultImage i++data SingleRowSingleAttrImage + = SingleRowSingleAttrImage + { expectedAttr :: Attr+ , expectedColumns :: Int+ , rowImage :: Image+ }++instance Show SingleRowSingleAttrImage where+ show (SingleRowSingleAttrImage attr columns image) + = "SingleRowSingleAttrImage (" ++ show attr ++ ") " ++ show columns ++ " ( " ++ show image ++ " )"++newtype WidthResize = WidthResize (Image -> (Image, Int))++instance Arbitrary WidthResize where+ arbitrary = do+ WidthResize f <- arbitrary+ w <- choose (1,64)+ oneof $ map (return . WidthResize)+ [ \i -> (i, imageWidth i)+ , \i -> (resizeWidth w $ fst $ f i, w)+ , \i -> let i' = fst $ f i in (cropLeft w i', min (imageWidth i') w)+ , \i -> let i' = fst $ f i in (cropRight w i', min (imageWidth i') w)+ ]++newtype HeightResize = HeightResize (Image -> (Image, Int))++instance Arbitrary HeightResize where+ arbitrary = do+ HeightResize f <- arbitrary+ h <- choose (1,64)+ oneof $ map (return . HeightResize)+ [ \i -> (i, imageHeight i)+ , \i -> (resizeHeight h $ fst $ f i, h)+ , \i -> let i' = fst $ f i in (cropTop h i', min (imageHeight i') h)+ , \i -> let i' = fst $ f i in (cropBottom h i', min (imageHeight i') h)+ ]++newtype ImageResize = ImageResize (Image -> (Image, (Int, Int)))++instance Arbitrary ImageResize where+ arbitrary = oneof+ [ return $! ImageResize $! \i -> (i, (imageWidth i, imageHeight i))+ , return $! ImageResize $! \i -> (i, (imageWidth i, imageHeight i))+ , return $! ImageResize $! \i -> (i, (imageWidth i, imageHeight i))+ , return $! ImageResize $! \i -> (i, (imageWidth i, imageHeight i))+ , return $! ImageResize $! \i -> (i, (imageWidth i, imageHeight i))+ , return $! ImageResize $! \i -> (i, (imageWidth i, imageHeight i))+ , do+ ImageResize f <- arbitrary+ WidthResize g <- arbitrary+ return $! ImageResize $! \i -> + let (i0, (_, outHeight)) = f i+ gI = g i0+ in (fst gI, (snd gI, outHeight))+ , do+ ImageResize f <- arbitrary+ HeightResize g <- arbitrary+ return $! ImageResize $! \i -> + let (i0, (outWidth, _)) = f i+ gI = g i0+ in (fst gI, (outWidth, snd gI))+ ]+++instance Arbitrary SingleRowSingleAttrImage where+ arbitrary = do+ -- The text must contain at least one character. Otherwise the image simplifies to the+ -- IdImage which has a height of 0. If this is to represent a single row then the height+ -- must be 1+ singleColumnRowText <- Verify.resize 16 (listOf1 arbitrary)+ a <- arbitrary+ let outImage = horizCat $ [char a c | SingleColumnChar c <- singleColumnRowText]+ outWidth = length singleColumnRowText+ return $ SingleRowSingleAttrImage a outWidth outImage++data SingleRowTwoAttrImage + = SingleRowTwoAttrImage + { part0 :: SingleRowSingleAttrImage+ , part1 :: SingleRowSingleAttrImage+ , joinImage :: Image+ } deriving Show++instance Arbitrary SingleRowTwoAttrImage where+ arbitrary = do+ p0 <- arbitrary+ p1 <- arbitrary+ return $ SingleRowTwoAttrImage p0 p1 (rowImage p0 <|> rowImage p1)++data SingleAttrSingleSpanStack = SingleAttrSingleSpanStack + { stackImage :: Image + , stackSourceImages :: [SingleRowSingleAttrImage]+ , stackWidth :: Int+ , stackHeight :: Int+ }+ deriving Show++instance Arbitrary SingleAttrSingleSpanStack where+ arbitrary = do+ imageList <- Verify.resize 16 (listOf1 arbitrary)+ return $ mkSingleAttrSingleSpanStack imageList+ shrink s = do+ imageList <- shrink $ stackSourceImages s+ if null imageList+ then []+ else return $ mkSingleAttrSingleSpanStack imageList++mkSingleAttrSingleSpanStack imageList =+ let image = vertCat [ i | SingleRowSingleAttrImage { rowImage = i } <- imageList ]+ in SingleAttrSingleSpanStack image imageList (maximum $ map expectedColumns imageList)+ (toEnum $ length imageList)++instance Arbitrary Image where+ arbitrary = oneof+ [ return EmptyImage+ , do+ SingleAttrSingleSpanStack {stackImage} <- Verify.resize 8 arbitrary+ ImageResize f <- Verify.resize 2 arbitrary+ return $! fst $! f stackImage+ , do+ SingleAttrSingleSpanStack {stackImage} <- Verify.resize 8 arbitrary+ ImageResize f <- Verify.resize 2 arbitrary+ return $! fst $! f stackImage+ , do+ i0 <- arbitrary+ i1 <- arbitrary+ let i = i0 <|> i1+ ImageResize f <- Verify.resize 2 arbitrary+ return $! fst $! f i+ , do+ i0 <- arbitrary+ i1 <- arbitrary+ let i = i0 <-> i1+ ImageResize f <- Verify.resize 2 arbitrary+ return $! fst $! f i+ ]+ {-+ shrink i@(HorizJoin {partLeft, partRight}) = do+ let !i_alt = backgroundFill (imageWidth i) (imageHeight i)+ !partLeft' <- shrink partLeft+ !partRight' <- shrink partRight+ [i_alt, partLeft' <|> partRight']+ shrink i@(VertJoin {partTop, partBottom}) = do+ let !i_alt = backgroundFill (imageWidth i) (imageHeight i)+ !partTop' <- shrink partTop+ !partBottom' <- shrink partBottom+ [i_alt, partTop' <-> partBottom']+ shrink i@(CropRight {croppedImage, outputWidth}) = do+ let !i_alt = backgroundFill (imageWidth i) (imageHeight i)+ [i_alt, croppedImage]+ shrink i@(CropLeft {croppedImage, leftSkip, outputWidth}) = do+ let !i_alt = backgroundFill (imageWidth i) (imageHeight i)+ [i_alt, croppedImage]+ shrink i@(CropBottom {croppedImage, outputHeight}) = do+ let !i_alt = backgroundFill (imageWidth i) (imageHeight i)+ [i_alt, croppedImage]+ shrink i@(CropTop {croppedImage, topSkip, outputHeight}) = do+ let !i_alt = backgroundFill (imageWidth i) (imageHeight i)+ [i_alt, croppedImage]+ shrink i = [emptyImage, backgroundFill (imageWidth i) (imageHeight i)]+ -}++data CropOperation+ = CropFromLeft+ | CropFromRight+ | CropFromTop+ | CropFromBottom+ deriving (Eq, Show)++instance Arbitrary CropOperation where+ arbitrary = oneof $ map return [CropFromLeft, CropFromRight, CropFromTop, CropFromBottom]++data Translation = Translation Image (Int, Int) Image+ deriving (Eq, Show)++instance Arbitrary Translation where+ arbitrary = do+ i <- arbitrary+ x <- arbitrary `suchThat` (> 0)+ y <- arbitrary `suchThat` (> 0)+ let i' = translate x y i+ return $ Translation i (x,y) i'+
vty-examples.cabal view
@@ -1,7 +1,7 @@ name: vty-examples-version: 5.4.0+version: 5.5.0 license: BSD3-license-file: ../LICENSE+license-file: LICENSE author: AUTHORS maintainer: Corey O'Connor (coreyoconnor@gmail.com) homepage: https://github.com/coreyoconnor/vty@@ -20,6 +20,10 @@ cabal-version: >= 1.18.0 build-type: Simple +source-repository head+ type: git+ location: https://github.com/coreyoconnor/vty.git+ executable vty-interactive-terminal-test main-is: interactive_terminal_test.hs @@ -44,6 +48,9 @@ utf8-string, vector + other-modules: Verify.Data.Terminfo.Parse+ Verify+ executable vty-event-echo main-is: EventEcho.hs @@ -113,3 +120,9 @@ utf8-string, vector + other-modules: BenchImageFuzz+ BenchNoDiffOpt+ BenchRenderChar+ BenchVerticalScroll+ Verify.Graphics.Vty.Image+ Verify.Graphics.Vty.Attributes