haskell - Understanding lighting in OpenGL

Question

I am trying to create a 3D sphere out of a bunch of triangles with Haskell / GLUT. It works quite nicely: The green one is "my" sphere, the red one is done with GLUT's renderObject Sphere'. And I can see "my" sphere is really 3D when I move the camera around, so that's fine.

So why does the GLUT one has nice lighting, and mine has not? (I'm a newbie and do not really know what I'm doing below in initGL, copied that stuff from Hackage's cuboid package...)

Here's the code:

module Main where

import Graphics.UI.GLUT 

main :: IO ()
main = do
  initGL
  displayCallback $= render
  mainLoop

initGL :: IO ()
initGL = do
    getArgsAndInitialize
    initialDisplayMode $= [DoubleBuffered]
    createWindow "Chip!"
    initialDisplayMode $= [ WithDepthBuffer ]
    depthFunc          $= Just Less
    clearColor         $= Color4 0 0 0 0
    light (Light 0)    $= Enabled
    lighting           $= Enabled 
    lightModelAmbient  $= Color4 0.5 0.5 0.5 1 
    diffuse (Light 0)  $= Color4 1 1 1 1
    blend              $= Enabled
    blendFunc          $= (SrcAlpha, OneMinusSrcAlpha) 
    colorMaterial      $= Just (FrontAndBack, AmbientAndDiffuse)
    reshapeCallback    $= Just resizeScene
    return () 

render :: DisplayCallback
render = do
    clear [ ColorBuffer, DepthBuffer ]

    loadIdentity

    color $ Color3 (1 :: GLdouble) 1 1
    position (Light 0) $= Vertex4 0 50 (50) 1  

    preservingMatrix $ do 
        translate $ Vector3 ((-0.5) :: GLfloat) (-0.5) (-5)
        color green
        ball 12 8 0.03

    preservingMatrix $ do 
        translate $ Vector3 (0.5 :: GLfloat) 0.5 (-5)
        color red
        renderObject Solid (Sphere' 0.25 20 20)

    flush
    swapBuffers
    where green  = Color4 0.8 1.0 0.7 0.9 :: Color4 GLdouble
          red    = Color4 1.0 0.7 0.8 1.0 :: Color4 GLdouble

vertex3f :: (GLfloat, GLfloat, GLfloat) -> IO ()
vertex3f (x, y, z) = vertex $ Vertex3 x y z

upperInnerCircle :: Int -> [(GLfloat, GLfloat)]
upperInnerCircle numSegs =
    concat [[(0,0)
            ,(cos a, sqrt(1-(cos a)*(cos a)))
            ,(cos b, sqrt(1-(cos b)*(cos b)))] 
                 | (a,b)<-as ]
    where 
        seg'=pi/(fromIntegral numSegs)
        as = [(fromIntegral n * seg', fromIntegral (n+1) * seg') | n<-[0..numSegs-1]]

lowerInnerCircle :: Int -> [(GLfloat, GLfloat)]
lowerInnerCircle numSegs =
    map ((x,y) -> (x,-y)) $ upperInnerCircle numSegs

innerCircle :: Int -> [(GLfloat, GLfloat)]
innerCircle numSegs = upperInnerCircle numSegs ++ (lowerInnerCircle numSegs)

upperOutSegment :: Int -> Int -> Int -> [(GLfloat, GLfloat)]
upperOutSegment numSegs ring seg =
   [x,y,u, u,v,y]
    where 
        seg'=pi/(fromIntegral numSegs)
        (a, b)  = (fromIntegral seg * seg', fromIntegral (seg+1) * seg')
        x =  (fromIntegral ring * cos a, fromIntegral ring * sqrt(1-(cos a)*(cos a)))
        y = (fromIntegral ring * cos b, fromIntegral ring * sqrt(1-(cos b)*(cos b)))
        u =  (fromIntegral (ring+1) * cos a, fromIntegral (ring+1) * sqrt(1-(cos a)*(cos a)))
        v = (fromIntegral (ring+1) * cos b, fromIntegral (ring+1) * sqrt(1-(cos b)*(cos b)))

lowerOutSegment :: Int -> Int -> Int -> [(GLfloat, GLfloat)]
lowerOutSegment numSegs ring seg =
    map ((x,y) -> (x,-y)) $ upperOutSegment numSegs ring seg 

outSegment :: Int -> Int -> Int -> [(GLfloat, GLfloat)]
outSegment numSegs ring seg = upperOutSegment numSegs ring seg ++ (lowerOutSegment numSegs ring seg)

outerRing :: Int -> Int -> [(GLfloat, GLfloat)]
outerRing numSegs ring =
    concat [outSegment numSegs ring n | n<-[0..numSegs-1]] 

ball numSegs numRings factor =
  let ips = innerCircle numSegs
      ops = concat [outerRing numSegs i | i<-[1..numRings]]
      height dir ps = 
           map ((x,y) -> 
                  let dist = sqrt(x*x+y*y)/(fromIntegral (numRings+1))
                      height' = sqrt(1.001-dist*dist)*factor*(fromIntegral (numRings+1))
                  in (x*factor,y*factor,dir*height')) $ ps
      ups = height 1 $ ips ++ ops
      lps = height (-1) $ ips ++ ops
  in  renderPrimitive Triangles $ mapM_ vertex3f (ups++lps)


resizeScene :: Size -> IO ()
resizeScene (Size w 0) = resizeScene (Size w 1) -- prevent divide by zero
resizeScene s@(Size width height) = do
  viewport   $= (Position 0 0, s)
  matrixMode $= Projection
  loadIdentity
  perspective 45 (w2/h2) 1 1000
  matrixMode $= Modelview 0
  flush
 where
   w2 = half width
   h2 = half height
   half z = realToFrac z / 2

EDIT: Works now, thanks to Spektre!

Here's the pic:

And here's the code:

module Main where

import Graphics.UI.GLUT 

main :: IO ()
main = do
  initGL
  displayCallback $= render
  mainLoop

initGL :: IO ()
initGL = do
    getArgsAndInitialize
    initialDisplayMode $= [DoubleBuffered]
    createWindow "Chip!"
    initialDisplayMode $= [ WithDepthBuffer ]
    depthFunc          $= Just Less
    clearColor         $= Color4 0 0 0 0
    light (Light 0)    $= Enabled
    lighting           $= Enabled 
    lightModelAmbient  $= Color4 0.5 0.5 0.5 1 
    diffuse (Light 0)  $= Color4 1 1 1 1
    blend              $= Enabled
    blendFunc          $= (SrcAlpha, OneMinusSrcAlpha) 
    colorMaterial      $= Just (FrontAndBack, AmbientAndDiffuse)
    reshapeCallback    $= Just resizeScene
    return () 

render :: DisplayCallback
render = do
    clear [ ColorBuffer, DepthBuffer ]

    loadIdentity

    color $ Color3 (1 :: GLdouble) 1 1
    position (Light 0) $= Vertex4 0 50 (50) 1  

    preservingMatrix $ do 
        translate $ Vector3 ((-0.5) :: GLfloat) (-0.5) (-5)
        color green
        ball 12 8 0.03

    preservingMatrix $ do 
        translate $ Vector3 (0.5 :: GLfloat) 0.5 (-5)
        color red
        renderObject Solid (Sphere' 0.25 20 20)

    flush
    swapBuffers
    where green  = Color4 0.8 1.0 0.7 0.9 :: Color4 GLdouble
          red    = Color4 1.0 0.7 0.8 1.0 :: Color4 GLdouble

pushTriangle :: ((GLfloat, GLfloat, GLfloat) 
                ,(GLfloat, GLfloat, GLfloat) 
                ,(GLfloat, GLfloat, GLfloat)) -> 
                IO ()
pushTriangle (p0, p1, p2) = do
    let (_,d0,_)=p0
    let (_,d1,_)=p1
    let (_,d2,_)=p2

    --if it points upwards, reverse normal
    let d=if d0+d1+d2>0 then (-1) else 1
    let n = cross (minus p1 p0) (minus p2 p1)
    let nL = 1/lenVec n
    let (n1, n2, n3) = scaleVec n (nL*d)
    normal $ Normal3 n1 n2 n3

    vertex3f p0
    vertex3f p1
    vertex3f p2

vertex3f :: (GLfloat, GLfloat, GLfloat) -> IO ()
vertex3f (x, y, z) = 
   vertex $ Vertex3 x y z

lenVec (a1,a2,a3) = sqrt $ a1*a1 + a2*a2 + a3*a3

scaleVec (a1,a2,a3) x = (a1*x,a2*x,a3*x)

cross (a1,a2,a3) (b1,b2,b3) =
   (a2*b3-a3*b2
   ,a3*b1-a1*b3
   ,a1*b2-a2*b1)

minus (a1,a2,a3) (b1,b2,b3) =
  (a1-b1, a2-b2, a3-b3)

upperInnerCircle :: Int -> [(GLfloat, GLfloat)]
upperInnerCircle numSegs =
    concat [[(cos a, sqrt(1-(cos a)*(cos a)))
            ,(0,0)
            ,(cos b, sqrt(1-(cos b)*(cos b)))] 
                 | (a,b)<-as ]
    where 
        seg'=pi/(fromIntegral numSegs)
        as = [(fromIntegral n * seg', fromIntegral (n+1) * seg') | n<-[0..numSegs-1]]

lowerInnerCircle :: Int -> [(GLfloat, GLfloat)]
lowerInnerCircle numSegs =
    map ((x,y) -> (x,-y)) $ upperInnerCircle numSegs

innerCircle :: Int -> [(GLfloat, GLfloat)]
innerCircle numSegs = upperInnerCircle numSegs ++ (lowerInnerCircle numSegs)

upperOutSegment :: Int -> Int -> Int -> [(GLfloat, GLfloat)]
upperOutSegment numSegs ring seg =
   [x,y,u, v,u,y]
    where 
        seg'=pi/(fromIntegral numSegs)
        (a, b)  = (fromIntegral seg * seg', fromIntegral (seg+1) * seg')
        x =  (fromIntegral ring * cos a, fromIntegral ring * sqrt(1-(cos a)*(cos a)))
        y = (fromIntegral ring * cos b, fromIntegral ring * sqrt(1-(cos b)*(cos b)))
        u =  (fromIntegral (ring+1) * cos a, fromIntegral (ring+1) * sqrt(1-(cos a)*(cos a)))
        v = (fromIntegral (ring+1) * cos b, fromIntegral (ring+1) * sqrt(1-(cos b)*(cos b)))

lowerOutSegment :: Int -> Int -> Int -> [(GLfloat, GLfloat)]
lowerOutSegment numSegs ring seg =
    map ((x,y) -> (x,-y)) $ upperOutSegment numSegs ring seg 

outSegment :: Int -> Int -> Int -> [(GLfloat, GLfloat)]
outSegment numSegs ring seg = upperOutSegment numSegs ring seg ++ (lowerOutSegment numSegs ring seg)

outerRing :: Int -> Int -> [(GLfloat, GLfloat)]
outerRing numSegs ring =
    concat [outSegment numSegs ring n | n<-[0..numSegs-1]] 

ball numSegs numRings factor =
  let ips = innerCircle numSegs
      ops = concat [outerRing numSegs i | i<-[1..numRings]]
      height dir ps = 
           map ((x,y) -> 
                  let dist = sqrt(x*x+y*y)/(fromIntegral (numRings+1))
                      height' = sqrt(1.001-dist*dist)*factor*(fromIntegral (numRings+1))
                  in (x*factor,y*factor,dir*height')) $ ps
      ups = height 1 $ ips ++ ops
      lps = height (-1) $ ips ++ ops
  in  renderPrimitive Triangles $ mapM_ pushTriangle (toTriples (ups++lps))

toTriples :: [a] -> [(a,a,a)]
toTriples [] = []
toTriples (a:b:c:rest) = (a,b,c):toTriples rest 

resizeScene :: Size -> IO ()
resizeScene (Size w 0) = resizeScene (Size w 1) -- prevent divide by zero
resizeScene s@(Size width height) = do
  viewport   $= (Position 0 0, s)
  matrixMode $= Projection
  loadIdentity
  perspective 45 (w2/h2) 1 1000
  matrixMode $= Modelview 0
  flush
 where
   w2 = half width
   h2 = half height
   half z = realToFrac z / 2

Answer 1

1. Surface normals are crucial for lighting equations

   Normal to surface is vector perpendicular to surface. For triangle is computed by cross product of any its 2 vertices vectors so if triangle points are p0,p1,p2 then normal is n=cross(p1-p0,p2-p1) or any other combination.

   Normals tells which way is pixel/face/polygon turned usually dot product with light direction is computed by render engine that gives a cos(angle_between light and surface normal). This number is the scale of amount of light hitting the surface when multiplied with light source strength you got the light color ... with combination of surface color render get the pixel color there are many light models this one was very simple (normal shading).

   To make the dot product work the normal should be unit vector so divide it by its length n=n/|n|

   Here small example of normals

   

   For sphere the normal is easy normal n for any point p is n=(p-center)/radius

2. If normal does not correspond with surface

   then you can do light effects like visually smooth sharp edges of mesh. for example how Look here:

   • smoothing normals

   also the exact opposite can be achieved (smooth mesh but sharp edge render)

3. OpenGL interface

   old style gl uses something like glNormal3f(nx,ny,nz); The VBO/VAO/arrays knows normals too. In new style glNormal is depreceated like most parameters so you need to bind it to your custom layout on your own

4. Normal direction

   any surface has 2 possible direction of perpendicular normal to it. Usually the one pointing outwards from mesh is used. Sometimes for 3D curves is double sided material used that means that the dot product is handled as abs value so it does not matter which way the normal is pointing. Without this the opposite side of surface will be always dark

   So if you have normals and no lighting is visible then try to negate normals