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

keyboard-controls for tessellation

Browse Source
This commit is contained in:
Nicole Dresselhaus 2014-01-21 16:44:42 +01:00
parent 8b7d2d6c1a
commit 080776b25c
2 changed files with 35 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
src/Main.hs
View File

@ -93,6 +93,9 @@ data State = State
, shdrViewMatIndex :: !GL.UniformLocation
, shdrModelMatIndex :: !GL.UniformLocation
, shdrNormalMatIndex :: !GL.UniformLocation
, shdrTessInnerIndex :: !GL.UniformLocation
, shdrTessOuterIndex :: !GL.UniformLocation
, stateTessellationFactor :: !Int
--- the map
, stateMap :: !GL.BufferObject
, mapVert :: !GL.NumArrayIndices
@ -116,7 +119,7 @@ main = do
initRendering
--generate map vertices
(mapBuffer, vert) <- getMapBufferObject
(ci, ni, vi, pri, vii, mi, nmi) <- initShader
(ci, ni, vi, pri, vii, mi, nmi, tli, tlo) <- initShader
putStrLn "foo"
eventQueue <- newTQueueIO :: IO (TQueue Event)
putStrLn "foo"
@ -165,12 +168,15 @@ main = do
, shdrViewMatIndex = vii
, shdrModelMatIndex = mi
, shdrNormalMatIndex = nmi
, shdrTessInnerIndex = tli
, shdrTessOuterIndex = tlo
, stateMap = mapBuffer
, mapVert = vert
, stateFrustum = frust
, stateWinClose = False
, stateClock = now
, stateArrowsPressed = aks
, stateTessellationFactor = 4
}
putStrLn "init done."
@ -189,6 +195,8 @@ draw = do
(GL.UniformLocation proj) = shdrProjMatIndex state
(GL.UniformLocation nmat) = shdrNormalMatIndex state
(GL.UniformLocation vmat) = shdrViewMatIndex state
(GL.UniformLocation tli) = shdrTessInnerIndex state
(GL.UniformLocation tlo) = shdrTessOuterIndex state
vi = shdrVertexIndex state
ni = shdrNormalIndex state
ci = shdrColorIndex state
@ -198,6 +206,7 @@ draw = do
camX = statePositionX state
camY = statePositionY state
zDist = stateZDist state
tessFac = stateTessellationFactor state
liftIO $ do
--(vi,GL.UniformLocation proj) <- initShader
GL.clear [GL.ColorBuffer, GL.DepthBuffer]
@ -223,6 +232,9 @@ draw = do
glUniformMatrix3fv nmat 1 0 (castPtr (ptr :: Ptr (M33 CFloat)))
checkError "nmat"
glUniform1f tli (fromIntegral tessFac)
glUniform1f tlo (fromIntegral tessFac)
GL.bindBuffer GL.ArrayBuffer GL.$= Just map'
GL.vertexAttribPointer ci GL.$= fgColorIndex
@ -387,6 +399,18 @@ processEvent e = do
arrowDown = movement == KeyDown
}
}
SDL.KeypadPlus -> when (movement == KeyDown) $ do
modify $ \s -> s {
stateTessellationFactor = min ((stateTessellationFactor s)+1) 5
}
state <- get
liftIO $ putStrLn $ unwords ["Tessellation at: ", show $ stateTessellationFactor state]
SDL.KeypadMinus -> when (movement == KeyDown) $ do
modify $ \s -> s {
stateTessellationFactor = max ((stateTessellationFactor s)-1) 1
}
state <- get
liftIO $ putStrLn $ unwords ["Tessellation at: ", show $ stateTessellationFactor state]
_ -> return ()
MouseMotion _ id st (Position x y) xrel yrel -> do
state <- get

11
src/Render/Render.hs
View File

@ -46,6 +46,8 @@ initShader :: IO (
, UniformLocation -- ^ ViewMat
, UniformLocation -- ^ ModelMat
, UniformLocation -- ^ NormalMat
, UniformLocation -- ^ TessLevelInner
, UniformLocation -- ^ TessLevelOuter
)
initShader = do
! vertexSource <- B.readFile vertexShaderFile
@ -77,6 +79,13 @@ initShader = do
normalMatrixIndex <- get (uniformLocation program "NormalMatrix")
checkError "normalMat"
tessLevelInner <- get (uniformLocation program "TessLevelInner")
checkError "TessLevelInner"
tessLevelOuter <- get (uniformLocation program "TessLevelOuter")
checkError "TessLevelOuter"
vertexIndex <- get (attribLocation program "Position")
vertexAttribArray vertexIndex $= Enabled
checkError "vertexInd"
@ -95,7 +104,7 @@ initShader = do
putStrLn $ unlines $ ["Indices: ", show (colorIndex, normalIndex, vertexIndex)]
checkError "initShader"
return (colorIndex, normalIndex, vertexIndex, projectionMatrixIndex, viewMatrixIndex, modelMatrixIndex, normalMatrixIndex)
return (colorIndex, normalIndex, vertexIndex, projectionMatrixIndex, viewMatrixIndex, modelMatrixIndex, normalMatrixIndex, tessLevelInner, tessLevelOuter)
initRendering :: IO ()
initRendering = do