diff --git a/.gitignore b/.gitignore
index b2c2064..a39d61e 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,5 +1,9 @@
*.o
*.hi
*~
+*.swp
Mandelbulb
hglmandel
+.stack-work/
+dist/
+.hdevtools.sock
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..5bb212a
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,3 @@
+Public Domain. Do what you want with it. Just don't be a dick.
+
+Also, I can't give you what I've done. So you are forced to remember I'm at the source of this repo.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/hglmandel.cabal b/hglmandel.cabal
new file mode 100644
index 0000000..339db9e
--- /dev/null
+++ b/hglmandel.cabal
@@ -0,0 +1,30 @@
+-- Initial hglmandel.cabal generated by cabal init. For further
+-- documentation, see http://haskell.org/cabal/users-guide/
+
+name: hglmandel
+version: 0.1.0.0
+synopsis: 3D Fractals
+-- description:
+homepage: http://yannesposito.com/Scratch/fr/blog/Haskell-OpenGL-Mandelbrot/
+license: PublicDomain
+license-file: LICENSE
+author: Yann Esposito (Yogsototh)
+maintainer: Yann.Esposito@gmail.com
+-- copyright:
+category: Graphics
+build-type: Simple
+-- extra-source-files:
+cabal-version: >=1.10
+
+executable hglmandel
+ main-is: Mandelbulb.lhs
+ -- other-modules:
+ -- other-extensions:
+ build-depends: base
+ , containers
+ , GLUT
+ , OpenGL
+ , OpenGLRaw
+ hs-source-dirs: src
+ ghc-options: -Wall -dynamic
+ default-language: Haskell2010
diff --git a/src/ExtComplex.hs b/src/ExtComplex.hs
new file mode 100644
index 0000000..caba8d0
--- /dev/null
+++ b/src/ExtComplex.hs
@@ -0,0 +1,37 @@
+module ExtComplex where
+
+import Graphics.Rendering.OpenGL
+
+-- This time I use unpacked strict data type
+-- Far faster when compiled.
+data ExtComplex = C {-# UNPACK #-} !GLfloat
+ {-# UNPACK #-} !GLfloat
+ {-# UNPACK #-} !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) (signum y) (signum z)
+
+extcomplex :: GLfloat -> GLfloat -> GLfloat -> ExtComplex
+extcomplex x y z = C x y z
+
+real :: ExtComplex -> GLfloat
+real (C x _ _) = x
+
+im :: ExtComplex -> GLfloat
+im (C _ y _) = y
+
+strange :: ExtComplex -> GLfloat
+strange (C _ _ z) = z
+
+magnitude :: ExtComplex -> GLfloat
+magnitude = real.abs
diff --git a/src/Mandel.hs b/src/Mandel.hs
new file mode 100644
index 0000000..62787da
--- /dev/null
+++ b/src/Mandel.hs
@@ -0,0 +1,15 @@
+-- The Mandelbrot function
+module Mandel (mandel) where
+
+import ExtComplex
+import Graphics.Rendering.OpenGL.Raw.Types (GLfloat)
+
+mandel :: GLfloat -> GLfloat -> GLfloat -> Int -> Int
+mandel r i s nbIterations =
+ f (extcomplex r i s) 0 nbIterations
+ where
+ f :: ExtComplex -> ExtComplex -> Int -> Int
+ f _ _ 0 = 0
+ f c z n = if (magnitude z > 2 )
+ then n
+ else f c ((z*z)+c) (n-1)
diff --git a/src/Mandelbulb.lhs b/src/Mandelbulb.lhs
new file mode 100644
index 0000000..90b9e04
--- /dev/null
+++ b/src/Mandelbulb.lhs
@@ -0,0 +1,220 @@
+ ## Optimization
+
+Our code architecture feel very clean.
+All the meaningful code is in our main file and all display details are
+externalized.
+If you read the code of `YGL.hs`, you'll see I didn't made everything perfect.
+For example, I didn't finished the code of the lights.
+But I believe it is a good first step and it will be easy to go further.
+Unfortunately the program of the preceding session is extremely slow.
+We compute the Mandelbulb for each frame now.
+
+Before our program structure was:
+
+
+Constant Function -> Constant List of Triangles -> Display
+
+
+Now we have
+
+
+Main loop -> World -> Function -> List of Objects -> Atoms -> Display
+
+
+The World state could change.
+The compiler can no more optimize the computation for us.
+We have to manually explain when to redraw the shape.
+
+To optimize we must do some things in a lower level.
+Mostly the program remains the same,
+but it will provide the list of atoms directly.
+
+
+
+> import YGL -- Most the OpenGL Boilerplate
+> import Mandel -- The 3D Mandelbrot maths
+>
+> -- Centralize all user input interaction
+> inputActionMap :: InputMap World
+> inputActionMap = inputMapFromList [
+> (Press ' ' , switchRotation)
+> ,(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 2.0)
+> ,(Press 'g' , resize (1/2.0))
+> ]
+
+
+
+> data World = World {
+> angle :: Point3D
+> , anglePerSec :: Scalar
+> , scale :: Scalar
+> , position :: Point3D
+> , box :: Box3D
+> , told :: Time
+> -- We replace shape by cache
+> , cache :: [YObject]
+> }
+
+
+> instance DisplayableWorld World where
+> winTitle _ = "The YGL Mandelbulb"
+> camera w = Camera {
+> camPos = position w,
+> camDir = angle w,
+> camZoom = scale w }
+> -- We update our objects instanciation
+> objects = cache
+
+
+
+> 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) }
+>
+> switchRotation :: World -> World
+> switchRotation world =
+> world {
+> anglePerSec = if anglePerSec world > 0 then 0 else 5.0 }
+>
+> 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 }
+
+> main :: IO ()
+> main = yMainLoop inputActionMap idleAction initialWorld
+
+
+
+Our initial world state is slightly changed:
+
+> -- 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)
+> , anglePerSec = 5.0
+> , position = makePoint3D (0,0,0)
+> , scale = 1.0
+> , box = Box3D { minPoint = makePoint3D (0-eps, 0-eps, 0-eps)
+> , maxPoint = makePoint3D (0+eps, 0+eps, 0+eps)
+> , resolution = 0.02 }
+> , told = 0
+> -- We declare cache directly this time
+> , cache = objectFunctionFromWorld initialWorld
+> }
+> where eps=2
+
+The use of `eps` is a hint to make a better zoom by computing with the right bounds.
+
+We use the `YGL.getObject3DFromShapeFunction` function directly.
+This way instead of providing `XYFunc`, we provide directly a list of Atoms.
+
+> objectFunctionFromWorld :: World -> [YObject]
+> objectFunctionFromWorld w = [Atoms atomList]
+> where atomListPositive =
+> getObject3DFromShapeFunction
+> (shapeFunc (resolution (box w))) (box w)
+> atomList = atomListPositive ++
+> map negativeTriangle atomListPositive
+> negativeTriangle (ColoredTriangle (p1,p2,p3,c)) =
+> ColoredTriangle (negz p1,negz p3,negz p2,c)
+> where negz (P (x,y,z)) = P (x,y,-z)
+
+We know that resize is the only world change that necessitate to
+recompute the list of atoms (triangles).
+Then we update our world state accordingly.
+
+> resize :: Scalar -> World -> World
+> resize r world =
+> tmpWorld { cache = objectFunctionFromWorld tmpWorld }
+> where
+> tmpWorld = world { box = (box world) {
+> resolution = sqrt ((resolution (box world))**2 * r) }}
+
+All the rest is exactly the same.
+
+
+
+> idleAction :: Time -> World -> World
+> idleAction tnew world =
+> world {
+> angle = angle world + (delta -*< zdir)
+> , told = tnew
+> }
+> where
+> delta = anglePerSec world * elapsed / 1000.0
+> elapsed = fromIntegral (tnew - (told world))
+>
+> shapeFunc :: Scalar -> Function3D
+> shapeFunc res x y =
+> let
+> z = maxZeroIndex (ymandel x y) 0 1 20
+> in
+> if and [ maxZeroIndex (ymandel (x+xeps) (y+yeps)) 0 1 20 < 0.000001 |
+> val <- [res], xeps <- [-val,val], yeps<-[-val,val]]
+> then Nothing
+> else Just (z,colorFromValue 0)
+>
+> colorFromValue :: Point -> Color
+> colorFromValue n =
+> let
+> t :: Point -> Scalar
+> t i = 0.0 + 0.5*cos( i /10 )
+> in
+> makeColor (t n) (t (n+5)) (t (n+10))
+>
+> -- given f min max nbtest,
+> -- considering
+> -- - f is an increasing function
+> -- - f(min)=0
+> -- - f(max)≠0
+> -- then maxZeroIndex f min max nbtest returns x such that
+> -- f(x - ε)=0 and f(x + ε)≠0
+> -- where ε=(max-min)/2^(nbtest+1)
+> maxZeroIndex :: (Fractional a,Num a,Num b,Eq b) =>
+> (a -> b) -> a -> a -> Int -> a
+> maxZeroIndex _ minval maxval 0 = (minval+maxval)/2
+> maxZeroIndex func minval maxval n =
+> if func medpoint /= 0
+> then maxZeroIndex func minval medpoint (n-1)
+> else maxZeroIndex 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
+
+
+
+And you can also consider minor changes in the `YGL.hs` source file.
+
+- [`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/src/YGL.hs b/src/YGL.hs
new file mode 100644
index 0000000..0cddeb5
--- /dev/null
+++ b/src/YGL.hs
@@ -0,0 +1,384 @@
+{-
+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 (
+ -- Here is declared our interface with external files
+ -- that will include our YGL module
+
+ -- Declarations related to data types
+ Point -- the 1 dimension point type
+ , Time -- the type for the time
+ , Scalar -- the type for scalar values
+ , Color -- the type for color (3 scalars)
+ , Point3D (..) -- A 3D point type (3 Points)
+ , makePoint3D -- helper (x,y,z) -> Point3D
+ , (-*<) -- scalar product on Point3D a -*< (x,y,z) = (ax,ay,az)
+ , Function3D -- Point -> Point -> Maybe (Point,Color)
+ , xpoint, ypoint, zpoint
+ , Atom (..) -- The Atom object (colored triangles for now)
+
+ -- Your world state must be an instance
+ -- of the DisplayableWorld type class
+ , DisplayableWorld (..)
+ -- Datas related to DisplayableWorld
+ , Camera (..)
+ , YObject (..) -- 3D Objects to display
+ , Box3D (..) -- Some bounded 3D box
+ , getObject3DFromShapeFunction
+ , makeBox -- helper to make a box
+ , hexColor -- Color from hexadecimal string
+ , makeColor -- make color from RGB values
+
+ -- Interface related to user input
+ , InputMap
+ , UserInput (Press,Ctrl,Alt,CtrlAlt)
+ , inputMapFromList
+
+ -- The main loop function to call
+ , yMainLoop
+) where
+
+-- A bunch of imports
+import Numeric (readHex) -- to read hexadecimal values
+
+-- Import of OpenGL and GLUT
+-- but, I use my own Color type, therefore I hide the definition
+-- of Color inside GLUT and OpenGL packages
+import Graphics.Rendering.OpenGL hiding (Color)
+import Graphics.UI.GLUT hiding (Color)
+import Data.IORef
+
+-- I use Map to deal with user interaction
+import qualified Data.Map as Map
+
+-- Some standard stuff
+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
+
+-- Get x (resp. y, z) coordinate of a 3D point
+xpoint :: Point3D -> Point
+xpoint (P (x,_,_)) = x
+ypoint :: Point3D -> Point
+ypoint (P (_,y,_)) = y
+zpoint :: Point3D -> Point
+zpoint (P (_,_,z)) = z
+
+-- Create a Point3D element from a triplet
+makePoint3D :: (Point,Point,Point) -> Point3D
+makePoint3D = P
+
+-- Make Point3D an instance of Num
+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)
+
+-- The scalar product
+infixr 5 -*<
+(-*<) :: Scalar -> Point3D -> Point3D
+(-*<) s p = P (s*xpoint p, s*ypoint p, s*zpoint p)
+
+-- Used internally to convert point3D to different types
+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 }
+
+-- | A Triangle3D is simply 3 points and a color
+type Triangle3D = (Point3D,Point3D,Point3D,Color)
+
+-- | The type Atom is the atom for our display here we'll only use triangles.
+-- | For a general purpose library we should add many other different atoms
+-- | corresponding to Quads for example.
+data Atom = ColoredTriangle Triangle3D
+
+-- | A Function3D is simply a function for each x,y associate a z and a color
+-- | If undefined at point (x,y), it returns Nothing.
+type Function3D = Point -> Point -> Maybe (Point,Color)
+
+-- | Our objects that will be displayed
+-- | Wether a function3D delimited by a Box
+-- | or a list of Atoms
+data YObject = XYFunc Function3D Box3D
+ | Atoms [Atom]
+
+-- | The function atoms retrieve the list of atoms from an YObject
+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
+-- | I don't use Mouse but it can be easily added
+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 is a type for which
+-- | ther exists a function that provide sufficient informations
+-- | to provide a camera, lights, objects and a window title.
+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 }
+
+-- | A default initial camera
+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 Atoms (here only colored 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
+
+-- | Get the user input map from a list
+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 pure functional function.
+--}
+yMainLoop :: (DisplayableWorld worldType) =>
+ -- the mapping user input / world
+ InputMap worldType
+ -- function that modify the world
+ -> (Time -> worldType -> worldType)
+ -- the world state of type worldType
+ -> worldType
+ -- into IO () for obvious reason
+ -> IO ()
+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
+ -- let OpenGL resize normal vectors to unity
+ normalize $= Enabled
+ shadeModel $= Smooth
+ -- Lights (in a better version should be put elsewhere)
+ lighting $= Enabled
+ ambient (Light 0) $= Color4 0.5 0.5 0.5 1
+ diffuse (Light 0) $= Color4 1 1 1 1
+ light (Light 0) $= Enabled
+ pointSmooth $= Enabled
+
+ colorMaterial $= Just (Front,AmbientAndDiffuse)
+ materialAmbient Front $= Color4 0.0 0.0 0.0 1
+ materialDiffuse Front $= Color4 0.0 0.0 0.0 1
+ materialSpecular Front $= Color4 1 1 1 1
+ materialEmission Front $= Color4 0.0 0.0 0.0 1
+ materialShininess Front $= 96
+ -- 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 complete if you want to finish it
+ 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 t world, DisplayableWorld world) => t -> 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)
+ -- Could also be externalized to world state
+ 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
+
+-- | Color from CSS style color string
+hexColor :: String -> 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!!!!"
+
+-- | Helper to make a color from RGB scalar values
+makeColor :: Scalar -> Scalar -> Scalar -> Color
+makeColor = Color3
+
+-- | Where the drawing occurs
+drawObject :: YObject -> IO()
+drawObject shape = renderPrimitive Triangles $
+ 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
+-- I don't normalize it; it is done by OpenGL
+-- in main with 'normalize $= Enabled'
+getNormal :: Atom -> Point3D
+getNormal (ColoredTriangle (p0,p1,p2,_)) = (p1 - p0) * (p2 - p0)
diff --git a/stack.yaml b/stack.yaml
new file mode 100644
index 0000000..6252712
--- /dev/null
+++ b/stack.yaml
@@ -0,0 +1,5 @@
+flags: {}
+packages:
+- '.'
+extra-deps: []
+resolver: lts-2.17