git.iko.soy/vty
on master help sign in
add remaining benchmarks to simple benchmark runner
commitc80c7884e8ec57b3b3bed06ba958fb885de3eb8c authorCorey O'Connor <corey@ooyala.com> dateSun 27 Jan 2013, 23:08 (14 years ago) parenta029bda
7 files changed+52−42
compare with master
unifiedsplit
.gitignore+3 test/Bench2.hs−30 test/BenchNoDiffOpt.hs+34 test/BenchRenderChar.hs+5−6 test/BenchVerticalScroll.hs+1−1 test/benchmark.hs+7−4 vty.cabal+2−1
.gitignore+3
@@ -2,3 +2,6 @@
22*.swp
33*.hi
44*.prof
5+Setup
6+dist
7+test/benchmark
test/Bench2.hsdeleted−30
@@ -1,30 +0,0 @@
1−{-# LANGUAGE BangPatterns #-}
2−import Graphics.Vty
3−import System.IO
4−import System.Environment( getArgs )
5−import Control.Concurrent( threadDelay )
6−import System.Random
7−import Data.List
8−import Control.Monad( liftM2 )
9−
10−import qualified Data.ByteString.Char8 as B
11−
12−main = do
13− let fixed_gen = mkStdGen 0
14− setStdGen fixed_gen
15− args <- getArgs
16− vt <- mkVty
17− (w, h) <- getSize vt
18− let !image_0 = renderFill attr 'X' w h
19− let !image_1 = renderFill attr '0' w h
20− run vt image_0 image_1
21− shutdown vt
22−
23−run vt image_0 image_1 = run' vt 300 image_0 image_1
24−
25−run' vt 0 image_0 image_1 = return ()
26−run' vt n image_0 image_1 = do
27− let p = pic { pImage = image_0 }
28− update vt p
29− run' vt (n - 1) image_1 image_0
30−
test/BenchNoDiffOpt.hsnew file+34
@@ -0,0 +1,34 @@
1+{-# LANGUAGE BangPatterns #-}
2+module BenchNoDiffOpt where
3+
4+{-# LANGUAGE BangPatterns #-}
5+import Graphics.Vty
6+
7+import Control.Concurrent( threadDelay )
8+import Control.Monad( liftM2 )
9+
10+import qualified Data.ByteString.Char8 as B
11+import Data.List
12+
13+import System.Environment( getArgs )
14+import System.IO
15+import System.Random
16+
17+bench_0 = do
18+ let fixed_gen = mkStdGen 0
19+ setStdGen fixed_gen
20+ vty <- mkVty
21+ DisplayRegion w h <- display_bounds $ terminal vty
22+ let image_0 = char_fill def_attr 'X' w h
23+ let image_1 = char_fill def_attr '0' w h
24+ flip_out vty 300 image_0 image_1
25+ shutdown vty
26+
27+flip_out vty n image_0 image_1 =
28+ let !p_left = pic_for_image image_0
29+ !p_right = pic_for_image image_1
30+ w_left 0 = return ()
31+ w_left n = update vty p_left >> w_right (n-1)
32+ w_right 0 = return ()
33+ w_right n = update vty p_right >> w_left (n-1)
34+ in w_left n
test/BenchRenderChar.hs+5−6
@@ -3,25 +3,24 @@
33 - composed should provide no worse performance than a fill render op.
44 -}
55module BenchRenderChar where
6+
67import Graphics.Vty
78
89import Control.Monad ( forM_ )
910
10−import System.Time
11−
1211bench_0 = do
1312 vty <- mkVty
1413 DisplayRegion w h <- display_bounds $ terminal vty
1514 let test_chars = take 500 $ cycle $ [ c | c <- ['a'..'z']]
1615 forM_ test_chars $ \test_char -> do
17− let test_image = test_image_using_renderChar test_char w h
16+ let test_image = test_image_using_char test_char w h
1817 out_pic = pic_for_image test_image
1918 update vty out_pic
2019 shutdown vty
2120
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)
21+test_image_using_char c w h
22+ = vert_cat $ replicate (fromIntegral h)
23+ $ horiz_cat $ map (char def_attr) (replicate (fromIntegral w) c)
2524
2625bench_1 = do
2726 vty <- mkVty
test/BenchVerticalScroll.hs+1−1
@@ -13,7 +13,7 @@ import System.IO
1313import System.Random
1414
1515
16−main = do
16+bench_0 = do
1717 let fixed_gen = mkStdGen 0
1818 setStdGen fixed_gen
1919 mkVty >>= liftM2 (>>) run shutdown
test/benchmark.hs+7−4
@@ -4,8 +4,9 @@ module Main where
44
55import Graphics.Vty
66
7−import qualified BenchVerticalScroll
7+import qualified BenchNoDiffOpt
88import qualified BenchRenderChar
9+import qualified BenchVerticalScroll
910
1011import Control.Monad
1112
@@ -17,9 +18,10 @@ import System.Posix.Process
1718
1819main = do
1920 args <- getArgs
20− let benches = [ ("vertical-scroll-0", BenchVerticalScroll.main)
21+ let benches = [ ("no-diff-opt-0", BenchNoDiffOpt.bench_0)
2122 , ("render-char-0", BenchRenderChar.bench_0)
22− , ("render-char-1", BenchRenderChar.bench_1)]
23+ , ("render-char-1", BenchRenderChar.bench_1)
24+ , ("vertical-scroll-0", BenchVerticalScroll.bench_0)]
2325 help = forM_ benches $ \(b,_) -> putStrLn $ "--" ++ b
2426 case args of
2527 ["--help"] -> help
@@ -28,7 +30,8 @@ main = do
2830 let args' = if args /= []
2931 then args
3032 else map fst benches
31− results <- forM args' $ \b -> do
33+ -- drop the dash-dash "--"
34+ results <- forM args' $ \(_ : _ : b) -> do
3235 case lookup b benches of
3336 Just f -> bench b f
3437 Nothing -> fail $ "No benchmark named " ++ b
vty.cabal+2−1
@@ -620,7 +620,7 @@ executable vty-interactive-terminal-test
620620 vector >= 0.7
621621
622622executable vty-benchmark
623− main-is: benchmarsk.hs
623+ main-is: benchmark.hs
624624
625625 default-language: Haskell2010
626626
@@ -640,6 +640,7 @@ executable vty-benchmark
640640 mtl >= 1.1.1.0 && < 2.2,
641641 parallel >= 2.2 && < 3.3,
642642 parsec >= 2 && < 4,
643+ random == 1.0.*,
643644 string-qq,
644645 terminfo >= 0.3 && < 0.4,
645646 unix,