Cleaned version
This commit is contained in:
parent
ac769474f6
commit
c7eb9f254b
4 changed files with 233 additions and 0 deletions
33
04_Mandelbulb/ExtComplex.hs
Normal file
33
04_Mandelbulb/ExtComplex.hs
Normal file
|
@ -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
|
13
04_Mandelbulb/Mandel.hs
Normal file
13
04_Mandelbulb/Mandel.hs
Normal file
|
@ -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)
|
67
04_Mandelbulb/Mandelbulb.lhs
Normal file
67
04_Mandelbulb/Mandelbulb.lhs
Normal file
|
@ -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
|
120
04_Mandelbulb/YBoiler.hs
Normal file
120
04_Mandelbulb/YBoiler.hs
Normal file
|
@ -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
|
Loading…
Reference in a new issue