hfractal 0.2.0 → 0.3.0
raw patch · 5 files changed
+62/−38 lines, 5 files
Files
- Bindings.hs +40/−16
- FracState.hs +1/−1
- Hfractal.hs +5/−11
- README +15/−9
- hfractal.cabal +1/−1
Bindings.hs view
@@ -5,40 +5,64 @@ import Data.IORef import System.Exit import Data.Accessor+import Control.Concurrent import FracState import FracImg -keyboardAct :: IORef Mandstate -> Key -> KeyState -> IO ()-keyboardAct ms (SpecialKey KeyLeft) Down = do+keyboardMouseAct :: IORef Mandstate -> Sz -> Key -> KeyState -> Position -> IO ()+--Keyboard actions as described in README+keyboardMouseAct ms _ (SpecialKey KeyLeft) Down _ = do ms' <- readIORef ms modifyIORef ms (xmid ^: ((+) ( -0.05 * ms'^.range)))-keyboardAct ms (SpecialKey KeyRight) Down = do+keyboardMouseAct ms _ (SpecialKey KeyRight) Down _ = do ms' <- readIORef ms modifyIORef ms (xmid ^: ((+) ( 0.05 * ms'^.range)))-keyboardAct ms (SpecialKey KeyUp) Down = do+keyboardMouseAct ms _ (SpecialKey KeyUp) Down _ = do ms' <- readIORef ms modifyIORef ms (ymid ^: ((+) ( 0.05 * ms'^.range)))-keyboardAct ms (SpecialKey KeyDown) Down = do+keyboardMouseAct ms _ (SpecialKey KeyDown) Down _ = do ms' <- readIORef ms modifyIORef ms (ymid ^: ((+) ( -0.05 * ms'^.range)))-keyboardAct ms (Char '+') Down = do+keyboardMouseAct ms _ (Char '+') Down _ = do modifyIORef ms (range ^: (/rangemul))-keyboardAct ms (Char '-') Down = do+keyboardMouseAct ms _ (Char '-') Down _ = do modifyIORef ms (range ^: (*rangemul))-keyboardAct ms (Char 'a') Down = do+keyboardMouseAct ms _ (Char 'a') Down _ = do modifyIORef ms (colourmul ^: (*cmul)) -keyboardAct ms (Char 's') Down = do+keyboardMouseAct ms _ (Char 's') Down _ = do modifyIORef ms (colourmul ^: (/cmul)) -keyboardAct ms (Char '<') Down = do+keyboardMouseAct ms _ (Char '<') Down _ = do modifyIORef ms (maxiter ^: ((-) iteradd))-keyboardAct ms (Char '>') Down = do+keyboardMouseAct ms _ (Char '>') Down _ = do modifyIORef ms (maxiter ^: (+ iteradd))-keyboardAct ms (Char 'p') Down = do+keyboardMouseAct ms _ (Char 'p') Down _ = do ms' <- readIORef ms- imagAt "frac.png" ms' --TODO: Allow user-namable output images-keyboardAct ms (Char 'o') Down = do+ putStrLn "Creating frac.png"+ forkIO (imagAt "frac.png" ms' >> putStrLn "Finished Image") >> return ()+ --TODO: Allow user-namable output images, make this concurrent+keyboardMouseAct ms _ (Char 'o') Down _ = do ms' <- readIORef ms print ms'-keyboardAct _ (Char '\27') _ = exitWith ExitSuccess-keyboardAct _ _ _ = return ()+--Mouse actions+keyboardMouseAct ms _ (MouseButton WheelUp) Down _ = do+ modifyIORef ms (range ^: (/ (rangemul*1.05)))+keyboardMouseAct ms _ (MouseButton WheelDown) Down _ = do+ modifyIORef ms (range ^: (* (rangemul*1.05)))+keyboardMouseAct ms (Sz w h) (MouseButton RightButton) Down (Position x y) = do+ ms' <- readIORef ms+ modifyIORef ms ((xmid ^: ((+) ((x `mp` w) * ms'^.range ))) .+ (ymid ^: ((+) (-(y `mp` h) * ms'^.range ))) .+ (range ^: (/rangemul)))+keyboardMouseAct ms (Sz w h) (MouseButton LeftButton) Down (Position x y) = do+ ms' <- readIORef ms+ modifyIORef ms ((xmid ^: ((+) ((x `mp` w) * ms'^.range ))) .+ (ymid ^: ((+) (-(y `mp` h) * ms'^.range ))))+--Exit and default+keyboardMouseAct _ _ (Char '\27') _ _ = exitWith ExitSuccess+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
FracState.hs view
@@ -9,7 +9,7 @@ --These values alter the state in various ways iteradd :: Int rangemul, cmul :: Double-rangemul = 1.013+rangemul = 1.019 cmul = 1.2 iteradd = 100
Hfractal.hs view
@@ -27,8 +27,7 @@ pixarr <- newArray (0, w*h-1) 0.0 :: IO Pix --Set the callbacks reshapeCallback $= Just (reshape opts)- idleCallback $= Just idle- keyboardMouseCallback $= Just (keyboardMouse ms)+ keyboardMouseCallback $= Just (keyboardMouse ms s) displayCallback $= display ms s pixarr ----------------------------------------@@ -60,19 +59,14 @@ --Other Callbacks ----------------------------------------- ---TODO: This is necessary currently---want to only postRedisplay if something changes-idle :: IO ()-idle = do- postRedisplay Nothing- 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 postRedisplay Nothing -keyboardMouse ms key state _ _ = do- keyboardAct ms key state+keyboardMouse ms s key state _ pos = do+ keyboardMouseAct ms s key state pos+ postRedisplay Nothing ----------------------------------------- --Option Parsing and Main loop@@ -100,7 +94,7 @@ getOpts argv = case getOpt Permute options argv of (o, [], []) -> return $ foldl (flip ($)) defOpts o (_, _, errs) -> ioError (userError (concat errs ++ usageInfo header options))- where header = "Usage: hfractal [OPTION...]"+ where header = "Usage: hfractal [OPTIONS...] [+RTS -N{cores}]" main :: IO() main = do
README view
@@ -1,13 +1,19 @@ OpenGL Fractal renderer. Currently only renders the Mandelbrot set, but can (and will) be easily extened to other fractals.-+Doesn't play well with xmonad - use on the floating layer. Controls:-Arrow keys - Movement-+/- - Zoom in/out-a/s - Alter colouring gradient-</> - Decrease/increase number of iterations - in escape algorithm.-p - Print a hi-res image of the current location- in the working direction-o - Print current location to console+ Keyboard+ Arrow keys - Movement+ +/- - Zoom in/out+ a/s - Alter colouring gradient+ </> - Decrease/increase number of iterations + in escape algorithm.+ p - Print a hi-res image of the current location+ in the working direction+ o - Print current location to console++ Mouse+ Left Mouse - Centre+ Right Mouse - Centre and zoom+ Mouse Wheel - Zoom Can exploit multiple cores - Use hfractal [opts] +RTS -N{cores} to enable this.
hfractal.cabal view
@@ -1,5 +1,5 @@ name: hfractal-version: 0.2.0+version: 0.3.0 cabal-version: >= 1.2 synopsis: OpenGL fractal renderer category: Graphics