-- |
-- Module      :  System.Drawille
-- Description :  A port of asciimoo's drawille to haskell.
-- Copyright   :  (c) Pedro Yamada
-- License     :  GPL-3
--
-- Maintainer  :  Pedro Yamada <tacla.yamada@gmail.com>
-- Stability   :  stable
-- Portability :  non-portable (not tested on multiple environments)
--
-- This module enables using UTF-8 braille characters to render drawings onto
-- the console.
module System.Drawille ( Canvas
                       , empty -- drawing API
                       , frame
                       , get
                       , set
                       , unset
                       , toggle
                       , fromList

                       , toPs -- utility functions
                       , toPx
                       , pxMap
                       , pxOff
                       ) where

import qualified Data.Map as M (Map, empty, lookup, insertWith, keys)
import Data.Bits ((.|.), (.&.), complement, xor)
import Data.Char (chr)

-- |
-- The Canvas type. Represents a canvas, mapping points to their braille
-- "px" codes.
type Canvas = M.Map (Int, Int) Int

-- |
-- The empty canvas, to be drawn upon.
empty :: Canvas
empty :: Canvas
empty = forall k a. Map k a
M.empty

-- |
-- Pretty prints a canvas as a `String`, ready to be printed.
frame :: Canvas -> String
frame :: Canvas -> String
frame Canvas
c = [String] -> String
unlines forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Canvas -> (Int, Int) -> Int -> String
row Canvas
c (Int, Int)
mX) [Int
minY..Int
maxY]
    where keys :: [(Int, Int)]
keys = forall k a. Map k a -> [k]
M.keys Canvas
c
          mX :: (Int, Int)
mX = forall a. Ord a => [a] -> (a, a)
maximumMinimum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Int, Int)]
keys
          (Int
maxY, Int
minY) = forall a. Ord a => [a] -> (a, a)
maximumMinimum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(Int, Int)]
keys

-- |
-- Gets the current state for a coordinate in a canvas.
get :: Canvas -> (Int, Int) -> Bool
get :: Canvas -> (Int, Int) -> Bool
get Canvas
c (Int, Int)
p = case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ((Int, Int) -> (Int, Int)
toPs (Int, Int)
p) Canvas
c of
            Just Int
x  -> let px :: Int
px = (Int, Int) -> Int
toPx (Int, Int)
p in Int
x forall a. Bits a => a -> a -> a
.&. Int
px forall a. Eq a => a -> a -> Bool
== Int
px
            Maybe Int
Nothing -> Bool
False

-- |
-- Sets a coordinate in a canvas.
set :: Canvas -> (Int, Int) -> Canvas
set :: Canvas -> (Int, Int) -> Canvas
set Canvas
c (Int, Int)
p = forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith forall a. Bits a => a -> a -> a
(.|.) ((Int, Int) -> (Int, Int)
toPs (Int, Int)
p) ((Int, Int) -> Int
toPx (Int, Int)
p) Canvas
c

-- |
-- Unsets a coordinate in a canvas.
unset :: Canvas -> (Int, Int) -> Canvas
unset :: Canvas -> (Int, Int) -> Canvas
unset Canvas
c (Int, Int)
p = forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith forall a. Bits a => a -> a -> a
(.&.) ((Int, Int) -> (Int, Int)
toPs (Int, Int)
p) ((forall a. Bits a => a -> a
complement forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> Int
toPx) (Int, Int)
p) Canvas
c

-- |
-- Toggles the state of a coordinate in a canvas
toggle :: Canvas -> (Int, Int) -> Canvas
toggle :: Canvas -> (Int, Int) -> Canvas
toggle Canvas
c (Int, Int)
p = forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith forall a. Bits a => a -> a -> a
xor ((Int, Int) -> (Int, Int)
toPs (Int, Int)
p) ((Int, Int) -> Int
toPx (Int, Int)
p) Canvas
c

-- |
-- Creates a canvas from a List of coordinates
fromList :: [(Int, Int)] -> Canvas
fromList :: [(Int, Int)] -> Canvas
fromList = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a b c. (a -> b -> c) -> b -> a -> c
flip Canvas -> (Int, Int) -> Canvas
set) Canvas
empty

-- |
-- Pretty prints a single canvas' row into a `String`.
row :: Canvas -> (Int, Int) -> Int -> String
row :: Canvas -> (Int, Int) -> Int -> String
row Canvas
c (Int
maxX, Int
minX) Int
y = forall a b. (a -> b) -> [a] -> [b]
map Maybe Int -> Char
helper [Maybe Int]
vs
    where vs :: [Maybe Int]
vs = forall a b. (a -> b) -> [a] -> [b]
map (\Int
x -> forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Int
x, Int
y) Canvas
c) [Int
minX..Int
maxX]
          helper :: Maybe Int -> Char
helper (Just Int
v) = Int -> Char
chr forall a b. (a -> b) -> a -> b
$ Int
v forall a. Num a => a -> a -> a
+ forall a. Num a => a
pxOff
          helper Maybe Int
Nothing  = Char
' '

-- |
-- A mapping between local coordinates, inside of a single cell, and each
-- of the braille characters they correspond to (with an offset).
pxMap :: Num a => [[a]]
pxMap :: forall a. Num a => [[a]]
pxMap = [ [a
0x01, a
0x08]
        , [a
0x02, a
0x10]
        , [a
0x04, a
0x20]
        , [a
0x40, a
0x80]
        ]

-- |
-- The offset between the values in the `pxMap`, which have nice binary
-- properties between each other, and the actual braille character codes.
pxOff :: Num a => a
pxOff :: forall a. Num a => a
pxOff = a
0x2800

-- |
-- Converts a coordinate into its local braille "px" code, using the
-- `pxMap`.
toPx :: (Int, Int) -> Int
toPx :: (Int, Int) -> Int
toPx (Int
px, Int
py) = forall a. Num a => [[a]]
pxMap forall a. [a] -> Int -> a
!! forall a. Integral a => a -> a -> a
mod Int
py Int
4 forall a. [a] -> Int -> a
!! forall a. Integral a => a -> a -> a
mod Int
px Int
2

-- |
-- Helper to convert a coordinate to its corespondent in the bigger braille
-- grid's size
toPs :: (Int, Int) -> (Int, Int)
toPs :: (Int, Int) -> (Int, Int)
toPs (Int
x, Int
y) = (Int
x forall a. Integral a => a -> a -> a
`div` Int
2, Int
y forall a. Integral a => a -> a -> a
`div` Int
4)

-- |
-- Gets the maximum and minimum values of a list and return them in
-- a tuple of `(maximumValue, minimumValue)`.
maximumMinimum :: Ord a => [a] -> (a, a)
maximumMinimum :: forall a. Ord a => [a] -> (a, a)
maximumMinimum [] = forall a. HasCallStack => String -> a
error String
"Empty list"
maximumMinimum (a
x:[a]
xs) = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {b}. Ord b => b -> (b, b) -> (b, b)
maxMin (a
x, a
x) [a]
xs
  where maxMin :: b -> (b, b) -> (b, b)
maxMin b
y (b
b, b
s) = (forall a. Ord a => a -> a -> a
max b
y b
b, forall a. Ord a => a -> a -> a
min b
y b
s)