Name: Anonymous 2016-08-11 23:22
It can be simple, like just a single pixel or a line or a shape.
import Data.ByteString (ByteString, pack, writeFile)
import Data.Word
import Data.Array
import Data.List
type Bit = Bool
type Coordinate = (Int, Int)
type Bitmap = Array Coordinate Bit
empty w h = array ((0, 0), (w - 1, h - 1)) [ ((x, y), False) | x <- [0..w - 1], y <- [0..h - 1] ]
circle x y r = empty (x * 2) (y * 2) // step (r - 1) 0 where
step x y | x <= y = draw (x, y)
step x y = draw (x, y) ++ step (if x^2 + y^2 <= r^2 then x else x - 1) (y + 1)
draw (x', y') = flip zip (repeat True)
(map (\(x', y') -> (x + x', y + y'))
[( x', y'),
(-x', y'),
( x', -y'),
(-x', -y'),
( y', x'),
(-y', x'),
( y', -x'),
(-y', -x')])
base 0 = [False]
base 1 = [True]
base x = if odd x then True:(base ((x - 1) / 2)) else False:(base (x / 2))
where x / y = x `div` y
unbase :: [Bit] -> Word8
unbase xs = unbase' xs 0 where
unbase' [] _ = 0
unbase' (x:xs) n = (if x then 1 else 0) * (2^n) + (unbase' xs (n + 1))
extend xs n x = if length xs < n then xs ++ (take (n - length xs) (repeat x))
else xs
encode :: Int -> [Word8]
encode n = (reverse . map unbase) [a, b, c, d] where
bs = (extend (base n) 32 False)
(a, bs') = splitAt 8 bs
(b, bs'') = splitAt 8 bs'
(c, d) = splitAt 8 bs''
emit :: Bitmap -> ByteString
emit b = (pack . concat) [farbfeld,
(encode . (+ 1) . fst . snd . bounds) b,
(encode . (+ 1) . snd . snd . bounds) b,
payload] where
payload = concatMap (\b -> if b then black else white) ((map snd . sort . assocs) b)
black = [0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xFF, 0xFF]
white = [0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF]
sort = sortBy $ \((a, b), _) ((d, e), _) -> if b == e then compare a d else compare b e
farbfeld = [0x66, 0x61, 0x72, 0x62, 0x66, 0x65, 0x6C, 0x64]
main = writeFile "circle.ff" (emit (circle 1000 1000 500))