{-# LANGUAGE StrictData #-}
module NanoUI.Input
( Key (..)
, Modifiers (..)
, Input (..)
, DropType (..)
, DropEvent (..)
, emptyDropEvents
, emptyInput
, inputInteracted
, inputPointerHeld
, appendInputKey
, appendDropEvent
, MouseButton (..)
, applyMouseButton
, inputKeysNull
, inputKeysElem
, foldInputKeys
, inputKeysFromList
, emptyInputKeys
, stripInteractionInput
, UiCursorKind (..)
, grabHoverKind
, grabDragKind
, clearEphemeral
, isHardQuitInput
, splitFrame
) where
import Data.Text (Text)
import qualified Data.Text as T
import Data.Primitive.SmallArray (SmallArray, copySmallArray, emptySmallArray, newSmallArray, runSmallArray, sizeofSmallArray, smallArrayFromList)
import NanoUI.Types (Size (..), V2 (..))
data Key
= KeyBackspace
| KeyDelete
| KeyEnter
| KeyEscape
| KeyTab
| KeyLeft
| KeyRight
| KeyUp
| KeyDown
| KeyHome
| KeyEnd
deriving (Key -> Key -> Bool
(Key -> Key -> Bool) -> (Key -> Key -> Bool) -> Eq Key
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Key -> Key -> Bool
== :: Key -> Key -> Bool
$c/= :: Key -> Key -> Bool
/= :: Key -> Key -> Bool
Eq, Int -> Key -> ShowS
[Key] -> ShowS
Key -> String
(Int -> Key -> ShowS)
-> (Key -> String) -> ([Key] -> ShowS) -> Show Key
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Key -> ShowS
showsPrec :: Int -> Key -> ShowS
$cshow :: Key -> String
show :: Key -> String
$cshowList :: [Key] -> ShowS
showList :: [Key] -> ShowS
Show, Int -> Key
Key -> Int
Key -> [Key]
Key -> Key
Key -> Key -> [Key]
Key -> Key -> Key -> [Key]
(Key -> Key)
-> (Key -> Key)
-> (Int -> Key)
-> (Key -> Int)
-> (Key -> [Key])
-> (Key -> Key -> [Key])
-> (Key -> Key -> [Key])
-> (Key -> Key -> Key -> [Key])
-> Enum Key
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Key -> Key
succ :: Key -> Key
$cpred :: Key -> Key
pred :: Key -> Key
$ctoEnum :: Int -> Key
toEnum :: Int -> Key
$cfromEnum :: Key -> Int
fromEnum :: Key -> Int
$cenumFrom :: Key -> [Key]
enumFrom :: Key -> [Key]
$cenumFromThen :: Key -> Key -> [Key]
enumFromThen :: Key -> Key -> [Key]
$cenumFromTo :: Key -> Key -> [Key]
enumFromTo :: Key -> Key -> [Key]
$cenumFromThenTo :: Key -> Key -> Key -> [Key]
enumFromThenTo :: Key -> Key -> Key -> [Key]
Enum, Key
Key -> Key -> Bounded Key
forall a. a -> a -> Bounded a
$cminBound :: Key
minBound :: Key
$cmaxBound :: Key
maxBound :: Key
Bounded)
data Modifiers = Modifiers
{ Modifiers -> Bool
modShift :: !Bool
, Modifiers -> Bool
modCtrl :: !Bool
, Modifiers -> Bool
modAlt :: !Bool
}
deriving (Modifiers -> Modifiers -> Bool
(Modifiers -> Modifiers -> Bool)
-> (Modifiers -> Modifiers -> Bool) -> Eq Modifiers
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Modifiers -> Modifiers -> Bool
== :: Modifiers -> Modifiers -> Bool
$c/= :: Modifiers -> Modifiers -> Bool
/= :: Modifiers -> Modifiers -> Bool
Eq, Int -> Modifiers -> ShowS
[Modifiers] -> ShowS
Modifiers -> String
(Int -> Modifiers -> ShowS)
-> (Modifiers -> String)
-> ([Modifiers] -> ShowS)
-> Show Modifiers
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Modifiers -> ShowS
showsPrec :: Int -> Modifiers -> ShowS
$cshow :: Modifiers -> String
show :: Modifiers -> String
$cshowList :: [Modifiers] -> ShowS
showList :: [Modifiers] -> ShowS
Show)
data DropType
= DropBegin
| DropPosition
| DropFile
| DropText
| DropComplete
deriving (DropType -> DropType -> Bool
(DropType -> DropType -> Bool)
-> (DropType -> DropType -> Bool) -> Eq DropType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DropType -> DropType -> Bool
== :: DropType -> DropType -> Bool
$c/= :: DropType -> DropType -> Bool
/= :: DropType -> DropType -> Bool
Eq, Int -> DropType -> ShowS
[DropType] -> ShowS
DropType -> String
(Int -> DropType -> ShowS)
-> (DropType -> String) -> ([DropType] -> ShowS) -> Show DropType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DropType -> ShowS
showsPrec :: Int -> DropType -> ShowS
$cshow :: DropType -> String
show :: DropType -> String
$cshowList :: [DropType] -> ShowS
showList :: [DropType] -> ShowS
Show)
data DropEvent = DropEvent
{ DropEvent -> DropType
dropEventType :: !DropType
, DropEvent -> Maybe V2
dropEventPos :: !(Maybe V2)
, DropEvent -> Text
dropEventData :: !Text
}
deriving (DropEvent -> DropEvent -> Bool
(DropEvent -> DropEvent -> Bool)
-> (DropEvent -> DropEvent -> Bool) -> Eq DropEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DropEvent -> DropEvent -> Bool
== :: DropEvent -> DropEvent -> Bool
$c/= :: DropEvent -> DropEvent -> Bool
/= :: DropEvent -> DropEvent -> Bool
Eq, Int -> DropEvent -> ShowS
[DropEvent] -> ShowS
DropEvent -> String
(Int -> DropEvent -> ShowS)
-> (DropEvent -> String)
-> ([DropEvent] -> ShowS)
-> Show DropEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DropEvent -> ShowS
showsPrec :: Int -> DropEvent -> ShowS
$cshow :: DropEvent -> String
show :: DropEvent -> String
$cshowList :: [DropEvent] -> ShowS
showList :: [DropEvent] -> ShowS
Show)
data Input = Input
{ Input -> V2
inputMousePos :: {-# UNPACK #-} !V2
, Input -> Bool
inputMouseDown :: {-# UNPACK #-} !Bool
, Input -> Bool
inputMousePressed :: {-# UNPACK #-} !Bool
, Input -> Bool
inputMouseReleased :: {-# UNPACK #-} !Bool
, Input -> Bool
inputMouseRightDown :: {-# UNPACK #-} !Bool
, Input -> Bool
inputMouseRightPressed :: {-# UNPACK #-} !Bool
, Input -> Bool
inputMouseRightReleased :: {-# UNPACK #-} !Bool
, Input -> Int
inputMouseClicks :: {-# UNPACK #-} !Int
, Input -> V2
inputScroll :: {-# UNPACK #-} !V2
, Input -> SmallArray Key
inputKeys :: SmallArray Key
, Input -> Text
inputChars :: !Text
, Input -> Modifiers
inputModifiers :: !Modifiers
, Input -> Size
inputWindowSize :: {-# UNPACK #-} !Size
, Input -> Float
inputDeltaTime :: {-# UNPACK #-} !Float
, Input -> SmallArray DropEvent
inputDrops :: SmallArray DropEvent
, Input -> Bool
inputWindowRedraw :: {-# UNPACK #-} !Bool
}
deriving (Input -> Input -> Bool
(Input -> Input -> Bool) -> (Input -> Input -> Bool) -> Eq Input
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Input -> Input -> Bool
== :: Input -> Input -> Bool
$c/= :: Input -> Input -> Bool
/= :: Input -> Input -> Bool
Eq, Int -> Input -> ShowS
[Input] -> ShowS
Input -> String
(Int -> Input -> ShowS)
-> (Input -> String) -> ([Input] -> ShowS) -> Show Input
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Input -> ShowS
showsPrec :: Int -> Input -> ShowS
$cshow :: Input -> String
show :: Input -> String
$cshowList :: [Input] -> ShowS
showList :: [Input] -> ShowS
Show)
emptyInput :: Input
emptyInput :: Input
emptyInput =
Input
{ inputMousePos :: V2
inputMousePos = Float -> Float -> V2
V2 Float
0 Float
0
, inputMouseDown :: Bool
inputMouseDown = Bool
False
, inputMousePressed :: Bool
inputMousePressed = Bool
False
, inputMouseReleased :: Bool
inputMouseReleased = Bool
False
, inputMouseRightDown :: Bool
inputMouseRightDown = Bool
False
, inputMouseRightPressed :: Bool
inputMouseRightPressed = Bool
False
, inputMouseRightReleased :: Bool
inputMouseRightReleased = Bool
False
, inputMouseClicks :: Int
inputMouseClicks = Int
1
, inputScroll :: V2
inputScroll = Float -> Float -> V2
V2 Float
0 Float
0
, inputKeys :: SmallArray Key
inputKeys = SmallArray Key
emptyInputKeys
, inputChars :: Text
inputChars = Text
""
, inputModifiers :: Modifiers
inputModifiers = Bool -> Bool -> Bool -> Modifiers
Modifiers Bool
False Bool
False Bool
False
, inputWindowSize :: Size
inputWindowSize = Float -> Float -> Size
Size Float
800 Float
600
, inputDeltaTime :: Float
inputDeltaTime = Float
0
, inputDrops :: SmallArray DropEvent
inputDrops = SmallArray DropEvent
emptyDropEvents
, inputWindowRedraw :: Bool
inputWindowRedraw = Bool
False
}
data UiCursorKind
= UiCursorDefault
| UiCursorPointer
| UiCursorText
| UiCursorGrab
| UiCursorGrabbing
| UiCursorNsResize
| UiCursorEwResize
| UiCursorNwseResize
| UiCursorNeswResize
deriving (UiCursorKind -> UiCursorKind -> Bool
(UiCursorKind -> UiCursorKind -> Bool)
-> (UiCursorKind -> UiCursorKind -> Bool) -> Eq UiCursorKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UiCursorKind -> UiCursorKind -> Bool
== :: UiCursorKind -> UiCursorKind -> Bool
$c/= :: UiCursorKind -> UiCursorKind -> Bool
/= :: UiCursorKind -> UiCursorKind -> Bool
Eq, Int -> UiCursorKind -> ShowS
[UiCursorKind] -> ShowS
UiCursorKind -> String
(Int -> UiCursorKind -> ShowS)
-> (UiCursorKind -> String)
-> ([UiCursorKind] -> ShowS)
-> Show UiCursorKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UiCursorKind -> ShowS
showsPrec :: Int -> UiCursorKind -> ShowS
$cshow :: UiCursorKind -> String
show :: UiCursorKind -> String
$cshowList :: [UiCursorKind] -> ShowS
showList :: [UiCursorKind] -> ShowS
Show)
grabHoverKind :: Bool -> Input -> UiCursorKind
grabHoverKind :: Bool -> Input -> UiCursorKind
grabHoverKind Bool
onTarget Input
inp = Bool -> Bool -> Input -> UiCursorKind
grabDragKind Bool
onTarget Bool
False Input
inp
grabDragKind :: Bool -> Bool -> Input -> UiCursorKind
grabDragKind :: Bool -> Bool -> Input -> UiCursorKind
grabDragKind Bool
onTarget Bool
dragging Input
inp
| Bool
dragging = UiCursorKind
UiCursorGrabbing
| Bool
onTarget, Input -> Bool
inputMouseDown Input
inp = UiCursorKind
UiCursorGrabbing
| Bool
onTarget = UiCursorKind
UiCursorGrab
| Bool
otherwise = UiCursorKind
UiCursorDefault
clearEphemeral :: Input -> Input
clearEphemeral :: Input -> Input
clearEphemeral Input
inp =
Input
inp
{ inputKeys = emptyInputKeys
, inputChars = ""
, inputMousePressed = False
, inputMouseReleased = False
, inputMouseRightPressed = False
, inputMouseRightReleased = False
, inputMouseClicks = 1
, inputScroll = V2 0 0
, inputDrops = emptyDropEvents
, inputWindowRedraw = False
}
isHardQuitInput :: Input -> Bool
isHardQuitInput :: Input -> Bool
isHardQuitInput Input
inp =
Modifiers -> Bool
modCtrl (Input -> Modifiers
inputModifiers Input
inp)
Bool -> Bool -> Bool
&& (Char -> Text -> Bool
T.elem Char
'c' (Input -> Text
inputChars Input
inp) Bool -> Bool -> Bool
|| Char -> Text -> Bool
T.elem Char
'\ETX' (Input -> Text
inputChars Input
inp))
splitFrame :: (a -> Bool) -> [a] -> ([a], [a])
splitFrame :: forall a. (a -> Bool) -> [a] -> ([a], [a])
splitFrame a -> Bool
isEdge [a]
events =
case (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break a -> Bool
isEdge [a]
events of
([a]
before, a
edge : [a]
rest) -> ([a]
before [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
edge], [a]
rest)
([a]
before, []) -> ([a]
before, [])
{-# INLINE appendInputKey #-}
appendInputKey :: Key -> SmallArray Key -> SmallArray Key
appendInputKey :: Key -> SmallArray Key -> SmallArray Key
appendInputKey Key
k SmallArray Key
ks = SmallArray Key -> Key -> SmallArray Key
forall a. SmallArray a -> a -> SmallArray a
snocSmallArray SmallArray Key
ks Key
k
{-# INLINE appendDropEvent #-}
appendDropEvent :: DropEvent -> SmallArray DropEvent -> SmallArray DropEvent
appendDropEvent :: DropEvent -> SmallArray DropEvent -> SmallArray DropEvent
appendDropEvent DropEvent
ev SmallArray DropEvent
evs = SmallArray DropEvent -> DropEvent -> SmallArray DropEvent
forall a. SmallArray a -> a -> SmallArray a
snocSmallArray SmallArray DropEvent
evs DropEvent
ev
snocSmallArray :: SmallArray a -> a -> SmallArray a
snocSmallArray :: forall a. SmallArray a -> a -> SmallArray a
snocSmallArray SmallArray a
xs a
x = (forall s. ST s (SmallMutableArray s a)) -> SmallArray a
forall a. (forall s. ST s (SmallMutableArray s a)) -> SmallArray a
runSmallArray ((forall s. ST s (SmallMutableArray s a)) -> SmallArray a)
-> (forall s. ST s (SmallMutableArray s a)) -> SmallArray a
forall a b. (a -> b) -> a -> b
$ do
let n :: Int
n = SmallArray a -> Int
forall a. SmallArray a -> Int
sizeofSmallArray SmallArray a
xs
out <- Int -> a -> ST s (SmallMutableArray (PrimState (ST s)) a)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (SmallMutableArray (PrimState m) a)
newSmallArray (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) a
x
copySmallArray out 0 xs 0 n
pure out
data MouseButton = MouseLeft | MouseRight
deriving (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, 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)
applyMouseButton :: MouseButton -> Bool -> Input -> Input
applyMouseButton :: MouseButton -> Bool -> Input -> Input
applyMouseButton MouseButton
MouseLeft Bool
True Input
inp = Input
inp {inputMouseDown = True, inputMousePressed = True}
applyMouseButton MouseButton
MouseLeft Bool
False Input
inp = Input
inp {inputMouseDown = False, inputMouseReleased = True}
applyMouseButton MouseButton
MouseRight Bool
True Input
inp = Input
inp {inputMouseRightDown = True, inputMouseRightPressed = True}
applyMouseButton MouseButton
MouseRight Bool
False Input
inp = Input
inp {inputMouseRightDown = False, inputMouseRightReleased = True}
{-# INLINE inputKeysFromList #-}
inputKeysFromList :: [Key] -> SmallArray Key
inputKeysFromList :: [Key] -> SmallArray Key
inputKeysFromList = [Key] -> SmallArray Key
forall a. [a] -> SmallArray a
smallArrayFromList
emptyInputKeys :: SmallArray Key
emptyInputKeys :: SmallArray Key
emptyInputKeys = SmallArray Key
forall a. SmallArray a
emptySmallArray
emptyDropEvents :: SmallArray DropEvent
emptyDropEvents :: SmallArray DropEvent
emptyDropEvents = SmallArray DropEvent
forall a. SmallArray a
emptySmallArray
{-# INLINE inputKeysNull #-}
inputKeysNull :: SmallArray Key -> Bool
inputKeysNull :: SmallArray Key -> Bool
inputKeysNull SmallArray Key
ks = SmallArray Key -> Int
forall a. SmallArray a -> Int
sizeofSmallArray SmallArray Key
ks Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
{-# INLINE inputKeysElem #-}
inputKeysElem :: Key -> SmallArray Key -> Bool
inputKeysElem :: Key -> SmallArray Key -> Bool
inputKeysElem = Key -> SmallArray Key -> Bool
forall a. Eq a => a -> SmallArray a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem
{-# INLINE foldInputKeys #-}
foldInputKeys :: (a -> Key -> a) -> a -> SmallArray Key -> a
foldInputKeys :: forall a. (a -> Key -> a) -> a -> SmallArray Key -> a
foldInputKeys = (a -> Key -> a) -> a -> SmallArray Key -> a
forall b a. (b -> a -> b) -> b -> SmallArray a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
inputInteracted :: Input -> Input -> Bool
inputInteracted :: Input -> Input -> Bool
inputInteracted Input
a Input
b =
Input -> Bool
inputMouseDown Input
a Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Input -> Bool
inputMouseDown Input
b
Bool -> Bool -> Bool
|| Input -> Bool
inputMousePressed Input
a Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Input -> Bool
inputMousePressed Input
b
Bool -> Bool -> Bool
|| Input -> Bool
inputMouseReleased Input
a Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Input -> Bool
inputMouseReleased Input
b
Bool -> Bool -> Bool
|| Input -> Bool
inputMouseRightDown Input
a Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Input -> Bool
inputMouseRightDown Input
b
Bool -> Bool -> Bool
|| Input -> Bool
inputMouseRightPressed Input
a Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Input -> Bool
inputMouseRightPressed Input
b
Bool -> Bool -> Bool
|| Input -> Bool
inputMouseRightReleased Input
a Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Input -> Bool
inputMouseRightReleased Input
b
Bool -> Bool -> Bool
|| Input -> Int
inputMouseClicks Input
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Input -> Int
inputMouseClicks Input
b
Bool -> Bool -> Bool
|| Input -> V2
inputScroll Input
a V2 -> V2 -> Bool
forall a. Eq a => a -> a -> Bool
/= Input -> V2
inputScroll Input
b
Bool -> Bool -> Bool
|| Input -> SmallArray Key
inputKeys Input
a SmallArray Key -> SmallArray Key -> Bool
forall a. Eq a => a -> a -> Bool
/= Input -> SmallArray Key
inputKeys Input
b
Bool -> Bool -> Bool
|| Input -> Text
inputChars Input
a Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Input -> Text
inputChars Input
b
Bool -> Bool -> Bool
|| Input -> Modifiers
inputModifiers Input
a Modifiers -> Modifiers -> Bool
forall a. Eq a => a -> a -> Bool
/= Input -> Modifiers
inputModifiers Input
b
Bool -> Bool -> Bool
|| Input -> Size
inputWindowSize Input
a Size -> Size -> Bool
forall a. Eq a => a -> a -> Bool
/= Input -> Size
inputWindowSize Input
b
Bool -> Bool -> Bool
|| Input -> SmallArray DropEvent
inputDrops Input
a SmallArray DropEvent -> SmallArray DropEvent -> Bool
forall a. Eq a => a -> a -> Bool
/= Input -> SmallArray DropEvent
inputDrops Input
b
{-# INLINE inputPointerHeld #-}
inputPointerHeld :: Input -> Bool
inputPointerHeld :: Input -> Bool
inputPointerHeld Input
inp =
Input -> Bool
inputMouseDown Input
inp Bool -> Bool -> Bool
|| Input -> Bool
inputMouseRightDown Input
inp
stripInteractionInput :: Input -> Input
stripInteractionInput :: Input -> Input
stripInteractionInput Input
inp =
Input
inp
{ inputMousePressed = False
, inputMouseReleased = False
, inputMouseRightPressed = False
, inputMouseRightReleased = False
, inputKeys = emptyInputKeys
, inputChars = ""
, inputScroll = V2 0 0
, inputDrops = emptyDropEvents
}