concurrent-output-1.3.0: demo2.hs

import Control.Concurrent.Async
import Control.Concurrent
import System.Console.Concurrent
import System.Console.Regions
import System.Console.Terminal.Size
import qualified Data.Text as T
import Control.Concurrent.STM
import Control.Applicative
import Data.Time.Clock
import Control.Monad

main = displayConsoleRegions $ mapConcurrently id
	[ spinner 100 1 "Pinwheels!!" setConsoleRegion "/-\\|" (withtitle 1)
	, spinner 100 1 "Bubbles!!!!" setConsoleRegion ".oOo." (withtitle 1)
	, spinner 100 1 "Dots......!" appendConsoleRegion "."  (const (take 3))
	, spinner  30 2 "KleisiFish?" setConsoleRegion "  <=<   <=<  " (withtitle 10)
	, spinner  10 9 "Countdowns!" setConsoleRegion
		(reverse [1..10])
		(\t n -> t ++ show (head n))
	]
  where
	withtitle n t s = t ++ take n s

spinner :: Int -> Int -> String -> (ConsoleRegionHandle -> String -> IO ()) -> [s] -> (String -> [s] -> String) -> IO ()
spinner cycles delay title updater source f =
	withConsoleRegion Linear $ \r -> do
		setConsoleRegion r title'
		mapM_ (go r) (zip [1..cycles] sourcestream)
		finishConsoleRegion r ("Enough " ++ title)
  where
	title' = title ++ "  "
	sourcestream = repeat (concat (repeat source))
	go r (n, s) = do
		updater r (f title' (drop n s))
		threadDelay (delay * 100000)