Drezil/pioneers
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

No shadows anymore - but shadow-map is correct

Browse Source
This commit is contained in:
Nicole Dresselhaus 2014-01-01 21:58:43 +01:00
parent 448bb7ac73
commit 35f1a09d13
1 changed files with 24 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
src/Main.hs
View File

@ -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,6 +162,7 @@ display state t =
generateShadowMap tiles [] generateShadowMap tiles []
generateTextureMatrix generateTextureMatrix
unless showShadowMap $ do
clear [ ColorBuffer, DepthBuffer ] clear [ ColorBuffer, DepthBuffer ]
preservingMatrix $ do preservingMatrix $ do
drawObjects tiles [] False drawObjects tiles [] False
@ -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)