Cleaned version

04_Mandelbulb/ExtComplex.hs

@@ -0,0 +1,33 @@
+module ExtComplex where
+
+import Graphics.Rendering.OpenGL
+
+data ExtComplex = C (GLfloat,GLfloat,GLfloat) 
+                  deriving (Show,Eq)
+
+instance Num ExtComplex where
+    -- The shape of the 3D mandelbrot 
+    -- will depend on this formula
+    C (x,y,z) * C (x',y',z') = C (x*x' - y*y' - z*z', 
+                                  x*y' + y*x' + z*z', 
+                                  x*z' + z*x' )
+    -- The rest is straightforward
+    fromInteger n = C (fromIntegral n, 0, 0)
+    C (x,y,z) + C (x',y',z') = C (x+x', y+y', z+z')
+    abs (C (x,y,z))     = C (sqrt (x*x + y*y + z*z), 0, 0)
+    signum (C (x,y,z))  = C (signum x, 0, 0)
+
+extcomplex :: GLfloat -> GLfloat -> GLfloat -> ExtComplex
+extcomplex x y z = C (x,y,z)
+
+real :: ExtComplex -> GLfloat
+real (C (x,y,z))    = x
+
+im :: ExtComplex -> GLfloat
+im   (C (x,y,z))    = y
+
+strange :: ExtComplex -> GLfloat
+strange (C (x,y,z)) = z
+
+magnitude :: ExtComplex -> GLfloat
+magnitude = real.abs

04_Mandelbulb/Mandel.hs

@@ -0,0 +1,13 @@
+-- The Mandelbrot function
+module Mandel (mandel) where
+
+import ExtComplex
+
+mandel r i s nbIterations = 
+    f (extcomplex r i s) 0 nbIterations
+    where
+        f :: ExtComplex -> ExtComplex -> Int -> Int
+        f c z 0 = 0
+        f c z n = if (magnitude z > 2 ) 
+                  then n
+                  else f c ((z*z)+c) (n-1)

04_Mandelbulb/Mandelbulb.lhs

@@ -0,0 +1,67 @@
+ ## Cleaning the code
+
+The first thing to do is to separate the GLUT/OpenGL 
+part from the computation of the shape.
+Here is the cleaned version of the preceeding section.
+Most boilerplate was put in external files.
+
+- [`YBoiler.hs`](code/YBoiler.hs), the 3D rendering
+- [`Mandel`](code/Mandel.hs), the mandel function
+- [`ExtComplex`](code/ExtComplex.hs), the extended complexes
+
+> import YBoiler -- Most the OpenGL Boilerplate
+> import Mandel -- The 3D Mandelbrot maths
+> 
+> -- yMainLoop takes two arguments
+> --   the title of the window
+> --   a function from time to triangles
+> main :: IO ()
+> main = yMainLoop "3D Mandelbrot" (\_ -> allPoints)
+> 
+> nbDetails = 200 :: GLfloat
+> width  = nbDetails
+> height = nbDetails
+> deep   = nbDetails
+> 
+> depthPoints :: [ColoredPoint]
+> depthPoints = do
+>   x <- [-width..width]
+>   y <- [0..height]
+>   let 
+>     neighbors = [(x,y),(x+1,y),(x+1,y+1),(x,y+1)]
+>     depthOf (u,v) = findMaxOrdFor (ymandel u v) 0 deep 7
+>     -- zs are 3D points with found depth
+>     zs = map (\(u,v) -> (u,v,depthOf (u,v))) neighbors
+>     -- ts are 3D pixels + mandel value
+>     ts = map (\(u,v,w) -> (u,v,w,ymandel u v (w+1))) zs
+>     -- ps are 3D opengl points + color value
+>     ps = map (\(u,v,w,c') -> 
+>         (u/width,v/height,w/deep,colorFromValue c')) ts
+>   -- If the point diverged too fast, don't display it
+>   if (and $ map (\(_,_,_,c) -> c>=57) ts)
+>   then []
+>   -- Draw two triangles
+>   else [ps!!0,ps!!1,ps!!2,ps!!0,ps!!2,ps!!3]
+> 
+> allPoints :: [ColoredPoint]
+> allPoints = planPoints ++ map inverseDepth  planPoints
+>   where 
+>       planPoints = depthPoints ++ map inverseHeight depthPoints
+>       inverseHeight (x,y,z,c) = (x,-y,z,c)
+>       inverseDepth (x,y,z,c) = (x,y,-z+1/deep,c)
+> 
+> findMaxOrdFor func minval maxval 0 = (minval+maxval)/2
+> findMaxOrdFor func minval maxval n = 
+>   if (func medpoint) /= 0 
+>        then findMaxOrdFor func minval medpoint (n-1)
+>        else findMaxOrdFor func medpoint maxval (n-1)
+>   where medpoint = (minval+maxval)/2
+> 
+> colorFromValue n =
+>   let 
+>       t :: Int -> GLfloat
+>       t i = 0.7 + 0.3*cos( fromIntegral i / 10 )
+>   in
+>     ((t n),(t (n+5)),(t (n+10)))
+> 
+> ymandel x y z = mandel (2*x/width) (2*y/height) (2*z/deep) 64

04_Mandelbulb/YBoiler.hs

@@ -0,0 +1,120 @@
+-- An OpenGL boilerplate
+module YBoiler (GLfloat,yMainLoop,ColoredPoint,Color3) where
+
+import Graphics.Rendering.OpenGL
+import Graphics.UI.GLUT
+import Data.IORef
+
+
+type ColorRGB = (GLfloat,GLfloat,GLfloat)
+type YAngle = (GLfloat,GLfloat,GLfloat)
+type ColoredPoint = (GLfloat,GLfloat,GLfloat,ColorRGB)
+
+yMainLoop :: String -> (Int -> [ColoredPoint]) -> IO ()
+yMainLoop windowTitle triangles = do
+  -- GLUT need to be initialized
+  (progname,_) <- getArgsAndInitialize
+  -- We will use the double buffered mode (GL constraint)
+  -- We also Add the DepthBuffer (for 3D)
+  initialDisplayMode $= 
+      [WithDepthBuffer,DoubleBuffered,RGBMode]
+  -- We create a window with some title
+  createWindow windowTitle
+  -- We add some directives
+  depthFunc  $= Just Less
+  -- matrixMode $= Projection
+  windowSize $= Size 500 500
+  -- Some state variables (I know it feels BAD)
+  angle   <- newIORef ((35,0,0)::YAngle)
+  zoom    <- newIORef (2::GLfloat)
+  campos  <- newIORef ((0.7,0)::(GLfloat,GLfloat))
+  -- Action to call when waiting
+  idleCallback $= Just idle
+  -- We will use the keyboard
+  keyboardMouseCallback $= 
+          Just (keyboardMouse angle zoom campos)
+  -- Each time we will need to update the display
+  -- we will call the function 'display'
+  -- But this time, we add some parameters
+  displayCallback $= display angle zoom campos triangles
+  -- We enter the main loop
+  mainLoop
+
+idle = postRedisplay Nothing
+
+-- modify IORef cleanly
+modVar :: IORef a -> (a -> a) -> IO ()
+modVar v f = do
+  v' <- get v
+  v $= (f v')
+-- modify IORef (a,b) using f:a->a
+mapFst f (x,y) = (f x,  y)
+-- modify IORef (a,b) using f:b->b
+mapSnd f (x,y) = (  x,f y)
+mapFst3 f (x,y,z) = (f x, y, z)
+mapSnd3 f (x,y,z) = (x, f y, z)
+mapThi3 f (x,y,z) = (x, y, f z)
+
+-- Get User Input
+keyboardMouse angle zoom pos key state modifiers position =
+  kact angle zoom pos key state
+  where 
+    -- reset view when hitting space
+    kact a z p (Char ' ') Down = do
+          a $= (0,0,0)
+          z $= 1
+          p $= (0,0)
+    -- use of hjkl to rotate
+    kact a _ _ (Char 'j') Down = modVar a (mapFst3 (+0.5))
+    kact a _ _ (Char 'l') Down = modVar a (mapFst3 (+(-0.5)))
+    kact a _ _ (Char 'i') Down = modVar a (mapSnd3 (+0.5))
+    kact a _ _ (Char 'k') Down = modVar a (mapSnd3 (+(-0.5)))
+    kact a _ _ (Char 'o') Down = modVar a (mapThi3 (+0.5))
+    kact a _ _ (Char 'u') Down = modVar a (mapThi3 (+(-0.5)))
+    -- use o and i to zoom
+    kact _ s _ (Char '+') Down = modVar s (*1.1)
+    kact _ s _ (Char '-') Down = modVar s (*0.9)
+    -- use sdfe to move the camera
+    kact _ _ p (Char 's') Down = modVar p (mapFst (+0.1))
+    kact _ _ p (Char 'f') Down = modVar p (mapFst (+(-0.1)))
+    kact _ _ p (Char 'd') Down = modVar p (mapSnd (+0.1))
+    kact _ _ p (Char 'e') Down = modVar p (mapSnd (+(-0.1)))
+    -- any other keys does nothing
+    kact _ _ _ _ _ = return ()
+
+-- The function that will display datas
+display angle zoom position triangles = do
+   -- set the background color (dark solarized theme)
+  clearColor $= Color4 0 0.1686 0.2117 1
+  clear [ColorBuffer,DepthBuffer]
+  -- Transformation to change the view
+  loadIdentity -- reset any transformation
+  -- tranlate
+  (x,y) <- get position
+  translate $ Vector3 x y 0 
+  -- zoom
+  z <- get zoom
+  scale z z z
+  -- rotate
+  (xangle,yangle,zangle) <- get angle
+  rotate xangle $ Vector3 1.0 0.0 (0.0::GLfloat)
+  rotate yangle $ Vector3 0.0 1.0 (0.0::GLfloat)
+  rotate zangle $ Vector3 0.0 0.0 (1.0::GLfloat)
+  -- Now that all transformation were made
+  -- We create the object(s)
+  t <- get elapsedTime
+  preservingMatrix $ drawObject (triangles t)
+  swapBuffers -- refresh screen
+
+red   (r,_,_) = r
+green (_,g,_) = g
+blue  (_,_,b) = b
+
+drawObject triangles = do
+  -- We will print Points (not triangles for example) 
+  renderPrimitive Triangles $ do
+    mapM_ drawColoredPoint triangles
+  where
+      drawColoredPoint (x,y,z,c) = do
+          color $ Color3 (red c) (green c) (blue c)
+          vertex $ Vertex3 x y z