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

minor stuff .. STILL NO TRIANGLE -.-

Browse Source
This commit is contained in:
Nicole Dresselhaus 2014-01-03 23:19:39 +01:00
parent 2fc28adfd1
commit a2214082ca
2 changed files with 19 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
src/Main.hs
View File

@ -10,7 +10,7 @@ import Data.List (intercalate)
import Data.Maybe (catMaybes) import Data.Maybe (catMaybes)
import Text.PrettyPrint import Text.PrettyPrint
import qualified Graphics.Rendering.OpenGL as GL import qualified Graphics.Rendering.OpenGL.GL as GL
import qualified Graphics.UI.GLFW as GLFW import qualified Graphics.UI.GLFW as GLFW
import Map.Map import Map.Map
@ -101,16 +101,6 @@ main = do
GLFW.swapInterval 1 GLFW.swapInterval 1
GL.position (GL.Light 0) GL.$= GL.Vertex4 5 5 10 0
GL.light (GL.Light 0) GL.$= GL.Enabled
GL.lighting GL.$= GL.Enabled
GL.cullFace GL.$= Just GL.FrontAndBack -- Back
GL.depthFunc GL.$= Just GL.Always -- Less
GL.clearColor GL.$= GL.Color4 0.05 0.05 0.05 1
GL.normalize GL.$= GL.Enabled
(fbWidth, fbHeight) <- GLFW.getFramebufferSize win (fbWidth, fbHeight) <- GLFW.getFramebufferSize win
--generate map vertices --generate map vertices
@ -231,6 +221,7 @@ run = do
GLFW.swapBuffers win GLFW.swapBuffers win
GL.flush -- not necessary, but someone recommended it GL.flush -- not necessary, but someone recommended it
GLFW.pollEvents GLFW.pollEvents
GL.finish
-- getEvents & process -- getEvents & process
processEvents processEvents
@ -368,29 +359,16 @@ processEvent ev =
adjustWindow :: Pioneer () adjustWindow :: Pioneer ()
adjustWindow = do adjustWindow = do
state <- get state <- get
let width = stateWindowWidth state let fbWidth = stateWindowWidth state
height = stateWindowHeight state fbHeight = stateWindowHeight state
zDist = stateZDist state fov = 90 --field of view
near = 1 --near plane
let pos = GL.Position 0 0 far = 100 --far plane
size = GL.Size (fromIntegral width) (fromIntegral height) ratio = fromIntegral fbWidth / fromIntegral fbHeight
h = fromIntegral height / fromIntegral width :: Double frust = createFrustum fov near far ratio
znear = 1 :: Double put $ state {
zfar = 40 :: Double stateFrustum = frust
xmax = znear * 0.5 :: Double }
liftIO $ do
GL.viewport GL.$= (pos, size)
GL.matrixMode GL.$= GL.Projection
GL.loadIdentity
GL.frustum (realToFrac $ -xmax)
(realToFrac xmax)
(realToFrac $ -xmax * realToFrac h)
(realToFrac $ xmax * realToFrac h)
(realToFrac znear)
(realToFrac zfar)
GL.matrixMode GL.$= GL.Modelview 0
GL.loadIdentity
GL.translate (GL.Vector3 0 0 (negate $ realToFrac zDist) :: GL.Vector3 GL.GLfloat)
draw :: Pioneer () draw :: Pioneer ()
draw = do draw = do
@ -407,7 +385,6 @@ draw = do
map' = stateMap state map' = stateMap state
frust = stateFrustum state frust = stateFrustum state
liftIO $ do liftIO $ do
GL.clear [GL.ColorBuffer, GL.DepthBuffer]
lookAtUniformMatrix4fv (0.0,0.0,0.0) (0, 15, 0) up frust proj 1 lookAtUniformMatrix4fv (0.0,0.0,0.0) (0, 15, 0) up frust proj 1
GL.bindBuffer GL.ArrayBuffer GL.$= Just map' GL.bindBuffer GL.ArrayBuffer GL.$= Just map'
GL.vertexAttribPointer ci GL.$= fgColorIndex GL.vertexAttribPointer ci GL.$= fgColorIndex

7
src/Render/Misc.hs
View File

@ -2,13 +2,14 @@ module Render.Misc where
import Control.Monad import Control.Monad
import qualified Data.ByteString as B (ByteString) import qualified Data.ByteString as B (ByteString)
import Foreign.Marshal.Array (allocaArray,
pokeArray)
import Graphics.Rendering.OpenGL.GL.Shaders import Graphics.Rendering.OpenGL.GL.Shaders
import Graphics.Rendering.OpenGL.GL.StateVar import Graphics.Rendering.OpenGL.GL.StateVar
import Graphics.Rendering.OpenGL.GL.StringQueries import Graphics.Rendering.OpenGL.GL.StringQueries
import Graphics.Rendering.OpenGL.GLU.Errors import Graphics.Rendering.OpenGL.GLU.Errors
import System.IO (hPutStrLn, stderr)
import Graphics.Rendering.OpenGL.Raw.Core31 import Graphics.Rendering.OpenGL.Raw.Core31
import Foreign.Marshal.Array (allocaArray, pokeArray) import System.IO (hPutStrLn, stderr)
up :: (Double, Double, Double) up :: (Double, Double, Double)
@ -77,7 +78,7 @@ lookAtUniformMatrix4fv o c u frust num size = allocaArray 16 $ \projMat ->
do do
pokeArray projMat $ pokeArray projMat $
[1, 0, 0, 0, [1, 0, 0, 0,
0, 0, 1, 0.1, 0, 0, 1, 0,
0, 1, 0, 0, 0, 1, 0, 0,
0, 0, 0, 1 0, 0, 0, 1
] ]