{-# 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
data SingleClick = SingleClick
{ SingleClick -> Button
_singleClick_button :: V.Button
, SingleClick -> (Int, Int)
_singleClick_coordinates :: (Int, Int)
, 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
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
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 {
DoubleClickConfig -> Integer
_doubleClickConfig_timeTolerance :: Integer
, 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_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
splitHDrag :: (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 :: 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)
data Drag2 = Drag2
{ Drag2 -> (Int, Int)
_drag2_from :: (Int, Int)
, Drag2 -> (Int, Int)
_drag2_to :: (Int, Int)
, Drag2 -> Button
_drag2_button :: V.Button
, Drag2 -> [Modifier]
_drag2_modifiers :: [V.Modifier]
, Drag2 -> DragState
_drag2_state :: DragState
}
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)
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
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
| 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)