{-# LANGUAGE RecordWildCards #-}

module Potato.Flow.Controller.Input (
  KeyModifier(..)
  , KeyboardData(..)
  , KeyboardKey(..)
  , MouseButton(..)
  , MouseDragState(..)
  , LMouseData(..)
  , MouseDrag(..)
  , mouseDrag_isActive
  , newDrag
  , continueDrag
  , cancelDrag
  , mouseDragDelta
  , RelMouseDrag(..)
  , toRelMouseDrag
) where

import           Relude

import           Potato.Flow.Math
import           Potato.Flow.OwlState

import           Control.Exception    (assert)
import           Data.Default

-- TODO consider adding space as a modifier so you can do space drag panning in web version
data KeyModifier = KeyModifier_Shift | KeyModifier_Alt | KeyModifier_Ctrl deriving (Int -> KeyModifier -> ShowS
[KeyModifier] -> ShowS
KeyModifier -> String
(Int -> KeyModifier -> ShowS)
-> (KeyModifier -> String)
-> ([KeyModifier] -> ShowS)
-> Show KeyModifier
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> KeyModifier -> ShowS
showsPrec :: Int -> KeyModifier -> ShowS
$cshow :: KeyModifier -> String
show :: KeyModifier -> String
$cshowList :: [KeyModifier] -> ShowS
showList :: [KeyModifier] -> ShowS
Show, KeyModifier -> KeyModifier -> Bool
(KeyModifier -> KeyModifier -> Bool)
-> (KeyModifier -> KeyModifier -> Bool) -> Eq KeyModifier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: KeyModifier -> KeyModifier -> Bool
== :: KeyModifier -> KeyModifier -> Bool
$c/= :: KeyModifier -> KeyModifier -> Bool
/= :: KeyModifier -> KeyModifier -> Bool
Eq)

-- KEYBOARD
data KeyboardData = KeyboardData KeyboardKey [KeyModifier] deriving (Int -> KeyboardData -> ShowS
[KeyboardData] -> ShowS
KeyboardData -> String
(Int -> KeyboardData -> ShowS)
-> (KeyboardData -> String)
-> ([KeyboardData] -> ShowS)
-> Show KeyboardData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> KeyboardData -> ShowS
showsPrec :: Int -> KeyboardData -> ShowS
$cshow :: KeyboardData -> String
show :: KeyboardData -> String
$cshowList :: [KeyboardData] -> ShowS
showList :: [KeyboardData] -> ShowS
Show)

data KeyboardKey =
  KeyboardKey_Esc
  | KeyboardKey_Return
  | KeyboardKey_Space
  | KeyboardKey_Delete
  | KeyboardKey_Backspace
  | KeyboardKey_Left
  | KeyboardKey_Right
  | KeyboardKey_Up
  | KeyboardKey_Down
  | KeyboardKey_Home
  | KeyboardKey_End
  | KeyboardKey_PageUp
  | KeyboardKey_PageDown
  | KeyboardKey_Char Char
  -- not really a keypress but it's fine to put it here
  | KeyboardKey_Paste Text

  -- easier to handle as keyboard input
  | KeyboardKey_Scroll Int
  deriving (Int -> KeyboardKey -> ShowS
[KeyboardKey] -> ShowS
KeyboardKey -> String
(Int -> KeyboardKey -> ShowS)
-> (KeyboardKey -> String)
-> ([KeyboardKey] -> ShowS)
-> Show KeyboardKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> KeyboardKey -> ShowS
showsPrec :: Int -> KeyboardKey -> ShowS
$cshow :: KeyboardKey -> String
show :: KeyboardKey -> String
$cshowList :: [KeyboardKey] -> ShowS
showList :: [KeyboardKey] -> ShowS
Show, KeyboardKey -> KeyboardKey -> Bool
(KeyboardKey -> KeyboardKey -> Bool)
-> (KeyboardKey -> KeyboardKey -> Bool) -> Eq KeyboardKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: KeyboardKey -> KeyboardKey -> Bool
== :: KeyboardKey -> KeyboardKey -> Bool
$c/= :: KeyboardKey -> KeyboardKey -> Bool
/= :: KeyboardKey -> KeyboardKey -> Bool
Eq)

-- MOUSE
data MouseButton = MouseButton_Left | MouseButton_Middle | MouseButton_Right deriving (Int -> MouseButton -> ShowS
[MouseButton] -> ShowS
MouseButton -> String
(Int -> MouseButton -> ShowS)
-> (MouseButton -> String)
-> ([MouseButton] -> ShowS)
-> Show MouseButton
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MouseButton -> ShowS
showsPrec :: Int -> MouseButton -> ShowS
$cshow :: MouseButton -> String
show :: MouseButton -> String
$cshowList :: [MouseButton] -> ShowS
showList :: [MouseButton] -> ShowS
Show, MouseButton -> MouseButton -> Bool
(MouseButton -> MouseButton -> Bool)
-> (MouseButton -> MouseButton -> Bool) -> Eq MouseButton
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MouseButton -> MouseButton -> Bool
== :: MouseButton -> MouseButton -> Bool
$c/= :: MouseButton -> MouseButton -> Bool
/= :: MouseButton -> MouseButton -> Bool
Eq)

data MouseDragState = MouseDragState_Down | MouseDragState_Dragging | MouseDragState_Up | MouseDragState_Cancelled deriving (Int -> MouseDragState -> ShowS
[MouseDragState] -> ShowS
MouseDragState -> String
(Int -> MouseDragState -> ShowS)
-> (MouseDragState -> String)
-> ([MouseDragState] -> ShowS)
-> Show MouseDragState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MouseDragState -> ShowS
showsPrec :: Int -> MouseDragState -> ShowS
$cshow :: MouseDragState -> String
show :: MouseDragState -> String
$cshowList :: [MouseDragState] -> ShowS
showList :: [MouseDragState] -> ShowS
Show, MouseDragState -> MouseDragState -> Bool
(MouseDragState -> MouseDragState -> Bool)
-> (MouseDragState -> MouseDragState -> Bool) -> Eq MouseDragState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MouseDragState -> MouseDragState -> Bool
== :: MouseDragState -> MouseDragState -> Bool
$c/= :: MouseDragState -> MouseDragState -> Bool
/= :: MouseDragState -> MouseDragState -> Bool
Eq)


-- TODO is there a way to optionally support more fidelity here?
-- NOTE mouse drags are sent as click streams
data LMouseData = LMouseData {
  LMouseData -> XY
_lMouseData_position       :: XY
  , LMouseData -> Bool
_lMouseData_isRelease    :: Bool
  , LMouseData -> MouseButton
_lMouseData_button       :: MouseButton
  , LMouseData -> [KeyModifier]
_lMouseData_modifiers    :: [KeyModifier]
  -- TODO get rid of this, instead split input into 2
  , LMouseData -> Bool
_lMouseData_isLayerMouse :: Bool
} deriving (Int -> LMouseData -> ShowS
[LMouseData] -> ShowS
LMouseData -> String
(Int -> LMouseData -> ShowS)
-> (LMouseData -> String)
-> ([LMouseData] -> ShowS)
-> Show LMouseData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LMouseData -> ShowS
showsPrec :: Int -> LMouseData -> ShowS
$cshow :: LMouseData -> String
show :: LMouseData -> String
$cshowList :: [LMouseData] -> ShowS
showList :: [LMouseData] -> ShowS
Show, LMouseData -> LMouseData -> Bool
(LMouseData -> LMouseData -> Bool)
-> (LMouseData -> LMouseData -> Bool) -> Eq LMouseData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LMouseData -> LMouseData -> Bool
== :: LMouseData -> LMouseData -> Bool
$c/= :: LMouseData -> LMouseData -> Bool
/= :: LMouseData -> LMouseData -> Bool
Eq)

data MouseDrag = MouseDrag {
  MouseDrag -> XY
_mouseDrag_from           :: XY
  , MouseDrag -> MouseButton
_mouseDrag_button       :: MouseButton -- tracks button on start of drag
  , MouseDrag -> [KeyModifier]
_mouseDrag_modifiers    :: [KeyModifier] -- tracks modifiers held at current state of drag
  , MouseDrag -> XY
_mouseDrag_to           :: XY -- likely not needed as they will be in the input event, but whatever
  , MouseDrag -> MouseDragState
_mouseDrag_state        :: MouseDragState
  -- TODO get rid of this, instead split input into 2
  , MouseDrag -> Bool
_mouseDrag_isLayerMouse :: Bool
} deriving (Int -> MouseDrag -> ShowS
[MouseDrag] -> ShowS
MouseDrag -> String
(Int -> MouseDrag -> ShowS)
-> (MouseDrag -> String)
-> ([MouseDrag] -> ShowS)
-> Show MouseDrag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MouseDrag -> ShowS
showsPrec :: Int -> MouseDrag -> ShowS
$cshow :: MouseDrag -> String
show :: MouseDrag -> String
$cshowList :: [MouseDrag] -> ShowS
showList :: [MouseDrag] -> ShowS
Show, MouseDrag -> MouseDrag -> Bool
(MouseDrag -> MouseDrag -> Bool)
-> (MouseDrag -> MouseDrag -> Bool) -> Eq MouseDrag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MouseDrag -> MouseDrag -> Bool
== :: MouseDrag -> MouseDrag -> Bool
$c/= :: MouseDrag -> MouseDrag -> Bool
/= :: MouseDrag -> MouseDrag -> Bool
Eq)

mouseDrag_isActive :: MouseDrag -> Bool
mouseDrag_isActive :: MouseDrag -> Bool
mouseDrag_isActive MouseDrag {Bool
[KeyModifier]
XY
MouseDragState
MouseButton
_mouseDrag_from :: MouseDrag -> XY
_mouseDrag_button :: MouseDrag -> MouseButton
_mouseDrag_modifiers :: MouseDrag -> [KeyModifier]
_mouseDrag_to :: MouseDrag -> XY
_mouseDrag_state :: MouseDrag -> MouseDragState
_mouseDrag_isLayerMouse :: MouseDrag -> Bool
_mouseDrag_from :: XY
_mouseDrag_button :: MouseButton
_mouseDrag_modifiers :: [KeyModifier]
_mouseDrag_to :: XY
_mouseDrag_state :: MouseDragState
_mouseDrag_isLayerMouse :: Bool
..} = case MouseDragState
_mouseDrag_state of
  MouseDragState
MouseDragState_Down     -> Bool
True
  MouseDragState
MouseDragState_Dragging -> Bool
True
  MouseDragState
_                       -> Bool
False

instance Default MouseDrag where
  def :: MouseDrag
def = MouseDrag {
      _mouseDrag_from :: XY
_mouseDrag_from  = XY
0
      , _mouseDrag_button :: MouseButton
_mouseDrag_button = MouseButton
MouseButton_Left
      , _mouseDrag_modifiers :: [KeyModifier]
_mouseDrag_modifiers = []
      , _mouseDrag_to :: XY
_mouseDrag_to    = XY
0
      , _mouseDrag_state :: MouseDragState
_mouseDrag_state = MouseDragState
MouseDragState_Up -- if the last state was MouseDragState_Up we are ready to process more inputs fresh
      , _mouseDrag_isLayerMouse :: Bool
_mouseDrag_isLayerMouse = Bool
False
    }

newDrag :: LMouseData -> MouseDrag
newDrag :: LMouseData -> MouseDrag
newDrag LMouseData {Bool
[KeyModifier]
XY
MouseButton
_lMouseData_position :: LMouseData -> XY
_lMouseData_isRelease :: LMouseData -> Bool
_lMouseData_button :: LMouseData -> MouseButton
_lMouseData_modifiers :: LMouseData -> [KeyModifier]
_lMouseData_isLayerMouse :: LMouseData -> Bool
_lMouseData_position :: XY
_lMouseData_isRelease :: Bool
_lMouseData_button :: MouseButton
_lMouseData_modifiers :: [KeyModifier]
_lMouseData_isLayerMouse :: Bool
..} = Bool -> MouseDrag -> MouseDrag
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Bool -> Bool
not Bool
_lMouseData_isRelease) (MouseDrag -> MouseDrag) -> MouseDrag -> MouseDrag
forall a b. (a -> b) -> a -> b
$ MouseDrag {
    _mouseDrag_from :: XY
_mouseDrag_from = XY
_lMouseData_position
    , _mouseDrag_button :: MouseButton
_mouseDrag_button = MouseButton
_lMouseData_button
    , _mouseDrag_modifiers :: [KeyModifier]
_mouseDrag_modifiers = [KeyModifier]
_lMouseData_modifiers
    , _mouseDrag_to :: XY
_mouseDrag_to = XY
_lMouseData_position
    , _mouseDrag_state :: MouseDragState
_mouseDrag_state = MouseDragState
MouseDragState_Down
    , _mouseDrag_isLayerMouse :: Bool
_mouseDrag_isLayerMouse = Bool
_lMouseData_isLayerMouse
  }

continueDrag :: LMouseData -> MouseDrag -> MouseDrag
continueDrag :: LMouseData -> MouseDrag -> MouseDrag
continueDrag LMouseData {Bool
[KeyModifier]
XY
MouseButton
_lMouseData_position :: LMouseData -> XY
_lMouseData_isRelease :: LMouseData -> Bool
_lMouseData_button :: LMouseData -> MouseButton
_lMouseData_modifiers :: LMouseData -> [KeyModifier]
_lMouseData_isLayerMouse :: LMouseData -> Bool
_lMouseData_position :: XY
_lMouseData_isRelease :: Bool
_lMouseData_button :: MouseButton
_lMouseData_modifiers :: [KeyModifier]
_lMouseData_isLayerMouse :: Bool
..} MouseDrag
md = MouseDrag
md {
    _mouseDrag_to = _lMouseData_position
    , _mouseDrag_state = if _lMouseData_isRelease
      then MouseDragState_Up
      else MouseDragState_Dragging
    , _mouseDrag_modifiers = _lMouseData_modifiers
  }

cancelDrag :: MouseDrag -> MouseDrag
cancelDrag :: MouseDrag -> MouseDrag
cancelDrag MouseDrag
md = MouseDrag
md { _mouseDrag_state = case _mouseDrag_state md of
    MouseDragState
MouseDragState_Up -> MouseDragState
MouseDragState_Up
    MouseDragState
_                 -> MouseDragState
MouseDragState_Cancelled
  }

-- wats this for D:?
mouseDragDelta :: MouseDrag -> MouseDrag -> XY
mouseDragDelta :: MouseDrag -> MouseDrag -> XY
mouseDragDelta MouseDrag
md MouseDrag
prev = (MouseDrag -> XY
_mouseDrag_to MouseDrag
md) XY -> XY -> XY
forall a. Num a => a -> a -> a
- (MouseDrag -> XY
_mouseDrag_to MouseDrag
prev)

-- TODO rename to CanvasMouseDrag
-- represents MouseDrag in local coordinates (e.g. canvas coordinates)
newtype RelMouseDrag = RelMouseDrag MouseDrag deriving (Int -> RelMouseDrag -> ShowS
[RelMouseDrag] -> ShowS
RelMouseDrag -> String
(Int -> RelMouseDrag -> ShowS)
-> (RelMouseDrag -> String)
-> ([RelMouseDrag] -> ShowS)
-> Show RelMouseDrag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RelMouseDrag -> ShowS
showsPrec :: Int -> RelMouseDrag -> ShowS
$cshow :: RelMouseDrag -> String
show :: RelMouseDrag -> String
$cshowList :: [RelMouseDrag] -> ShowS
showList :: [RelMouseDrag] -> ShowS
Show)

toRelMouseDrag :: OwlPFState -> XY -> MouseDrag -> RelMouseDrag
toRelMouseDrag :: OwlPFState -> XY -> MouseDrag -> RelMouseDrag
toRelMouseDrag OwlPFState
pfs XY
pan MouseDrag
md = MouseDrag -> RelMouseDrag
RelMouseDrag (MouseDrag -> RelMouseDrag) -> MouseDrag -> RelMouseDrag
forall a b. (a -> b) -> a -> b
$ MouseDrag
md {
    _mouseDrag_from = owlPFState_toCanvasCoordinates pfs (_mouseDrag_from md) - pan
    , _mouseDrag_to = owlPFState_toCanvasCoordinates pfs (_mouseDrag_to md) - pan
  }