diff --git a/examples/BenchImageFuzz.hs b/examples/BenchImageFuzz.hs deleted file mode 100644 index 0ecfe55..0000000 --- a/examples/BenchImageFuzz.hs +++ /dev/null @@ -1,29 +0,0 @@ -module BenchImageFuzz where -import Graphics.Vty -import Graphics.Vty.Debug - -import Verify.Graphics.Vty.Image -import Verify - -import Control.Applicative -import Control.Monad - -import System.Random - -rand :: Arbitrary a => IO a -rand = head <$> sample' arbitrary - -randomImage :: IO Image -randomImage = rand - -randomPicture = picForImage <$> randomImage - -bench0 = do - vty <- mkVty defaultConfig - (w,h) <- displayBounds $ outputIface vty - let pictures = replicateM 3000 randomPicture - bench ps = do - forM ps (update vty) - shutdown vty - return $ Bench pictures bench - diff --git a/examples/BenchNoDiffOpt.hs b/examples/BenchNoDiffOpt.hs deleted file mode 100644 index 0b1db02..0000000 --- a/examples/BenchNoDiffOpt.hs +++ /dev/null @@ -1,37 +0,0 @@ -{-# LANGUAGE BangPatterns #-} -module BenchNoDiffOpt where - -import Graphics.Vty -import Verify - -import Control.Concurrent( threadDelay ) -import Control.Monad( liftM2 ) - -import qualified Data.ByteString.Char8 as B -import Data.List - -import System.Environment( getArgs ) -import System.IO -import System.Random - -bench0 = do - let fixedGen = mkStdGen 0 - setStdGen fixedGen - vty <- mkVty defaultConfig - (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 diff --git a/examples/BenchRenderChar.hs b/examples/BenchRenderChar.hs deleted file mode 100644 index 6348ebf..0000000 --- a/examples/BenchRenderChar.hs +++ /dev/null @@ -1,38 +0,0 @@ --- 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_ ) - -bench0 = do - vty <- mkVty defaultConfig - (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 defaultConfig - (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 diff --git a/examples/BenchVerticalScroll.hs b/examples/BenchVerticalScroll.hs deleted file mode 100644 index df27707..0000000 --- a/examples/BenchVerticalScroll.hs +++ /dev/null @@ -1,60 +0,0 @@ -module BenchVerticalScroll where - -import Graphics.Vty hiding ( pad ) -import Verify - -import Control.Concurrent( threadDelay ) -import Control.Monad( liftM2 ) - -import Data.List -import Data.Word - -import System.Environment( getArgs ) -import System.IO -import System.Random - -bench0 :: IO Bench -bench0 = do - let fixedGen = mkStdGen 0 - setStdGen fixedGen - return $ Bench (return ()) (\() -> mkVty defaultConfig >>= 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 diff --git a/examples/LICENSE b/examples/LICENSE deleted file mode 100644 index 8d8eff3..0000000 --- a/examples/LICENSE +++ /dev/null @@ -1,33 +0,0 @@ -BSD 3-Clause License - -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. - diff --git a/examples/benchmark.hs b/examples/benchmark.hs deleted file mode 100644 index 5a55723..0000000 --- a/examples/benchmark.hs +++ /dev/null @@ -1,56 +0,0 @@ -{-# LANGUAGE QuasiQuotes #-} -module Main where - -import Graphics.Vty - -import qualified BenchImageFuzz -import qualified BenchNoDiffOpt -import qualified BenchRenderChar -import qualified BenchVerticalScroll - -import Control.Monad - -import Data.Maybe -import Data.List - -import System.Environment -import System.Posix.Process - -import Verify - -main = do - args <- getArgs - let benches = [ ("no-diff-opt-0", BenchNoDiffOpt.bench0) - , ("render-char-0", BenchRenderChar.bench0) - , ("render-char-1", BenchRenderChar.bench1) - , ("vertical-scroll-0", BenchVerticalScroll.bench0) - , ("image-fuzz-0", BenchImageFuzz.bench0) ] - help = forM_ benches $ \(b,_) -> putStrLn $ "--" ++ b - case args of - ["--help"] -> help - ["-h" ] -> help - _ -> do - let args' = if args /= [] - then map (drop 2) args - else map fst benches - -- drop the dash-dash "--" - results <- forM args' $ \bName -> do - case lookup bName benches of - Just b -> bench bName b - Nothing -> fail $ "No benchmark named " ++ bName - print results - return () - -bench bName b = do - putStrLn $ "starting " ++ bName - Bench bDataGen bProc <- b - bData <- bDataGen - startTimes <- bData `deepseq` getProcessTimes - bProc bData - endTimes <- getProcessTimes - let ut = userTime endTimes - userTime startTimes - st = systemTime endTimes - systemTime startTimes - putStrLn $ "user time: " ++ show ut - putStrLn $ "system time: " ++ show st - return (bName, ut, st) - diff --git a/examples/vty-examples.cabal b/examples/vty-examples.cabal deleted file mode 100644 index 3b19d61..0000000 --- a/examples/vty-examples.cabal +++ /dev/null @@ -1,45 +0,0 @@ -name: vty-examples -version: 5.37 -license: BSD3 -license-file: LICENSE -author: AUTHORS -maintainer: Jonathan Daugherty (cygnus@foobox.com) -homepage: https://github.com/jtdaugherty/vty -category: User Interfaces -synopsis: Examples programs using the vty library. -description: - vty is terminal GUI library in the niche of ncurses. It is intended to - be easy to use, have no confusing corner cases, and good support for - common terminal types. - . - vty-benchmark - benchmarks vty. A series of tests that push random - pictures to the terminal. - . - © Corey O'Connor; BSD3 license. - . - © Jonathan Daugherty; BSD3 license. -cabal-version: >= 1.18.0 -build-type: Simple - -source-repository head - type: git - location: https://github.com/jtdaugherty/vty.git - -executable vty-benchmark - main-is: benchmark.hs - - default-language: Haskell2010 - default-extensions: ScopedTypeVariables - ghc-options: -threaded - - build-depends: base >= 4 && < 5, - vty, - vty-tests, - bytestring, - random, - unix - - other-modules: BenchImageFuzz - BenchNoDiffOpt - BenchRenderChar - BenchVerticalScroll