keyboard-controls for tessellation

src/Main.hs

@@ -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]
@@ -224,6 +233,9 @@ draw = do
 
         checkError "nmat"
         
+        glUniform1f tli (fromIntegral tessFac)
+        glUniform1f tlo (fromIntegral tessFac)
+
         GL.bindBuffer GL.ArrayBuffer GL.$= Just map'
         GL.vertexAttribPointer ci GL.$= fgColorIndex
         GL.vertexAttribArray ci   GL.$= GL.Enabled
@@ -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

src/Render/Render.hs

@@ -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