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

import Affection.MessageBus
import Affection.Types
import Affection.Util

import Linear.Affine (unP)

import qualified SDL

-- | Helper funtion that consumes all Mouse-related 'SDL.Eventpayload's
-- and emits appropriate 'MouseMessage's
consumeSDLMouseEvents
  :: forall am us. (Participant am us, Mesg am us ~ MouseMessage)
  => am                              -- ^ The message system participant
  -> [SDL.EventPayload]              -- ^ Incoming events
  -> Affection us [SDL.EventPayload] -- ^ Leftover SDL events
consumeSDLMouseEvents am = doConsume
  where
    doConsume
      :: [SDL.EventPayload]
      -> Affection us [SDL.EventPayload]
    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.mouseButtonEventMotion 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)