finished episode 23

This commit is contained in:
nek0 2020-08-10 15:09:23 +02:00
parent c27d0a72e3
commit dc68854f19
3 changed files with 76 additions and 26 deletions

View file

@ -1,6 +1,6 @@
module EventHandler where module EventHandler where
import Control.Monad (when) import Control.Monad
import Control.Concurrent.MVar import Control.Concurrent.MVar
@ -9,16 +9,17 @@ import Control.Lens as Lens
import Linear import Linear
import qualified SDL import qualified SDL
import qualified SDL.Internal.Numbered as SDL
import qualified Graphics.Rendering.OpenGL as GL import qualified Graphics.Rendering.OpenGL as GL
moveQuad moveObj
:: MVar (M44 GL.GLfloat) :: MVar (M44 GL.GLfloat)
-> MVar (M44 GL.GLfloat) -> MVar (M44 GL.GLfloat)
-> MVar (M44 GL.GLfloat) -> MVar (M44 GL.GLfloat)
-> MVar [SDL.Event] -> MVar [SDL.Event]
-> IO () -> IO ()
moveQuad proj view model evs = moveObj proj view model evs =
modifyMVar_ proj (\mproj -> do modifyMVar_ proj (\mproj -> do
modifyMVar_ view (\mview -> do modifyMVar_ view (\mview -> do
modifyMVar_ model (\mmodel -> do modifyMVar_ model (\mmodel -> do
@ -34,7 +35,7 @@ moveQuad proj view model evs =
let trans = let trans =
mkTransformationMat mkTransformationMat
(identity :: M33 GL.GLfloat) (identity :: M33 GL.GLfloat)
( ( if not (SDL.keyModifierLeftShift mod) ( ( if SDL.keyModifierLeftShift mod
then (-1) then (-1)
else 1 else 1
) )
@ -43,7 +44,7 @@ moveQuad proj view model evs =
SDL.KeycodeX -> SDL.KeycodeX ->
V3 1 0 0 V3 1 0 0
SDL.KeycodeY -> SDL.KeycodeY ->
V3 0 (-1) 0 V3 0 1 0
_ -> _ ->
V3 0 0 0 V3 0 0 0
) )
@ -65,3 +66,37 @@ moveQuad proj view model evs =
) )
return mproj 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
print code
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
)

View file

@ -87,11 +87,11 @@ main = do
-- define vertices (positions of the rectangle corners) as List of Floats -- define vertices (positions of the rectangle corners) as List of Floats
-- with added in texture coordinates -- with added in texture coordinates
let vertexPositions = let vertexPositions =
-- 3D positions | texture coordinates -- 3D positions | texture coordinates
[ 100, 100, 0, 0, 0 [ -67, -100, 0, 0, 0
, 233, 100, 0, 1, 0 , 67, -100, 0, 1, 0
, 233, 300, 0, 1, 1 , 67, 100, 0, 1, 1
, 100, 300, 0, 0, 1 , -67, 100, 0, 0, 1
] :: [GL.GLfloat] ] :: [GL.GLfloat]
-- create draw order indices -- create draw order indices
@ -116,13 +116,15 @@ main = do
-- -- MATRICES -- -- MATRICES
let mproj = ortho 0 800 0 600 (-1) 1 :: M44 GL.GLfloat let mproj = ortho 0 800 0 600 (-1) 1 :: M44 GL.GLfloat
mview = mkTransformationMat (identity :: M33 GL.GLfloat) (V3 (-100) 0 0) mview = mkTransformationMat (identity :: M33 GL.GLfloat) (V3 0 0 0)
mmodel = mkTransformationMat (identity :: M33 GL.GLfloat) (V3 200 200 0) mmodel1 = mkTransformationMat (identity :: M33 GL.GLfloat) (V3 200 200 0)
mmodel2 = mkTransformationMat (identity :: M33 GL.GLfloat) (V3 400 400 0)
-- store the mtrices for later adjustments -- store the mtrices for later adjustments
proj <- newMVar mproj proj <- newMVar mproj
view <- newMVar mview view <- newMVar mview
model <- newMVar mmodel model1 <- newMVar mmodel1
model2 <- newMVar mmodel2
-- -- TEXTURE -- -- TEXTURE
@ -147,19 +149,16 @@ main = do
-- -- tell the shader where to find the texture -- -- tell the shader where to find the texture
bind sp bind sp
setUniform sp "u_texture" (texSlot tex) setUniform sp "u_texture" (texSlot tex)
setUniform sp "u_mvp" (mproj !*! mview !*! mmodel)
-- -- UNIFORMS -- -- UNIFORMS
-- create MVars for pulsating red channel
red <- newMVar 0
increment <- newMVar 0.05
err <- get GL.errors err <- get GL.errors
print $ "pre-loop errors: " <> show err print $ "pre-loop errors: " <> show err
-- -- EVENTING AND DRAWING -- -- EVENTING AND DRAWING
switch <- newMVar model1
-- -- UNBINDING ALL BUFFERS AND VERTEX ARRAYS -- -- UNBINDING ALL BUFFERS AND VERTEX ARRAYS
unbind vao unbind vao
@ -186,19 +185,36 @@ main = do
-- <*> pure 1 -- <*> pure 1
-- GL.clearColor $= clearcol -- GL.clearColor $= clearcol
-- -- rebind everything neccessary for draw call -- clear previous frame
bind sp clear
-- retrieve matrices from MVars and modify them on demand -- retrieve matrices from MVars
moveQuad proj view model evs
mproj <- readMVar proj mproj <- readMVar proj
mview <- readMVar view mview <- readMVar view
mmodel <- readMVar model
setUniform sp "u_mvp" (mproj !*! mview !*! mmodel) -- modify the mvars based on keystrokes
switchObject switch [model1, model2] evs
focus <- readMVar switch
moveObj proj view focus evs
-- -- bind shader and provide mvp for object1 and draw it
mmodel1 <- readMVar model1
bind sp
setUniform sp "u_mvp" (mproj !*! mview !*! mmodel1)
-- the actual drawing happens here -- the actual drawing happens here
draw vao ibo sp draw vao ibo sp
-- GL.drawElements GL.Triangles 6 GL.UnsignedInt nullPtr
-- -- bind shader and provide mvp for object2 and draw it
mmodel2 <- readMVar model2
bind sp
setUniform sp "u_mvp" (mproj !*! mview !*! mmodel2)
-- the actual drawing happens here
draw vao ibo sp
err <- get GL.errors err <- get GL.errors
when (not $ null err) (print $ "loop errors: " <> show err) when (not $ null err) (print $ "loop errors: " <> show err)

View file

@ -15,7 +15,6 @@ import Shader
draw :: VertexArray -> (IndexBuffer a) -> Shader -> IO () draw :: VertexArray -> (IndexBuffer a) -> Shader -> IO ()
draw va ib sp = do draw va ib sp = do
clear
bind sp bind sp
bind va bind va
bind ib bind ib