c80c788 · vty · git.iko.soy

.gitignore+3

compare with master

unifiedsplit

@@ -2,3 +2,6 @@

2*.swp

3*.hi

4*.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 @@

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

4 -}

5module BenchRenderChar where

6+

6import Graphics.Vty

7import Graphics.Vty

7

8

8import Control.Monad ( forM_ )

9import Control.Monad ( forM_ )

9

10

10−import System.Time

11−

12bench_0 = do

11bench_0 = do

13 vty <- mkVty

12 vty <- mkVty

14 DisplayRegion w h <- display_bounds $ terminal vty

13 DisplayRegion w h <- display_bounds $ terminal vty

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

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

16 forM_ test_chars $ \test_char -> do

15 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

18 out_pic = pic_for_image test_image

17 out_pic = pic_for_image test_image

19 update vty out_pic

18 update vty out_pic

20 shutdown vty

19 shutdown vty

21

20

21+test_image_using_char c w h

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

22+ = vert_cat $ replicate (fromIntegral h)

23− $ horiz_cat $ map (char def_attr)

23+ $ horiz_cat $ map (char def_attr) (replicate (fromIntegral w) c)

24− (replicate (fromIntegral w) c)

25

24

26bench_1 = do

25bench_1 = do

27 vty <- mkVty

26 vty <- mkVty

test/BenchVerticalScroll.hs+1−1

@@ -13,7 +13,7 @@ import System.IO

13import System.Random

14

15

16−main = do

16+bench_0 = do

17 let fixed_gen = mkStdGen 0

18 setStdGen fixed_gen

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

test/benchmark.hs+7−4

@@ -4,8 +4,9 @@ module Main where

4

5import Graphics.Vty

6

7−import qualified BenchVerticalScroll

7+import qualified BenchNoDiffOpt

8import qualified BenchRenderChar

9+import qualified BenchVerticalScroll

9

10

10import Control.Monad

11import Control.Monad

11

12

@@ -17,9 +18,10 @@ import System.Posix.Process

17

18

18main = do

19main = do

19 args <- getArgs

20 args <- getArgs

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

21+ let benches = [ ("no-diff-opt-0", BenchNoDiffOpt.bench_0)

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

22 , ("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)]

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

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

24 case args of

26 case args of

25 ["--help"] -> help

27 ["--help"] -> help

@@ -28,7 +30,8 @@ main = do

28 let args' = if args /= []

30 let args' = if args /= []

29 then args

31 then args

30 else map fst benches

32 else map fst benches

33+ -- drop the dash-dash "--"

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

34+ results <- forM args' $ \(_ : _ : b) -> do

32 case lookup b benches of

35 case lookup b benches of

33 Just f -> bench b f

36 Just f -> bench b f

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

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

vty.cabal+2−1

@@ -620,7 +620,7 @@ executable vty-interactive-terminal-test

620 vector >= 0.7

621

622executable vty-benchmark

623− main-is: benchmarsk.hs

623+ main-is: benchmark.hs

624

625 default-language: Haskell2010

626

@@ -640,6 +640,7 @@ executable vty-benchmark

640 mtl >= 1.1.1.0 && < 2.2,

641 parallel >= 2.2 && < 3.3,

642 parsec >= 2 && < 4,

643+ random == 1.0.*,

643 string-qq,

644 string-qq,

644 terminfo >= 0.3 && < 0.4,

645 terminfo >= 0.3 && < 0.4,

645 unix,

646 unix,