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