{-# LANGUAGE DefaultSignatures          #-}
{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE FunctionalDependencies     #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE RecursiveDo                #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE TupleSections              #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE UndecidableInstances       #-}


module Potato.Reflex.Vty.Widget
  (
  SingleClick(..)
  , singleClick
  , singleClickNoDragOffSimple
  , singleClickWithDownState
  , DoubleClickConfig(..)
  , doubleClick
  , doubleClickSimple

  , splitHDrag
  , DragState(..)
  , Drag2(..)
  , drag2
  ) where

import           Prelude

import qualified Graphics.Vty                  as V

import           Reflex
import           Reflex.Class                  ()
import           Reflex.Vty.Widget
import           Reflex.Vty.Widget.Input.Mouse



import           Control.Monad.NodeId
import           Control.Monad.Reader
import           System.Clock


-- currently only works for a SINGLE POINT
-- TODO integrate with pane2 so it reports clicks that happen on pane.
data SingleClick = SingleClick
  { SingleClick -> Button
_singleClick_button      :: V.Button
  , SingleClick -> (Int, Int)
_singleClick_coordinates :: (Int, Int) -- ^ coordinates of down click
  , SingleClick -> [Modifier]
_singleClick_modifiers   :: [V.Modifier]
  , SingleClick -> Bool
_singleClick_didDragOff  :: Bool
  }
  deriving (SingleClick -> SingleClick -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SingleClick -> SingleClick -> Bool
$c/= :: SingleClick -> SingleClick -> Bool
== :: SingleClick -> SingleClick -> Bool
$c== :: SingleClick -> SingleClick -> Bool
Eq, Eq SingleClick
SingleClick -> SingleClick -> Bool
SingleClick -> SingleClick -> Ordering
SingleClick -> SingleClick -> SingleClick
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SingleClick -> SingleClick -> SingleClick
$cmin :: SingleClick -> SingleClick -> SingleClick
max :: SingleClick -> SingleClick -> SingleClick
$cmax :: SingleClick -> SingleClick -> SingleClick
>= :: SingleClick -> SingleClick -> Bool
$c>= :: SingleClick -> SingleClick -> Bool
> :: SingleClick -> SingleClick -> Bool
$c> :: SingleClick -> SingleClick -> Bool
<= :: SingleClick -> SingleClick -> Bool
$c<= :: SingleClick -> SingleClick -> Bool
< :: SingleClick -> SingleClick -> Bool
$c< :: SingleClick -> SingleClick -> Bool
compare :: SingleClick -> SingleClick -> Ordering
$ccompare :: SingleClick -> SingleClick -> Ordering
Ord, Int -> SingleClick -> ShowS
[SingleClick] -> ShowS
SingleClick -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SingleClick] -> ShowS
$cshowList :: [SingleClick] -> ShowS
show :: SingleClick -> String
$cshow :: SingleClick -> String
showsPrec :: Int -> SingleClick -> ShowS
$cshowsPrec :: Int -> SingleClick -> ShowS
Show)


singleClick :: (Reflex t, MonadHold t m, MonadFix m, HasInput t m) => V.Button -> m (Event t SingleClick)
singleClick :: forall t (m :: * -> *).
(Reflex t, MonadHold t m, MonadFix m, HasInput t m) =>
Button -> m (Event t SingleClick)
singleClick Button
btn = do
  let
    -- TODO implement for pane2 instead
    withinBounds :: Drag2 -> Bool
withinBounds (Drag2 (Int
fromX, Int
fromY) (Int
toX, Int
toY) Button
_ [Modifier]
_ DragState
_) = Int
fromX forall a. Eq a => a -> a -> Bool
== Int
toX Bool -> Bool -> Bool
&& Int
fromY forall a. Eq a => a -> a -> Bool
== Int
toY
  Event t Drag2
dragEv <- forall t (m :: * -> *).
(Reflex t, MonadFix m, MonadHold t m, HasInput t m) =>
Button -> m (Event t Drag2)
drag2 Button
btn
  Dynamic t Bool
didStayOnDyn <- forall {k} (t :: k) (m :: * -> *) a b.
(Reflex t, MonadHold t m, MonadFix m) =>
(a -> b -> b) -> b -> Event t a -> m (Dynamic t b)
foldDyn (forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. Drag2 -> Bool
withinBounds) Bool
False Event t Drag2
dragEv
  return $ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall {k} (t :: k) a b.
Reflex t =>
(a -> PushM t (Maybe b)) -> Event t a -> Event t b
push Event t Drag2
dragEv forall a b. (a -> b) -> a -> b
$ \d :: Drag2
d@(Drag2 (Int
fromX, Int
fromY) (Int, Int)
_ Button
_ [Modifier]
mods DragState
ds) -> do
    Bool
didStayOn <- forall {k} (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current forall a b. (a -> b) -> a -> b
$ Dynamic t Bool
didStayOnDyn
    return $ if DragState
ds forall a. Eq a => a -> a -> Bool
== DragState
DragEnd Bool -> Bool -> Bool
&& Drag2 -> Bool
withinBounds Drag2
d
      then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Button -> (Int, Int) -> [Modifier] -> Bool -> SingleClick
SingleClick Button
btn (Int
fromX, Int
fromY) [Modifier]
mods (Bool -> Bool
not Bool
didStayOn)
      else forall a. Maybe a
Nothing

singleClickNoDragOffSimple :: (Reflex t, MonadHold t m, MonadFix m, HasInput t m) => V.Button -> m (Event t ())
singleClickNoDragOffSimple :: forall t (m :: * -> *).
(Reflex t, MonadHold t m, MonadFix m, HasInput t m) =>
Button -> m (Event t ())
singleClickNoDragOffSimple Button
btn = do
  Event t SingleClick
ev <- forall t (m :: * -> *).
(Reflex t, MonadHold t m, MonadFix m, HasInput t m) =>
Button -> m (Event t SingleClick)
singleClick Button
btn
  return $ forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
fmapMaybe (\SingleClick
sc -> if SingleClick -> Bool
_singleClick_didDragOff SingleClick
sc then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just ()) Event t SingleClick
ev


singleClickWithDownState :: (Reflex t, MonadHold t m, MonadFix m, HasInput t m) => V.Button -> m (Event t SingleClick, Dynamic t Bool)
singleClickWithDownState :: forall t (m :: * -> *).
(Reflex t, MonadHold t m, MonadFix m, HasInput t m) =>
Button -> m (Event t SingleClick, Dynamic t Bool)
singleClickWithDownState Button
btn = do
  let
    -- TODO implement for pane2 instead
    withinBounds :: Drag2 -> Bool
withinBounds (Drag2 (Int
fromX, Int
fromY) (Int
toX, Int
toY) Button
_ [Modifier]
_ DragState
_) = Int
fromX forall a. Eq a => a -> a -> Bool
== Int
toX Bool -> Bool -> Bool
&& Int
fromY forall a. Eq a => a -> a -> Bool
== Int
toY
  Event t Drag2
dragEv <- forall t (m :: * -> *).
(Reflex t, MonadFix m, MonadHold t m, HasInput t m) =>
Button -> m (Event t Drag2)
drag2 Button
btn
  Dynamic t Bool
downDyn <- forall {k} (t :: k) (m :: * -> *) a b.
(Reflex t, MonadHold t m, MonadFix m) =>
(a -> b -> b) -> b -> Event t a -> m (Dynamic t b)
foldDyn (\(Drag2 (Int, Int)
_ (Int, Int)
_ Button
_ [Modifier]
_ DragState
ds) Bool
_ -> DragState
ds forall a. Eq a => a -> a -> Bool
/= DragState
DragEnd) Bool
False Event t Drag2
dragEv
  Dynamic t Bool
didStayOnDyn <- forall {k} (t :: k) (m :: * -> *) a b.
(Reflex t, MonadHold t m, MonadFix m) =>
(a -> b -> b) -> b -> Event t a -> m (Dynamic t b)
foldDyn (forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. Drag2 -> Bool
withinBounds) Bool
False Event t Drag2
dragEv
  let
    scEv :: Event t SingleClick
scEv = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall {k} (t :: k) a b.
Reflex t =>
(a -> PushM t (Maybe b)) -> Event t a -> Event t b
push Event t Drag2
dragEv forall a b. (a -> b) -> a -> b
$ \d :: Drag2
d@(Drag2 (Int
fromX, Int
fromY) (Int, Int)
_ Button
_ [Modifier]
mods DragState
ds) -> do
      Bool
didStayOn <- forall {k} (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current forall a b. (a -> b) -> a -> b
$ Dynamic t Bool
didStayOnDyn
      return $ if DragState
ds forall a. Eq a => a -> a -> Bool
== DragState
DragEnd Bool -> Bool -> Bool
&& Drag2 -> Bool
withinBounds Drag2
d
        then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Button -> (Int, Int) -> [Modifier] -> Bool -> SingleClick
SingleClick Button
btn (Int
fromX, Int
fromY) [Modifier]
mods (Bool -> Bool
not Bool
didStayOn)
        else forall a. Maybe a
Nothing
  return (Event t SingleClick
scEv, Dynamic t Bool
downDyn)

data DoubleClickConfig = DoubleClickConfig  {
    -- TODO lol...
    --_doubleClickConfig_spaceTolerance :: (Int, Int) -- the (x,y) mouse travel tolerance
    DoubleClickConfig -> Integer
_doubleClickConfig_timeTolerance :: Integer -- the time (ms) between click tolerance
    , DoubleClickConfig -> Button
_dobuleClickConfig_button      :: V.Button
  }

doubleClick :: (Reflex t, MonadHold t m, MonadFix m, PerformEvent t m, MonadIO (Performable m), HasInput t m) => DoubleClickConfig -> m (Event t ())
doubleClick :: forall t (m :: * -> *).
(Reflex t, MonadHold t m, MonadFix m, PerformEvent t m,
 MonadIO (Performable m), HasInput t m) =>
DoubleClickConfig -> m (Event t ())
doubleClick DoubleClickConfig {Integer
Button
_dobuleClickConfig_button :: Button
_doubleClickConfig_timeTolerance :: Integer
_dobuleClickConfig_button :: DoubleClickConfig -> Button
_doubleClickConfig_timeTolerance :: DoubleClickConfig -> Integer
..} = do
  Event t ()
singleClickEv <- forall t (m :: * -> *).
(Reflex t, MonadHold t m, MonadFix m, HasInput t m) =>
Button -> m (Event t ())
singleClickNoDragOffSimple Button
_dobuleClickConfig_button
  Event t TimeSpec
singleClickTimeEv <- forall t (m :: * -> *) a.
PerformEvent t m =>
Event t (Performable m a) -> m (Event t a)
performEvent forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t ()
singleClickEv forall a b. (a -> b) -> a -> b
$ \()
_ -> do
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Clock -> IO TimeSpec
getTime Clock
Monotonic
  Dynamic t TimeSpec
lastClickTimeDyn <- forall {k} (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn (-TimeSpec
1) forall a b. (a -> b) -> a -> b
$ Event t TimeSpec
singleClickTimeEv
  (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
fmapMaybe forall a. a -> a
id)) forall a b. (a -> b) -> a -> b
$ forall t (m :: * -> *) a.
PerformEvent t m =>
Event t (Performable m a) -> m (Event t a)
performEvent forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor (forall {k} (t :: k) b a.
Reflex t =>
Behavior t b -> Event t a -> Event t b
tag (forall {k} (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t TimeSpec
lastClickTimeDyn) Event t ()
singleClickEv) forall a b. (a -> b) -> a -> b
$ \TimeSpec
ns -> do
    TimeSpec
time <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Clock -> IO TimeSpec
getTime Clock
Monotonic
    return $ if (TimeSpec -> Integer
toNanoSecs forall a b. (a -> b) -> a -> b
$ TimeSpec
time forall a. Num a => a -> a -> a
- TimeSpec
ns) forall a. Integral a => a -> a -> a
`div` Integer
1000000 forall a. Ord a => a -> a -> Bool
< Integer
_doubleClickConfig_timeTolerance 
      then forall a. a -> Maybe a
Just () 
      else forall a. Maybe a
Nothing
  
doubleClickSimple :: (Reflex t, MonadHold t m, MonadFix m, PerformEvent t m, MonadIO (Performable m), HasInput t m) => m (Event t ())
doubleClickSimple :: forall t (m :: * -> *).
(Reflex t, MonadHold t m, MonadFix m, PerformEvent t m,
 MonadIO (Performable m), HasInput t m) =>
m (Event t ())
doubleClickSimple = forall t (m :: * -> *).
(Reflex t, MonadHold t m, MonadFix m, PerformEvent t m,
 MonadIO (Performable m), HasInput t m) =>
DoubleClickConfig -> m (Event t ())
doubleClick DoubleClickConfig {
    --_doubleClickConfig_spaceTolerance = (0,0)
    _doubleClickConfig_timeTolerance :: Integer
_doubleClickConfig_timeTolerance = Integer
300
    , _dobuleClickConfig_button :: Button
_dobuleClickConfig_button = Button
V.BLeft
  }


integralFractionalDivide :: (Integral a, Fractional b) => a -> a -> b
integralFractionalDivide :: forall a b. (Integral a, Fractional b) => a -> a -> b
integralFractionalDivide a
n a
d = forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral a
d

-- | A split of the available space into two parts with a draggable separator.
-- Starts with half the space allocated to each, and the first pane has focus.
-- Clicking in a pane switches focus.
splitHDrag :: (Reflex t, MonadFix m, MonadHold t m, HasDisplayRegion t m, HasInput t m, HasImageWriter t m, HasFocusReader t m)
  => Int -- ^ initial width of left panel
  -> m ()
  -> m a
  -> m b
  -> m (a,b)
splitHDrag :: forall t (m :: * -> *) a b.
(Reflex t, MonadFix m, MonadHold t m, HasDisplayRegion t m,
 HasInput t m, HasImageWriter t m, HasFocusReader t m) =>
Int -> m () -> m a -> m b -> m (a, b)
splitHDrag Int
splitter0 m ()
wS m a
wA m b
wB = mdo
  Dynamic t Int
dh <- forall {k} (t :: k) (m :: * -> *).
HasDisplayRegion t m =>
m (Dynamic t Int)
displayHeight
  Dynamic t Int
dw <- forall {k} (t :: k) (m :: * -> *).
HasDisplayRegion t m =>
m (Dynamic t Int)
displayWidth
  Int
w0 <- forall {k} (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current forall a b. (a -> b) -> a -> b
$ Dynamic t Int
dw
  Event t Drag
dragE <- forall {k} (t :: k) (m :: * -> *).
(Reflex t, MonadFix m, MonadHold t m, HasInput t m) =>
Button -> m (Event t Drag)
drag Button
V.BLeft
  Dynamic t Int
splitterCheckpoint <- forall {k} (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn Int
splitter0 forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Filterable f => (a -> Bool) -> f a -> f a
ffilter forall a b. (a, b) -> b
snd Event t (Int, Bool)
dragSplitter, Event t Int
resizeSplitter]
  Dynamic t Int
splitterPos <- forall {k} (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn Int
splitter0 forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event t (Int, Bool)
dragSplitter, Event t Int
resizeSplitter]
  Dynamic t Double
splitterFrac <- forall {k} (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn (forall a b. (Integral a, Fractional b) => a -> a -> b
integralFractionalDivide Int
splitter0 Int
w0) forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor (forall {k} (t :: k) a b.
Reflex t =>
Behavior t a -> Event t b -> Event t (a, b)
attach (forall {k} (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t Int
dw) (forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event t (Int, Bool)
dragSplitter)) forall a b. (a -> b) -> a -> b
$ \(Int
w, Int
x) ->
    forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x forall a. Fractional a => a -> a -> a
/ (forall a. Ord a => a -> a -> a
max Double
1 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w))
  let dragSplitter :: Event t (Int, Bool)
dragSplitter = forall (f :: * -> *) a b.
Filterable f =>
f a -> (a -> Maybe b) -> f b
fforMaybe (forall {k} (t :: k) a b.
Reflex t =>
Behavior t a -> Event t b -> Event t (a, b)
attach (forall {k} (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t Int
splitterCheckpoint) Event t Drag
dragE) forall a b. (a -> b) -> a -> b
$
        \(Int
splitterX, Drag (Int
fromX, Int
_) (Int
toX, Int
_) Button
_ [Modifier]
_ Bool
end) ->
          if Int
splitterX forall a. Eq a => a -> a -> Bool
== Int
fromX then forall a. a -> Maybe a
Just (Int
toX, Bool
end) else forall a. Maybe a
Nothing
      regA :: Dynamic t Region
regA = Int -> Int -> Int -> Int -> Region
Region Int
0 Int
0 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t Int
splitterPos forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Dynamic t Int
dh
      regS :: Dynamic t Region
regS = Int -> Int -> Int -> Int -> Region
Region forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t Int
splitterPos forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Dynamic t Int
0 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Dynamic t Int
1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Dynamic t Int
dh
      regB :: Dynamic t Region
regB = Int -> Int -> Int -> Int -> Region
Region forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Dynamic t Int
splitterPos forall a. Num a => a -> a -> a
+ Dynamic t Int
1) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Dynamic t Int
0 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Dynamic t Int
dw forall a. Num a => a -> a -> a
- Dynamic t Int
splitterPos forall a. Num a => a -> a -> a
- Dynamic t Int
1) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Dynamic t Int
dh
      resizeSplitter :: Event t Int
resizeSplitter = forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor (forall {k} (t :: k) a b.
Reflex t =>
Behavior t a -> Event t b -> Event t (a, b)
attach (forall {k} (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t Double
splitterFrac) (forall {k} (t :: k) a. Reflex t => Dynamic t a -> Event t a
updated Dynamic t Int
dw)) forall a b. (a -> b) -> a -> b
$
        \(Double
frac, Int
w) -> forall a b. (RealFrac a, Integral b) => a -> b
round (Double
frac forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w)
  Dynamic t Bool
focA <- forall {k} (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn Bool
True forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost
    [ Bool
True forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Event t MouseDown
mA
    , Bool
False forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Event t MouseDown
mB
    ]

  (Event t MouseDown
mA, a
rA) <- forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasInput t m, HasImageWriter t m,
 HasDisplayRegion t m, HasFocusReader t m) =>
Dynamic t Region -> Dynamic t Bool -> m a -> m a
pane Dynamic t Region
regA Dynamic t Bool
focA forall a b. (a -> b) -> a -> b
$ forall {t} {f :: * -> *} {b}.
(Reflex t, HasInput t f, Monad f) =>
f b -> f (Event t MouseDown, b)
withMouseDown m a
wA
  forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasInput t m, HasImageWriter t m,
 HasDisplayRegion t m, HasFocusReader t m) =>
Dynamic t Region -> Dynamic t Bool -> m a -> m a
pane Dynamic t Region
regS (forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False) m ()
wS
  (Event t MouseDown
mB, b
rB) <- forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasInput t m, HasImageWriter t m,
 HasDisplayRegion t m, HasFocusReader t m) =>
Dynamic t Region -> Dynamic t Bool -> m a -> m a
pane Dynamic t Region
regB (Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t Bool
focA) forall a b. (a -> b) -> a -> b
$ forall {t} {f :: * -> *} {b}.
(Reflex t, HasInput t f, Monad f) =>
f b -> f (Event t MouseDown, b)
withMouseDown m b
wB

  forall (m :: * -> *) a. Monad m => a -> m a
return (a
rA, b
rB)
  where
    withMouseDown :: f b -> f (Event t MouseDown, b)
withMouseDown f b
x = do
      Event t MouseDown
m <- forall {k} (t :: k) (m :: * -> *).
(Reflex t, Monad m, HasInput t m) =>
Button -> m (Event t MouseDown)
mouseDown Button
V.BLeft
      b
x' <- f b
x
      return (Event t MouseDown
m, b
x')



data DragState = DragStart | Dragging | DragEnd deriving (DragState -> DragState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DragState -> DragState -> Bool
$c/= :: DragState -> DragState -> Bool
== :: DragState -> DragState -> Bool
$c== :: DragState -> DragState -> Bool
Eq, Eq DragState
DragState -> DragState -> Bool
DragState -> DragState -> Ordering
DragState -> DragState -> DragState
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DragState -> DragState -> DragState
$cmin :: DragState -> DragState -> DragState
max :: DragState -> DragState -> DragState
$cmax :: DragState -> DragState -> DragState
>= :: DragState -> DragState -> Bool
$c>= :: DragState -> DragState -> Bool
> :: DragState -> DragState -> Bool
$c> :: DragState -> DragState -> Bool
<= :: DragState -> DragState -> Bool
$c<= :: DragState -> DragState -> Bool
< :: DragState -> DragState -> Bool
$c< :: DragState -> DragState -> Bool
compare :: DragState -> DragState -> Ordering
$ccompare :: DragState -> DragState -> Ordering
Ord, Int -> DragState -> ShowS
[DragState] -> ShowS
DragState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DragState] -> ShowS
$cshowList :: [DragState] -> ShowS
show :: DragState -> String
$cshow :: DragState -> String
showsPrec :: Int -> DragState -> ShowS
$cshowsPrec :: Int -> DragState -> ShowS
Show)

-- | Same as 'Drag' but able to track drag start case
data Drag2 = Drag2
  { Drag2 -> (Int, Int)
_drag2_from      :: (Int, Int) -- ^ Where the drag began
  , Drag2 -> (Int, Int)
_drag2_to        :: (Int, Int) -- ^ Where the mouse currently is
  , Drag2 -> Button
_drag2_button    :: V.Button -- ^ Which mouse button is dragging
  , Drag2 -> [Modifier]
_drag2_modifiers :: [V.Modifier] -- ^ What modifiers are held
  , Drag2 -> DragState
_drag2_state     :: DragState -- ^ Whether the drag ended (the mouse button was released)
  }
  deriving (Drag2 -> Drag2 -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Drag2 -> Drag2 -> Bool
$c/= :: Drag2 -> Drag2 -> Bool
== :: Drag2 -> Drag2 -> Bool
$c== :: Drag2 -> Drag2 -> Bool
Eq, Eq Drag2
Drag2 -> Drag2 -> Bool
Drag2 -> Drag2 -> Ordering
Drag2 -> Drag2 -> Drag2
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Drag2 -> Drag2 -> Drag2
$cmin :: Drag2 -> Drag2 -> Drag2
max :: Drag2 -> Drag2 -> Drag2
$cmax :: Drag2 -> Drag2 -> Drag2
>= :: Drag2 -> Drag2 -> Bool
$c>= :: Drag2 -> Drag2 -> Bool
> :: Drag2 -> Drag2 -> Bool
$c> :: Drag2 -> Drag2 -> Bool
<= :: Drag2 -> Drag2 -> Bool
$c<= :: Drag2 -> Drag2 -> Bool
< :: Drag2 -> Drag2 -> Bool
$c< :: Drag2 -> Drag2 -> Bool
compare :: Drag2 -> Drag2 -> Ordering
$ccompare :: Drag2 -> Drag2 -> Ordering
Ord, Int -> Drag2 -> ShowS
[Drag2] -> ShowS
Drag2 -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Drag2] -> ShowS
$cshowList :: [Drag2] -> ShowS
show :: Drag2 -> String
$cshow :: Drag2 -> String
showsPrec :: Int -> Drag2 -> ShowS
$cshowsPrec :: Int -> Drag2 -> ShowS
Show)

-- | Same as 'drag' but returns 'Drag2' which tracks drag start events
drag2
  :: (Reflex t, MonadFix m, MonadHold t m, HasInput t m)
  => V.Button
  -> m (Event t Drag2)
drag2 :: forall t (m :: * -> *).
(Reflex t, MonadFix m, MonadHold t m, HasInput t m) =>
Button -> m (Event t Drag2)
drag2 Button
btn = mdo
  Event t VtyEvent
inp <- forall {k} (t :: k) (m :: * -> *).
HasInput t m =>
m (Event t VtyEvent)
input
  let f :: Maybe Drag2 -> V.Event -> Maybe Drag2
      f :: Maybe Drag2 -> VtyEvent -> Maybe Drag2
f Maybe Drag2
Nothing = \case
        V.EvMouseDown Int
x Int
y Button
btn' [Modifier]
mods
          | Button
btn forall a. Eq a => a -> a -> Bool
== Button
btn' -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ (Int, Int)
-> (Int, Int) -> Button -> [Modifier] -> DragState -> Drag2
Drag2 (Int
x,Int
y) (Int
x,Int
y) Button
btn' [Modifier]
mods DragState
DragStart
          | Bool
otherwise   -> forall a. Maybe a
Nothing
        VtyEvent
_ -> forall a. Maybe a
Nothing
      f (Just (Drag2 (Int, Int)
from (Int, Int)
_ Button
_ [Modifier]
mods DragState
st)) = \case
        V.EvMouseDown Int
x Int
y Button
btn' [Modifier]
mods'
          | DragState
st forall a. Eq a => a -> a -> Bool
== DragState
DragEnd Bool -> Bool -> Bool
&& Button
btn forall a. Eq a => a -> a -> Bool
== Button
btn'  -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ (Int, Int)
-> (Int, Int) -> Button -> [Modifier] -> DragState -> Drag2
Drag2 (Int
x,Int
y) (Int
x,Int
y) Button
btn' [Modifier]
mods' DragState
DragStart
          | Button
btn forall a. Eq a => a -> a -> Bool
== Button
btn'         -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ (Int, Int)
-> (Int, Int) -> Button -> [Modifier] -> DragState -> Drag2
Drag2 (Int, Int)
from (Int
x,Int
y) Button
btn [Modifier]
mods' DragState
Dragging
          | Bool
otherwise           -> forall a. Maybe a
Nothing -- Ignore other buttons.
        V.EvMouseUp Int
x Int
y (Just Button
btn')
          | DragState
st forall a. Eq a => a -> a -> Bool
== DragState
DragEnd        -> forall a. Maybe a
Nothing
          | Button
btn forall a. Eq a => a -> a -> Bool
== Button
btn' -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ (Int, Int)
-> (Int, Int) -> Button -> [Modifier] -> DragState -> Drag2
Drag2 (Int, Int)
from (Int
x,Int
y) Button
btn [Modifier]
mods DragState
DragEnd
          | Bool
otherwise   -> forall a. Maybe a
Nothing
        V.EvMouseUp Int
x Int
y Maybe Button
Nothing -- Terminal doesn't specify mouse up button,
                                -- assume it's the right one.
          | DragState
st forall a. Eq a => a -> a -> Bool
== DragState
DragEnd      -> forall a. Maybe a
Nothing
          | Bool
otherwise -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ (Int, Int)
-> (Int, Int) -> Button -> [Modifier] -> DragState -> Drag2
Drag2 (Int, Int)
from (Int
x,Int
y) Button
btn [Modifier]
mods DragState
DragEnd
        VtyEvent
_ -> forall a. Maybe a
Nothing
  let
    newDrag :: Event t Drag2
newDrag = forall {k} (t :: k) a b c.
Reflex t =>
(a -> b -> Maybe c) -> Behavior t a -> Event t b -> Event t c
attachWithMaybe Maybe Drag2 -> VtyEvent -> Maybe Drag2
f (forall {k} (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t (Maybe Drag2)
dragD) Event t VtyEvent
inp
  Dynamic t (Maybe Drag2)
dragD <- forall {k} (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event t Drag2
newDrag
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
fmapMaybe forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) a. Reflex t => Dynamic t a -> Event t a
updated Dynamic t (Maybe Drag2)
dragD)