packages feed

haha (empty) → 0.1

raw patch · 8 files changed

+687/−0 lines, 8 filesdep +basedep +containersdep +timesetup-changed

Dependencies added: base, containers, time

Files

+ LICENSE view
@@ -0,0 +1,28 @@+Copyright (c) Sebastiaan Visser 2008++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.+3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+SUCH DAMAGE.+
+ Setup.lhs view
@@ -0,0 +1,6 @@+#! /usr/bin/env runhaskell++>import Distribution.Simple++>main = defaultMain+
+ haha.cabal view
@@ -0,0 +1,26 @@+Name:             haha+Version:          0.1+Description:      A simple library for creating animated ascii art on ANSI terminals.+Synopsis:         A simple library for creating animated ascii art on ANSI terminals.+Category:         System, Terminal+License:          BSD3+License-file:     LICENSE+Author:           Sebastiaan Visser+Maintainer:       sfvisser@cs.uu.nl+Build-Type:       Simple+Build-Depends:    base, containers, time++GHC-Options:      -Wall+Extensions:       CPP+HS-Source-Dirs:   src+Other-modules:    +Exposed-modules:  Bitmap,+                  Geometry,+                  Plot,+                  Terminal++GHC-Options:      -Wall+Executable:       rotating-lambda+HS-Source-Dirs:   src+Main-is:          Main.hs+
+ src/Bitmap.hs view
@@ -0,0 +1,107 @@+module Bitmap where++import qualified Data.Map as M+import Prelude hiding (filter)++import Geometry++--------[ image data type ]----------------------------------------------------++data Bitmap u p = Bitmap { bits :: M.Map (Point u) p }+  deriving (Show, Eq)++withBits :: (M.Map (Point u) p -> M.Map (Point v) q) -> Bitmap u p -> Bitmap v q+withBits f = Bitmap . f . bits++empty :: Bitmap u p+empty = Bitmap M.empty++get :: Ord u => Point u -> Bitmap u p -> Maybe p+get p img = M.lookup p (bits img)++put :: Ord u => Point u -> p -> Bitmap u p -> Bitmap u p+put p px = withBits (M.insert p px)++erase :: Ord u => Point u -> Bitmap u p -> Bitmap u p+erase p = withBits (M.delete p)++--mapPt :: (Point u -> p -> q) -> Bitmap u p -> Bitmap u q+mapPoints :: (Ord v) => (Point u -> Point v) -> Bitmap u p -> Bitmap v p+mapPoints f = withBits (M.mapKeys f)++{-mapPt :: (Point u -> p -> q) -> Bitmap u p -> Bitmap u q+mapPt f = withBits (M.mapWithKey f)++mapPtMaybe :: Ord u => (Point u -> p -> Maybe q) -> Bitmap u p -> Bitmap u q+mapPtMaybe f = withBits (M.mapMaybeWithKey f)-}++filterPt :: Ord u => (Point u -> p -> Bool) -> Bitmap u p -> Bitmap u p+filterPt f = withBits (M.filterWithKey f)++toList :: Bitmap u p -> [(Point u, p)]+toList = M.toAscList . bits++{-+fromList = Bitmap . M.fromList+points = M.keys . gr+filter = withBits . M.filter+filterWithKey = withBits . M.filterWithKey+member x = M.member x . gr-}++instance Functor (Bitmap u) where+  fmap = withBits . M.map++{-instance Monoid (Bitmap a) where+  mempty      = empty+  mappend x y = Bitmap $ M.union (bits x) (bits y)-}++--------[ clipping and sub-imaging ]-------------------------------------------++clip :: Ord u => Rect u -> Bitmap u p -> Bitmap u p+clip r img = filterPt (\p _ -> inRect p r) img++--------[ primitive drawing on the bits ]--------------------------------------++drawPoint :: Ord u => Point u -> p -> Bitmap u p -> Bitmap u p+drawPoint = put++drawList :: Ord u => [Point u] -> p -> Bitmap u p -> Bitmap u p+drawList l v g = foldr (flip drawPoint v) g l++drawLine :: (Fractional u, Ord u, Enum u) => Line u -> p -> Bitmap u p -> Bitmap u p+drawLine (Line (Point x0 y0) (Point x1 y1))+  | xIsY = drawPoint (Point x0 y0)+  | xOrY = drawList [Point s (y0 + (s - x0) * (y1 - y0) / (x1 - x0)) | s <- range x0 x1 ]+  | True = drawList [Point (x0 + (s - y0) * (x1 - x0) / (y1 - y0)) s | s <- range y0 y1 ]+  where+    xIsY = x0 == x1 && y0 == y1+    xOrY = abs (x1-x0) > abs (y1-y0)+    range f t = if f < t then [f .. t] else reverse [t .. f]++drawPoly :: (Fractional u, Ord u, Enum u) => Poly u -> p -> Bitmap u p -> Bitmap u p+drawPoly (Poly (a:b:xs)) v =+    drawLine (Line a b) v+  . drawPoly (Poly (b:xs)) v+drawPoly _ _ = id++drawElipse :: (Floating u, Ord u, Enum u) => Elipse u -> u -> p -> Bitmap u p -> Bitmap u p+drawElipse (Elipse (Point x y) rx ry) s = drawPoly $ Poly+  [ Point (x + rx * cos (2 * pi / s * t))+          (y + ry * sin (2 * pi / s * t))+  | t <- [0 .. s]]++drawCircle :: (Floating u, Ord u, Enum u) => Circle u -> u -> p -> Bitmap u p -> Bitmap u p+drawCircle (Circle p r) = drawElipse $ Elipse p r r++drawRect :: (Ord u, Enum u) => Rect u -> p -> Bitmap u p -> Bitmap u p+drawRect (Rect (Point x0 y0) (Point x1 y1)) = drawList+   [Point x y | x <- [x0 .. x1], y <- [y0 .. y1]]++--------[ layers and masks functions ]-----------------------------------------++{-drawLayers :: [Bitmap p] -> Bitmap p+drawLayers = Bitmap . M.unions . map bits++drawMask :: Bitmap p -> Bitmap q -> Bitmap p+drawMask g m = mapPtMaybe (\p _ -> get p g) m-}+
+ src/Geometry.hs view
@@ -0,0 +1,234 @@+module Geometry where++---------[ primitive geometries ]-----------------------------------------------++data Point u = Point  { _x :: u, _y :: u }+  deriving (Show, Eq, Ord)++data Line u = Line { _a :: Point u, _b :: Point u }+  deriving (Show, Eq, Ord)++data Tri u = Tri (Point u) (Point u) (Point u)+  deriving (Show, Eq, Ord)++data Poly u = Poly [Point u]+  deriving (Show, Eq, Ord)++data Mesh u = Mesh [Tri u]+  deriving (Show, Eq, Ord)++---------[ procedural geometrical objects ]-------------------------------------++data Rect u = Rect (Point u) (Point u)+  deriving (Show, Eq, Ord)++data Circle u = Circle (Point u) u+  deriving (Show, Eq, Ord)++data Elipse u = Elipse (Point u) u u+  deriving (Show, Eq, Ord)++---------[ primitive geometry class ]-------------------------------------------++class Geometry g where+  centroid  :: (Ord u, Floating u) => g u -> Point u+  bounds    :: (Ord u, Floating u) => g u -> Rect u+  translate :: (Ord u, Floating u) => u -> u -> g u -> g u+  rotate    :: (Ord u, Floating u) => u -> Point u -> g u -> g u+  scale     :: (Ord u, Floating u) => u -> Point u -> g u -> g u+  outline   :: g u -> Poly u+  mesh      :: g u -> Mesh u+  discrete  :: (RealFrac u, Integral i) => g u -> g i++-- Shortcut translations.++{-g +- d = translate (d, 0)  g+g +| d = translate (0, d)  g+g +\ d = translate (d, d)  g+g +/ d = translate (d, -d) g-}++-- Rotate geometry around own centroid.++rotateLocal :: (Geometry g, Ord u, Floating u) => u -> g u -> g u+rotateLocal u g = rotate u (centroid g) g++---------[ discrete 2-dimensional point type ]----------------------------------++instance Geometry Point where+  centroid  = centroidPoint+  bounds    = boundsPoint+  translate = translatePoint+  rotate    = rotatePoint+  scale     = scalePoint+  outline   = outlinePoint+  mesh      = meshPoint+  discrete  = discretePoint++centroidPoint :: Point u -> Point u+centroidPoint = id++boundsPoint :: Point u -> Rect u+boundsPoint p = Rect p p++translatePoint :: Num u => u -> u -> Point u -> Point u+translatePoint dx dy (Point x y) = Point (x + dx) (y + dy)++rotatePoint :: Floating u => u -> Point u -> Point u -> Point u+rotatePoint t (Point ox oy) (Point x y) = Point+  (ox + (x-ox) * cos t - (y-oy) * sin t)+  (oy + (x-ox) * sin t + (y-oy) * cos t)++scalePoint :: (Num u) => u -> Point u -> Point u -> Point u+scalePoint t (Point ox oy) (Point x y) = Point+  (ox + (x-ox) * t)+  (oy + (y-oy) * t)++outlinePoint :: Point u -> Poly u+outlinePoint p = Poly [p, p]++meshPoint :: Point u -> Mesh u+meshPoint p = Mesh [Tri p p p]++discretePoint :: (RealFrac u, Integral i) => Point u -> Point i+discretePoint (Point a b) = Point (round a) (round b)++--------[ discrete 2-dimensional line type ]-----------------------------------++instance Geometry Line where+  centroid  = centroidLine+  bounds    = boundsLine+  translate = translateLine+  rotate    = rotateLine+  scale     = scaleLine+  outline   = outlineLine+  mesh      = meshLine+  discrete  = discreteLine++centroidLine :: Fractional u => Line u -> Point u+centroidLine (Line (Point x0 y0) (Point x1 y1)) = Point ((x0+x1) / 2) ((y0+y1) / 2)++boundsLine :: Line u -> Rect u+boundsLine (Line a b) = Rect a b++translateLine :: (Ord u, Floating u) => u -> u -> Line u -> Line u+translateLine dx dy (Line a b) = Line (translate dx dy a) (translate dx dy b)++rotateLine :: (Ord u, Floating u) => u -> Point u -> Line u -> Line u+rotateLine d o (Line a b) = Line (rotate d o a) (rotate d o b)++scaleLine :: (Ord u, Floating u) => u -> Point u -> Line u -> Line u+scaleLine d o (Line a b) = Line (scale d o a) (scale d o b)++outlineLine :: Line u -> Poly u+outlineLine (Line a b) = Poly [a, b]++meshLine :: Line u -> Mesh u+meshLine (Line a b) = Mesh [Tri a a b]++discreteLine :: (RealFrac u, Integral i) => Line u -> Line i+discreteLine (Line a b) = Line (discrete a) (discrete b)++--------[ discrete 2-dimensional triangle type ]-------------------------------++instance Geometry Tri where+  centroid  = centroidTri+  bounds    = boundsTri+  translate = translateTri+  rotate    = rotateTri+  scale     = scaleTri+  outline   = outlineTri+  mesh      = meshTri+  discrete  = discreteTri++centroidTri :: (Ord u, Floating u) => Tri u -> Point u+centroidTri (Tri a b c) = centroid $ Line (centroid $ Line a b) c++boundsTri :: Ord u => Tri u -> Rect u+boundsTri (Tri (Point x0 y0) (Point x1 y1) (Point x2 y2)) = Rect+  (Point (min (min x0 x1) x2) (min (min y0 y1) y2))+  (Point (max (max x0 x1) x2) (max (max y0 y1) y2))++translateTri :: (Ord u, Floating u) => u -> u -> Tri u -> Tri u+translateTri dx dy (Tri a b c) = Tri (translate dx dy a) (translate dx dy b) (translate dx dy c)++rotateTri :: (Ord u, Floating u) => u -> Point u -> Tri u -> Tri u+rotateTri d o (Tri a b c) = Tri (rotate d o a) (rotate d o b) (rotate d o c)++scaleTri :: (Ord u, Floating u) => u -> Point u -> Tri u -> Tri u+scaleTri d o (Tri a b c) = Tri (scale d o a) (scale d o b) (scale d o c)++outlineTri :: Tri u -> Poly u+outlineTri (Tri a b c) = Poly [a, b, c, a]++meshTri :: Tri u -> Mesh u+meshTri t = Mesh [t]++discreteTri :: (RealFrac u, Integral i) => Tri u -> Tri i+discreteTri (Tri a b c) = Tri (discrete a) (discrete b) (discrete c)++--------[ discrete 2-dimensional polygon type ]--------------------------------++instance Geometry Poly where+  centroid  = centroidPoly+  bounds    = boundsPoly+  translate = translatePoly+  rotate    = rotatePoly+  scale     = scalePoly+  outline   = outlinePoly+  mesh      = meshPoly+  discrete  = discretePoly++centroidPoly :: Fractional u => Poly u -> Point u+centroidPoly (Poly xs) = Point (sum (map _x xs) / n) (sum (map _y xs) / n)+  where n = fromIntegral $ length xs++boundsPoly :: Ord u => Poly u -> Rect u+boundsPoly (Poly xs) = Rect+  (Point (minimum $ map _x xs) (minimum $ map _y xs))+  (Point (maximum $ map _x xs) (maximum $ map _y xs))++translatePoly :: (Ord u, Floating u) => u -> u -> Poly u -> Poly u+translatePoly dx dy (Poly xs) = Poly $ map (translate dx dy) xs++rotatePoly :: (Ord u, Floating u) => u -> Point u -> Poly u -> Poly u+rotatePoly d o (Poly xs) = Poly $ map (rotate d o) xs++scalePoly :: (Ord u, Floating u) => u -> Point u -> Poly u -> Poly u+scalePoly d o (Poly xs) = Poly $ map (scale d o) xs++outlinePoly :: Poly u -> Poly u+outlinePoly = id++meshPoly :: Poly u -> Mesh u+meshPoly = error "todo"++discretePoly :: (RealFrac u, Integral i) => Poly u -> Poly i+discretePoly (Poly xs) = Poly $ map discrete xs++--------[ discrete 2-dimensional rectangle utils ]-----------------------------++inRect :: (Ord u) => Point u -> Rect u -> Bool+inRect (Point x y) (Rect (Point x0 y0) (Point x1 y1)) =+  x >= x0 && x <= x1 && y >= y0 && y <= y1++intersectRect :: (Ord u, Num u) => Rect u -> Rect u -> Maybe (Rect u)+intersectRect (Rect (Point ax0 ay0) (Point ax1 ay1)) (Rect (Point bx0 by0) (Point bx1 by1)) =+  if ((x1-x0) <= 0 || (y1-y0) <= 0)+  then Nothing+  else Just $ Rect (Point x0 y0) (Point x1 y1)+    where+    x0 = max ax0 bx0 +    y0 = max ay0 by0 +    x1 = min ax1 bx1 +    y1 = min ay1 by1 ++star :: (Enum u, Floating u) => Point u -> u -> u -> u -> Poly u+star (Point x y) s r0 r1 = Poly $ concat+  [[  Point+        (x + r0 * cos (2 * pi / s * t))+        (y + r0 * sin (2 * pi / s * t))+    , Point+        (x + r1 * cos (2 * pi / (s*2) * (t*2+1)))+        (y + r1 * sin (2 * pi / (s*2) * (t*2+1)))+  ] | t <- [0 .. s]]+
+ src/Main.hs view
@@ -0,0 +1,60 @@+module Main where++import Data.Time.Clock (getCurrentTime, utctDayTime)+import Terminal+import Geometry+import Bitmap+import Plot++-- The viewport.++center :: Point Double+center = Point 40 40++screen :: Rect Integer+screen = Rect (Point 1 1) (Point 80 40)++view :: Rect Double+view = Rect (Point 1 1) (Point 80 80)++-- The renderer.++main :: IO ()+main = do+  tick <- getCurrentTime >>= return . fromRational . toRational . utctDayTime+  putStr $ move 1 (1::Int)+  putStr $ plot (myBmp tick)+  main++plot :: Bitmap Double Pixel -> String+plot = string False screen (Point 1 1) " " "" . list 0.5 view++-- The picture.++myBmp :: Double -> Bitmap Double Pixel+myBmp t =+    drawPoly (lambda   t) (Pixel 'x' yellow)+  $ drawPoly (darkstar t) (Pixel '@' black)+  $ empty++darkstar :: Double -> Poly Double+darkstar t = +    scale (1.2 + 0.6 * sin (t/2)) center+  $ rotate (-t*2) center+  $ star center 5 40 18++lambda :: Double -> Poly Double+lambda t =+    scale (0.7 + 0.6 * sin (t/4)) center+  $ rotate t center+  $ Poly [+    Point 25 22 , Point 24 22 , Point 25 15 , Point 27 13+  , Point 33 13 , Point 36 16 , Point 37 18 , Point 49 53+  , Point 52 57 , Point 56 57 , Point 58 55 , Point 58 53+  , Point 60 53 , Point 60 58 , Point 59 61 , Point 57 63+  , Point 55 64 , Point 52 64 , Point 50 63 , Point 48 60+  , Point 41 41 , Point 30 63 , Point 22 63 , Point 37 29+  , Point 36 25 , Point 35 22 , Point 34 20 , Point 31 18+  , Point 28 19 , Point 25 21 , Point 25 22+  ]+
+ src/Plot.hs view
@@ -0,0 +1,76 @@+module Plot where++import Data.List (sortBy)++import qualified Bitmap as Bm+import Geometry+import Terminal++data Pixel = Pixel Char String+  deriving (Show, Eq)++--------[ helper functions ]---------------------------------------------------++-- Ordering function for pixels, top-left pixels are `less than' bottom-right+-- pixels.++orderPoint :: (Ord t) => Point t -> Point t -> Ordering+orderPoint (Point x0 y0) (Point x1 y1)+  | y0 > y1   = GT+  | y0 < y1   = LT+  | x0 > x1   = GT+  | x0 < x1   = LT+  | otherwise = EQ++-- Create an ordered list of all pixels in grid.+list :: (Integral i, RealFrac u) => u -> Rect u -> Bm.Bitmap u p -> [(Point i, p)]+list m r =+    sortBy (\a b -> orderPoint (fst a) (fst b))+  . Bm.toList+  . Bm.mapPoints discrete+  . Bm.mapPoints (\(Point x y) -> Point x (y * m))+  . Bm.clip r++string :: Integral i => Bool -> Rect i -> Point i -> String -> String -> [(Point i, Pixel)] -> String+string o rect@(Rect (Point x0 _) (Point x1 y1)) (Point x' y') nop prev p+  | ((x' > x1 && y' == y1) || (y' > y1)) = color reset+  | not (null p) && x  == x' && y  == y' = color b ++ [a] ++ lf ++ string o rect nextPos nop b xs+  | otherwise                            = color reset ++ nop ++ lf ++ string o rect nextPos nop reset p+  where+    (((Point x y), Pixel a b):xs) = p+    color c = if c == prev then "" else c+    lf   = if x' >= x1 && y' < y1 then (if o then "\n" else moveBack (x1 - x0 + 1) ++ moveDown (1::Int)) else ""+    nextPos = if x' >= x1 then Point x0 (y' + 1) else Point (x' + 1) y'++--------[ plotter functions ]--------------------------------------------------++{-plotPixel :: Plottable a => Point -> a -> IO ()+plotPixel (x, y) px = do+  putStr $ move x y+  putStr $ color clr+  putStr $ [chr]+  where Pixel chr clr = plot px-}++{-plotGrid :: Rect -> Bm.Bitmap Pixel -> String+plotGrid rect@(o, _) = string rect o "" . list rect-}++{-+plotGrids :: Area -> [G.Grid Pixel] -> String+plotGrids a ps = plotGrid a $ G.drawLayers ps++textToGrid :: Point -> String -> String -> G.Grid Pixel+textToGrid (xx, yy) t clr =+    G.fromList+  $ concat+  $ map f+  $ zip [yy..]+  $ lines t+  where+    f (y, s) = zipWith (\x c -> ((x, y), Pixel c clr)) [xx..] s++putGrid a g = do+  putStr $ plotGrid a g++putGrids a gs = do+  putStr $ plotGrids a gs-}+
+ src/Terminal.hs view
@@ -0,0 +1,150 @@+module Terminal where++import Control.Applicative+import Data.List (intercalate)+import System.Environment (getEnvironment)++-- Generic function for producing ANSI escape sequences.++esc :: String -> [String] -> String -> String+esc a args b = concat ["\ESC[", a, intercalate ";" $ args, b]++-- Clear screen and end-of-line++clearAll, clearEol, clear :: String+clearAll = esc "2J" [] ""+clearEol = esc "K"  [] "" +clear    = clearAll ++ move (1::Int) 1++-- Move the cursor to the specified row and column.++move :: Integral i => i -> i -> String+move row col = esc "" [show col, show row] "H"++-- Relative cursor movements.++moveUp, moveDown, moveBack, moveForward :: Integral i => i -> String+moveUp      rs = esc "" [show rs] "A"+moveDown    rs = esc "" [show rs] "B"+moveBack    cs = esc "" [show cs] "D"+moveForward cs = esc "" [show cs] "C"++-- Load and store the current cursor position.++save, load :: String+save = esc "s" [] ""+load = esc "u" [] ""++-- Generic function for creating (foreground) color sequences.++clr :: [String] -> String+clr codes = esc "" codes "m"++-- Create foreground and background colors.++fg, bg :: Color -> [String]+fg c = [show (num c + 30::Int)]+bg c = [show (num c + 40::Int)]++-- Style modifiers.++normal, bold, faint, standout, underline, blink, reverse, invisible :: [String] -> [String]+normal    = ("0":)+bold      = ("1":)+faint     = ("2":)+standout  = ("3":)+underline = ("4":)+blink     = ("5":)+reverse   = ("7":)+invisible = ("8":)++--------[ ansi color listing ]-------------------------------------------------++data Color =+    Black+  | Red+  | Green+  | Yellow+  | Blue+  | Magenta+  | Cyan+  | White+  | Reset+  deriving (Show, Eq)++-- Ansi codes offsets for color values.+num :: Integral i => Color -> i+num Black   = 0+num Red     = 1+num Green   = 2+num Yellow  = 3+num Blue    = 4+num Magenta = 5+num Cyan    = 6+num White   = 7+num Reset   = 9++-- Reset all color and style information.++reset :: String+reset = esc "" ["0", "39", "49"] "m"++-- Shortcut for setting foreground colors.++black, red, green, yellow, blue, magenta, cyan, white :: String+black   = clr $ fg Black+red     = clr $ fg Red+green   = clr $ fg Green+yellow  = clr $ fg Yellow+blue    = clr $ fg Blue+magenta = clr $ fg Magenta+cyan    = clr $ fg Cyan+white   = clr $ fg White++-- Shortcut for setting bold foreground colors.++blackBold, redBold, greenBold, yellowBold, blueBold, magentaBold, cyanBold, whiteBold :: String +blackBold   = clr $ bold $ fg Black+redBold     = clr $ bold $ fg Red+greenBold   = clr $ bold $ fg Green+yellowBold  = clr $ bold $ fg Yellow+blueBold    = clr $ bold $ fg Blue+magentaBold = clr $ bold $ fg Magenta+cyanBold    = clr $ bold $ fg Cyan+whiteBold   = clr $ bold $ fg White++-- Shortcut for setting background colors.++blackBg, redBg, greenBg, yellowBg, blueBg, magentaBg, cyanBg, whiteBg, resetBg :: String+blackBg   = clr $ bg Black+redBg     = clr $ bg Red+greenBg   = clr $ bg Green+yellowBg  = clr $ bg Yellow+blueBg    = clr $ bg Blue+magentaBg = clr $ bg Magenta+cyanBg    = clr $ bg Cyan+whiteBg   = clr $ bg White+resetBg   = clr $ bg Reset++{-++big s =+     "\ESC#3" ++ s+  ++ move_back (length s)+  ++ move_down 1+  ++ "\ESC#4" ++ s+  ++ "\ESC#1" ++ "\n"+-}++-- Try to read terminal width from environment variable.+width :: (Read i, Integral i) => IO i+width = (maybe 80 read . lookup "COLUMNS") <$> getEnvironment++-- Try to read terminal height from environment variable.+height :: (Read i, Integral i) => IO i+height = (maybe 24 read . lookup "LINES") <$> getEnvironment++-- Try to read terminal width and height from environment variables.+geometry :: (Read i, Integral i) => IO (i, i)+geometry = (,) <$> width <*> height+