finished episode 24

This commit is contained in:
nek0 2020-08-29 04:41:23 +02:00
parent ad1e3579e8
commit fa0c6c4670
6 changed files with 136 additions and 114 deletions

View file

@ -24,6 +24,9 @@ to peruse it.
### Keyboard
* `1`, `2`: Switch input focus between the two displayed objects
* `X`/`Shift`+`X`: Move the focused object right/left
* `Y`/`Shift`+`Y`: Move the focused object up/down
To switch to a scene, press one of the buttons below
## `F1` - Colour changer
Use the keys `1` through `4` to increase the values of R, G, B or A of the
background colour. Press `Left Shift` and the number key to decrease it.

View file

@ -41,5 +41,7 @@ executable renderer-tutorial
, Renderer
, Texture
, EventHandler
, Scenes.SceneClass
, Scenes.ClearColor
hs-source-dirs: src
default-language: Haskell2010

View file

@ -84,7 +84,6 @@ switchObject focus elems evs =
(SDL.Keysym code _ mod)
))
-> do
print code
let selectIndex = fromIntegral (SDL.toNumber code) - 30
if ((selectIndex < 10) && (selectIndex >= 0)) &&
(SDL.toNumber mod == 0) &&

View file

@ -4,6 +4,7 @@ module Main where
import SDL (($=), get)
import qualified SDL
import qualified SDL.Internal.Numbered as SDL
import qualified SDL.Raw.Video as SDL (glSetAttribute)
import qualified SDL.Raw.Enum as SDL
@ -43,6 +44,9 @@ import Renderer
import Texture
import EventHandler
import Scenes.SceneClass
import Scenes.ClearColor
main :: IO ()
main = do
@ -78,93 +82,13 @@ main = do
version <- peekArray0 (0 :: Word8) =<< GLRaw.glGetString GLRaw.GL_VERSION
print (B.pack version)
-- -- VERTICES
-- first, create and bind a vertex array object
vao <- GL.genObjectName
GL.bindVertexArrayObject $= Just vao
-- define vertices (positions of the rectangle corners) as List of Floats
-- with added in texture coordinates
let vertexPositions =
-- 3D positions | texture coordinates
[ -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
indices = [0, 1, 2, 2, 3, 0] :: [GL.GLuint]
-- construct new VertexBuffer and fill it with data
vao <- newVertexArray
vbo <- newVertexBuffer vertexPositions
-- rebind the vertex buffer
bind vbo
-- enable and specify data layout of the in-memory vertices
layout <- newVertexBufferLayout
-- push vertex positions
pushElements layout GL.Float 3
-- pusht texture coordinates
pushElements layout GL.Float 2
addBuffer vao vbo layout
-- -- MATRICES
let mproj = ortho 0 800 0 600 (-1) 1 :: M44 GL.GLfloat
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
model1 <- newMVar mmodel1
model2 <- newMVar mmodel2
-- -- TEXTURE
-- generate and bind texture
tex <- newTexture "res/textures/lynx.jpg" 0
bind tex
-- construct new IndexBuffer and fill it with data
ibo <- newIndexBuffer indices
-- -- SHADERS
sp <- newShader
[ ShaderSource GL.VertexShader "./res/shaders/vert.shader"
, ShaderSource GL.FragmentShader "./res/shaders/frag.shader"
]
[ "u_color"
, "u_texture"
, "u_mvp"
]
-- -- tell the shader where to find the texture
bind sp
setUniform sp "u_texture" (texSlot tex)
-- -- UNIFORMS
err <- get GL.errors
print $ "pre-loop errors: " <> show err
-- -- EVENTING AND DRAWING
-- -- Constructing Scenes
switch <- newMVar model1
-- -- UNBINDING ALL BUFFERS AND VERTEX ARRAYS
unbind vao
unbind vbo
unbind ibo
unbind sp
-- Construct state machine for the Scenes
curScene <- newEmptyMVar :: IO (MVar Scene)
-- -- LOOPING
@ -177,6 +101,8 @@ main = do
-- poll again
void $ swapMVar evs =<< SDL.pollEvents
currentEvents <- readMVar evs
-- -- OBEY THE HYPNOTOAD!
-- clearcol <- GL.Color4
-- <$> (randomRIO (0, 1))
@ -185,35 +111,19 @@ main = do
-- <*> pure 1
-- GL.clearColor $= clearcol
-- clear previous frame
clear
hasSelect <- not <$> isEmptyMVar curScene
if hasSelect
then do
(Scene sceneObject) <- readMVar curScene
onEvents sceneObject currentEvents
update sceneObject 0
render sceneObject
else do
GL.clear [GL.ColorBuffer]
-- retrieve matrices from MVars
mproj <- readMVar proj
mview <- readMVar view
-- Switch to different scene on keyboard presses F1 thourgh F?
-- 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
-- -- 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
sceneSwitch curScene currentEvents
err <- get GL.errors
when (not $ null err) (print $ "loop errors: " <> show err)
@ -237,3 +147,26 @@ main = do
-- This is the end.
putStrLn "Bye!"
sceneSwitch :: MVar Scene -> [SDL.Event] -> IO ()
sceneSwitch curScene evs = mapM_ (switch . SDL.eventPayload) evs
where
switch (SDL.KeyboardEvent
(SDL.KeyboardEventData
_
SDL.Pressed
_
(SDL.Keysym _ code mod))) =
when (SDL.toNumber mod == 0) $
case code of
SDL.KeycodeF1 -> do
void $ tryTakeMVar curScene
putMVar curScene =<< scene1
_ ->
return ()
switch _ = return ()
-- initialize scenes
scene1 = Scene <$> ClearColor <$> newMVar (V4 0 0.2 0.3 1)

65
src/Scenes/ClearColor.hs Normal file
View file

@ -0,0 +1,65 @@
module Scenes.ClearColor where
import SDL (($=), get)
import qualified SDL
import qualified SDL.Internal.Numbered as SDL
import qualified Graphics.Rendering.OpenGL as GL
import Control.Monad
import Control.Concurrent.MVar
import Linear
-- internal imports
import Scenes.SceneClass
data ClearColor = ClearColor
{ ccColor :: MVar (V4 GL.GLfloat)
}
instance SceneClass ClearColor where
update _ _ = return ()
onEvents (ClearColor col) evs =
modifyMVar_ col (\(V4 r g b a) -> do
[nr, ng, nb, na] <- foldM
(\acc ev -> case SDL.eventPayload ev of
(SDL.KeyboardEvent
(SDL.KeyboardEventData
_
SDL.Pressed
_
(SDL.Keysym _ code mod)
)) -> do
-- Scancode for key "1" 1 is 30
let alter =
map
-- flip direction on pressed "Shift" key
(if SDL.keyModifierLeftShift mod
then ((-1) *)
else id
)
-- alter colors only for key 1 to 4, ignore all others
(case code of
SDL.Keycode1 -> [1, 0, 0, 0]
SDL.Keycode2 -> [0, 1, 0, 0]
SDL.Keycode3 -> [0, 0, 1, 0]
SDL.Keycode4 -> [0, 0, 0, 1]
_ -> [0, 0, 0, 0]
)
return $ zipWith (+) acc (map (/ 256) alter)
_ -> return acc
)
[r, g, b, a]
evs
return (V4 nr ng nb na)
)
render (ClearColor col) = do
(V4 r g b a) <- readMVar col
GL.clearColor $= GL.Color4 r g b a
GL.clear [GL.ColorBuffer]

20
src/Scenes/SceneClass.hs Normal file
View file

@ -0,0 +1,20 @@
{-# LANGUAGE ExistentialQuantification #-}
module Scenes.SceneClass where
import qualified SDL
class SceneClass a where
-- | Run updates on the data given the time elapsed since last frame
update :: a -> Float -> IO ()
-- | Handle input events
onEvents :: a -> [SDL.Event] -> IO ()
-- | perform the drawing
render :: a -> IO ()
-- Existential type wrapper to make all Scenes implementing SceneClass
-- homogenous.
-- See more at https://wiki.haskell.org/Existential_type#Dynamic_dispatch_mechanism_of_OOP
data Scene = forall a. SceneClass a => Scene a