module System.Drawille ( Canvas
, empty
, frame
, get
, set
, unset
, toggle
, fromList
, toPs
, toPx
, pxMap
, pxOff
) where
import qualified Data.Map as M (Map, empty, lookup, insertWith, keys)
import Data.Bits ((.|.), (.&.), complement, xor)
import Data.Char (chr)
type Canvas = M.Map (Int, Int) Int
empty :: Canvas
empty :: Canvas
empty = forall k a. Map k a
M.empty
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
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
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
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
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
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
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
' '
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]
]
pxOff :: Num a => a
pxOff :: forall a. Num a => a
pxOff = a
0x2800
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
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)
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)