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
|