hfractal 0.4.1 → 0.4.2.1
raw patch · 4 files changed
+20/−17 lines, 4 filesdep ~GLUTdep ~OpenGLdep ~data-accessor
Dependency ranges changed: GLUT, OpenGL, data-accessor, data-accessor-template
Files
- hfractal.cabal +2/−2
- src/FracColour.hs +3/−0
- src/FracComp.hs +11/−11
- src/Hfractal.hs +4/−4
hfractal.cabal view
@@ -1,5 +1,5 @@ name: hfractal-version: 0.4.1+version: 0.4.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.@@ -15,7 +15,7 @@ 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.0.0, OpenGLRaw < 1.1.0.0, GLUT >= 2.2.1.0 && < 2.2.2.0, colour >=2.3.1, containers >= 0.2+ 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 other-Modules: FracComp, FracColour, FracImg, FracState, Bindings ghc-options: -O2 -threaded -fvia-C -optc-O3 -optc-ffast-math Hs-Source-Dirs: src
src/FracColour.hs view
@@ -44,6 +44,9 @@ b = {-# SCC "blue" #-} 0.5 + 0.5 * cos ((m + 32.0) * cm) {-+--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
src/FracComp.hs view
@@ -28,11 +28,11 @@ initPixArray :: Int -> Int -> IO PixArray initPixArray width height = do pixels <- newArray (0, width * height - 1) 0.0 :: IO Pix- rows <- newArray (0, width) 0.0 :: IO RowVals- cols <- newArray (0, height) 0.0 :: IO ColVals+ rows <- newArray (0, height) 0.0 :: IO RowVals+ cols <- newArray (0, width) 0.0 :: IO ColVals pixelsTemp <- newArray (0, width * height - 1) 0.0 :: IO Pix- rowsTemp <- newArray (0, width) 0.0 :: IO RowVals- colsTemp <- newArray (0, height) 0.0 :: IO ColVals+ rowsTemp <- newArray (0, height) 0.0 :: IO RowVals+ colsTemp <- newArray (0, width) 0.0 :: IO ColVals return (PixArray pixels rows cols pixelsTemp rowsTemp colsTemp (Sz width height)) copyArr :: Int -> IOUArray Int Double -> IOUArray Int Double -> IO ()@@ -47,10 +47,10 @@ copyPix sz@(Sz width height) = copyArr (width * height) copyRow :: Sz -> RowVals -> RowVals -> IO ()-copyRow sz@(Sz width height) = copyArr width+copyRow sz@(Sz width height) = copyArr height copyCol :: Sz -> RowVals -> RowVals -> IO ()-copyCol sz@(Sz width height) = copyArr height+copyCol sz@(Sz width height) = copyArr width children :: MVar [MVar ()] children = unsafePerformIO (newMVar [])@@ -133,7 +133,7 @@ then do return () :: IO () else do rc <- (readArray rows rowIndex) let cy = {-# SCC "cy" #-} rng * (fi y - fi h2) / fi height + ym :: Double- if (rowIndex == height) + if (rowIndex >= height) then do writeArray rowst y cy forkChild (goRow 0 y) >> go rowIndex (y+1) else if (rc < (cy - step)) @@ -146,12 +146,12 @@ --putStrLn "NoCache" forkChild (goRow 0 y) >> go rowIndex (y+1) goRowCache ri rc cy !colIndex !x y = do- if (x == width) + if (x >= width) then do return () :: IO () else do cc <- (readArray cols colIndex) let cx = rng * (fi x - fi w2) / fi width + xm :: Double let k = x + y*width - if (colIndex == width) + if (colIndex >= width) then do writeArray colst x cx writeArray pixt k (mandPoint cx cy mi) goRowCache ri rc cy colIndex (x+1) y @@ -166,10 +166,10 @@ else do writeArray colst x cx writeArray pixt k (mandPoint cx cy mi) goRowCache ri rc cy colIndex (x+1) y - goRow !x y | x == width = return () :: IO ()+ goRow !x y | x >= width = return () :: IO () | otherwise = do writeArray pixt k (mandPoint cx cy mi)- writeArray colst y cx+ writeArray colst x cx goRow (x+1) y where k = x + y*width cx = rng * (fi x - fi w2) / fi width + xm :: Double
src/Hfractal.hs view
@@ -16,8 +16,8 @@ initialDisplayMode $= [DoubleBuffered] lineSmooth $= Enabled blendFunc $= (SrcAlpha, OneMinusSrcAlpha)+ initialWindowSize $= Size (fromIntegral w) (fromIntegral h) createWindow "HFractal"- windowSize $= Size (fromIntegral (w-2)) (fromIntegral (h-1)) reshapeCallback $= Just (reshape opts) setCallBacks opts@(Options s@(Sz w h) state) = do@@ -26,13 +26,13 @@ pix <- initPixArray w h --Deal with the window size matrixMode $= Projection- ortho2D 0.0 (fromIntegral (w-1)) 0.0 (fromIntegral (h-1)) + ortho2D 0.0 (fromIntegral w) 0.0 (fromIntegral h) matrixMode $= Modelview 0 --Set the callbacks keyboardMouseCallback $= Just (keyboardMouse ms s)- displayCallback $= display ms s pix ----------------------------------------+ displayCallback $= display ms s pix+ --Display Callback and related functions----------------------------------------- display :: (HasGetter g) => g Mandstate -> Sz -> PixArray -> IO () display ms sz@(Sz w h) pix@(PixArray pixarr _ _ _ _ _ _ ) = do