haha 0.1 → 0.2

raw patch · 10 files changed

+577/−577 lines, 10 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• haha.cabal +6/−6
• src/Bitmap.hs +0/−107
• src/Geometry.hs +0/−234
• src/Graphics/Ascii/Haha/Bitmap.hs +107/−0
• src/Graphics/Ascii/Haha/Geometry.hs +234/−0
• src/Graphics/Ascii/Haha/Plot.hs +76/−0
• src/Graphics/Ascii/Haha/Terminal.hs +150/−0
• src/Main.hs +4/−4
• src/Plot.hs +0/−76
• src/Terminal.hs +0/−150

@@ -1,8 +1,8 @@ Name:             haha-Version:          0.1+Version:          0.2 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+Category:         Graphics License:          BSD3 License-file:     LICENSE Author:           Sebastiaan Visser@@ -14,10 +14,10 @@ Extensions:       CPP HS-Source-Dirs:   src Other-modules:    -Exposed-modules:  Bitmap,-                  Geometry,-                  Plot,-                  Terminal+Exposed-modules:  Graphics.Ascii.Haha.Bitmap,+                  Graphics.Ascii.Haha.Geometry,+                  Graphics.Ascii.Haha.Plot,+                  Graphics.Ascii.Haha.Terminal  GHC-Options:      -Wall Executable:       rotating-lambda

@@ -1,107 +0,0 @@-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-}-

@@ -1,234 +0,0 @@-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]]-

@@ -0,0 +1,107 @@+module Graphics.Ascii.Haha.Bitmap where++import qualified Data.Map as M+import Prelude hiding (filter)++import Graphics.Ascii.Haha.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-}+

@@ -0,0 +1,234 @@+module Graphics.Ascii.Haha.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]]+

@@ -0,0 +1,76 @@+module Graphics.Ascii.Haha.Plot where++import Data.List (sortBy)++import qualified Graphics.Ascii.Haha.Bitmap as Bm+import Graphics.Ascii.Haha.Geometry+import Graphics.Ascii.Haha.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-}+

@@ -0,0 +1,150 @@+module Graphics.Ascii.Haha.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+

@@ -1,10 +1,10 @@ module Main where  import Data.Time.Clock (getCurrentTime, utctDayTime)-import Terminal-import Geometry-import Bitmap-import Plot+import Graphics.Ascii.Haha.Terminal+import Graphics.Ascii.Haha.Geometry+import Graphics.Ascii.Haha.Bitmap+import Graphics.Ascii.Haha.Plot  -- The viewport. 

@@ -1,76 +0,0 @@-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-}-

@@ -1,150 +0,0 @@-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-