No shadows anymore - but shadow-map is correct
This commit is contained in:
parent
448bb7ac73
commit
35f1a09d13
36
src/Main.hs
36
src/Main.hs
@ -37,7 +37,8 @@ data ProgramState = PS { keysPressed :: IntSet
|
|||||||
, dy :: GLfloat
|
, dy :: GLfloat
|
||||||
, dz :: GLfloat
|
, dz :: GLfloat
|
||||||
, dheading :: GLfloat
|
, dheading :: GLfloat
|
||||||
, dpitch :: GLfloat }
|
, dpitch :: GLfloat
|
||||||
|
, showShadowMap :: Bool }
|
||||||
deriving (Show)
|
deriving (Show)
|
||||||
|
|
||||||
type RenderObject = (Vector3 GLfloat, Color3 GLfloat, [Vertex3 GLfloat])
|
type RenderObject = (Vector3 GLfloat, Color3 GLfloat, [Vertex3 GLfloat])
|
||||||
@ -53,7 +54,7 @@ deltaH = 0.5
|
|||||||
deltaP = 0.15
|
deltaP = 0.15
|
||||||
black = Color3 0 0 0 :: Color3 GLfloat
|
black = Color3 0 0 0 :: Color3 GLfloat
|
||||||
shadowMapSize :: TextureSize2D
|
shadowMapSize :: TextureSize2D
|
||||||
shadowMapSize = TextureSize2D 256 256
|
shadowMapSize = TextureSize2D 512 512
|
||||||
|
|
||||||
up :: Vector3 GLdouble
|
up :: Vector3 GLdouble
|
||||||
up = Vector3 0 1 0
|
up = Vector3 0 1 0
|
||||||
@ -124,12 +125,13 @@ drawObjects map ent shadowRender = do
|
|||||||
translate $ fmap (+ (-15.0)) pos
|
translate $ fmap (+ (-15.0)) pos
|
||||||
drawSphere
|
drawSphere
|
||||||
--draw sun-indicator
|
--draw sun-indicator
|
||||||
preservingMatrix $ do
|
{- preservingMatrix $ do
|
||||||
pos <- getSunPos Vector3
|
pos <- getSunPos Vector3
|
||||||
translate pos
|
translate pos
|
||||||
color (Color4 1.0 1.0 0.0 1.0 :: Color4 GLfloat)
|
color (Color4 1.0 1.0 0.0 1.0 :: Color4 GLfloat)
|
||||||
drawSphere
|
drawSphere
|
||||||
--putStrLn $ unwords ["sun at", show pos]
|
--putStrLn $ unwords ["sun at", show pos]
|
||||||
|
-- -}
|
||||||
--draw map
|
--draw map
|
||||||
mapM_ renderTile map
|
mapM_ renderTile map
|
||||||
|
|
||||||
@ -150,7 +152,8 @@ display state t =
|
|||||||
, py = py
|
, py = py
|
||||||
, pz = pz
|
, pz = pz
|
||||||
, pitch = pitch
|
, pitch = pitch
|
||||||
, heading = heading }
|
, heading = heading
|
||||||
|
, showShadowMap = showShadowMap }
|
||||||
<- readMVar state
|
<- readMVar state
|
||||||
loadIdentity
|
loadIdentity
|
||||||
GL.rotate pitch (Vector3 1.0 0.0 0.0 :: Vector3 GLfloat)
|
GL.rotate pitch (Vector3 1.0 0.0 0.0 :: Vector3 GLfloat)
|
||||||
@ -159,9 +162,10 @@ display state t =
|
|||||||
|
|
||||||
generateShadowMap tiles []
|
generateShadowMap tiles []
|
||||||
generateTextureMatrix
|
generateTextureMatrix
|
||||||
clear [ ColorBuffer, DepthBuffer ]
|
unless showShadowMap $ do
|
||||||
preservingMatrix $ do
|
clear [ ColorBuffer, DepthBuffer ]
|
||||||
drawObjects tiles [] False
|
preservingMatrix $ do
|
||||||
|
drawObjects tiles [] False
|
||||||
|
|
||||||
return ()
|
return ()
|
||||||
|
|
||||||
@ -176,7 +180,8 @@ updateCamera state = do
|
|||||||
, pitch = pitch
|
, pitch = pitch
|
||||||
, heading = heading
|
, heading = heading
|
||||||
, dpitch = dpitch
|
, dpitch = dpitch
|
||||||
, dheading = dheading }
|
, dheading = dheading
|
||||||
|
}
|
||||||
<- takeMVar state
|
<- takeMVar state
|
||||||
|
|
||||||
d@((dx,dy,dz),(heading',pitch')) <-
|
d@((dx,dy,dz),(heading',pitch')) <-
|
||||||
@ -228,7 +233,7 @@ generateTextureMatrix = do
|
|||||||
scalef = scale :: GLfloat -> GLfloat -> GLfloat -> IO ()
|
scalef = scale :: GLfloat -> GLfloat -> GLfloat -> IO ()
|
||||||
translatef (Vector3 0.5 0.5 0.0)
|
translatef (Vector3 0.5 0.5 0.0)
|
||||||
scalef 0.5 0.5 1.0
|
scalef 0.5 0.5 1.0
|
||||||
perspective 60 1 1 1000
|
ortho (-20) 20 (-20) 20 1 100
|
||||||
lightPos' <- getSunPos Vertex3
|
lightPos' <- getSunPos Vertex3
|
||||||
lookAt lightPos' origin up
|
lookAt lightPos' origin up
|
||||||
get (matrix (Just (Modelview 0)))
|
get (matrix (Just (Modelview 0)))
|
||||||
@ -254,10 +259,12 @@ generateShadowMap tiles obj = do
|
|||||||
|
|
||||||
clear [ ColorBuffer, DepthBuffer ]
|
clear [ ColorBuffer, DepthBuffer ]
|
||||||
|
|
||||||
|
--cullFace $= Just Front -- only backsides cast shadows -> less polys
|
||||||
|
|
||||||
matrixMode $= Projection
|
matrixMode $= Projection
|
||||||
preservingMatrix $ do
|
preservingMatrix $ do
|
||||||
loadIdentity
|
loadIdentity
|
||||||
perspective 80 1 10 1000
|
ortho (-20) 20 (-20) 20 10 100
|
||||||
matrixMode $= Modelview 0
|
matrixMode $= Modelview 0
|
||||||
preservingMatrix $ do
|
preservingMatrix $ do
|
||||||
loadIdentity
|
loadIdentity
|
||||||
@ -268,6 +275,8 @@ generateShadowMap tiles obj = do
|
|||||||
|
|
||||||
copyTexImage2D Texture2D 0 DepthComponent' (Position 0 0) shadowMapSize 0
|
copyTexImage2D Texture2D 0 DepthComponent' (Position 0 0) shadowMapSize 0
|
||||||
|
|
||||||
|
--cullFace $= Just Back
|
||||||
|
|
||||||
when True $ do
|
when True $ do
|
||||||
let numShadowMapPixels = fromIntegral (shadowMapWidth * shadowMapHeight)
|
let numShadowMapPixels = fromIntegral (shadowMapWidth * shadowMapHeight)
|
||||||
allocaArray numShadowMapPixels $ \depthImage -> do
|
allocaArray numShadowMapPixels $ \depthImage -> do
|
||||||
@ -322,7 +331,8 @@ keyEvent state press = do
|
|||||||
, pitch = pitch
|
, pitch = pitch
|
||||||
, heading = heading
|
, heading = heading
|
||||||
, dpitch = dpitch
|
, dpitch = dpitch
|
||||||
, dheading = dheading }
|
, dheading = dheading
|
||||||
|
, showShadowMap = showShadowMap }
|
||||||
<- takeMVar state
|
<- takeMVar state
|
||||||
-- Only process the key event if it is not a repeat
|
-- Only process the key event if it is not a repeat
|
||||||
(ps',ret) <- if (fromIntegral code `member` kp && not press) ||
|
(ps',ret) <- if (fromIntegral code `member` kp && not press) ||
|
||||||
@ -350,6 +360,7 @@ keyEvent state press = do
|
|||||||
| code == 66 -> accept $ ps { dy = dy + deltaV }
|
| code == 66 -> accept $ ps { dy = dy + deltaV }
|
||||||
| code == 25 -> accept $ ps { dheading = dheading - deltaH }
|
| code == 25 -> accept $ ps { dheading = dheading - deltaH }
|
||||||
| code == 27 -> accept $ ps { dheading = dheading + deltaH }
|
| code == 27 -> accept $ ps { dheading = dheading + deltaH }
|
||||||
|
| code == 42 -> accept $ ps { showShadowMap = not showShadowMap }
|
||||||
| otherwise -> deny ps
|
| otherwise -> deny ps
|
||||||
-- on RELEASE only
|
-- on RELEASE only
|
||||||
False
|
False
|
||||||
@ -380,7 +391,8 @@ main = do
|
|||||||
, dy = 0
|
, dy = 0
|
||||||
, dz = 0
|
, dz = 0
|
||||||
, dheading = 0
|
, dheading = 0
|
||||||
, dpitch = 0}
|
, dpitch = 0
|
||||||
|
, showShadowMap = False }
|
||||||
trace (show terrain) Gtk.initGUI
|
trace (show terrain) Gtk.initGUI
|
||||||
-- Initialise the Gtk+ OpenGL extension
|
-- Initialise the Gtk+ OpenGL extension
|
||||||
-- (including reading various command line parameters)
|
-- (including reading various command line parameters)
|
||||||
|
Loading…
Reference in New Issue
Block a user