hfractal 0.3.1 → 0.3.2.1
raw patch · 6 files changed
+78/−22 lines, 6 filesdep +OpenGLRawdep +colourdep +containersdep ~GLUTdep ~OpenGL
Dependencies added: OpenGLRaw, colour, containers
Dependency ranges changed: GLUT, OpenGL
Files
- Bindings.hs +1/−0
- FracColour.hs +51/−0
- FracComp.hs +11/−9
- FracImg.hs +2/−1
- Hfractal.hs +9/−8
- hfractal.cabal +4/−4
Bindings.hs view
@@ -5,6 +5,7 @@ import Data.IORef import System.Exit import Data.Accessor+import Data.Accessor.Basic (T) import Control.Concurrent import FracState
+ FracColour.hs view
@@ -0,0 +1,51 @@+module FracColour + where++import Graphics.UI.GLUT hiding (blend)--(Color3, GLdouble)+import Data.Colour as C+import Data.Colour.SRGB+import Data.List as L+import Data.IntMap as IM+import Data.Maybe+import Data.Colour.Names+import Graphics.GD++-- Create a pallette of colours with which is a map from escape iterations to colours+createPallete :: Int -> [(Int, Colour Double)] -> IntMap (Colour Double)+createPallete maxIter points | length points < 2 || maximum (L.map fst points) > maxIter + || minimum (L.map fst points) < 0 = error "Invalid pallete reference points"+ | otherwise = fromList (interpolate $ sortBy (\x y -> fst x `compare` fst y) points)++interpolate :: [(Int, Colour Double)] -> [(Int, Colour Double)]+interpolate [(_,_)] = []+interpolate ((n1,c1):(n2,c2):xs) = [(n1 + i, C.blend (fromIntegral i / delta) c1 c2) | i <- [0 .. (n2 - n1 - 1)]] ++ (interpolate ((n2,c2):xs)) where+ delta = fromIntegral (n2 - n1)++colourPoint' :: IntMap (Colour Double) -> Double -> Colour Double+colourPoint' colpal n = {-# SCC "blend" #-} C.blend (n-fromIntegral n1) (fromJust c1) (fromJust c2) where --Will it blend?+ n1 = {-# SCC "floor" #-} truncate n+ n2 = n1 + 1+ (c1, c2) = {-# SCC "lookups" #-} (IM.lookup n1 colpal, IM.lookup n2 colpal)++pallete = createPallete 5002 [(0,red), (1200, white), (1600, yellow), (2000, blend 0.3 white orange), (2500,darken 0.2 orange), (3200, blend 0.7 orange black), (4400, white), (5002, red)]++{-+colourPoint :: Double -> Double -> Color3 GLdouble+colourPoint 0.0 _ = fmap realToFrac $ Color3 0.0 0.0 0.0+colourPoint n _ = let c = toSRGB $ colourPoint' pallete n in+ {-# SCC "conversions" #-} fmap realToFrac $ Color3 (channelRed c) (channelGreen c) (channelBlue c)+-}++colourGD :: Double -> Double -> Graphics.GD.Color+colourGD 0.0 _ = rgb 0 0 0+colourGD n _ = let c = toSRGB24 $ colourPoint' pallete n in+ rgb (fromIntegral $ channelRed c) (fromIntegral $ channelGreen c) (fromIntegral $ channelBlue c)++-- Colour a vertex based on the number of iterations it took to escape+colourPoint :: Double -> Double -> Color3 GLdouble+colourPoint 0.0 _ = fmap realToFrac $ Color3 0.0 0.0 0.0+colourPoint m cm = fmap realToFrac $ Color3 r g b where+ r = 0.5 + 0.5 * cos (m * cm) + g = 0.5 + 0.5 * cos ((m + 16.0) * cm)+ b = 0.5 + 0.5 * cos ((m + 32.0) * cm)+
FracComp.hs view
@@ -12,7 +12,7 @@ type Pix = IOUArray Int Double --- Number of iterations to escape+-- Number of iterations to escape the mandelbrot set mandPoint :: Int -> Double -> Double -> Double -> Double -> Int -> Double mandPoint !n !x !y cx cy mi | n > mi = 0.0 | (x2 + y2) > 4.0 = 1.0 - logBase 2 (0.5 * logBase 2 (x2 + y2)) + fromIntegral n@@ -20,13 +20,15 @@ !x2 = x*x --This CSE saves a few cycles !y2 = y*y --- Colour a vertex-colourMand :: Double -> Double -> Color3 GLdouble-colourMand 0.0 _ = fmap realToFrac $ Color3 0.0 0.0 0.0-colourMand m cm = fmap realToFrac $ Color3 r g b where- r = 0.5 + 0.5 * cos (m * cm) - g = 0.5 + 0.5 * cos ((m + 16.0) * cm)- b = 0.5 + 0.5 * cos ((m + 32.0) * cm)+{-+-- Number of iterations to escape the burning ship fractal+burnPoint :: Int -> Double -> Double -> Double -> Double -> Int -> Double+burnPoint !n !x !y cx cy mi | n > mi = 0.0+ | (x2 + y2) > 4.0 = 1.0 - logBase 2 (0.5 * logBase 2 (x2 + y2)) + fromIntegral n+ | otherwise = burnPoint (n+1) (x2 - y2 + cx) (-2.0 * abs (x*y) + cy) cx cy mi where+ !x2 = x*x + !y2 = y*y+-} children :: MVar [MVar ()] children = unsafePerformIO (newMVar [])@@ -51,7 +53,7 @@ forkIO (io `finally` putMVar mvar ()) -mandPointSampled !x !y !xrng !yrng !mi ss = if (any (== 0.0) points) then 0.0 else average points where+mandPointSampled !x !y !xrng !yrng !mi ss = average points where points = [ mandPoint 0 0.0 0.0 (x + dx) (y + dy) mi | dx <- ((take ss) . iterate (+xrng)) 0.0, dy <- ((take ss) . iterate (+yrng)) 0.0]
FracImg.hs view
@@ -4,6 +4,7 @@ import FracComp import FracState+import FracColour import Graphics.GD import Data.Array.IO hiding (range)@@ -26,7 +27,7 @@ | x == w = go 0 (y+1) | otherwise = do p <- readArray pixarr (x + y*w)- (antiAliased $ setPixel (x,y)) (convColour $ colourMand p cm) im+ (antiAliased $ setPixel (x,y)) (convColour $ colourPoint p cm) im go (x+1) y imagAt :: FilePath -> Mandstate -> IO ()
Hfractal.hs view
@@ -8,6 +8,7 @@ import Bindings import FracState+import FracColour import FracComp inializeScreen opts@(Options (Sz w h) _) = do@@ -53,7 +54,7 @@ | x == width = go 0 (y+1) | otherwise = do dk <- readArray pixarr (x + y*width)- color (colourMand dk cm)+ color (colourPoint dk cm) vertex $ Vertex2 (fromIntegral x) (fromIntegral y :: GLfloat) go (x+1) y @@ -84,18 +85,18 @@ state0 = Mandstate (-0.14076572210832694) 0.8510989379408804 1.0 0.05 500 state1 = Mandstate 0.001643721971153 0.822467633298876 0.05 0.0625 500 state2 = Mandstate 0.35473015182773904 9.541013313560959e-2 0.0002 0.0625 500-state = state0+state = state1 defOpts = Options (Sz 400 400) state options :: [OptDescr (Options -> Options)] options = [ - Option ['w'] ["width"] (ReqArg (\w -> size^:wi^=(read w)) "Window width") "Set width of rendering window", - Option ['h'] ["height"] (ReqArg (\h -> size^:hi^=(read h)) "Window height") "Set height of rendering window",- Option ['x'] ["x-mid"] (ReqArg (\x -> ms^:xmid^=(read x)) "Real(z)") "Set the real part of the initial z (double)",- Option ['y'] ["y-mid"] (ReqArg (\y -> ms^:ymid^=(read y)) "Imag(z)") "Set the imaginary part of the inital z (double)",- Option ['i'] ["maxiter"] (ReqArg (\i -> ms^:maxiter^=(read i)) "Max iterations") "Maximum iterations until escape (int)",- Option ['z'] ["zoom"] (ReqArg (\z -> ms^:range^=(read z)) "Zoom") "Level of zoom (double)"]+ Option ['w'] ["width"] (ReqArg (\w -> size^:wi^=read w) "Window width") "Set width of rendering window", + Option ['h'] ["height"] (ReqArg (\h -> size^:hi^=read h) "Window height") "Set height of rendering window",+ Option ['x'] ["x-mid"] (ReqArg (\x -> ms^:xmid^=read x) "Real(z)") "Set the real part of the initial z (double)",+ Option ['y'] ["y-mid"] (ReqArg (\y -> ms^:ymid^=read y) "Imag(z)") "Set the imaginary part of the inital z (double)",+ Option ['i'] ["maxiter"] (ReqArg (\i -> ms^:maxiter^=read i) "Max iterations") "Maximum iterations until escape (int)",+ Option ['z'] ["zoom"] (ReqArg (\z -> ms^:range^=read z) "Zoom") "Level of zoom (double)"] getOpts :: [String] -> IO Options getOpts argv = case getOpt Permute options argv of
hfractal.cabal view
@@ -1,5 +1,5 @@ name: hfractal-version: 0.3.1+version: 0.3.2.1 cabal-version: >= 1.2 synopsis: OpenGL fractal renderer description: An OpenGL fractal browser with multicore support and the capability to output high quality png images.@@ -14,6 +14,6 @@ Executable hfractal main-is: Hfractal.hs- build-depends: base >=3 && <5, array, gd < 3000.3.0 && >= 3000.2.0, data-accessor >=0.2 && <=0.3, data-accessor-template >=0.2 && <=0.3, OpenGL >= 2.3 && < 2.4, GLUT- other-Modules: FracComp, FracState, FracImg, Bindings- ghc-options: -O2 -threaded+ build-depends: base >=3 && <5, array, gd < 3000.3.0 && >= 3000.2.0, data-accessor >=0.2 && <=0.3, data-accessor-template >=0.2 && <=0.3, OpenGL >= 2.3 && < 2.4.0.0, OpenGLRaw < 1.1.0.0, GLUT >= 2.2.1.0 && < 2.2.2.0, colour >=2.3.1, containers >= 0.2+ other-Modules: FracComp, FracColour, FracImg, FracState, Bindings+ ghc-options: -O2 -threaded -fvia-C -optc-O3 -optc-ffast-math