Console Fractals

Dots.hs

-- Defines a data structure for plotting data in a text console using braille

module Dots where

import Control.Monad.State (State, modify, execState)
import Data.Ix (range)
import qualified Data.Set as S

data Dots = Dots (Int, Int) (S.Set (Int, Int))

-- Ordered list of the 8 bits.
bits :: [(Int, Int)]
bits = [(0, 0), (1, 0), (2, 0), (0, 1), (1, 1), (2, 1), (3, 0), (3, 1)]

instance Show Dots where
  show (Dots (rows, cols) points) = show' 0 0
    where show' row col
            | row > rows = ""
            | col > cols = '\n' : show' (row + 4) 0
            | otherwise = char row col : show' row (col + 2)
          char r c = toEnum $ (0x2800+) $ codepoint bits 1 r c
          codepoint [] _ _ _ = 0
          codepoint ((dr, dc) : bs) n r c = inc + codepoint bs (2 * n) r c
            where inc | (r + dr, c + dc) `S.member` points = n
                      | otherwise = 0

alloc :: Int -> Int -> Dots
alloc rows cols = Dots (rows, cols) S.empty

empty :: Dots
empty = alloc 0 0

add :: Int -> Int -> Dots -> Dots
add r c (Dots (rs, cs) s) = Dots (max r rs, max c cs) $ (r, c) `S.insert` s

graph :: Bool -> (Int -> Int -> Bool) -> (Int, Int) -> IO ()
graph label func (mx, my) = putStrLn $ box $
                            foldl maybeAdd (alloc my mx) $
                            range ((0, 0), (my - 1, mx - 1))
  where maybeAdd d (y, x) = if func x (fromIntegral (my - 1) - y)
                            then add (y + (4 - my) `mod` 4) x d
                            else d
        box :: Dots -> String
        box d = box' $ lines $ show d
        box' [] = "++\n++\n"
        box' ls = tl : header ++ tr : '\n' :
                  concat (map (\l -> '|' : l ++ "|\n") ls) ++
                  bl : header ++ br : ""
          where header = replicate (length $ head ls) '-'
        tl = if label then 'y' else '+'
        tr = '+'
        bl = if label then '0' else '+'
        br = if label then 'x' else '+'

Fractal.hs

module Fractal where

import Data.Complex (Complex(..), magnitude)
import Dots (graph)

type C = Complex Double

data Fractal = Fractal C C (C -> Bool)

fractal :: (Double, Double) -> (Double, Double) -> (C -> Bool) -> Fractal
fractal min max f = Fractal (complex min) (complex max) f
  where complex = uncurry (:+)

plot :: Fractal -> Int -> IO ()
plot (Fractal min max f) n = graph False pred (n, n)
  where pred x y = f $ min + (fromIntegral x * dx :+ fromIntegral y * dy)
        dx :+ dy = (max - min) / (fromIntegral n - 1)

converges :: (C -> C) -> C -> Int -> Bool
converges _ z _ | magnitude z > 2 = False
converges _ _ 0 = True
converges f z n = converges f (f z) (n - 1)

sq :: Num a => a -> a -> a
sq c z = z * z + c

mandelbrot :: Fractal
mandelbrot = fractal (-2.25, -1.5) (0.75, 1.5) $ \z -> converges (sq z) 0 20

julia :: C -> Fractal
julia c = fractal (-1.5, -1.5) (1.5, 1.5) $ \z -> converges (sq c) z 20

Main.hs

module Main where

import Data.Complex (Complex(..))
import Fractal (plot, mandelbrot, julia)

main :: IO ()
main = do plot mandelbrot 151
          plot (julia $ 0.14 :+ 0.66) 151