diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -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.
+
diff --git a/Setup.lhs b/Setup.lhs
new file mode 100644
--- /dev/null
+++ b/Setup.lhs
@@ -0,0 +1,6 @@
+#! /usr/bin/env runhaskell
+
+>import Distribution.Simple
+
+>main = defaultMain
+
diff --git a/haha.cabal b/haha.cabal
new file mode 100644
--- /dev/null
+++ b/haha.cabal
@@ -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
+
diff --git a/src/Bitmap.hs b/src/Bitmap.hs
new file mode 100644
--- /dev/null
+++ b/src/Bitmap.hs
@@ -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-}
+
diff --git a/src/Geometry.hs b/src/Geometry.hs
new file mode 100644
--- /dev/null
+++ b/src/Geometry.hs
@@ -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]]
+
diff --git a/src/Main.hs b/src/Main.hs
new file mode 100644
--- /dev/null
+++ b/src/Main.hs
@@ -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
+  ]
+
diff --git a/src/Plot.hs b/src/Plot.hs
new file mode 100644
--- /dev/null
+++ b/src/Plot.hs
@@ -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-}
+
diff --git a/src/Terminal.hs b/src/Terminal.hs
new file mode 100644
--- /dev/null
+++ b/src/Terminal.hs
@@ -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
+