102 lines
2.8 KiB
Haskell
102 lines
2.8 KiB
Haskell
module EventHandler where
|
|
|
|
import Control.Monad
|
|
|
|
import Control.Concurrent.MVar
|
|
|
|
import Control.Lens as Lens
|
|
|
|
import Linear
|
|
|
|
import qualified SDL
|
|
import qualified SDL.Internal.Numbered as SDL
|
|
|
|
import qualified Graphics.Rendering.OpenGL as GL
|
|
|
|
moveObj
|
|
:: MVar (M44 GL.GLfloat)
|
|
-> MVar (M44 GL.GLfloat)
|
|
-> MVar (M44 GL.GLfloat)
|
|
-> MVar [SDL.Event]
|
|
-> IO ()
|
|
moveObj 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 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
|
|
)
|
|
zero
|
|
<$> readMVar evs
|
|
let retval = mmodel !+! plusModel
|
|
when (not $ plusModel == zero) $
|
|
print ("Current Position of object: " <>
|
|
show (Lens.view translation $ retval))
|
|
return retval
|
|
)
|
|
return mview
|
|
)
|
|
return mproj
|
|
)
|
|
|
|
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
|
|
)
|