content: {-|
    Description: Mouse clicks, drags, and scrolls
  -}
  module Reflex.Vty.Widget.Input.Mouse where
  
  import Control.Monad.Fix
  import qualified Graphics.Vty as V
  import Reflex
  import Reflex.Vty.Widget
  
  -- | Information about a drag operation
  data Drag = Drag
    { _drag_from :: (Int, Int) -- ^ Where the drag began
    , _drag_to :: (Int, Int) -- ^ Where the mouse currently is
    , _drag_button :: V.Button -- ^ Which mouse button is dragging
    , _drag_modifiers :: [V.Modifier] -- ^ What modifiers are held
    , _drag_end :: Bool -- ^ Whether the drag ended (the mouse button was released)
    }
    deriving (Eq, Ord, Show)
  
  -- | Converts raw vty mouse drag events into an event stream of 'Drag's
  drag
    :: (Reflex t, MonadFix m, MonadHold t m, HasInput t m)
    => V.Button
    -> m (Event t Drag)
  drag btn = do
    inp <- input
    let f :: Maybe Drag -> V.Event -> Maybe Drag
        f Nothing = \case
          V.EvMouseDown x y btn' mods
            | btn == btn' -> Just $ Drag (x,y) (x,y) btn' mods False
            | otherwise   -> Nothing
          _ -> Nothing
        f (Just (Drag from _ _ mods end)) = \case
          V.EvMouseDown x y btn' mods'
            | end && btn == btn'  -> Just $ Drag (x,y) (x,y) btn' mods' False
            | btn == btn'         -> Just $ Drag from (x,y) btn mods' False
            | otherwise           -> Nothing -- Ignore other buttons.
          V.EvMouseUp x y (Just btn')
            | end         -> Nothing
            | btn == btn' -> Just $ Drag from (x,y) btn mods True
            | otherwise   -> Nothing
          V.EvMouseUp x y Nothing -- Terminal doesn't specify mouse up button,
                                  -- assume it's the right one.
            | end       -> Nothing
            | otherwise -> Just $ Drag from (x,y) btn mods True
          _ -> Nothing
    rec let newDrag = attachWithMaybe f (current dragD) inp
        dragD <- holdDyn Nothing $ Just <$> newDrag
    return (fmapMaybe id $ updated dragD)
  
  -- | Mouse down events for a particular mouse button
  mouseDown
    :: (Reflex t, Monad m, HasInput t m)
    => V.Button
    -> m (Event t MouseDown)
  mouseDown btn = do
    i <- input
    return $ fforMaybe i $ \case
      V.EvMouseDown x y btn' mods -> if btn == btn'
        then Just $ MouseDown btn' (x, y) mods
        else Nothing
      _ -> Nothing
  
  -- | Mouse up events for a particular mouse button
  mouseUp
    :: (Reflex t, Monad m, HasInput t m)
    => m (Event t MouseUp)
  mouseUp = do
    i <- input
    return $ fforMaybe i $ \case
      V.EvMouseUp x y btn' -> Just $ MouseUp btn' (x, y)
      _ -> Nothing
  
  -- | Information about a mouse down event
  data MouseDown = MouseDown
    { _mouseDown_button :: V.Button
    , _mouseDown_coordinates :: (Int, Int)
    , _mouseDown_modifiers :: [V.Modifier]
    }
    deriving (Eq, Ord, Show)
  
  -- | Information about a mouse up event
  data MouseUp = MouseUp
    { _mouseUp_button :: Maybe V.Button
    , _mouseUp_coordinates :: (Int, Int)
    }
    deriving (Eq, Ord, Show)
  
  -- | Mouse scroll direction
  data ScrollDirection = ScrollDirection_Up | ScrollDirection_Down
    deriving (Eq, Ord, Show)
  
  -- | Produce an event that fires when the mouse wheel is scrolled
  mouseScroll
    :: (Reflex t, Monad m, HasInput t m)
    => m (Event t ScrollDirection)
  mouseScroll = do
    up <- mouseDown V.BScrollUp
    down <- mouseDown V.BScrollDown
    return $ leftmost
      [ ScrollDirection_Up <$ up
      , ScrollDirection_Down <$ down
      ]
  
  
  