haha-0.1: src/Plot.hs

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-}