hfractal 0.3.0 → 0.3.1

raw patch · 5 files changed

+53/−16 lines, 5 files

Files

• Bindings.hs +0/−1
• FracComp.hs +29/−2
• FracImg.hs +3/−2
• Hfractal.hs +17/−10
• hfractal.cabal +4/−1

@@ -63,6 +63,5 @@ keyboardMouseAct _ _ _ _ _ = return ()  --TODO, have a separate mouse and keyboard functions and then a wrapper with cases on the type of Key- mp :: GLint -> Int -> Double mp x w = (fromIntegral x - fromIntegral (w `div` 2)) / fromIntegral w

@@ -50,6 +50,33 @@ 	putMVar children (mvar:childs) 	forkIO (io `finally` putMVar mvar ()) ++mandPointSampled !x !y !xrng !yrng !mi ss = if (any (== 0.0) points) then 0.0 else 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]+	average xs = sum xs / (fromIntegral . length) xs+++--This gives an image in a sligtly different position than the unsampled function+--But the code is easier this way+compPointsSampled :: Double -> Double -> Double -> Int -> Sz -> Pix -> Int -> IO ()+compPointsSampled xm ym rng mi sz@(Sz width height) arr ss = 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 (mandPointSampled cx cy xrng yrng mi ss)+			goRow (x+1) y where+				(xrng, yrng) = (rng / fi (ss * width), rng / fi (ss * height))+				k = x + y*width+				fi = fromIntegral+				cx = rng * (fi x - fi w2) / fi width + xm :: Double+				cy = rng * (fi y - fi h2) / fi height + ym :: Double+				(w2, h2) = (width `div` 2, height `div` 2) + compPoints :: Double -> Double -> Double -> Int -> Sz -> Pix -> IO () compPoints xm ym rng mi sz@(Sz width height) arr = do 	go 0@@ -62,8 +89,8 @@ 			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+				cx = rng * (fi x - fi w2) / fi width + xm :: Double+				cy = rng * (fi y - fi h2) / fi height + ym :: Double 				(w2, h2) = (width `div` 2, height `div` 2)   -----------------------------------------

@@ -10,6 +10,7 @@ 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@@ -25,14 +26,14 @@ 			 | x == w = go 0 (y+1) 			 | otherwise = do 		p <- readArray pixarr (x + y*w)-		setPixel (x,y) (convColour $ colourMand p cm) im+		(antiAliased $ setPixel (x,y)) (convColour $ colourMand p cm) im 		go (x+1) y  imagAt ::  FilePath -> Mandstate -> IO () imagAt fp (Mandstate xm ym rng cm mi) = do 	pixarr <- newArray (0, w*h-1) 0.0 :: IO Pix 	im <- newImage (w, h)-	compPoints xm ym rng (max imgMaxIter mi) (Sz w h) pixarr+	compPointsSampled xm ym rng (max imgMaxIter mi) (Sz w h) pixarr supSamp 	pixelWrite im (Sz w h) cm pixarr  	savePngFile fp im 

@@ -17,16 +17,17 @@ 	blendFunc   $= (SrcAlpha, OneMinusSrcAlpha) 	createWindow "HFractal" 	windowSize $= Size (fromIntegral (w-2)) (fromIntegral (h-1))-	matrixMode $= Projection-	ortho2D 0.0 (fromIntegral (w-1)) 0.0 (fromIntegral (h-1)) -	matrixMode $= Modelview 0+--	reshapeCallback $= Just (reshape opts)  setCallBacks opts@(Options s@(Sz w h) state) = do 	--Create the state and pixel array-	ms <- newIORef state+	ms <- newIORef state  	pixarr <- newArray (0, w*h-1) 0.0 :: IO Pix+	--Deal with the window size+	matrixMode $= Projection+	ortho2D 0.0 (fromIntegral (w-1)) 0.0 (fromIntegral (h-1)) +	matrixMode $= Modelview 0 	--Set the callbacks-	reshapeCallback $= Just (reshape opts) 	keyboardMouseCallback $= Just (keyboardMouse ms s) 	displayCallback $= display ms s pixarr @@ -34,6 +35,7 @@ --Display Callback and related functions ---------------------------------------- +display ::  (HasGetter g) => g Mandstate -> Sz -> Pix -> IO () display ms sz@(Sz w h) pixarr = do 	clear [ColorBuffer] 	loadIdentity@@ -59,10 +61,14 @@ --Other Callbacks ----------------------------------------- +--Don't allow resizing+{-+reshape ::  Options -> Size -> IO () reshape opts s'@(Size w h) = do 	viewport $= (Position 0 0, s')-	--setCallBacks opts{size=Sz (fromIntegral w) (fromIntegral h)} --Reset the callbacks so that the pixarr is recreated+	--setCallBacks opts{size_=Sz (fromIntegral w) (fromIntegral h)} --Reset the callbacks so that the pixarr is recreated 	postRedisplay Nothing+-}  keyboardMouse ms s key state _ pos = do 	keyboardMouseAct ms s key state pos@@ -72,15 +78,16 @@ --Option Parsing and Main loop ---------------------------------------- ---Some defualt starting positions-zeroState, state1 :: Mandstate+--Some interesting starting positions+zeroState, state0, state1, state2 :: Mandstate zeroState = Mandstate 0.0 0.0 2.0 0.05 500+state0	  = Mandstate (-0.14076572210832694) 0.8510989379408804 1.0 0.05 500 state1    = Mandstate 0.001643721971153 0.822467633298876 0.05 0.0625 500-state     = state1+state2    = Mandstate 0.35473015182773904 9.541013313560959e-2 0.0002 0.0625 500+state     = state0  defOpts = Options (Sz 400 400) state ---TODO: Tidy up the option parser with Data.Accessor(.Template) options :: [OptDescr (Options -> Options)] options = [  	Option ['w'] ["width"] (ReqArg (\w -> size^:wi^=(read w))  "Window width") "Set width of rendering window", 

@@ -1,9 +1,12 @@ name:                hfractal-version:             0.3.0+version:             0.3.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.+stability:           Experimental category:            Graphics license:             BSD3+copyright:           2009-2009 Chris Holdsworth author:              Chris Holdsworth <chrisholdsworth@gmail.com> maintainer:          Chris Holdsworth <chrisholdsworth@gmail.com> build-type:          Simple