{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleContexts #-}
module Affection.Subsystems.AffectionMouse where

import Affection.MessageBus
import Affection.Subsystems.Class
import Affection.Types
import Affection.Util

import Control.Monad.IO.Class (liftIO)
import Control.Concurrent.STM

import Linear.Affine (unP)

import qualified SDL

consumeSDLMouseEvents
  :: (Participant am MouseMessage us)
  => am
  -> [SDL.EventPayload]
  -> Affection us [SDL.EventPayload]
consumeSDLMouseEvents am = doConsume
  where
    doConsume [] = return []
    doConsume (e:es) = do
      ts <- getElapsedTime
      case e of
        SDL.MouseMotionEvent dat -> do
          partEmit am (MsgMouseMotion
            ts
            (SDL.mouseMotionEventWindow dat)
            (SDL.mouseMotionEventWhich dat)
            (SDL.mouseMotionEventState dat)
            (unP $ SDL.mouseMotionEventPos dat)
            (SDL.mouseMotionEventRelMotion dat)
            )
          doConsume es
        SDL.MouseButtonEvent dat -> do
          partEmit am (MsgMouseButton
            ts
            (SDL.mouseButtonEventWindow dat)
            (SDL.mouseButtonEventWhich dat)
            (SDL.mouseButtonEventButton dat)
            (SDL.mouseButtonEventClicks dat)
            (unP $ SDL.mouseButtonEventPos dat)
            )
          doConsume es
        SDL.MouseWheelEvent dat -> do
          partEmit am (MsgMouseWheel
            ts
            (SDL.mouseWheelEventWindow dat)
            (SDL.mouseWheelEventWhich dat)
            (SDL.mouseWheelEventPos dat)
            (SDL.mouseWheelEventDirection dat)
            )
          doConsume es
        _ -> fmap (e :) (doConsume es)