{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}

module Aztecs.Input
  ( Key (..),
    InputMotion (..),
    KeyboardInput (..),
    keyboardInput,
    isKeyPressed,
    wasKeyPressed,
    wasKeyReleased,
    handleKeyboardEvent,
    MouseButton (..),
    MouseInput (..),
    mouseInput,
    handleMouseMotion,
  )
where

import Aztecs.ECS
import Control.DeepSeq (NFData)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Set (Set)
import qualified Data.Set as Set
import GHC.Generics (Generic)
import Linear (V2 (..))
import Linear.Affine (Point (..))

data Key
  = KeyA
  | KeyB
  | KeyC
  | KeyD
  | KeyE
  | KeyF
  | KeyG
  | KeyH
  | KeyI
  | KeyJ
  | KeyK
  | KeyL
  | KeyM
  | KeyN
  | KeyO
  | KeyP
  | KeyQ
  | KeyR
  | KeyS
  | KeyT
  | KeyU
  | KeyV
  | KeyW
  | KeyX
  | KeyY
  | KeyZ
  | Key0
  | Key1
  | Key2
  | Key3
  | Key4
  | Key5
  | Key6
  | Key7
  | Key8
  | Key9
  | KeyF1
  | KeyF2
  | KeyF3
  | KeyF4
  | KeyF5
  | KeyF6
  | KeyF7
  | KeyF8
  | KeyF9
  | KeyF10
  | KeyF11
  | KeyF12
  | KeyEscape
  | KeyEnter
  | KeySpace
  | KeyBackspace
  | KeyTab
  | KeyCapsLock
  | KeyShift
  | KeyCtrl
  | KeyAlt
  | KeyLeft
  | KeyRight
  | KeyUp
  | KeyDown
  | KeyHome
  | KeyEnd
  | KeyPageUp
  | KeyPageDown
  | KeyInsert
  | KeyDelete
  | KeyMinus
  | KeyEquals
  | KeyBracketLeft
  | KeyBracketRight
  | KeyBackslash
  | KeySemicolon
  | KeyComma
  | KeyPeriod
  | KeySlash
  | KeyNumLock
  | KeyNumpad0
  | KeyNumpad1
  | KeyNumpad2
  | KeyNumpad3
  | KeyNumpad4
  | KeyNumpad5
  | KeyNumpad6
  | KeyNumpad7
  | KeyNumpad8
  | KeyNumpad9
  | KeyNumpadDivide
  | KeyNumpadMultiply
  | KeyNumpadMinus
  | KeyNumpadPlus
  | KeyNumpadEnter
  | KeyNumpadPeriod
  | KeySuper
  | KeyMenu
  deriving (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, 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, Eq Key
Eq Key =>
(Key -> Key -> Ordering)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Key)
-> (Key -> Key -> Key)
-> Ord Key
Key -> Key -> Bool
Key -> Key -> Ordering
Key -> Key -> Key
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Key -> Key -> Ordering
compare :: Key -> Key -> Ordering
$c< :: Key -> Key -> Bool
< :: Key -> Key -> Bool
$c<= :: Key -> Key -> Bool
<= :: Key -> Key -> Bool
$c> :: Key -> Key -> Bool
> :: Key -> Key -> Bool
$c>= :: Key -> Key -> Bool
>= :: Key -> Key -> Bool
$cmax :: Key -> Key -> Key
max :: Key -> Key -> Key
$cmin :: Key -> Key -> Key
min :: Key -> Key -> Key
Ord, 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, (forall x. Key -> Rep Key x)
-> (forall x. Rep Key x -> Key) -> Generic Key
forall x. Rep Key x -> Key
forall x. Key -> Rep Key x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Key -> Rep Key x
from :: forall x. Key -> Rep Key x
$cto :: forall x. Rep Key x -> Key
to :: forall x. Rep Key x -> Key
Generic, Key -> ()
(Key -> ()) -> NFData Key
forall a. (a -> ()) -> NFData a
$crnf :: Key -> ()
rnf :: Key -> ()
NFData)

-- | Keyboard input component.
data KeyboardInput = KeyboardInput
  { -- | Keyboard events that occured this frame.
    KeyboardInput -> Map Key InputMotion
keyboardEvents :: !(Map Key InputMotion),
    -- | Keys that are currently pressed.
    KeyboardInput -> Set Key
keyboardPressed :: !(Set Key)
  }
  deriving (Int -> KeyboardInput -> ShowS
[KeyboardInput] -> ShowS
KeyboardInput -> String
(Int -> KeyboardInput -> ShowS)
-> (KeyboardInput -> String)
-> ([KeyboardInput] -> ShowS)
-> Show KeyboardInput
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> KeyboardInput -> ShowS
showsPrec :: Int -> KeyboardInput -> ShowS
$cshow :: KeyboardInput -> String
show :: KeyboardInput -> String
$cshowList :: [KeyboardInput] -> ShowS
showList :: [KeyboardInput] -> ShowS
Show, (forall x. KeyboardInput -> Rep KeyboardInput x)
-> (forall x. Rep KeyboardInput x -> KeyboardInput)
-> Generic KeyboardInput
forall x. Rep KeyboardInput x -> KeyboardInput
forall x. KeyboardInput -> Rep KeyboardInput x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. KeyboardInput -> Rep KeyboardInput x
from :: forall x. KeyboardInput -> Rep KeyboardInput x
$cto :: forall x. Rep KeyboardInput x -> KeyboardInput
to :: forall x. Rep KeyboardInput x -> KeyboardInput
Generic, KeyboardInput -> ()
(KeyboardInput -> ()) -> NFData KeyboardInput
forall a. (a -> ()) -> NFData a
$crnf :: KeyboardInput -> ()
rnf :: KeyboardInput -> ()
NFData)

instance Component KeyboardInput

keyboardInput :: KeyboardInput
keyboardInput :: KeyboardInput
keyboardInput = Map Key InputMotion -> Set Key -> KeyboardInput
KeyboardInput Map Key InputMotion
forall k a. Map k a
Map.empty Set Key
forall a. Set a
Set.empty

data InputMotion = Pressed | Released
  deriving (Int -> InputMotion -> ShowS
[InputMotion] -> ShowS
InputMotion -> String
(Int -> InputMotion -> ShowS)
-> (InputMotion -> String)
-> ([InputMotion] -> ShowS)
-> Show InputMotion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InputMotion -> ShowS
showsPrec :: Int -> InputMotion -> ShowS
$cshow :: InputMotion -> String
show :: InputMotion -> String
$cshowList :: [InputMotion] -> ShowS
showList :: [InputMotion] -> ShowS
Show, InputMotion -> InputMotion -> Bool
(InputMotion -> InputMotion -> Bool)
-> (InputMotion -> InputMotion -> Bool) -> Eq InputMotion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InputMotion -> InputMotion -> Bool
== :: InputMotion -> InputMotion -> Bool
$c/= :: InputMotion -> InputMotion -> Bool
/= :: InputMotion -> InputMotion -> Bool
Eq, (forall x. InputMotion -> Rep InputMotion x)
-> (forall x. Rep InputMotion x -> InputMotion)
-> Generic InputMotion
forall x. Rep InputMotion x -> InputMotion
forall x. InputMotion -> Rep InputMotion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. InputMotion -> Rep InputMotion x
from :: forall x. InputMotion -> Rep InputMotion x
$cto :: forall x. Rep InputMotion x -> InputMotion
to :: forall x. Rep InputMotion x -> InputMotion
Generic, InputMotion -> ()
(InputMotion -> ()) -> NFData InputMotion
forall a. (a -> ()) -> NFData a
$crnf :: InputMotion -> ()
rnf :: InputMotion -> ()
NFData)

-- | @True@ if this key is currently pressed.
isKeyPressed :: Key -> KeyboardInput -> Bool
isKeyPressed :: Key -> KeyboardInput -> Bool
isKeyPressed Key
key KeyboardInput
kb = Key -> Set Key -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Key
key (Set Key -> Bool) -> Set Key -> Bool
forall a b. (a -> b) -> a -> b
$ KeyboardInput -> Set Key
keyboardPressed KeyboardInput
kb

-- | Check for a key event that occured this frame.
keyEvent :: Key -> KeyboardInput -> Maybe InputMotion
keyEvent :: Key -> KeyboardInput -> Maybe InputMotion
keyEvent Key
key KeyboardInput
kb = Key -> Map Key InputMotion -> Maybe InputMotion
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Key
key (Map Key InputMotion -> Maybe InputMotion)
-> Map Key InputMotion -> Maybe InputMotion
forall a b. (a -> b) -> a -> b
$ KeyboardInput -> Map Key InputMotion
keyboardEvents KeyboardInput
kb

-- | @True@ if this key was pressed this frame.
wasKeyPressed :: Key -> KeyboardInput -> Bool
wasKeyPressed :: Key -> KeyboardInput -> Bool
wasKeyPressed Key
key KeyboardInput
kb = case Key -> KeyboardInput -> Maybe InputMotion
keyEvent Key
key KeyboardInput
kb of
  Just InputMotion
Pressed -> Bool
True
  Maybe InputMotion
_ -> Bool
False

-- | @True@ if this key was released this frame.
wasKeyReleased :: Key -> KeyboardInput -> Bool
wasKeyReleased :: Key -> KeyboardInput -> Bool
wasKeyReleased Key
key KeyboardInput
kb = case Key -> KeyboardInput -> Maybe InputMotion
keyEvent Key
key KeyboardInput
kb of
  Just InputMotion
Released -> Bool
True
  Maybe InputMotion
_ -> Bool
False

handleKeyboardEvent :: Key -> InputMotion -> KeyboardInput -> KeyboardInput
handleKeyboardEvent :: Key -> InputMotion -> KeyboardInput -> KeyboardInput
handleKeyboardEvent Key
key InputMotion
motion KeyboardInput
kb =
  KeyboardInput
    { keyboardEvents :: Map Key InputMotion
keyboardEvents = Key -> InputMotion -> Map Key InputMotion -> Map Key InputMotion
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Key
key InputMotion
motion (Map Key InputMotion -> Map Key InputMotion)
-> Map Key InputMotion -> Map Key InputMotion
forall a b. (a -> b) -> a -> b
$ KeyboardInput -> Map Key InputMotion
keyboardEvents KeyboardInput
kb,
      keyboardPressed :: Set Key
keyboardPressed = case InputMotion
motion of
        InputMotion
Pressed -> Key -> Set Key -> Set Key
forall a. Ord a => a -> Set a -> Set a
Set.insert Key
key (Set Key -> Set Key) -> Set Key -> Set Key
forall a b. (a -> b) -> a -> b
$ KeyboardInput -> Set Key
keyboardPressed KeyboardInput
kb
        InputMotion
Released -> Key -> Set Key -> Set Key
forall a. Ord a => a -> Set a -> Set a
Set.delete Key
key (Set Key -> Set Key) -> Set Key -> Set Key
forall a b. (a -> b) -> a -> b
$ KeyboardInput -> Set Key
keyboardPressed KeyboardInput
kb
    }

data MouseButton
  = ButtonLeft
  | ButtonMiddle
  | ButtonRight
  | ButtonX1
  | ButtonX2
  | -- | An unknown mouse button.
    ButtonExtra !Int
  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, Eq MouseButton
Eq MouseButton =>
(MouseButton -> MouseButton -> Ordering)
-> (MouseButton -> MouseButton -> Bool)
-> (MouseButton -> MouseButton -> Bool)
-> (MouseButton -> MouseButton -> Bool)
-> (MouseButton -> MouseButton -> Bool)
-> (MouseButton -> MouseButton -> MouseButton)
-> (MouseButton -> MouseButton -> MouseButton)
-> Ord MouseButton
MouseButton -> MouseButton -> Bool
MouseButton -> MouseButton -> Ordering
MouseButton -> MouseButton -> MouseButton
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: MouseButton -> MouseButton -> Ordering
compare :: MouseButton -> MouseButton -> Ordering
$c< :: MouseButton -> MouseButton -> Bool
< :: MouseButton -> MouseButton -> Bool
$c<= :: MouseButton -> MouseButton -> Bool
<= :: MouseButton -> MouseButton -> Bool
$c> :: MouseButton -> MouseButton -> Bool
> :: MouseButton -> MouseButton -> Bool
$c>= :: MouseButton -> MouseButton -> Bool
>= :: MouseButton -> MouseButton -> Bool
$cmax :: MouseButton -> MouseButton -> MouseButton
max :: MouseButton -> MouseButton -> MouseButton
$cmin :: MouseButton -> MouseButton -> MouseButton
min :: MouseButton -> MouseButton -> MouseButton
Ord, 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, (forall x. MouseButton -> Rep MouseButton x)
-> (forall x. Rep MouseButton x -> MouseButton)
-> Generic MouseButton
forall x. Rep MouseButton x -> MouseButton
forall x. MouseButton -> Rep MouseButton x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MouseButton -> Rep MouseButton x
from :: forall x. MouseButton -> Rep MouseButton x
$cto :: forall x. Rep MouseButton x -> MouseButton
to :: forall x. Rep MouseButton x -> MouseButton
Generic, MouseButton -> ()
(MouseButton -> ()) -> NFData MouseButton
forall a. (a -> ()) -> NFData a
$crnf :: MouseButton -> ()
rnf :: MouseButton -> ()
NFData)

-- | Mouse input component.
data MouseInput = MouseInput
  { -- | Mouse position in screen-space.
    MouseInput -> Point V2 Int
mousePosition :: !(Point V2 Int),
    -- | Mouse offset since last frame.
    MouseInput -> V2 Int
mouseOffset :: !(V2 Int),
    -- | Mouse button states.
    MouseInput -> Map MouseButton InputMotion
mouseButtons :: !(Map MouseButton InputMotion)
  }
  deriving (Int -> MouseInput -> ShowS
[MouseInput] -> ShowS
MouseInput -> String
(Int -> MouseInput -> ShowS)
-> (MouseInput -> String)
-> ([MouseInput] -> ShowS)
-> Show MouseInput
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MouseInput -> ShowS
showsPrec :: Int -> MouseInput -> ShowS
$cshow :: MouseInput -> String
show :: MouseInput -> String
$cshowList :: [MouseInput] -> ShowS
showList :: [MouseInput] -> ShowS
Show, (forall x. MouseInput -> Rep MouseInput x)
-> (forall x. Rep MouseInput x -> MouseInput) -> Generic MouseInput
forall x. Rep MouseInput x -> MouseInput
forall x. MouseInput -> Rep MouseInput x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MouseInput -> Rep MouseInput x
from :: forall x. MouseInput -> Rep MouseInput x
$cto :: forall x. Rep MouseInput x -> MouseInput
to :: forall x. Rep MouseInput x -> MouseInput
Generic, MouseInput -> ()
(MouseInput -> ()) -> NFData MouseInput
forall a. (a -> ()) -> NFData a
$crnf :: MouseInput -> ()
rnf :: MouseInput -> ()
NFData)

instance Component MouseInput

mouseInput :: MouseInput
mouseInput :: MouseInput
mouseInput = Point V2 Int -> V2 Int -> Map MouseButton InputMotion -> MouseInput
MouseInput (V2 Int -> Point V2 Int
forall (f :: * -> *) a. f a -> Point f a
P V2 Int
0) (Int -> Int -> V2 Int
forall a. a -> a -> V2 a
V2 Int
0 Int
0) Map MouseButton InputMotion
forall k a. Map k a
Map.empty

handleMouseMotion :: V2 Int -> MouseInput -> MouseInput
handleMouseMotion :: V2 Int -> MouseInput -> MouseInput
handleMouseMotion V2 Int
delta MouseInput
mouse =
  MouseInput
mouse
    { mouseOffset = delta,
      mousePosition = mousePosition mouse + P delta
    }