made a stack version for hglmandel

.gitignore

@@ -1,5 +1,9 @@
 *.o
 *.hi
 *~
+*.swp
 Mandelbulb
 hglmandel
+.stack-work/
+dist/
+.hdevtools.sock

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.

Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

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

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

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)

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:
+
+<code class="no-highlight">
+Constant Function -> Constant List of Triangles -> Display
+</code>
+
+Now we have 
+
+<code class="no-highlight">
+Main loop -> World -> Function -> List of Objects -> Atoms -> Display
+</code>
+
+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.
+
+<div style="display:none">
+
+> 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))
+>     ]
+
+</div>
+
+> 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
+
+<div style="display:none">
+
+> 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
+
+</div>
+
+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.
+
+<div style="display:none">
+
+> 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
+
+</div>
+
+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

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<x' & y<y' & z<z'
+data Box3D = Box3D {
+         minPoint :: Point3D 
+       , maxPoint :: Point3D
+       , resolution :: Scalar }
+
+-- | An helper to make a Box3D
+makeBox :: (Point,Point,Point) -> (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)

stack.yaml

@@ -0,0 +1,5 @@
+flags: {}
+packages:
+- '.'
+extra-deps: []
+resolver: lts-2.17