2020-08-09 22:24:32 +02:00
|
|
|
module EventHandler where
|
|
|
|
|
2020-08-10 12:50:29 +02:00
|
|
|
import Control.Monad (when)
|
|
|
|
|
2020-08-09 22:24:32 +02:00
|
|
|
import Control.Concurrent.MVar
|
|
|
|
|
2020-08-10 12:50:29 +02:00
|
|
|
import Control.Lens as Lens
|
|
|
|
|
2020-08-09 22:24:32 +02:00
|
|
|
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 ->
|
2020-08-10 12:50:29 +02:00
|
|
|
V3 0 (-1) 0
|
2020-08-09 22:24:32 +02:00
|
|
|
_ ->
|
|
|
|
V3 0 0 0
|
|
|
|
)
|
|
|
|
)
|
|
|
|
!-!
|
|
|
|
(identity :: M44 GL.GLfloat)
|
|
|
|
in acc !+! trans
|
2020-08-10 12:50:29 +02:00
|
|
|
_ -> acc
|
2020-08-09 22:24:32 +02:00
|
|
|
)
|
2020-08-10 12:50:29 +02:00
|
|
|
zero
|
2020-08-09 22:24:32 +02:00
|
|
|
<$> readMVar evs
|
2020-08-10 12:50:29 +02:00
|
|
|
let retval = mmodel !+! plusModel
|
|
|
|
when (not $ plusModel == zero) $
|
|
|
|
print ("Current Position of object: " <>
|
|
|
|
show (Lens.view translation $ retval))
|
|
|
|
return retval
|
2020-08-09 22:24:32 +02:00
|
|
|
)
|
|
|
|
return mview
|
|
|
|
)
|
|
|
|
return mproj
|
|
|
|
)
|