on 5edacaa help sign in
vty/test/Bench.hs
60 lines 2.0 kB history raw
1import Graphics.Vty
3import Control.Concurrent( threadDelay )
4import Control.Monad( liftM2 )
6import Data.List
7import Data.Word
9import System.Environment( getArgs )
10import System.IO
11import System.Random
14main = do
15 let fixed_gen = mkStdGen 0
16 setStdGen fixed_gen
17 args <- getArgs
18 case args of
19 [] -> mkVty >>= liftM2 (>>) (run $ Just 0) shutdown
20 ["--delay"] -> mkVty >>= liftM2 (>>) (run $ Just 1000000) shutdown
21 ["--slow"] -> mkVty >>= liftM2 (>>) (run Nothing ) shutdown
22 _ -> fail "usage: ./Bench [--slow|--delay]"
24run (Just delay) vt = mapM_ (\p -> update vt p >> threadDelay delay) . benchgen =<< display_bounds (terminal vt)
25run Nothing vt = mapM_ (update vt) (benchgen $ DisplayRegion 200 100)
27-- Currently, we just do scrolling.
28takem :: (a -> Word) -> Word -> [a] -> ([a],[a])
29takem len n [] = ([],[])
30takem len n (x:xs) | lx > n = ([], x:xs)
31 | True = let (tk,dp) = takem len (n - lx) xs in (x:tk,dp)
32 where lx = len x
34fold :: (a -> Word) -> [Word] -> [a] -> [[a]]
35fold len [] xs = []
36fold len (ll:lls) xs = let (tk,dp) = takem len ll xs in tk : fold len lls dp
38lengths :: Word -> StdGen -> [Word]
39lengths ml g =
40 let (x,g2) = randomR (0,fromEnum ml) g
41 (y,g3) = randomR (0,x) g2
42 in (toEnum y) : lengths ml g3
44nums :: StdGen -> [(Attr, String)]
45nums g = let (x,g2) = (random g :: (Int, StdGen))
46 (c,g3) = random g2
47 in ( if c then def_attr `with_fore_color` red else def_attr
48 , shows x " "
49 ) : nums g3
51pad :: Word -> Image -> Image
52pad ml img = img <|> char_fill def_attr ' ' (ml - image_width img) 1
54clines :: StdGen -> Word -> [Image]
55clines g maxll = map (pad maxll . horiz_cat . map (uncurry string)) $ fold (toEnum . length . snd) (lengths maxll g1) (nums g2)
56 where (g1,g2) = split g
58benchgen :: DisplayRegion -> [Picture]
59benchgen (DisplayRegion w h) = take 500 $ map ((\i -> pic_for_image i) . vert_cat . take (fromEnum h)) $ tails $ clines (mkStdGen 42) w