Menu
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
783
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
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:
also the exact opposite can be achieved (smooth mesh but sharp edge render)
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
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
93
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With
