renderer-tutorial/src/EventHandler.hs

102 lines
2.8 KiB
Haskell
Raw Permalink Normal View History

2020-08-09 20:24:32 +00:00
module EventHandler where
2020-08-10 13:09:23 +00:00
import Control.Monad
2020-08-09 20:24:32 +00:00
import Control.Concurrent.MVar
import Control.Lens as Lens
2020-08-09 20:24:32 +00:00
import Linear
import qualified SDL
2020-08-10 13:09:23 +00:00
import qualified SDL.Internal.Numbered as SDL
2020-08-09 20:24:32 +00:00
import qualified Graphics.Rendering.OpenGL as GL
2020-08-10 13:09:23 +00:00
moveObj
2020-08-09 20:24:32 +00:00
:: MVar (M44 GL.GLfloat)
-> MVar (M44 GL.GLfloat)
-> MVar (M44 GL.GLfloat)
-> MVar [SDL.Event]
-> IO ()
2020-08-10 13:09:23 +00:00
moveObj proj view model evs =
2020-08-09 20:24:32 +00:00
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)
2020-08-10 13:09:23 +00:00
( ( if SDL.keyModifierLeftShift mod
2020-08-09 20:24:32 +00:00
then (-1)
else 1
)
*
( case code of
SDL.KeycodeX ->
V3 1 0 0
SDL.KeycodeY ->
2020-08-10 13:09:23 +00:00
V3 0 1 0
2020-08-09 20:24:32 +00:00
_ ->
V3 0 0 0
)
)
!-!
(identity :: M44 GL.GLfloat)
in acc !+! trans
_ -> acc
2020-08-09 20:24:32 +00:00
)
zero
2020-08-09 20:24:32 +00:00
<$> readMVar evs
let retval = mmodel !+! plusModel
when (not $ plusModel == zero) $
print ("Current Position of object: " <>
show (Lens.view translation $ retval))
return retval
2020-08-09 20:24:32 +00:00
)
return mview
)
return mproj
)
2020-08-10 13:09:23 +00:00
switchObject
:: MVar (MVar (M44 GL.GLfloat))
-> [MVar (M44 GL.GLfloat)]
-> MVar [SDL.Event]
-> IO ()
switchObject focus elems evs =
modifyMVar_ focus (\foc -> do
foldM
(\acc ev -> case SDL.eventPayload ev of
(SDL.KeyboardEvent
(SDL.KeyboardEventData
_
SDL.Pressed
_
(SDL.Keysym code _ mod)
))
-> do
let selectIndex = fromIntegral (SDL.toNumber code) - 30
if ((selectIndex < 10) && (selectIndex >= 0)) &&
(SDL.toNumber mod == 0) &&
(selectIndex < length elems) &&
(acc /= (elems !! selectIndex))
then do
print ("selected element number: " <> show selectIndex)
return $ elems !! selectIndex
else
return foc
_ -> return acc
)
foc
=<< readMVar evs
)