yogsototh/hglmandel
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Nicer step

Browse source
This commit is contained in:
Yann Esposito (Yogsototh) 2012-05-04 20:27:23 +02:00
parent b6c3dfa56e
commit 05c0f5d0dd
1 changed files with 46 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

56
03_Mandelbulb/Mandelbulb.lhs
View file

@ -23,7 +23,7 @@ But it will be enough for us to create something nice.
> data ExtComplex = C (GLfloat,GLfloat,GLfloat) deriving (Show,Eq)
> instance Num ExtComplex where
> fromInteger n = C (fromIntegral n,0.0,0.0)
> C (x,y,u) * C (z,t,v) = C (z*x - y*t + u*v, y*z + x*t - u*v, x*v + y*t + u*z )
> C (x,y,u) * C (z,t,v) = C (z*x - y*t + u*v, y*z + x*t - u*v, x*v - y*z + u*t)
> C (x,y,u) + C (z,t,v) = C (x+z, y+t, u+v)
> abs (C (x,y,z)) = C (sqrt (x*x + y*y + z*z),0.0,0.0)
> signum (C (x,y,z)) = C (signum x , 0.0, 0.0)
@ -46,7 +46,7 @@ But it will be enough for us to create something nice.
> -- GLUT need to be initialized
> (progname,_) <- getArgsAndInitialize
> -- We will use the double buffered mode (GL constraint)
> initialDisplayMode $= [DoubleBuffered]
> initialDisplayMode $= [DoubleBuffered,RGBMode,WithDepthBuffer]
> -- We create a window with some title
> createWindow "Mandelbrot Set with Haskell and OpenGL"
> -- Some state variables
@ -60,6 +60,13 @@ But it will be enough for us to create something nice.
> -- Each time we will need to update the display
> -- we will call the function 'display'
> displayCallback $= display angle zoom position
> -- lighting $= Enabled
> -- ambient (Light 0) $= Color4 0.3 0.3 0.3 1.0
> -- diffuse (Light 0) $= Color4 0.9 0.9 0.8 1.0
> -- light (Light 0) $= Enabled
> -- ambient (Light 1) $= Color4 0.5 0.3 0.3 1.0
> -- diffuse (Light 1) $= Color4 0.9 0.9 0.8 1.0
> -- light (Light 1) $= Enabled
> -- We enter the main loop
> mainLoop
> idle angle delta = do
@ -112,9 +119,9 @@ But it will be enough for us to create something nice.
> preservingMatrix drawMandelbrot
> swapBuffers -- refresh screen
>
> width = 500 :: GLfloat
> height = 500 :: GLfloat
> deep = 500 :: GLfloat
> width = 100 :: GLfloat
> height = 100 :: GLfloat
> deep = 100 :: GLfloat
</div>
@ -125,7 +132,7 @@ We replace the `Points` by `LineLoop`
> drawMandelbrot =
> -- We will print Points (not triangles for example)
> renderPrimitive LineLoop $ do
> renderPrimitive Quads $ do
> mapM_ drawColoredPoint allPoints
> where
> drawColoredPoint (x,y,z,c) = do
@ -140,13 +147,42 @@ we will choose only point on the surface.
> allPoints :: [ColoredPoint]
> allPoints = do
> allPoints = depthPoints ++ map (\(x,y,z,c) -> (x,y,-z,c)) depthPoints
> ++ heightPoints ++ map (\(x,y,z,c) -> (x,y,-z,c)) heightPoints
>
> depthPoints :: [ColoredPoint]
> depthPoints = do
> x <- [-width..width]
> y <- [-height..height]
> let z = findMaxOrdFor (mandel x y) 0 deep 7
> if mandel x y z /= 0
> let
> z = findMaxOrdFor (mandel x y) 0 deep 7
> z' = findMaxOrdFor (mandel (x+1) y) 0 deep 7
> z'' = findMaxOrdFor (mandel (x+1) (y+1)) 0 deep 7
> z''' = findMaxOrdFor (mandel x (y+1)) 0 deep 7
> if (mandel x y (z-1) /= 0)
> then []
> else return (x/width,y/height,z/deep,colorFromValue $ mandel x y (z+1))
> else [(x/width,y/height,z/deep,colorFromValue $ mandel x y (z+1))
> ,((x+1)/width,y/height,z'/deep,colorFromValue $ mandel (x+1) y (z'+1))
> ,((x+1)/width,(y+1)/height,z''/deep,colorFromValue $ mandel (x+1) (y+1) (z''+1))
> ,(x/width,(y+1)/height,z'''/deep,colorFromValue $ mandel x (y+1) (z'''+1))]
> heightPoints :: [ColoredPoint]
> heightPoints = do
> x <- [-width..width]
> z <- [-deep..deep]
> let
> y = findMaxOrdFor (nm x z) 0 height 7
> y' = findMaxOrdFor (nm (x+1) z) 0 height 7
> y'' = findMaxOrdFor (nm (x+1) (z+1)) 0 height 7
> y''' = findMaxOrdFor (nm x (z+1)) 0 height 7
> if (mandel x (y-1) z /= 0)
> then []
> else [(x/width,y/height,z/deep,colorFromValue $ mandel x y z)
> ,((x+1)/width,y'/height,z/deep,colorFromValue $ mandel (x+1) y' z)
> ,((x+1)/width,y''/height,z/deep,colorFromValue $ mandel (x+1) y'' (z+1))
> ,(x/width,y'''/height,z/deep,colorFromValue $ mandel x y''' (z+1))]
> where
> nm x z = \y -> mandel x y z
This function is interresting.
For those not used to the list monad here is a natural language version of this function: