module Fractal.RUFF.Mandelbrot.Image
( simpleImage, complexImage, imageLoop, coordinates, ascii, unicode
, Channel(..), Coordinates, border
) where
import Control.Monad.ST (ST)
import Data.Array.ST (newArray, writeArray, runSTUArray)
import Data.STRef (STRef, newSTRef, readSTRef, writeSTRef)
import Data.Array.Unboxed (UArray, (!), bounds, range, amap, ixmap)
import Data.Ix (Ix)
import Data.Data (Data)
import Data.Typeable (Typeable)
import Fractal.RUFF.Types.Complex (Complex((:+)), magnitude)
import Fractal.RUFF.Types.Tuple (Tuple2(Tuple2))
import Fractal.RUFF.Mandelbrot.Iterate (iterates, initial, Mode(Simple, DistanceEstimate), Iterate(), Output(OutSimple, OutDistanceEstimate), escapeTime, distanceEstimate, finalAngle, outUser)
simpleImage :: (Ord r, Floating r) => Coordinates r -> Int -> UArray (Int, Int) Bool
simpleImage (bs, cs) n0 = runSTUArray $ do
a <- newArray bs True
s <- newSTRef (0 :: Int)
imageLoop s a n0 0 False 64 i0s (out s a)
where
i0s = map (uncurry $ initial Simple) cs
out s a (OutSimple{ outUser = Tuple2 j i }) = do
writeArray a (j, i) False
modifySTRef' s (+ 1)
out _ _ _ = return ()
complexImage :: (Ord r, Real r, Floating r) => Coordinates r -> Int -> UArray (Int, Int, Channel) Float
complexImage (((jlo,ilo),(jhi,ihi)), cs) !n0 = runSTUArray $ do
a <- newArray bs (1)
s <- newSTRef (0 :: Int)
imageLoop s a n0 0 False 64 i0s (out s a)
where
bs = ((jlo,ilo,minBound), (jhi,ihi,maxBound))
(_, cx0):(_, cx1):_ = cs
pixelSpacing = magnitude (cx1 cx0)
i0s = map (uncurry $ initial DistanceEstimate) cs
out !s !a (OutDistanceEstimate{ escapeTime = et, distanceEstimate = de, finalAngle = fa, outUser = Tuple2 j i }) = do
writeArray a (j, i, EscapeTime) (realToFrac et)
writeArray a (j, i, DistanceEstimate') (realToFrac (de / pixelSpacing))
writeArray a (j, i, FinalAngle) (realToFrac fa)
modifySTRef' s (+ 1)
out _ _ _ = return ()
data Channel = EscapeTime | DistanceEstimate' | FinalAngle
deriving (Eq, Ord, Enum, Bounded, Ix, Read, Show, Data, Typeable)
imageLoop :: (Ord r, Floating r) => STRef s Int -> a -> Int -> Int -> Bool -> Int -> [Iterate u r] -> (Output u r -> ST s ()) -> ST s a
imageLoop s a !n0 !n1 !f1 !m1 is1 out = loop f1 n1 m1 is1
where
loop !f !n !m is = do
writeSTRef s 0
is' <- iterates m is out
o <- readSTRef s
if null is || (f && o == 0) || n > n0 then return a else loop (f || o > 0) (n + m) (m * 2) is'
type Coordinates r = (((Int,Int),(Int,Int)), [(Tuple2 Int Int, Complex r)])
coordinates :: (Ord r, Floating r) => Int -> Int -> Complex r -> r -> Coordinates r
coordinates !width !height !(c0r :+ c0i) !r0 = (bs, cs)
where
bs = ((0, 0), (height 1, width 1))
cs = [ (Tuple2 j i, c)
| (j,i) <- range bs
, let y = (fromIntegral j h) / h
, let x = (fromIntegral i w) / h
, let ci = c0i + r0 * y
, let cr = c0r + r0 * x
, let c = cr :+ ci
]
w = fromIntegral $ width `div` 2
h = fromIntegral $ height `div` 2
border :: UArray (Int, Int, Channel) Float -> UArray (Int, Int) Bool
border a = amap (\x -> x > 0 && x < 1) . ixmap bs (\(j, i) -> (j, i, DistanceEstimate')) $ a
where
((jlo, ilo, _), (jhi, ihi, _)) = bounds a
bs = ((jlo, ilo), (jhi, ihi))
ascii :: UArray (Int, Int) Bool -> String
ascii a = unlines . map concat $ [ [ b (a ! (j, i)) | i <- [ ilo .. ihi ] ] | j <- [ jhi, jhi 1 .. jlo ] ]
where
((jlo, ilo), (jhi, ihi)) = bounds a
b False = " "
b True = "##"
unicode :: UArray (Int, Int) Bool -> String
unicode a = unlines [ [ b (a ! (j, i)) (a ! (j 1, i)) | i <- [ ilo .. ihi ] ] | j <- [ jhi, jhi 2 .. jlo ] ]
where
((jlo, ilo), (jhi, ihi)) = bounds a
b False False = ' '
b True False = '\x2580'
b False True = '\x2584'
b True True = '\x2588'
modifySTRef' :: STRef s a -> (a -> a) -> ST s ()
modifySTRef' s f = do
x <- readSTRef s
writeSTRef s $! f x