{-# 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeyModifier] -> ShowS
$cshowList :: [KeyModifier] -> ShowS
show :: KeyModifier -> String
$cshow :: KeyModifier -> String
showsPrec :: Int -> KeyModifier -> ShowS
$cshowsPrec :: Int -> KeyModifier -> ShowS
Show, KeyModifier -> KeyModifier -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeyModifier -> KeyModifier -> Bool
$c/= :: KeyModifier -> KeyModifier -> Bool
== :: KeyModifier -> KeyModifier -> Bool
$c== :: KeyModifier -> KeyModifier -> Bool
Eq)

-- KEYBOARD
data KeyboardData = KeyboardData KeyboardKey [KeyModifier] deriving (Int -> KeyboardData -> ShowS
[KeyboardData] -> ShowS
KeyboardData -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeyboardData] -> ShowS
$cshowList :: [KeyboardData] -> ShowS
show :: KeyboardData -> String
$cshow :: KeyboardData -> String
showsPrec :: Int -> KeyboardData -> ShowS
$cshowsPrec :: Int -> 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeyboardKey] -> ShowS
$cshowList :: [KeyboardKey] -> ShowS
show :: KeyboardKey -> String
$cshow :: KeyboardKey -> String
showsPrec :: Int -> KeyboardKey -> ShowS
$cshowsPrec :: Int -> KeyboardKey -> ShowS
Show, KeyboardKey -> KeyboardKey -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeyboardKey -> KeyboardKey -> Bool
$c/= :: KeyboardKey -> KeyboardKey -> Bool
== :: KeyboardKey -> KeyboardKey -> Bool
$c== :: KeyboardKey -> KeyboardKey -> Bool
Eq)

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

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

-- TODO add modifier
-- TODO is this the all encompassing mouse event we want?
-- TODO is there a way to optionally support more fidelity here?
-- 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]
  , LMouseData -> Bool
_lMouseData_isLayerMouse :: Bool
} deriving (Int -> LMouseData -> ShowS
[LMouseData] -> ShowS
LMouseData -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LMouseData] -> ShowS
$cshowList :: [LMouseData] -> ShowS
show :: LMouseData -> String
$cshow :: LMouseData -> String
showsPrec :: Int -> LMouseData -> ShowS
$cshowsPrec :: Int -> LMouseData -> ShowS
Show, LMouseData -> LMouseData -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LMouseData -> LMouseData -> Bool
$c/= :: LMouseData -> LMouseData -> Bool
== :: LMouseData -> LMouseData -> Bool
$c== :: 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
  , MouseDrag -> Bool
_mouseDrag_isLayerMouse :: Bool
} deriving (Int -> MouseDrag -> ShowS
[MouseDrag] -> ShowS
MouseDrag -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MouseDrag] -> ShowS
$cshowList :: [MouseDrag] -> ShowS
show :: MouseDrag -> String
$cshow :: MouseDrag -> String
showsPrec :: Int -> MouseDrag -> ShowS
$cshowsPrec :: Int -> MouseDrag -> ShowS
Show, MouseDrag -> MouseDrag -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MouseDrag -> MouseDrag -> Bool
$c/= :: MouseDrag -> MouseDrag -> Bool
== :: MouseDrag -> MouseDrag -> Bool
$c== :: MouseDrag -> MouseDrag -> Bool
Eq)

mouseDrag_isActive :: MouseDrag -> Bool
mouseDrag_isActive :: MouseDrag -> Bool
mouseDrag_isActive MouseDrag {Bool
[KeyModifier]
XY
MouseDragState
MouseButton
_mouseDrag_isLayerMouse :: Bool
_mouseDrag_state :: MouseDragState
_mouseDrag_to :: XY
_mouseDrag_modifiers :: [KeyModifier]
_mouseDrag_button :: MouseButton
_mouseDrag_from :: XY
_mouseDrag_isLayerMouse :: MouseDrag -> Bool
_mouseDrag_state :: MouseDrag -> MouseDragState
_mouseDrag_to :: MouseDrag -> XY
_mouseDrag_modifiers :: MouseDrag -> [KeyModifier]
_mouseDrag_button :: MouseDrag -> MouseButton
_mouseDrag_from :: MouseDrag -> XY
..} = 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_isLayerMouse :: Bool
_lMouseData_modifiers :: [KeyModifier]
_lMouseData_button :: MouseButton
_lMouseData_isRelease :: Bool
_lMouseData_position :: XY
_lMouseData_isLayerMouse :: LMouseData -> Bool
_lMouseData_modifiers :: LMouseData -> [KeyModifier]
_lMouseData_button :: LMouseData -> MouseButton
_lMouseData_isRelease :: LMouseData -> Bool
_lMouseData_position :: LMouseData -> XY
..} = forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Bool -> Bool
not Bool
_lMouseData_isRelease) 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_isLayerMouse :: Bool
_lMouseData_modifiers :: [KeyModifier]
_lMouseData_button :: MouseButton
_lMouseData_isRelease :: Bool
_lMouseData_position :: XY
_lMouseData_isLayerMouse :: LMouseData -> Bool
_lMouseData_modifiers :: LMouseData -> [KeyModifier]
_lMouseData_button :: LMouseData -> MouseButton
_lMouseData_isRelease :: LMouseData -> Bool
_lMouseData_position :: LMouseData -> XY
..} MouseDrag
md = MouseDrag
md {
    _mouseDrag_to :: XY
_mouseDrag_to = XY
_lMouseData_position
    , _mouseDrag_state :: MouseDragState
_mouseDrag_state = if Bool
_lMouseData_isRelease
      then MouseDragState
MouseDragState_Up
      else MouseDragState
MouseDragState_Dragging
    , _mouseDrag_modifiers :: [KeyModifier]
_mouseDrag_modifiers = [KeyModifier]
_lMouseData_modifiers
  }

cancelDrag :: MouseDrag -> MouseDrag
cancelDrag :: MouseDrag -> MouseDrag
cancelDrag MouseDrag
md = MouseDrag
md { _mouseDrag_state :: MouseDragState
_mouseDrag_state = case MouseDrag -> MouseDragState
_mouseDrag_state MouseDrag
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) 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RelMouseDrag] -> ShowS
$cshowList :: [RelMouseDrag] -> ShowS
show :: RelMouseDrag -> String
$cshow :: RelMouseDrag -> String
showsPrec :: Int -> RelMouseDrag -> ShowS
$cshowsPrec :: Int -> RelMouseDrag -> ShowS
Show)

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