{-# 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
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)
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
| KeyboardKey_Paste Text
| 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)
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)
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
(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
, MouseDrag -> [KeyModifier]
_mouseDrag_modifiers :: [KeyModifier]
, MouseDrag -> XY
_mouseDrag_to :: XY
, MouseDrag -> MouseDragState
_mouseDrag_state :: MouseDragState
, 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
, _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
}
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)
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
}