vty/test/Bench.hs

module Main where

import Graphics.Vty

import Control.Concurrent( threadDelay )
import Control.Monad( liftM2 )

import Data.List
import Data.Word

import System.Environment( getArgs )
import System.IO
import System.Random


main = do 
    let fixed_gen = mkStdGen 0
    setStdGen fixed_gen
    args <- getArgs
    case args of
        []         -> mkVty >>= liftM2 (>>) (run $ Just 0) shutdown
        ["--delay"]         -> mkVty >>= liftM2 (>>) (run $ Just 1000000) shutdown
        ["--slow"] -> mkVty >>= liftM2 (>>) (run Nothing ) shutdown
        _          -> fail "usage: ./Bench [--slow|--delay]"

run (Just delay) vt  = mapM_ (\p -> update vt p >> threadDelay delay) . benchgen =<< display_bounds (terminal vt)
run Nothing vt = mapM_ (update vt) (benchgen $ DisplayRegion 200 100)

-- Currently, we just do scrolling.
takem :: (a -> Word) -> Word -> [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 -> Word) -> [Word] -> [a] -> [[a]]
fold len [] xs = []
fold len (ll:lls) xs = let (tk,dp) = takem len ll xs in tk : fold len lls dp

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

nums :: StdGen -> [(Attr, String)]
nums g = let (x,g2) = (random g :: (Int, StdGen))
             (c,g3) = random g2
         in ( if c then def_attr `with_fore_color` red else def_attr
            , shows x " "
            ) : nums g3

pad :: Word -> Image -> Image
pad ml img = img <|> char_fill def_attr ' ' (ml - image_width img) 1

clines :: StdGen -> Word -> [Image]
clines g maxll = map (pad maxll . horiz_cat . map (uncurry string)) $ fold (toEnum . length . snd) (lengths maxll g1) (nums g2)
  where (g1,g2)  = split g

benchgen :: DisplayRegion -> [Picture]
benchgen (DisplayRegion w h) = take 500 $ map ((\i -> pic_for_image i) . vert_cat . take (fromEnum h)) $ tails $ clines (mkStdGen 42) w