git.iko.soy/vty
on master help sign in
add a generic benchmark executable
a029bdaCorey O'Connor
src/Graphics/Vty/DisplayRegion.hs+1−1
compare with master
unifiedsplit
@@ -6,7 +6,7 @@ import Data.Word
6
6
7-- | Region of the terminal that vty will output to. Units are columns not characters.
7-- | Region of the terminal that vty will output to. Units are columns not characters.
8data DisplayRegion = DisplayRegion
8data DisplayRegion = DisplayRegion
9− { region_width :: !Word
9+ { region_width :: !Word
10 , region_height :: !Word
10 , region_height :: !Word
11 } deriving ( Show, Eq )
11 } deriving ( Show, Eq )
12
12
src/Graphics/Vty/Error.hsnew file+11
@@ -0,0 +1,11 @@
1+module Graphics.Vty.Error
2+ where
3+
4+import Control.Exception
5+
6+
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 @@
2 - This is what Yi uses in Yi.UI.Vty.drawText. Ideally a sequence of renderChar images horizontally
2 - This is what Yi uses in Yi.UI.Vty.drawText. Ideally a sequence of renderChar images horizontally
3 - composed should provide no worse performance than a fill render op.
3 - composed should provide no worse performance than a fill render op.
4 -}
4 -}
5+module BenchRenderChar where
5import Graphics.Vty
6import Graphics.Vty
6
7
7import Control.Monad ( forM_ )
8import Control.Monad ( forM_ )
8
9
9import System.Time
10import System.Time
10
11
11−main = do
12+bench_0 = do
12 vty <- mkVty
13 vty <- mkVty
13− (w, h) <- getSize vty
14+ DisplayRegion w h <- display_bounds $ terminal vty
14 let test_chars = take 500 $ cycle $ [ c | c <- ['a'..'z']]
15 let test_chars = take 500 $ cycle $ [ c | c <- ['a'..'z']]
15− start_time_0 <- getClockTime
16 forM_ test_chars $ \test_char -> do
16 forM_ test_chars $ \test_char -> do
17 let test_image = test_image_using_renderChar test_char w h
17 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
19 update vty out_pic
19 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
27 shutdown vty
20 shutdown vty
28− putStrLn $ timeDiffToString $ diffClockTimes end_time_0 start_time_0
29− putStrLn $ timeDiffToString $ diffClockTimes end_time_1 start_time_1
30
21
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)
32
25
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
2
2
3import Graphics.Vty hiding ( pad )
3import Graphics.Vty hiding ( pad )
4
4
@@ -16,15 +16,9 @@ import System.Random
16main = do
16main = do
17 let fixed_gen = mkStdGen 0
17 let fixed_gen = mkStdGen 0
18 setStdGen fixed_gen
18 setStdGen fixed_gen
19− args <- getArgs
20− case args of
21− [] -> mkVty >>= liftM2 (>>) (run $ Just 0) shutdown
19+ mkVty >>= liftM2 (>>) run shutdown
22− ["--delay"] -> mkVty >>= liftM2 (>>) (run $ Just 1000000) shutdown
23− ["--slow"] -> mkVty >>= liftM2 (>>) (run Nothing ) shutdown
24− _ -> fail "usage: ./Bench [--slow|--delay]"
25
20
26−run (Just delay) vt = mapM_ (\p -> update vt p >> threadDelay delay) . benchgen =<< display_bounds (terminal vt)
21+run vt = mapM_ (\p -> update vt p) . benchgen =<< display_bounds (terminal vt)
27−run Nothing vt = mapM_ (update vt) (benchgen $ DisplayRegion 200 100)
28
22
29-- Currently, we just do scrolling.
23-- Currently, we just do scrolling.
30takem :: (a -> Word) -> Word -> [a] -> ([a],[a])
24takem :: (a -> Word) -> Word -> [a] -> ([a],[a])
@@ -54,9 +48,13 @@ pad :: Word -> Image -> Image
54pad ml img = img <|> char_fill def_attr ' ' (ml - image_width img) 1
48pad ml img = img <|> char_fill def_attr ' ' (ml - image_width img) 1
55
49
56clines :: StdGen -> Word -> [Image]
50clines :: 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)
58 where (g1,g2) = split g
53 where (g1,g2) = split g
59
54
60benchgen :: DisplayRegion -> [Picture]
55benchgen :: DisplayRegion -> [Picture]
56+benchgen (DisplayRegion w h)
61−benchgen (DisplayRegion w h) = take 500 $ map ((\i -> pic_for_image i) . vert_cat . take (fromEnum h)) $ tails $ clines (mkStdGen 42) w
57+ = take 2000 $ map ((\i -> pic_for_image i) . vert_cat . take (fromEnum h))
58+ $ tails
59+ $ clines (mkStdGen 80) w
62
60
test/benchmark.hsnew file+48
@@ -0,0 +1,48 @@
1+{-# LANGUAGE QuasiQuotes #-}
2+{-# LANGUAGE ScopedTypeVariables #-}
3+module Main where
4+
5+import Graphics.Vty
6+
7+import qualified BenchVerticalScroll
8+import qualified BenchRenderChar
9+
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 @@
1name: vty
1name: vty
2−version: 4.7.2
2+version: 4.8.0
3license: BSD3
3license: BSD3
4license-file: LICENSE
4license-file: LICENSE
5author: AUTHORS
5author: AUTHORS
@@ -619,9 +619,33 @@ executable vty-interactive-terminal-test
619 utf8-string >= 0.3 && < 0.4,
619 utf8-string >= 0.3 && < 0.4,
620 vector >= 0.7
620 vector >= 0.7
621
621
622−-- Bench.hs
622+executable vty-benchmark
623−-- Bench2.hs
623+ main-is: benchmarsk.hs
624−-- BenchRenderChar.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+
625-- ControlTable.hs
649-- ControlTable.hs
626-- HereDoc.hs
650-- HereDoc.hs
627-- Test.hs
651-- Test.hs