diff --git a/README b/README --- a/README +++ b/README @@ -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 diff --git a/hfractal.cabal b/hfractal.cabal --- a/hfractal.cabal +++ b/hfractal.cabal @@ -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 maintainer: Chris Holdsworth 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 diff --git a/src/FracColour.hs b/src/FracColour.hs --- a/src/FracColour.hs +++ b/src/FracColour.hs @@ -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 -} diff --git a/src/FracComp.hs b/src/FracComp.hs --- a/src/FracComp.hs +++ b/src/FracComp.hs @@ -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 diff --git a/src/FracImg.hs b/src/FracImg.hs --- a/src/FracImg.hs +++ b/src/FracImg.hs @@ -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 diff --git a/src/PointComp.hs b/src/PointComp.hs --- a/src/PointComp.hs +++ b/src/PointComp.hs @@ -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