File: Bench.hs

package info (click to toggle)
haskell-vty 3.0.1-1
  • links: PTS
  • area: main
  • in suites: lenny
  • size: 96 kB
  • ctags: 1
  • sloc: haskell: 383; makefile: 41; ansic: 9
file content (47 lines) | stat: -rw-r--r-- 1,740 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
import Graphics.Vty
import System.IO
import System.Environment( getArgs )
import Control.Concurrent( threadDelay )
import System.Random
import Data.List
import Control.Monad( liftM2 )

import qualified Data.ByteString.Char8 as B

main = do args <- getArgs
          case args of
            []         -> mkVty >>= liftM2 (>>) (run False) shutdown
            ["--slow"] -> mkVty >>= liftM2 (>>) (run True ) shutdown
            _          -> fail "usage: ./Bench [--slow]"

run True vt  = mapM_ (update vt) . uncurry benchgen =<< getSize vt
run False vt = mapM_ (update vt) (benchgen 200 100)

-- Currently, we just do scrolling.
takem :: (a -> Int) -> Int -> [a] -> ([a],[a])
takem len n [] = ([],[])
takem len n (x:xs) | lx > n = ([], x:xs)
                   | True = let (tk,dp) = takem len (n - lx) xs in (x:tk,dp)
    where lx = len x

fold :: (a -> Int) -> [Int] -> [a] -> [[a]]
fold len [] xs = []
fold len (ll:lls) xs = let (tk,dp) = takem len ll xs in tk : fold len lls dp

lengths :: Int -> StdGen -> [Int]
lengths ml g = let (x,g2) = randomR (0,ml) g ; (y,g3) = randomR (0,x) g2 in y : lengths ml g3

nums :: StdGen -> [(Attr, B.ByteString)]
nums g = let (x,g2) = (random g :: (Int, StdGen))
             (c,g3) = random g2
         in (if c then setFG red attr else attr, B.pack (shows x " ")) : nums g3

pad :: Int -> Image -> Image
pad ml img = img <|> renderHFill attr ' ' (ml - imgWidth img)

clines :: StdGen -> Int -> [Image]
clines g maxll = map (pad maxll . horzcat . map (uncurry renderBS)) $ fold (B.length . snd) (lengths maxll g1) (nums g2)
  where (g1,g2)  =split g

benchgen :: Int -> Int -> [Picture]
benchgen w h = take 1000 $ map ((\i -> pic{ pImage = i}) . vertcat . take h) $ tails $ clines (mkStdGen 42) w