renderer-tutorial/src/Scenes/ClearColor.hs
2020-08-29 04:45:51 +02:00

66 lines
1.8 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 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]