hfractal 0.4.2.2 → 0.4.2.4
raw patch · 6 files changed
+57/−29 lines, 6 filesdep ~GLUTdep ~OpenGLdep ~OpenGLRaw
Dependency ranges changed: GLUT, OpenGL, OpenGLRaw, base, colour, containers, data-accessor, data-accessor-template, gd
Files
- README +1/−0
- hfractal.cabal +13/−4
- src/FracColour.hs +27/−13
- src/FracComp.hs +0/−6
- src/FracImg.hs +5/−5
- src/PointComp.hs +11/−1
README view
@@ -21,3 +21,4 @@ Can exploit multiple cores - Use hfractal [opts] +RTS -N{cores} to enable this. On linux the following libraries may be required: [libjpeg8, libpng, libgd2-xpm-dev]+On windows the glut32.dll is required
hfractal.cabal view
@@ -1,12 +1,12 @@ name: hfractal-version: 0.4.2.2+version: 0.4.2.4 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. stability: Experimental category: Graphics license: BSD3-copyright: 2009-2010 Chris Holdsworth+copyright: 2009-2011 Chris Holdsworth author: Chris Holdsworth <chrisholdsworth@gmail.com> maintainer: Chris Holdsworth <chrisholdsworth@gmail.com> homepage: http://github.com/cmh/Hfractal@@ -15,7 +15,16 @@ Executable hfractal main-is: Hfractal.hs- build-depends: base >=3 && <5, array, gd < 3000.3.0 && >= 3000.2.0, data-accessor >=0.2, data-accessor-template >=0.2, OpenGL >= 2.3, OpenGLRaw < 1.1.0.0, GLUT >= 2.2.1.0, colour >=2.3.1, containers >= 0.2+ build-depends: base == 4,+ array, + gd,+ data-accessor,+ data-accessor-template,+ OpenGL,+ OpenGLRaw,+ GLUT,+ colour,+ containers other-Modules: FracComp, FracColour, FracImg, FracState, Bindings, PointComp- ghc-options: -O2 -threaded -fvia-C -optc-O3 -optc-ffast-math+ ghc-options: -O2 -threaded -rtsopts Hs-Source-Dirs: src
src/FracColour.hs view
@@ -1,6 +1,8 @@-module FracColour +{-# LANGUAGE BangPatterns #-}+module FracColour where +import Unsafe.Coerce import Graphics.UI.GLUT hiding (blend)--(Color3, GLdouble) import Data.Colour as C import Data.Colour.SRGB@@ -9,12 +11,13 @@ import Data.Maybe import Data.Colour.Names import Graphics.GD+import Data.Ord (comparing) -- 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 +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)+ | otherwise = fromList (interpolate $ sortBy (\x y -> Data.Ord.comparing fst x y) points) interpolate :: [(Int, Colour Double)] -> [(Int, Colour Double)] interpolate [(_,_)] = []@@ -31,26 +34,37 @@ (2500, darken 0.2 orange), (3200, blend 0.7 orange black), (4400, white), (5002, red)] colourPointPal :: Double -> Double -> Color3 GLdouble-colourPointPal 0.0 _ = fmap realToFrac $ Color3 0.0 0.0 0.0+colourPointPal 0.0 _ = fmap doubleToGLdouble $ Color3 0.0 0.0 0.0 colourPointPal n _ = let c = toSRGB $ colourPoint' pallete n in- {-# SCC "conversions" #-} fmap realToFrac $ Color3 (channelRed c) (channelGreen c) (channelBlue c)+ {-# SCC "conversions" #-} fmap doubleToGLdouble $ Color3 (channelRed c) (channelGreen c) (channelBlue c) ++doubleToGLdouble :: Double -> GLdouble+doubleToGLdouble = unsafeCoerce --This is neccesary as realToFrac is very slow (esp. in 7.x), the indirection will allow easier refactoring++colourPointFun = colourPointFun1+ -- Colour a vertex based on the number of iterations it took to escape-colourPointFun :: Double -> Double -> Color3 GLdouble-colourPointFun 0.0 _ = fmap realToFrac $ Color3 0.0 0.0 0.0-colourPointFun m cm = {-# SCC "conversions" #-} fmap realToFrac $ Color3 r g b where- r = {-# SCC "red" #-} 0.5 + 0.5 * cos (m * cm) - g = {-# SCC "green" #-} 0.5 + 0.5 * cos ((m + 16.0) * cm)- b = {-# SCC "blue" #-} 0.5 + 0.5 * cos ((m + 32.0) * cm)+colourPointFun1 :: Double -> Double -> Color3 GLdouble+colourPointFun1 0.0 _ = Color3 0.0 0.0 0.0+colourPointFun1 m cm = {-# SCC "conversions" #-} fmap doubleToGLdouble $ Color3 r g b where+ !r = {-# SCC "red" #-} 0.5 + 0.5 * cos (m * cm)+ !g = {-# SCC "green" #-} 0.5 + 0.5 * cos ((m + 16.0) * cm)+ !b = {-# SCC "blue" #-} 0.5 + 0.5 * cos ((m + 32.0) * cm) +colourPointFun2 :: Double -> Double -> Color3 GLdouble+colourPointFun2 0.0 _ = Color3 0.0 0.0 0.0+colourPointFun2 m cm = {-# SCC "conversions" #-} Color3 x x x where+ !x = {-# SCC "x" #-} doubleToGLdouble $ (min m 255.0) / 255.0+ {- --Store a colour specified by 3 doubles as an int colToInt :: Double -> Double -> Double -> Int -- Range based colouring, need access to the maxiter here (after refactor) colourPointFun2 :: Double -> Double -> Color3 GLdouble-colourPointFun2 0.0 _ = fmap realToFrac $ Color3 0.0 0.0 0.0-colourPointFun2 m cm = fmap realToFrac $ Color3 r g b where+colourPointFun2 0.0 _ = fmap doubleToGLdouble $ Color3 0.0 0.0 0.0+colourPointFun2 m cm = fmap doubleToGLdouble $ Color3 r g b where frac = fromIntegral m / fromIntegral maxIter -}
src/FracComp.hs view
@@ -196,9 +196,3 @@ copyRow sz rowst rows copyCol sz colst cols ---------------------------------------------QuickCheck Properties--------------------------------------------prop_reflection :: Double -> Double -> Bool-prop_reflection x y = mandPoint x y 500 == mandPoint x (-y) 500
src/FracImg.hs view
@@ -11,10 +11,10 @@ import System.IO import Graphics.Rendering.OpenGL -supSamp = 5 --Use subpixel sampling-imgMaxIter = 5000 --High iteration for the output image-w = 2000 --High resolution for the output image-h = 2000+supSamp = 1 --Use subpixel sampling+imgMaxIter = 35 --High iteration for the output image+w = 500 --High resolution for the output image+h = 500 filepath = "." :: FilePath --Convert a GL Colour datatype to a GD Colour datatype@@ -34,7 +34,7 @@ imagAt fp (Mandstate xm ym rng cm cf mi) = do pixarr <- newArray (0, w*h-1) 0.0 :: IO Pix im <- newImage (w, h)- compPointsSampled xm ym rng (max imgMaxIter mi) (Sz w h) pixarr supSamp+ compPointsSampled xm ym rng imgMaxIter (Sz w h) pixarr supSamp pixelWrite im (Sz w h) cf cm pixarr savePngFile fp im
src/PointComp.hs view
@@ -3,10 +3,14 @@ where {- Module for computing fractal functions at an indivdual point -} +{- Want an arbitrary class which defines computation of a fractal at a point -}+{-class FracComp where-}+ {-compAt :: Double -> Double -> Int -> Double -}+ -- Number of iterations to escape mandPoint :: Double -> Double -> Int -> Double mandPoint cx cy mi | inCardiod cx cy = 0.0- | otherwise = go 0 0.0 0.0 where+ | otherwise = go 0 0.0 0.0 where inCardiod cx cy = q * (q + (cx - 0.25)) < 0.25 * cy * cy where q = (cx - 0.25) * (cx - 0.25) + cy*cy go !n !x !y | x2 + y2 > 4.0 = 1.0 - logBase 2 (0.5 * logBase 2 (x2 + y2)) + fromIntegral n@@ -15,3 +19,9 @@ !x2 = x*x !y2 = y*y --This CSE saves a few cycles +-----------------------------------------+--QuickCheck Properties+-----------------------------------------++prop_reflection :: Double -> Double -> Bool+prop_reflection x y = mandPoint x y 500 == mandPoint x (-y) 500