hfractal 0.1.1.0 → 0.2.0

raw patch · 4 files changed

+49/−19 lines, 4 files

Files

• FracComp.hs +43/−15
• FracState.hs +2/−2
• README +2/−0
• hfractal.cabal +2/−2

@@ -4,6 +4,9 @@  import Graphics.UI.GLUT import Data.Array.IO+import Control.Concurrent+import Control.Exception+import System.IO.Unsafe  import FracState @@ -14,21 +17,8 @@ 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 					        | otherwise		   = mandPoint (n+1) (x2 - y2 + cx) (2.0*x*y + cy) cx cy mi where-	x2 = x*x  --This CSE saves a few cycles-	y2 = y*y--compPoints :: Double -> Double -> Double -> Int -> Sz -> Pix -> IO ()-compPoints xm ym rng mi sz@(Sz width height) arr = go 0 0 where-	go !x !y | y == height  = return () -			 | x == width   = go 0 (y+1)-			 | otherwise = do -		writeArray arr k (mandPoint 0 0.0 0.0 cx cy mi)-		go (x+1) y where-			k = x + y*width-			fi = fromIntegral-			cx = rng * (fi x - fi w2) / fi w2 + xm :: Double-			cy = rng * (fi y - fi h2) / fi h2 + ym :: Double-			(w2, h2) = (width `div` 2, height `div` 2)+	!x2 = x*x  --This CSE saves a few cycles+	!y2 = y*y  -- Colour a vertex colourMand :: Double -> Double -> Color3 GLdouble@@ -37,6 +27,44 @@ 	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)++children :: MVar [MVar ()]+children = unsafePerformIO (newMVar [])++waitForChildren :: IO ()+waitForChildren = do+	cs <- takeMVar children+	case cs of+		[]   -> do+			putMVar children []+			return ()+		m:ms -> do+			putMVar children ms+			takeMVar m+			waitForChildren++forkChild :: IO () -> IO ThreadId+forkChild io = do+	mvar <- newEmptyMVar+	childs <- takeMVar children+	putMVar children (mvar:childs)+	forkIO (io `finally` putMVar mvar ())++compPoints :: Double -> Double -> Double -> Int -> Sz -> Pix -> IO ()+compPoints xm ym rng mi sz@(Sz width height) arr = do+	go 0+	waitForChildren where+		go !y | y == height = return () +			  | otherwise = forkChild (goRow 0 y) >> go (y+1)+		goRow !x y  | x == width  = return () :: IO ()+					| otherwise = do	+			writeArray arr k (mandPoint 0 0.0 0.0 cx cy mi)+			goRow (x+1) y where+				k = x + y*width+				fi = fromIntegral+				cx = rng * (fi x - fi w2) / fi w2 + xm :: Double+				cy = rng * (fi y - fi h2) / fi h2 + ym :: Double+				(w2, h2) = (width `div` 2, height `div` 2)   ----------------------------------------- --QuickCheck Properties

@@ -9,8 +9,8 @@ --These values alter the state in various ways iteradd :: Int rangemul, cmul :: Double-rangemul = 1.02-cmul     = 1.3+rangemul = 1.013+cmul     = 1.2 iteradd  = 100  data Mandstate = Mandstate {

@@ -9,3 +9,5 @@ p            -    Print a hi-res image of the current location                   in the working direction o			 -    Print current location to console++Can exploit multiple cores - Use hfractal [opts] +RTS -N{cores} to enable this.

@@ -1,5 +1,5 @@ name:                hfractal-version:             0.1.1.0+version:             0.2.0 cabal-version:		 >= 1.2 synopsis:            OpenGL fractal renderer category:            Graphics@@ -13,4 +13,4 @@     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+    ghc-options:        -O2 -threaded