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]