-- Reimplementation of: -- Bash tree: https://github.com/sergiolepore/ChristBASHTree -- Perl tree: https://github.com/rcaputo/acme-poe-tree -- package name: 'ascii-holidays' , 'posix-holidays' etc -- TODO: handle screen resizes module Util ( getWriteAt , Write(..) , Stroke(..) , getNextYear , builtInColors , chunksOf -- Re-exports: , module Control.Monad , shuffleM , threadDelay , newStdGen, RandomGen(..), randoms -- , module System.Console.TermInfo , Color(..), getCapability, setupTermFromEnv, termColumns, termLines ) where import Control.Concurrent (threadDelay) import Control.Monad (forM_) import Data.Time (toGregorian, utctDay, getCurrentTime) import System.Console.Terminfo hiding (row, col) import System.Random (randoms, RandomGen(..), newStdGen) import System.Random.Shuffle (shuffleM) data Stroke = Bold | Plain | Dim -- TODO: rename data Write = Write Int Int Stroke Color String -- from https://rosettacode.org/wiki/Spinning_rod_animation/Text#Haskell : -- TODO: maybe remove?: runCapability :: Terminal -> String -> IO () runCapability term cap = forM_ (getCapability term (tiGetOutput1 cap)) (runTermOutput term) -- Could see how many more we can work with with 'termColors' and 'ColorNumber': builtInColors :: [Color] builtInColors = [Black, Red, Green, Yellow, Blue, Magenta, Cyan, White] getNextYear :: IO Integer getNextYear = do (thisYear, _, _) <- (toGregorian . utctDay) <$> getCurrentTime pure $ thisYear + 1 getWriteAt :: Terminal -> IO (Write -> IO ()) getWriteAt term = do let Just gotoPos = getCapability term cursorAddress Just withFGColor = getCapability term withForegroundColor Just makeBold = getCapability term withBold Just clear = getCapability term clearScreen Just numLines = getCapability term termLines Just withAttrs = getCapability term withAttributes runCapability term "civis" -- Make cursor invisible runTermOutput term $ clear numLines pure $ \(Write row col stroke color s) -> do runTermOutput term $ gotoPos $ Point row col let f = case stroke of Bold -> makeBold -- Setting bold twice to be sure; may very well be redundant _ -> id attrs = defaultAttributes{ invisibleAttr = True -- Doesn't seem to work; that's why we had to "civis" above , dimAttr = case stroke of Dim -> True _ -> False , boldAttr = case stroke of Bold -> True _ -> False } runTermOutput term $ withAttrs attrs $ f $ withFGColor color $ termText s -- So we don't need to depend on 'split': chunksOf :: Int -> [x] -> [[x]] chunksOf n l = case splitAt n l of ([], []) -> [] (x, []) -> [x] (x, xs) -> x : chunksOf n xs