77 lines
2 KiB
Haskell
77 lines
2 KiB
Haskell
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 BindableClass
|
|
import BufferClass
|
|
import VertexArray
|
|
import VertexBuffer
|
|
import IndexBuffer
|
|
import Shader
|
|
import Renderer
|
|
import Texture
|
|
|
|
import Scenes.SceneClass
|
|
|
|
data ClearColor = ClearColor
|
|
{ ccColor :: MVar (V4 GL.GLfloat)
|
|
}
|
|
|
|
instance SceneClass ClearColor where
|
|
|
|
initScene = do
|
|
ClearColor <$> newMVar (V4 0 0.2 0.3 1)
|
|
|
|
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]
|