module Rahm.Desktop.MouseMotion where

import XMonad

import Control.Monad (void, forever)
import Text.Printf
import Rahm.Desktop.Submap
import Control.Monad.Loops (iterateWhile)
import Control.Monad.Fix (fix)
import Rahm.Desktop.Logger

import Linear.V2
import Linear.Metric

data Quadrant = NE | SE | SW | NW deriving (Enum, Show)
data Direction = CW | CCW deriving (Enum, Show)

getQuadrant :: (Num a, Ord a) => (a, a) -> Quadrant
getQuadrant (x, y) | x >= 0 && y >= 0 = NE
getQuadrant (x, y) | x < 0 && y >= 0 = SE
getQuadrant (x, y) | x < 0 && y < 0 = SW
getQuadrant (x, y) = NW


getDirection :: Quadrant -> Quadrant -> Maybe Direction
getDirectory a b | a == b = Nothing
getDirection SW SE = Just CCW
getDirection SE NE = Just CCW
getDirection NE NW = Just CCW
getDirection NW SW = Just CCW
getDirection _ _ = Just CW


liftMouseMotionM :: X a -> MouseMotionM a
liftMouseMotionM = MouseMotionM . fmap Just

motion :: MouseMotionM (V2 Int)
motion = MouseMotionM $ do
  ev <- nextMotionOrButton
  case ev of
    Right button -> do
      logs ("Button " ++ show button)
      return Nothing

    Left motion -> return (Just $ uncurry V2 motion)

motionSize :: Int -> MouseMotionM (V2 Int)
motionSize size = do
  let fsize = fromIntegral size

  !firstmotion <- fmap fromIntegral <$> motion

  let get = do
        !next <- motion
        if distance (fmap fromIntegral next) firstmotion >= fsize
          then return next
          else get

  get

runMouseMotionM :: MouseMotionM a -> X (Maybe a)
runMouseMotionM (MouseMotionM a) = a

execMouseMotionM :: MouseMotionM () -> X ()
execMouseMotionM = void . runMouseMotionM

-- Monad for capturing mouse motion. Terminates and holds Nothing when a
-- button is pressed.
newtype MouseMotionM a = MouseMotionM (X (Maybe a))

instance Functor MouseMotionM where
  fmap fn (MouseMotionM xma) = MouseMotionM (fmap (fmap fn) xma)

instance Applicative MouseMotionM where
  mf <*> ma = do
    !f <- mf
    !a <- ma
    return (f a)

  pure = return

instance Monad MouseMotionM where
  return a = MouseMotionM (return (Just a))
  (MouseMotionM !xa) >>= fn = MouseMotionM $ do
    !ma <- xa
    case ma of
      Just !a ->
        let (MouseMotionM !xb) = fn a in xb
      Nothing -> return Nothing

mouseRotateMotion :: X () -> X () -> X ()
mouseRotateMotion clockWise counterClockwise = execMouseMotionM doMouse
  where
    doMouse = forever $ do
      v <- motion
      liftMouseMotionM $ logs $ "Motion: " ++ show v