move code to external module

This commit is contained in:
nek0 2020-08-09 22:24:32 +02:00
parent 85f45c71a3
commit 51718c2c66
3 changed files with 77 additions and 56 deletions

View file

@ -39,5 +39,6 @@ executable renderer-tutorial
, Shader
, Renderer
, Texture
, EventHandler
hs-source-dirs: src
default-language: Haskell2010

70
src/EventHandler.hs Normal file
View file

@ -0,0 +1,70 @@
module EventHandler where
import Control.Concurrent.MVar
import Linear
import qualified SDL
import qualified Graphics.Rendering.OpenGL as GL
moveQuad
:: MVar (M44 GL.GLfloat)
-> MVar (M44 GL.GLfloat)
-> MVar (M44 GL.GLfloat)
-> MVar [SDL.Event]
-> IO ()
moveQuad proj view model evs =
modifyMVar_ proj (\mproj -> do
modifyMVar_ view (\mview -> do
modifyMVar_ model (\mmodel -> do
plusModel <- foldl (\acc ev -> case SDL.eventPayload ev of
(SDL.KeyboardEvent
( SDL.KeyboardEventData
_
SDL.Pressed
_
(SDL.Keysym _ code mod)
))
->
let trans =
mkTransformationMat
(identity :: M33 GL.GLfloat)
( ( if not (SDL.keyModifierLeftShift mod)
then (-1)
else 1
)
*
( case code of
SDL.KeycodeX ->
V3 1 0 0
SDL.KeycodeY ->
V3 0 1 0
_ ->
V3 0 0 0
)
)
!-!
(identity :: M44 GL.GLfloat)
in acc !+! trans
_ -> acc !+!
(V4
(V4 0 0 0 0)
(V4 0 0 0 0)
(V4 0 0 0 0)
(V4 0 0 0 0)
)
)
(V4
(V4 0 0 0 0)
(V4 0 0 0 0)
(V4 0 0 0 0)
(V4 0 0 0 0)
)
<$> readMVar evs
return $ mmodel !+! plusModel
)
return mview
)
return mproj
)

View file

@ -41,6 +41,7 @@ import IndexBuffer
import Shader
import Renderer
import Texture
import EventHandler
main :: IO ()
main = do
@ -193,62 +194,11 @@ main = do
let newRed = redValue + incrementValue
-- retrieve matrices from MVars and modify them on demand
modifyMVar_ proj (\mproj -> do
modifyMVar_ view (\mview -> do
modifyMVar_ model (\mmodel -> do
plusModel <- foldl (\acc ev -> case SDL.eventPayload ev of
(SDL.KeyboardEvent
( SDL.KeyboardEventData
_
SDL.Pressed
_
(SDL.Keysym _ code mod)
))
->
let trans =
mkTransformationMat
(identity :: M33 GL.GLfloat)
( ( if not (SDL.keyModifierLeftShift mod)
then (-1)
else 1
)
*
( case code of
SDL.KeycodeX ->
V3 1 0 0
SDL.KeycodeY ->
V3 0 1 0
_ ->
V3 0 0 0
)
)
!-!
(identity :: M44 GL.GLfloat)
in acc !+! trans
_ -> acc !+!
(V4
(V4 0 0 0 0)
(V4 0 0 0 0)
(V4 0 0 0 0)
(V4 0 0 0 0)
)
)
(V4
(V4 0 0 0 0)
(V4 0 0 0 0)
(V4 0 0 0 0)
(V4 0 0 0 0)
)
<$> readMVar evs
let nmodel = mmodel !+! plusModel
setUniform sp "u_mvp" (mproj !*! mview !*! nmodel)
return nmodel
)
return mview
)
return mproj
)
moveQuad proj view model evs
mproj <- readMVar proj
mview <- readMVar view
mmodel <- readMVar model
setUniform sp "u_mvp" (mproj !*! mview !*! mmodel)
-- the actual drawing happens here
draw vao ibo sp