factor out some Coordinates and Channels; border function to convert distance estimat...
[ruff:ruff.git] / Fractal / RUFF / Mandelbrot / Image.hs
1 {-# LANGUAGE BangPatterns, DeriveDataTypeable #-}
2 {- |
3 Module      :  Fractal.RUFF.Mandelbrot.Image
4 Copyright   :  (c) Claude Heiland-Allen 2011
5 License     :  BSD3
6
7 Maintainer  :  claudiusmaximus@goto10.org
8 Stability   :  unstable
9 Portability :  portable
10
11 Generic (slow) functions to render images.
12
13 -}
14
15 module Fractal.RUFF.Mandelbrot.Image
16   ( simpleImage, complexImage, imageLoop, coordinates, ascii, unicode
17   , Channel(..), Coordinates, border
18   ) where
19
20 import Control.Monad.ST (ST)
21 import Data.Array.ST (newArray, writeArray, runSTUArray)
22 import Data.STRef (STRef, newSTRef, readSTRef, writeSTRef)
23 import Data.Array.Unboxed (UArray, (!), bounds, range, amap, ixmap)
24
25 import Data.Ix (Ix)
26 import Data.Data (Data)
27 import Data.Typeable (Typeable)
28
29 import Fractal.RUFF.Types.Complex (Complex((:+)), magnitude)
30 import Fractal.RUFF.Types.Tuple (Tuple2(Tuple2))
31 import Fractal.RUFF.Mandelbrot.Iterate (iterates, initial, Mode(Simple, DistanceEstimate), Iterate(), Output(OutSimple, OutDistanceEstimate), escapeTime, distanceEstimate, finalAngle, outUser)
32
33 -- | Render an image with the 'Simple' algorithm.  The iteration count is
34 --   doubled until the image is good enough, or the fixed maximum iteration
35 --   count is reached.
36 --
37 -- > putStr . unicode $ simpleImage (coordinates 100 100 ((-1.861):+0) (0.001)) 1000000000
38 simpleImage :: (Ord r, Floating r) => Coordinates r {- ^ coordinates -} -> Int {- ^ max iterations -} -> UArray (Int, Int) Bool {- ^ image -}
39 {-# INLINABLE simpleImage #-}
40 simpleImage (bs, cs) n0 = runSTUArray $ do
41     a <- newArray bs True
42     s <- newSTRef (0 :: Int)
43     imageLoop s a n0 0 False 64 i0s (out s a)
44   where
45     i0s = map (uncurry $ initial Simple) cs
46     out s a (OutSimple{ outUser = Tuple2 j i }) = do
47       writeArray a (j, i) False
48       modifySTRef' s (+ 1)
49     out _ _ _ = return ()
50  
51 -- | Render an image with the 'DistanceEstimate' algorithm.  The iteration count is
52 --   doubled until the image is good enough, or the fixed maximum iteration
53 --   count is reached.  The output values are converted to 'Float'.
54 complexImage :: (Ord r, Real r, Floating r) => Coordinates r {-^ coordinates -} -> Int {- ^ max iterations -} -> UArray (Int, Int, Channel) Float {- ^ image -}
55 {-# INLINABLE complexImage #-}
56 complexImage (((jlo,ilo),(jhi,ihi)), cs) !n0 = runSTUArray $ do
57     a <- newArray bs (-1)
58     s <- newSTRef (0 :: Int)
59     imageLoop s a n0 0 False 64 i0s (out s a)
60   where
61     bs = ((jlo,ilo,minBound), (jhi,ihi,maxBound))
62     (_, cx0):(_, cx1):_ = cs
63     pixelSpacing = magnitude (cx1 - cx0)
64     i0s = map (uncurry $ initial DistanceEstimate) cs
65     out !s !a (OutDistanceEstimate{ escapeTime = et, distanceEstimate = de, finalAngle = fa, outUser = Tuple2 j i }) = {-# SCC "complexImage.out" #-} do
66       writeArray a (j, i, EscapeTime) (realToFrac et)
67       writeArray a (j, i, DistanceEstimate') (realToFrac (de / pixelSpacing))
68       writeArray a (j, i, FinalAngle) (realToFrac fa)
69       modifySTRef' s (+ 1)
70     out _ _ _ = return ()
71
72 -- | Channels in an image.
73 data Channel = EscapeTime {- ^ continuous dwell -} | DistanceEstimate' {- ^ normalized to pixel spacing -} | FinalAngle {- ^ in [-pi,pi] -}
74   deriving (Eq, Ord, Enum, Bounded, Ix, Read, Show, Data, Typeable)
75
76 -- | Image rendering loop.
77 imageLoop :: (Ord r, Floating r) => STRef s Int {- ^ escapees -} -> a {- ^ output array -} -> Int {- ^ max iterations -} -> Int {- ^ iterations -} -> Bool {- ^ prior escapees -} -> Int {- ^ iterations this phase -} -> [Iterate u r] {- ^ iterates -} -> (Output u r -> ST s ()) {- ^ output callback -} -> ST s a {- ^ output array as given -}
78 {-# INLINABLE imageLoop #-}
79 imageLoop s a !n0 !n1 !f1 !m1 is1 out = loop f1 n1 m1 is1
80   where
81     loop !f !n !m is = do
82       writeSTRef s 0
83       is' <- iterates m is out
84       o <- readSTRef s
85       if null is || (f && o == 0) || n > n0 then return a else loop (f || o > 0) (n + m) (m * 2) is'
86
87 -- | Image bounds and coordinates.
88 type Coordinates r = (((Int,Int),(Int,Int)), [(Tuple2 Int Int, Complex r)])
89
90 -- | The parameter plane coordinates for an image, with bounds.
91 coordinates :: (Ord r, Floating r) => Int {- ^ width -} -> Int {- ^ height -} -> Complex r {- ^ center -} -> r {- ^ size -} -> Coordinates r
92 {-# INLINABLE coordinates #-}
93 coordinates !width !height !(c0r :+ c0i) !r0 = (bs, cs)
94   where
95     bs = ((0, 0), (height - 1, width - 1))
96     cs =  [ (Tuple2 j i, c)
97           | (j,i) <- range bs
98           , let y = (fromIntegral j - h) / h
99           , let x = (fromIntegral i - w) / h
100           , let ci = c0i + r0 * y
101           , let cr = c0r + r0 * x
102           , let c = cr :+ ci
103           ]
104     w = fromIntegral $ width  `div` 2
105     h = fromIntegral $ height `div` 2
106
107 -- | Convert a distance estimate image to a near-boundary bit array.
108 --   The input image must have a DistanceEstimate' channel.
109 border :: UArray (Int, Int, Channel) Float {- ^ image -} -> UArray (Int, Int) Bool
110 border a = amap (\x -> x > 0 && x < 1) . ixmap bs (\(j, i) -> (j, i, DistanceEstimate')) $ a
111   where
112     ((jlo, ilo, _), (jhi, ihi, _)) = bounds a
113     bs = ((jlo, ilo), (jhi, ihi))
114
115 -- | Convert a bit array to ascii graphics.
116 ascii :: UArray (Int, Int) Bool {- ^ image -} -> String {- ^ ascii -}
117 ascii a = unlines . map concat $ [ [ b (a ! (j, i)) | i <- [ ilo .. ihi ] ] | j <- [ jhi, jhi - 1 .. jlo ] ]
118   where
119     ((jlo, ilo), (jhi, ihi)) = bounds a
120     b False = "  "
121     b True  = "##"
122
123 -- | Convert a bit array to unicode block graphics.
124 unicode :: UArray (Int, Int) Bool {- ^ image -} -> String {- ^ unicode -}
125 unicode a = unlines [ [ b (a ! (j, i)) (a ! (j - 1, i)) | i <- [ ilo .. ihi ] ] | j <- [ jhi, jhi - 2 .. jlo ] ]
126   where
127     ((jlo, ilo), (jhi, ihi)) = bounds a
128     b False False = ' '
129     b True False = '\x2580'
130     b False True = '\x2584'
131     b True True = '\x2588'
132
133 -- | Strict version of 'modifySTRef'.
134 modifySTRef' :: STRef s a -> (a -> a) -> ST s ()
135 {-# INLINABLE modifySTRef' #-}
136 modifySTRef' s f = do
137   x <- readSTRef s
138   writeSTRef s $! f x