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]