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

@ -88,10 +88,10 @@ main = do
-- with added in texture coordinates
let vertexPositions =
-- 3D positions | texture coordinates
[ 100, 100, 0, 0, 0
, 233, 100, 0, 1, 0
, 233, 300, 0, 1, 1
, 100, 300, 0, 0, 1
[ -67, -100, 0, 0, 0
, 67, -100, 0, 1, 0
, 67, 100, 0, 1, 1
, -67, 100, 0, 0, 1
] :: [GL.GLfloat]
-- create draw order indices
@ -116,13 +116,15 @@ main = do
-- -- MATRICES
let mproj = ortho 0 800 0 600 (-1) 1 :: M44 GL.GLfloat
mview = mkTransformationMat (identity :: M33 GL.GLfloat) (V3 (-100) 0 0)
mmodel = mkTransformationMat (identity :: M33 GL.GLfloat) (V3 200 200 0)
mview = mkTransformationMat (identity :: M33 GL.GLfloat) (V3 0 0 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
proj <- newMVar mproj
view <- newMVar mview
model <- newMVar mmodel
model1 <- newMVar mmodel1
model2 <- newMVar mmodel2
-- -- TEXTURE
@ -147,19 +149,16 @@ main = do
-- -- tell the shader where to find the texture
bind sp
setUniform sp "u_texture" (texSlot tex)
setUniform sp "u_mvp" (mproj !*! mview !*! mmodel)
-- -- UNIFORMS
-- create MVars for pulsating red channel
red <- newMVar 0
increment <- newMVar 0.05
err <- get GL.errors
print $ "pre-loop errors: " <> show err
-- -- EVENTING AND DRAWING
switch <- newMVar model1
-- -- UNBINDING ALL BUFFERS AND VERTEX ARRAYS
unbind vao
@ -186,19 +185,36 @@ main = do
-- <*> pure 1
-- GL.clearColor $= clearcol
-- -- rebind everything neccessary for draw call
bind sp
-- clear previous frame
clear
-- retrieve matrices from MVars and modify them on demand
moveQuad proj view model evs
-- retrieve matrices from MVars
mproj <- readMVar proj
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
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
when (not $ null err) (print $ "loop errors: " <> show err)

View file

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