module Potato.Flow.Vty.Input (
convertModifiers
, convertKey
, convertButton
, makeLMouseDataInputEv
) where
import Relude
import Potato.Flow
import Potato.Flow.Controller
import qualified Graphics.Vty as V
import qualified Graphics.Vty.Input.Events as V
import Reflex
import Reflex.Vty
import Control.Monad.Fix
import qualified Data.Text.Encoding as T
convertModifiers :: [V.Modifier] -> [KeyModifier]
convertModifiers :: [Modifier] -> [KeyModifier]
convertModifiers = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a -> b) -> a -> b
$ \case
Modifier
V.MShift -> KeyModifier
KeyModifier_Shift
Modifier
V.MCtrl -> KeyModifier
KeyModifier_Ctrl
Modifier
V.MMeta -> KeyModifier
KeyModifier_Ctrl
Modifier
V.MAlt -> KeyModifier
KeyModifier_Alt
convertKey :: V.Key -> Maybe KeyboardKey
convertKey :: Key -> Maybe KeyboardKey
convertKey = \case
Key
V.KEsc -> forall a. a -> Maybe a
Just KeyboardKey
KeyboardKey_Esc
V.KChar Char
c -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Char -> KeyboardKey
KeyboardKey_Char Char
c
Key
V.KBS -> forall a. a -> Maybe a
Just KeyboardKey
KeyboardKey_Backspace
Key
V.KEnter -> forall a. a -> Maybe a
Just KeyboardKey
KeyboardKey_Return
Key
V.KLeft -> forall a. a -> Maybe a
Just KeyboardKey
KeyboardKey_Left
Key
V.KRight -> forall a. a -> Maybe a
Just KeyboardKey
KeyboardKey_Right
Key
V.KUp -> forall a. a -> Maybe a
Just KeyboardKey
KeyboardKey_Up
Key
V.KDown -> forall a. a -> Maybe a
Just KeyboardKey
KeyboardKey_Down
Key
V.KUpLeft -> forall a. Maybe a
Nothing
Key
V.KUpRight -> forall a. Maybe a
Nothing
Key
V.KDownLeft -> forall a. Maybe a
Nothing
Key
V.KDownRight -> forall a. Maybe a
Nothing
Key
V.KCenter -> forall a. Maybe a
Nothing
V.KFun Int
_ -> forall a. Maybe a
Nothing
Key
V.KBackTab -> forall a. Maybe a
Nothing
Key
V.KPrtScr -> forall a. Maybe a
Nothing
Key
V.KPause -> forall a. Maybe a
Nothing
Key
V.KIns -> forall a. Maybe a
Nothing
Key
V.KHome -> forall a. a -> Maybe a
Just KeyboardKey
KeyboardKey_Home
Key
V.KDel -> forall a. a -> Maybe a
Just KeyboardKey
KeyboardKey_Delete
Key
V.KEnd -> forall a. a -> Maybe a
Just KeyboardKey
KeyboardKey_End
Key
V.KBegin -> forall a. Maybe a
Nothing
Key
V.KMenu -> forall a. Maybe a
Nothing
Key
_ -> forall a. Maybe a
Nothing
convertButton :: V.Button -> Maybe MouseButton
convertButton :: Button -> Maybe MouseButton
convertButton = \case
Button
V.BLeft -> forall a. a -> Maybe a
Just MouseButton
MouseButton_Left
Button
V.BMiddle -> forall a. a -> Maybe a
Just MouseButton
MouseButton_Middle
Button
V.BRight -> forall a. a -> Maybe a
Just MouseButton
MouseButton_Right
Button
V.BScrollUp -> forall a. Maybe a
Nothing
Button
V.BScrollDown -> forall a. Maybe a
Nothing
tupleToXY :: (Int, Int) -> XY
tupleToXY :: (Int, Int) -> XY
tupleToXY (Int
x,Int
y) = forall a. a -> a -> V2 a
V2 Int
x Int
y
makeLMouseDataInputEv
:: (Reflex t, MonadFix m, MonadHold t m, HasInput t m)
=> Dynamic t (Int, Int)
-> Bool
-> m (Event t LMouseData)
makeLMouseDataInputEv :: forall t (m :: * -> *).
(Reflex t, MonadFix m, MonadHold t m, HasInput t m) =>
Dynamic t (Int, Int) -> Bool -> m (Event t LMouseData)
makeLMouseDataInputEv Dynamic t (Int, Int)
offsetDyn Bool
isLayerMouse = do
Event t VtyEvent
inp <- forall {k} (t :: k) (m :: * -> *).
HasInput t m =>
m (Event t VtyEvent)
input
let
mouseDownEv :: Event t (Button, [Modifier])
mouseDownEv = forall (f :: * -> *) a b.
Filterable f =>
f a -> (a -> Maybe b) -> f b
fforMaybe Event t VtyEvent
inp forall a b. (a -> b) -> a -> b
$ \case
V.EvMouseDown Int
_ Int
_ Button
b [Modifier]
mods -> forall a. a -> Maybe a
Just (Button
b, [Modifier]
mods)
VtyEvent
_ -> forall a. Maybe a
Nothing
mouseUpEv :: Event t Bool
mouseUpEv = forall (f :: * -> *) a b.
Filterable f =>
f a -> (a -> Maybe b) -> f b
fforMaybe Event t VtyEvent
inp forall a b. (a -> b) -> a -> b
$ \case
V.EvMouseUp Int
_ Int
_ Maybe Button
_ -> forall a. a -> Maybe a
Just Bool
True
V.EvMouseDown Int
_ Int
_ Button
_ [Modifier]
_ -> forall a. a -> Maybe a
Just Bool
False
VtyEvent
_ -> forall a. Maybe a
Nothing
mouseDownFoldFn :: (Bool, b) -> b -> b
mouseDownFoldFn (Bool
True, b
x) b
_ = b
x
mouseDownFoldFn (Bool
False, b
_) b
x = b
x
Dynamic t Bool
mouseUpDyn <- forall {k} (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn Bool
True Event t Bool
mouseUpEv
Dynamic t (Button, [Modifier])
mouseDownDyn <- 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 {b}. (Bool, b) -> b -> b
mouseDownFoldFn (Button
V.BLeft,[]) (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 Bool
mouseUpDyn) Event t (Button, [Modifier])
mouseDownEv)
return $ 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 ((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t (Button, [Modifier])
mouseDownDyn forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Dynamic t (Int, Int)
offsetDyn)) Event t VtyEvent
inp) forall a b. (a -> b) -> a -> b
$ \case
(((Button, [Modifier]), (Int, Int))
_, V.EvMouseDown Int
_ Int
_ Button
V.BScrollUp [Modifier]
_) -> forall a. Maybe a
Nothing
(((Button, [Modifier]), (Int, Int))
_, V.EvMouseDown Int
_ Int
_ Button
V.BScrollDown [Modifier]
_) -> forall a. Maybe a
Nothing
(((Button, [Modifier])
_,(Int, Int)
offset), V.EvMouseDown Int
x Int
y Button
b [Modifier]
mods) -> case Button -> Maybe MouseButton
convertButton Button
b of
Maybe MouseButton
Nothing -> forall a. Maybe a
Nothing
Just MouseButton
b' -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ LMouseData {
_lMouseData_position :: XY
_lMouseData_position = (forall a. a -> a -> V2 a
V2 Int
x Int
y) forall a. Num a => a -> a -> a
+ (Int, Int) -> XY
tupleToXY (Int, Int)
offset
, _lMouseData_isRelease :: Bool
_lMouseData_isRelease = Bool
False
, _lMouseData_button :: MouseButton
_lMouseData_button = MouseButton
b'
, _lMouseData_modifiers :: [KeyModifier]
_lMouseData_modifiers = [Modifier] -> [KeyModifier]
convertModifiers [Modifier]
mods
, _lMouseData_isLayerMouse :: Bool
_lMouseData_isLayerMouse = Bool
isLayerMouse
}
(((Button
b,[Modifier]
mods),(Int, Int)
offset), V.EvMouseUp Int
x Int
y Maybe Button
_) -> case Button -> Maybe MouseButton
convertButton Button
b of
Maybe MouseButton
Nothing -> forall a. Maybe a
Nothing
Just MouseButton
b' -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ LMouseData {
_lMouseData_position :: XY
_lMouseData_position = (forall a. a -> a -> V2 a
V2 Int
x Int
y) forall a. Num a => a -> a -> a
+ (Int, Int) -> XY
tupleToXY (Int, Int)
offset
, _lMouseData_isRelease :: Bool
_lMouseData_isRelease = Bool
True
, _lMouseData_button :: MouseButton
_lMouseData_button = MouseButton
b'
, _lMouseData_modifiers :: [KeyModifier]
_lMouseData_modifiers = [Modifier] -> [KeyModifier]
convertModifiers [Modifier]
mods
, _lMouseData_isLayerMouse :: Bool
_lMouseData_isLayerMouse = Bool
isLayerMouse
}
(((Button, [Modifier]), (Int, Int)), VtyEvent)
_ -> forall a. Maybe a
Nothing