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

merged .. but colors broken..

Browse Source
This commit is contained in:
Stefan Dresselhaus
2014-01-05 19:09:01 +01:00
parent 7db4bff2e4 df1fdc60d3
commit 2b2108ab87
7 changed files with 869 additions and 86 deletions
Download Patch File Download Diff File Expand all files Collapse all files

105
src/Main.hs
View File

@@ -1,3 +1,4 @@
{-# LANGUAGE BangPatterns #-}
module Main (main) where
--------------------------------------------------------------------------------
@@ -9,15 +10,18 @@ import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)
import Data.List (intercalate)
import Data.Maybe (catMaybes)
import Text.PrettyPrint
import Data.Distributive (distribute)
import Foreign (Ptr, castPtr, with)
import Foreign.C (CFloat)
import Linear as L
import qualified Graphics.Rendering.OpenGL.GL as GL
import qualified Graphics.Rendering.OpenGL.Raw.Core31 as GLRaw
import Graphics.Rendering.OpenGL.Raw.Core31
import qualified Graphics.UI.GLFW as GLFW
import qualified Data.Vector.Storable as V
import Map.Map
import Render.Render (initShader)
import Render.Misc (up, lookAtUniformMatrix4fv, createFrustum, checkError)
import Render.Render (initShader, initRendering)
import Render.Misc (up, createFrustum, checkError, lookAt)
--------------------------------------------------------------------------------
@@ -43,13 +47,15 @@ data State = State
, stateDragStartY :: !Double
, stateDragStartXAngle :: !Double
, stateDragStartYAngle :: !Double
, stateFrustum :: [GL.GLfloat]
, stateFrustum :: !(M44 CFloat)
-- pointer to bindings for locations inside the compiled shader
-- mutable because shaders may be changed in the future.
, shdrVertexIndex :: !GL.AttribLocation
, shdrColorIndex :: !GL.AttribLocation
, shdrNormalIndex :: !GL.AttribLocation
, shdrVertexIndex :: !GL.AttribLocation
, shdrProjMatIndex :: !GL.UniformLocation
, shdrViewMatIndex :: !GL.UniformLocation
, shdrModelMatIndex :: !GL.UniformLocation
-- the map
, stateMap :: !GL.BufferObject
, mapVert :: !GL.NumArrayIndices
@@ -105,13 +111,13 @@ main = do
(fbWidth, fbHeight) <- GLFW.getFramebufferSize win
initRendering
--generate map vertices
(mapBuffer, vert) <- getMapBufferObject
(ci, ni, vi, pi) <- initShader
(ci, ni, vi, pri, vii, mi) <- initShader
let zDistClosest = 10
zDistFarthest = zDistClosest + 20
zDist = zDistClosest + ((zDistFarthest - zDistClosest) / 2)
fov = 90 --field of view
near = 1 --near plane
far = 100 --far plane
@@ -126,8 +132,8 @@ main = do
state = State
{ stateWindowWidth = fbWidth
, stateWindowHeight = fbHeight
, stateXAngle = 0
, stateYAngle = 0
, stateXAngle = pi/6
, stateYAngle = pi/2
, stateZAngle = 0
, stateZDist = 10
, stateMouseDown = False
@@ -136,10 +142,12 @@ main = do
, stateDragStartY = 0
, stateDragStartXAngle = 0
, stateDragStartYAngle = 0
, shdrColorIndex = ci
, shdrNormalIndex = ni
, shdrVertexIndex = vi
, shdrProjMatIndex = pi
, shdrNormalIndex = ni
, shdrColorIndex = ci
, shdrProjMatIndex = pri
, shdrViewMatIndex = vii
, shdrModelMatIndex = mi
, stateMap = mapBuffer
, mapVert = vert
, stateFrustum = frust
@@ -210,8 +218,7 @@ charCallback tc win c = atomically $ writeTQueue tc $ EventC
--------------------------------------------------------------------------------
runDemo :: Env -> State -> IO ()
runDemo env state = do
void $ evalRWST (adjustWindow >> run) env state
runDemo env state = void $ evalRWST (adjustWindow >> run) env state
run :: Pioneer ()
run = do
@@ -221,13 +228,12 @@ run = do
draw
liftIO $ do
GLFW.swapBuffers win
GL.flush -- not necessary, but someone recommended it
GLFW.pollEvents
GL.finish
-- getEvents & process
processEvents
-- update State
state <- get
if stateDragging state
then do
@@ -238,10 +244,21 @@ run = do
(x, y) <- liftIO $ GLFW.getCursorPos win
let myrot = (x - sodx) / 2
mxrot = (y - sody) / 2
-- newXAngle = if newXAngle' > 2*pi then 2*pi else
newXAngle = if newXAngle' > 0.45*pi then 0.45*pi else
-- if newXAngle' < -2*pi then -2*pi else
if newXAngle' < 0 then 0 else
newXAngle'
newXAngle' = sodxa + mxrot/100
newYAngle = if newYAngle' > pi then newYAngle'-2*pi else
if newYAngle' < -pi then newYAngle'+2*pi else
newYAngle'
newYAngle' = sodya + myrot/100
put $ state
{ stateXAngle = sodxa + mxrot
, stateYAngle = sodya + myrot
{ stateXAngle = newXAngle
, stateYAngle = newYAngle
}
-- liftIO $ putStrLn $ unwords $ map show $ [newXAngle, newYAngle]
else do
(kxrot, kyrot) <- liftIO $ getCursorKeyDirections win
(jxrot, jyrot) <- liftIO $ getJoystickDirections GLFW.Joystick'1
@@ -249,6 +266,7 @@ run = do
{ stateXAngle = stateXAngle state + (2 * kxrot) + (2 * jxrot)
, stateYAngle = stateYAngle state + (2 * kyrot) + (2 * jyrot)
}
{-
--modify the state with all that happened in mt time.
mt <- liftIO GLFW.getTime
@@ -376,37 +394,44 @@ draw :: Pioneer ()
draw = do
env <- ask
state <- get
let xa = stateXAngle state
ya = stateYAngle state
let xa = fromRational $ toRational $ stateXAngle state
ya = fromRational $ toRational $ stateYAngle state
za = stateZAngle state
(GL.UniformLocation proj) = shdrProjMatIndex state
ci = shdrColorIndex state
ni = shdrNormalIndex state
(GL.UniformLocation proj) = shdrProjMatIndex state
(GL.UniformLocation vmat) = shdrViewMatIndex state
vi = shdrVertexIndex state
ni = shdrNormalIndex state
ci = shdrColorIndex state
numVert = mapVert state
map' = stateMap state
frust = stateFrustum state
liftIO $ do
GLRaw.glClearDepth 1.0
GLRaw.glDisable GLRaw.gl_CULL_FACE
--lookAtUniformMatrix4fv (0.0,0.0,0.0) (0, 15, 0) up frust proj 1
--(vi,GL.UniformLocation proj) <- initShader
GL.clearColor GL.$= GL.Color4 0.5 0.1 1 1
GL.clear [GL.ColorBuffer, GL.DepthBuffer]
--set up projection (= copy from state)
with (distribute $ frust) $ \ptr ->
glUniformMatrix4fv proj 1 0 (castPtr (ptr :: Ptr (M44 CFloat)))
-------------
--set up camera
let fov = 90
s = recip (tan $ fov * 0.5 * pi / 180)
f = 1000
n = 1
let ! cam = lookAt (cpos ^+^ at') at' up
let perspective = V.fromList [ s, 0, 0, 0
, 0, s, 0, 0
, 0, 0, -(f/(f - n)), -1
, 0, 0, -((f*n)/(f-n)), 0
]
at' = V3 5 0 5
upmap = (fromQuaternion $
axisAngle (V3 0 1 0) (ya::CFloat) :: M33 CFloat)
!* (V3 1 0 0)
crot' = (
(fromQuaternion $
axisAngle upmap (xa::CFloat))
!*!
(fromQuaternion $
axisAngle (V3 0 1 0) (ya::CFloat))
) :: M33 CFloat
cpos = crot' !* (V3 0 0 (-10))
V.unsafeWith perspective $ \ptr -> GLRaw.glUniformMatrix4fv proj 1 0 ptr
---------------
with (distribute $ cam) $ \ptr ->
glUniformMatrix4fv vmat 1 0 (castPtr (ptr :: Ptr (M44 CFloat)))
GL.bindBuffer GL.ArrayBuffer GL.$= Just map'
GL.vertexAttribPointer ci GL.$= fgColorIndex