a029bda · vty · git.iko.soy

git.iko.soy/vty

add a generic benchmark executable

commita029bda581fc81bd88fddfbd515a6e99c034ce0e authorCorey O'Connor <corey@ooyala.com> dateSun 27 Jan 2013, 21:41 (14 years ago) parent9c0f1e7

6 files changed+113−30

compare with master

unifiedsplit

src/Graphics/Vty/DisplayRegion.hs+1−1 src/Graphics/Vty/Error.hs+11 test/BenchRenderChar.hs+16−14 test/Bench.hs → test/BenchVerticalScroll.hs+9−11 test/benchmark.hs+48 vty.cabal+28−4

src/Graphics/Vty/DisplayRegion.hs+1−1

@@ -6,7 +6,7 @@ import Data.Word

77-- | Region of the terminal that vty will output to. Units are columns not characters.

88data DisplayRegion = DisplayRegion

9− { region_width :: !Word

9+ { region_width :: !Word

1010 , region_height :: !Word

1111 } deriving ( Show, Eq )

1212

src/Graphics/Vty/Error.hsnew file+11

@@ -0,0 +1,11 @@

1+module Graphics.Vty.Error

2+ where

4+import Control.Exception

7+-- | The type of exceptions specific to vty.

8+--

9+-- These have fully qualified names by default since, IMO, exception handling requires this.

10+data VtyException

11+ = VtyFailure String -- | Uncategorized failure specific to vty.

test/BenchRenderChar.hs+16−14

@@ -2,31 +2,33 @@

22 - This is what Yi uses in Yi.UI.Vty.drawText. Ideally a sequence of renderChar images horizontally

33 - composed should provide no worse performance than a fill render op.

44 -}

5+module BenchRenderChar where

56import Graphics.Vty

78import Control.Monad ( forM_ )

910import System.Time

1011

11−main = do

12+bench_0 = do

1213 vty <- mkVty

13− (w, h) <- getSize vty

14+ DisplayRegion w h <- display_bounds $ terminal vty

1415 let test_chars = take 500 $ cycle $ [ c | c <- ['a'..'z']]

15− start_time_0 <- getClockTime

1616 forM_ test_chars $ \test_char -> do

1717 let test_image = test_image_using_renderChar test_char w h

18− out_pic = pic { pImage = test_image }

18+ out_pic = pic_for_image test_image

1919 update vty out_pic

20− end_time_0 <- getClockTime

21− let start_time_1 = end_time_0

22− forM_ test_chars $ \test_char -> do

23− let test_image = renderFill attr test_char w h

24− out_pic = pic { pImage = test_image }

25− update vty out_pic

26− end_time_1 <- getClockTime

2720 shutdown vty

28− putStrLn $ timeDiffToString $ diffClockTimes end_time_0 start_time_0

29− putStrLn $ timeDiffToString $ diffClockTimes end_time_1 start_time_1

3021

31−test_image_using_renderChar c w h = vertcat $ replicate h $ horzcat $ map (renderChar attr) (replicate w c)

22+test_image_using_renderChar c w h = vert_cat $ replicate (fromIntegral h)

23+ $ horiz_cat $ map (char def_attr)

24+ (replicate (fromIntegral w) c)

3225

26+bench_1 = do

27+ vty <- mkVty

28+ DisplayRegion w h <- display_bounds $ terminal vty

29+ let test_chars = take 500 $ cycle $ [ c | c <- ['a'..'z']]

30+ forM_ test_chars $ \test_char -> do

31+ let test_image = char_fill def_attr test_char w h

32+ out_pic = pic_for_image test_image

33+ update vty out_pic

34+ shutdown vty

test/Bench.hs → test/BenchVerticalScroll.hsrenamed+9−11

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

1−module Main where

1+module BenchVerticalScroll where

33import Graphics.Vty hiding ( pad )

@@ -16,15 +16,9 @@ import System.Random

1616main = do

1717 let fixed_gen = mkStdGen 0

1818 setStdGen fixed_gen

19− args <- getArgs

20− case args of

21− [] -> mkVty >>= liftM2 (>>) (run $ Just 0) shutdown

22− ["--delay"] -> mkVty >>= liftM2 (>>) (run $ Just 1000000) shutdown

23− ["--slow"] -> mkVty >>= liftM2 (>>) (run Nothing ) shutdown

24− _ -> fail "usage: ./Bench [--slow|--delay]"

19+ mkVty >>= liftM2 (>>) run shutdown

2520

26−run (Just delay) vt = mapM_ (\p -> update vt p >> threadDelay delay) . benchgen =<< display_bounds (terminal vt)

27−run Nothing vt = mapM_ (update vt) (benchgen $ DisplayRegion 200 100)

21+run vt = mapM_ (\p -> update vt p) . benchgen =<< display_bounds (terminal vt)

2822

2923-- Currently, we just do scrolling.

3024takem :: (a -> Word) -> Word -> [a] -> ([a],[a])

@@ -54,9 +48,13 @@ pad :: Word -> Image -> Image

5448pad ml img = img <|> char_fill def_attr ' ' (ml - image_width img) 1

5549

5650clines :: StdGen -> Word -> [Image]

57−clines g maxll = map (pad maxll . horiz_cat . map (uncurry string)) $ fold (toEnum . length . snd) (lengths maxll g1) (nums g2)

51+clines g maxll = map (pad maxll . horiz_cat . map (uncurry string))

52+ $ fold (toEnum . length . snd) (lengths maxll g1) (nums g2)

5853 where (g1,g2) = split g

5954

6055benchgen :: DisplayRegion -> [Picture]

61−benchgen (DisplayRegion w h) = take 500 $ map ((\i -> pic_for_image i) . vert_cat . take (fromEnum h)) $ tails $ clines (mkStdGen 42) w

56+benchgen (DisplayRegion w h)

57+ = take 2000 $ map ((\i -> pic_for_image i) . vert_cat . take (fromEnum h))

58+ $ tails

59+ $ clines (mkStdGen 80) w

6260

test/benchmark.hsnew file+48

@@ -0,0 +1,48 @@

1+{-# LANGUAGE QuasiQuotes #-}

2+{-# LANGUAGE ScopedTypeVariables #-}

3+module Main where

5+import Graphics.Vty

7+import qualified BenchVerticalScroll

8+import qualified BenchRenderChar

10+import Control.Monad

11+

12+import Data.Maybe

13+import Data.List

14+

15+import System.Environment

16+import System.Posix.Process

17+

18+main = do

19+ args <- getArgs

20+ let benches = [ ("vertical-scroll-0", BenchVerticalScroll.main)

21+ , ("render-char-0", BenchRenderChar.bench_0)

22+ , ("render-char-1", BenchRenderChar.bench_1)]

23+ help = forM_ benches $ \(b,_) -> putStrLn $ "--" ++ b

24+ case args of

25+ ["--help"] -> help

26+ ["-h" ] -> help

27+ _ -> do

28+ let args' = if args /= []

29+ then args

30+ else map fst benches

31+ results <- forM args' $ \b -> do

32+ case lookup b benches of

33+ Just f -> bench b f

34+ Nothing -> fail $ "No benchmark named " ++ b

35+ print results

36+ return ()

37+

38+bench b f = do

39+ putStrLn $ "starting " ++ b

40+ start_times <- getProcessTimes

41+ f

42+ end_times <- getProcessTimes

43+ let user_time = userTime end_times - userTime start_times

44+ system_time = systemTime end_times - systemTime start_times

45+ putStrLn $ "user time: " ++ show user_time

46+ putStrLn $ "system time: " ++ show system_time

47+ return (b, user_time, system_time)

48+

vty.cabal+28−4

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

11name: vty

2−version: 4.7.2

2+version: 4.8.0

33license: BSD3

44license-file: LICENSE

55author: AUTHORS

@@ -619,9 +619,33 @@ executable vty-interactive-terminal-test

619619 utf8-string >= 0.3 && < 0.4,

620620 vector >= 0.7

621621

622−-- Bench.hs

623−-- Bench2.hs

624−-- BenchRenderChar.hs

622+executable vty-benchmark

623+ main-is: benchmarsk.hs

624+

625+ default-language: Haskell2010

626+

627+ hs-source-dirs: src test

628+

629+ c-sources: cbits/gwinsz.c

630+ cbits/set_term_timing.c

631+ cbits/mk_wcwidth.c

632+

633+ include-dirs: cbits

634+

635+ build-depends: base >= 4 && < 5,

636+ bytestring,

637+ containers,

638+ deepseq >= 1.1 && < 1.4,

639+ ghc-prim,

640+ mtl >= 1.1.1.0 && < 2.2,

641+ parallel >= 2.2 && < 3.3,

642+ parsec >= 2 && < 4,

643+ string-qq,

644+ terminfo >= 0.3 && < 0.4,

645+ unix,

646+ utf8-string >= 0.3 && < 0.4,

647+ vector >= 0.7

648+

625649-- ControlTable.hs

626650-- HereDoc.hs

627651-- Test.hs