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
  -- disabled for now cuz I use for debugging
  -- TODO enable
  --V.KPageUp -> Just KeyboardKey_PageUp
  --V.KPageDown -> Just KeyboardKey_PageDown
  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
  -- NOTE, must report both mouse down and up for any given drag or things will break
  -- button/mods is always the same button as mouse down, even if it changes during a drag
  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
    -- tracks if last event was a mouse up
    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 -- only updated button/mods just after a mouse up
    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