diff --git a/06_Mandelbulb/ExtComplex.hs b/06_Mandelbulb/ExtComplex.hs
new file mode 100644
index 0000000..6500028
--- /dev/null
+++ b/06_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
diff --git a/06_Mandelbulb/Mandel.hs b/06_Mandelbulb/Mandel.hs
new file mode 100644
index 0000000..9500e0b
--- /dev/null
+++ b/06_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)
diff --git a/06_Mandelbulb/Mandelbulb.lhs b/06_Mandelbulb/Mandelbulb.lhs
new file mode 100644
index 0000000..c919c57
--- /dev/null
+++ b/06_Mandelbulb/Mandelbulb.lhs
@@ -0,0 +1,188 @@
+ ## Optimization
+
+
+> import YGL -- Most the OpenGL Boilerplate
+> import Mandel -- The 3D Mandelbrot maths
+> import Data.Maybe (isNothing)
+
+
+> -- Centralize all user input interaction
+> inputActionMap :: InputMap World
+> inputActionMap = inputMapFromList [
+> (Press 'k' , rotate xdir 5)
+> ,(Press 'i' , rotate xdir (-5))
+> ,(Press 'j' , rotate ydir 5)
+> ,(Press 'l' , rotate ydir (-5))
+> ,(Press 'o' , rotate zdir 5)
+> ,(Press 'u' , rotate zdir (-5))
+> ,(Press 'f' , translate xdir 0.1)
+> ,(Press 's' , translate xdir (-0.1))
+> ,(Press 'e' , translate ydir 0.1)
+> ,(Press 'd' , translate ydir (-0.1))
+> ,(Press 'z' , translate zdir 0.1)
+> ,(Press 'r' , translate zdir (-0.1))
+> ,(Press '+' , zoom 1.1)
+> ,(Press '-' , zoom (1/1.1))
+> ,(Press 'h' , resize 1.2)
+> ,(Press 'g' , resize (1/1.2))
+> ]
+
+
+> -- I prefer to set my own name for these types
+> data World = World {
+> angle :: Point3D
+> , scale :: Scalar
+> , position :: Point3D
+> , shape :: Scalar -> Function3D
+> , box :: Box3D
+> , told :: Time -- last frame time
+> , toCompute :: Bool
+> , cache :: [YObject]
+> }
+
+
+> instance DisplayableWorld World where
+> winTitle _ = "The YGL Mandelbulb"
+> camera w = Camera {
+> camPos = position w,
+> camDir = angle w,
+> camZoom = scale w }
+> objects w = cache w
+
+
+
+> xdir :: Point3D
+> xdir = makePoint3D (1,0,0)
+> ydir :: Point3D
+> ydir = makePoint3D (0,1,0)
+> zdir :: Point3D
+> zdir = makePoint3D (0,0,1)
+>
+> rotate :: Point3D -> Scalar -> World -> World
+> rotate dir angleValue world =
+> world {
+> angle = (angle world) + (angleValue -*< dir) }
+>
+> translate :: Point3D -> Scalar -> World -> World
+> translate dir len world =
+> world {
+> position = (position world) + (len -*< dir) }
+>
+> zoom :: Scalar -> World -> World
+> zoom z world = world {
+> scale = z * scale world }
+>
+> resize :: Scalar -> World -> World
+> resize r world =
+> tmpWorld { cache = objectFunctionFromWorld tmpWorld }
+> where
+> tmpWorld = world { box = (box world) {
+> resolution = sqrt ((resolution (box world))**2 * r) }}
+>
+> main :: IO ()
+> main = yMainLoop inputActionMap idleAction initialWorld
+
+> -- We initialize the world state
+> -- then angle, position and zoom of the camera
+> -- And the shape function
+> initialWorld :: World
+> initialWorld = World {
+> angle = makePoint3D (-30,-30,0)
+> , position = makePoint3D (0,0,0)
+> , scale = 0.8
+> , shape = shapeFunc
+> , box = Box3D { minPoint = makePoint3D (-2,-2,-2)
+> , maxPoint = makePoint3D (2,2,2)
+> , resolution = 0.16 }
+> , told = 0
+> , cache = objectFunctionFromWorld initialWorld
+> , toCompute = True
+> }
+>
+> objectFunctionFromWorld w = [Atoms $
+> getObject3DFromShapeFunction (shapeFunc (resolution (box w))) (box w)]
+>
+> getObject3DFromShapeFunction :: Function3D -> Box3D -> [Atom]
+> getObject3DFromShapeFunction shape box = do
+> x <- [xmin,xmin+res..xmax]
+> y <- [ymin,ymin+res..ymax]
+> let
+> neighbors = [(x,y),(x+res,y),(x+res,y+res),(x,y+res)]
+> -- zs are 3D points with found depth and color
+> -- zs :: [ (Point,Point,Point,Maybe (Point,Color) ]
+> zs = map (\(u,v) -> (u,v,shape u v)) neighbors
+> -- ps are 3D opengl points + color value
+> ps = zs
+> -- If the point diverged too fast, don't display it
+> if any (\(_,_,z) -> isNothing z) zs
+> then []
+> -- Draw two triangles
+> -- 3 - 2
+> -- | / |
+> -- 0 - 1
+> -- The order is important
+> else
+> [ makeAtom (ps!!0) (ps!!2) (ps!!1)
+> , makeAtom (ps!!0) (ps!!3) (ps!!2) ]
+> where
+> makeAtom (p0x,p0y,Just (p0z,c0)) (p1x,p1y,Just (p1z,_)) (p2x,p2y,Just (p2z,_)) =
+> ColoredTriangle (makePoint3D (p0x,p0y,p0z)
+> ,makePoint3D (p1x,p1y,p1z)
+> ,makePoint3D (p2x,p2y,p2z)
+> ,c0)
+> makeAtom _ _ _ = error "Somethings wrong here"
+> -- some naming to make it
+> -- easier to read
+> xmin = xpoint $ minPoint box
+> xmax = xpoint $ maxPoint box
+> ymin = ypoint $ minPoint box
+> ymax = ypoint $ maxPoint box
+> res = resolution box
+>
+> idleAction :: Time -> World -> World
+> idleAction tnew world =
+> world {
+> angle = (angle world) + (delta -*< zdir)
+> , told = tnew
+> }
+> where
+> anglePerSec = 5.0
+> delta = anglePerSec * elapsed / 1000.0
+> elapsed = fromIntegral (tnew - (told world))
+>
+> shapeFunc :: Scalar -> Function3D
+> shapeFunc res x y =
+> let
+> z = findMaxOrdFor (ymandel x y) 0 1 20
+> in
+> if and [ findMaxOrdFor (ymandel (x+xeps) (y+yeps)) 0 1 20 < 0.000001 |
+> val <- [res], xeps <- [-val,val], yeps<-[-val,val]]
+> then Nothing
+> else Just (z,colorFromValue ((ymandel x y z) * 64))
+>
+> colorFromValue :: Point -> Color
+> colorFromValue n =
+> let
+> t :: Point -> Scalar
+> t i = 0.7 + 0.3*cos( i / 10 )
+> in
+> makeColor (t n) (t (n+5)) (t (n+10))
+>
+> findMaxOrdFor :: (Fractional a,Num a,Num b,Eq b) =>
+> (a -> b) -> a -> a -> Int -> a
+> findMaxOrdFor _ 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
+>
+> ymandel :: Point -> Point -> Point -> Point
+> ymandel x y z = fromIntegral (mandel x y z 64) / 64
+
+
+
+- [`YGL.hs`](code/06_Mandelbulb/YGL.hs), the 3D rendering framework
+- [`Mandel`](code/06_Mandelbulb/Mandel.hs), the mandel function
+- [`ExtComplex`](code/06_Mandelbulb/ExtComplex.hs), the extended complexes
+
diff --git a/06_Mandelbulb/YGL.hs b/06_Mandelbulb/YGL.hs
new file mode 100644
index 0000000..336713b
--- /dev/null
+++ b/06_Mandelbulb/YGL.hs
@@ -0,0 +1,344 @@
+-- The languages include needed because I wanted to use
+-- (Point,Point,Point) instead of
+-- data Point3D = Point3D (Point,Point,Point) deriving ...
+{-
+The module YGL will contains most boilerplate
+And display details.
+
+To make things even nicer, we should separate
+this file in many different parts.
+Typically separate the display function.
+
+-}
+module YGL (
+ -- Datas
+ Point
+ , Time
+ , Scalar
+ , Color
+ , Point3D
+ , makePoint3D -- helper (x,y,z) -> Point3D
+ , (-*<) -- scalar product on Point3D
+ , Function3D
+ , xpoint, ypoint, zpoint
+ , Atom (..)
+ -- Your world state must be an instance
+ -- of the DisplayableWorld type class
+ , DisplayableWorld (..)
+ -- Datas related to DisplayableWorld
+ , Camera (..)
+ , YObject (..)
+ , Box3D (..)
+ , makeBox
+ , hexColor
+ , makeColor
+ -- Datas related to user Input
+ , InputMap
+ , UserInput (Press,Ctrl,Alt,CtrlAlt)
+ , inputMapFromList
+ -- The main loop function to call
+ , yMainLoop) where
+
+import Numeric (readHex)
+import Graphics.Rendering.OpenGL hiding (Color)
+import Graphics.UI.GLUT hiding (Color)
+import Data.IORef
+import qualified Data.Map as Map
+import Control.Monad (when)
+import Data.Maybe (isNothing)
+
+{-- Things start to be complex here.
+- Just take the time to follow me.
+--}
+
+-- | A 1D point
+type Point = GLfloat
+-- | A Scalar value
+type Scalar = GLfloat
+-- | The time type (currently its Int
+type Time = Int
+-- | A 3D Point mainly '(x,y,z)'
+data Point3D = P (Point,Point,Point) deriving (Eq,Show,Read)
+type Color = Color3 Scalar
+
+xpoint :: Point3D -> Point
+xpoint (P (x,_,_)) = x
+ypoint :: Point3D -> Point
+ypoint (P (_,y,_)) = y
+zpoint :: Point3D -> Point
+zpoint (P (_,_,z)) = z
+
+makePoint3D :: (Point,Point,Point) -> Point3D
+makePoint3D p = P p
+
+
+instance Num Point3D where
+ (+) (P (ax,ay,az)) (P (bx,by,bz)) = P (ax+bx,ay+by,az+bz)
+ (-) (P (ax,ay,az)) (P (bx,by,bz)) = P (ax-bx,ay-by,az-bz)
+ (*) (P (ax,ay,az)) (P (bx,by,bz)) = P ( ay*bz - az*by
+ , az*bx - ax*bz
+ , ax*by - ay*bx )
+ abs (P (x,y,z)) = P (abs x,abs y, abs z)
+ signum (P (x,y,z)) = P (signum x, signum y, signum z)
+ fromInteger i = P (fromInteger i, 0, 0)
+
+infixr 5 -*<
+(-*<) :: Scalar -> Point3D -> Point3D
+(-*<) s p = P (s*xpoint p, s*ypoint p, s*zpoint p)
+
+
+toGLVector3 :: Point3D -> Vector3 GLfloat
+toGLVector3 (P(x,y,z)) = Vector3 x y z
+
+toGLVertex3 :: Point3D -> Vertex3 GLfloat
+toGLVertex3 (P(x,y,z)) = Vertex3 x y z
+
+toGLNormal3 :: Point3D -> Normal3 GLfloat
+toGLNormal3 (P(x,y,z)) = Normal3 x y z
+
+-- | The Box3D type represent a 3D bounding box
+-- | Note if minPoint = (x,y,z) and maxPoint = (x',y',z')
+-- | Then to have a non empty box you must have
+-- | x (Point,Point,Point) -> Scalar -> Box3D
+makeBox mini maxi res = Box3D {
+ minPoint = makePoint3D mini
+ , maxPoint = makePoint3D maxi
+ , resolution = res }
+
+type Triangle3D = (Point3D,Point3D,Point3D,Color)
+-- For a general purpose library we should add many other different atoms
+-- corresponding to Quads for example.
+data Atom = ColoredTriangle Triangle3D
+type Function3D = Point -> Point -> Maybe (Point,Color)
+data YObject = XYFunc Function3D Box3D
+ | Atoms [Atom]
+
+atoms :: YObject -> [Atom]
+atoms (XYFunc f b) = getObject3DFromShapeFunction f b
+atoms (Atoms atomList) = atomList
+
+-- | We decalre the input map type we need here
+-- | It is our API
+type InputMap worldType = Map.Map UserInput (worldType -> worldType)
+data UserInput = Press Char | Ctrl Char | Alt Char | CtrlAlt Char
+ deriving (Eq,Ord,Show,Read)
+
+-- | A displayable world
+class DisplayableWorld world where
+ camera :: world -> Camera
+ camera _ = defaultCamera
+ lights :: world -> [Light]
+ lights _ = []
+ objects :: world -> [YObject]
+ objects _ = []
+ winTitle :: world -> String
+ winTitle _ = "YGL"
+
+-- | the Camera type to know how to
+-- | Transform the scene to see the right view.
+data Camera = Camera {
+ camPos :: Point3D
+ , camDir :: Point3D
+ , camZoom :: Scalar }
+
+defaultCamera :: Camera
+defaultCamera = Camera {
+ camPos = makePoint3D (0,0,0)
+ , camDir = makePoint3D (0,0,0)
+ , camZoom = 1 }
+
+
+-- Given a shape function and a delimited Box3D
+-- return a list of Triangles to be displayed
+getObject3DFromShapeFunction :: Function3D -> Box3D -> [Atom]
+getObject3DFromShapeFunction shape box = do
+ x <- [xmin,xmin+res..xmax]
+ y <- [ymin,ymin+res..ymax]
+ let
+ neighbors = [(x,y),(x+res,y),(x+res,y+res),(x,y+res)]
+ -- zs are 3D points with found depth and color
+ -- zs :: [ (Point,Point,Point,Maybe (Point,Color) ]
+ zs = map (\(u,v) -> (u,v,shape u v)) neighbors
+ -- ps are 3D opengl points + color value
+ ps = zs
+ -- If the point diverged too fast, don't display it
+ if any (\(_,_,z) -> isNothing z) zs
+ then []
+ -- Draw two triangles
+ -- 3 - 2
+ -- | / |
+ -- 0 - 1
+ -- The order is important
+ else
+ [ makeAtom (ps!!0) (ps!!2) (ps!!1)
+ , makeAtom (ps!!0) (ps!!3) (ps!!2) ]
+ where
+ makeAtom (p0x,p0y,Just (p0z,c0)) (p1x,p1y,Just (p1z,_)) (p2x,p2y,Just (p2z,_)) =
+ ColoredTriangle (makePoint3D (p0x,p0y,p0z)
+ ,makePoint3D (p1x,p1y,p1z)
+ ,makePoint3D (p2x,p2y,p2z)
+ ,c0)
+ makeAtom _ _ _ = error "Somethings wrong here"
+
+ -- some naming to make it
+ -- easier to read
+ xmin = xpoint $ minPoint box
+ xmax = xpoint $ maxPoint box
+ ymin = ypoint $ minPoint box
+ ymax = ypoint $ maxPoint box
+ res = resolution box
+
+inputMapFromList :: (DisplayableWorld world) =>
+ [(UserInput,world -> world)] -> InputMap world
+inputMapFromList = Map.fromList
+
+{--
+- We set our mainLoop function
+- As you can see the code is _not_ pure
+- and not even functionnal friendly!
+- But when called,
+- it will look like a standard function.
+--}
+yMainLoop :: (DisplayableWorld worldType) =>
+ InputMap worldType -- the mapping user input / world
+ -> (Time -> worldType -> worldType)
+ -> worldType -- the world state
+ -> IO () -- into IO () for obvious reason
+yMainLoop inputActionMap
+ worldTranformer
+ world = do
+ -- The boilerplate
+ _ <- getArgsAndInitialize
+ initialDisplayMode $=
+ [WithDepthBuffer,DoubleBuffered,RGBMode]
+ _ <- createWindow $ winTitle world
+ depthFunc $= Just Less
+ windowSize $= Size 500 500
+ -- The state variables for the world (I know it feels BAD)
+ worldRef <- newIORef world
+ -- Action to call when waiting
+ idleCallback $= Just (idle worldTranformer worldRef)
+ -- the keyboard will update the world
+ keyboardMouseCallback $=
+ Just (keyboardMouse inputActionMap worldRef)
+ -- We generate one frame using the callback
+ displayCallback $= display worldRef
+ -- Lights
+ lighting $= Enabled
+ ambient (Light 0) $= Color4 0 0 0 1
+ diffuse (Light 0) $= Color4 1 1 1 1
+ specular (Light 0) $= Color4 1 1 1 1
+ position (Light 0) $= Vertex4 1 1 0 1
+ light (Light 0) $= Enabled
+ colorMaterial $= Just (Front,AmbientAndDiffuse)
+ materialDiffuse Front $= Color4 0.5 0.5 0.5 1
+ materialAmbient Front $= Color4 0.5 0.5 0.5 1
+ materialSpecular Front $= Color4 0.2 0.2 0.2 1
+ materialEmission Front $= Color4 0.3 0.3 0.3 1
+ materialShininess Front $= 50.0
+ -- We enter the main loop
+ mainLoop
+
+-- When no user input entered do nothing
+idle :: (Time -> worldType -> worldType) -> IORef worldType -> IO ()
+idle worldTranformer world = do
+ w <- get world
+ t <- get elapsedTime
+ world $= worldTranformer t w
+ postRedisplay Nothing
+
+-- Get User Input
+-- both cleaner, terser and more expendable than the preceeding code
+keyboardMouse :: InputMap a -> IORef a
+ -> Key -> KeyState -> Modifiers -> Position -> IO()
+keyboardMouse input world key state _ _ =
+ when (state == Down) $
+ let
+ charFromKey (Char c) = c
+ -- To replace
+ charFromKey _ = '#'
+
+ transformator = Map.lookup (Press (charFromKey key)) input
+ in
+ mayTransform transformator
+ where
+ mayTransform Nothing = return ()
+ mayTransform (Just transform) = do
+ w <- get world
+ world $= transform w
+
+
+-- The function that will display datas
+display :: (HasGetter g, DisplayableWorld world) =>
+ g world -> IO ()
+display worldRef = do
+ -- BEWARE UGLINESS!!!!
+ -- SHOULD NEVER MODIFY worldRef HERE!!!!
+ --
+ -- I SAID NEVER.
+ w <- get worldRef
+ -- NO REALLY, NEVER!!!!
+ -- If someone write a line starting by
+ -- w $= ... Shoot him immediately in the head
+ -- and refere to competent authorities
+ let cam = camera w
+ -- 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
+ translate $ toGLVector3 (camPos cam)
+ -- zoom
+ scale (camZoom cam) (camZoom cam) (camZoom cam)
+ -- rotate
+ rotate (xpoint (camDir cam)) $ Vector3 1.0 0.0 (0.0::GLfloat)
+ rotate (ypoint (camDir cam)) $ Vector3 0.0 1.0 (0.0::GLfloat)
+ rotate (zpoint (camDir cam)) $ Vector3 0.0 0.0 (1.0::GLfloat)
+ -- Now that all transformation were made
+ -- We create the object(s)
+ _ <- preservingMatrix $ mapM drawObject (objects w)
+ swapBuffers -- refresh screen
+
+-- Hexa style colors
+scalarFromHex :: String -> Scalar
+scalarFromHex = (/256) . fst . head . readHex
+
+hexColor :: [Char] -> Color
+hexColor ('#':rd:ru:gd:gu:bd:bu:[]) = Color3 (scalarFromHex (rd:ru:[]))
+ (scalarFromHex (gd:gu:[]))
+ (scalarFromHex (bd:bu:[]))
+hexColor ('#':r:g:b:[]) = hexColor ('#':r:r:g:g:b:b:[])
+hexColor _ = error "Bad color!!!!"
+
+makeColor :: Scalar -> Scalar -> Scalar -> Color
+makeColor x y z = Color3 x y z
+---
+
+-- drawObject :: (YObject obj) => obj -> IO()
+drawObject :: YObject -> IO()
+drawObject shape = do
+ -- We will print only Triangles
+ renderPrimitive Triangles $ do
+ -- solarized base3 color
+ -- color $ hexColor "#fdf603"
+ mapM_ drawAtom (atoms shape)
+
+-- simply draw an Atom
+drawAtom :: Atom -> IO ()
+drawAtom atom@(ColoredTriangle (p0,p1,p2,c)) = do
+ color c
+ normal $ toGLNormal3 (getNormal atom)
+ vertex $ toGLVertex3 p0
+ vertex $ toGLVertex3 p1
+ vertex $ toGLVertex3 p2
+
+-- get the normal vector of an Atom
+getNormal :: Atom -> Point3D
+getNormal (ColoredTriangle (p0,p1,p2,_)) = (p1 - p0) * (p2 - p0)