diff --git a/helm.cabal b/helm.cabal index fcc6801..936f0dc 100644 --- a/helm.cabal +++ b/helm.cabal @@ -53,7 +53,7 @@ library pango >= 0.13 && < 0.14, containers >= 0.5 && < 1, elerea >= 2.9 && < 3, - sdl2 > 2.1.1 && < 3, + sdl2 > 2.2 && < 3, linear >= 1 && < 2, text >= 1.1.1.3 && < 2, mtl >= 2.1 && < 3, diff --git a/src/Helm/Engine.hs b/src/Helm/Engine.hs index 1e2dc84..376b994 100644 --- a/src/Helm/Engine.hs +++ b/src/Helm/Engine.hs @@ -59,6 +59,9 @@ class Engine e where -- | The mouse click signal, with events provided by the engine. mouseClickSignal :: e -> SignalGen e (Signal [(MouseButton, V2 Int)]) + -- | The mouse wheel signal, with events provided by the engine. + mouseWheelSignal :: e -> SignalGen e (Signal [V2 Int]) + -- | The keyboard down signal, with events provided by the engine. keyboardDownSignal :: e -> SignalGen e (Signal [Key]) diff --git a/src/Helm/Engine/SDL/Engine.hs b/src/Helm/Engine/SDL/Engine.hs index 61758ef..53fd195 100644 --- a/src/Helm/Engine/SDL/Engine.hs +++ b/src/Helm/Engine/SDL/Engine.hs @@ -32,6 +32,7 @@ import qualified SDL import qualified SDL.Event as Event import qualified SDL.Init as Init import SDL.Input.Keyboard (Keysym(..)) +import SDL.Input.Mouse (MouseScrollDirection(..)) import qualified SDL.Time as Time import qualified SDL.Video as Video import SDL.Video (WindowConfig(..)) @@ -72,7 +73,9 @@ data SDLEngine = SDLEngine , mouseUpEventSink :: (MouseButton, V2 Int) -> IO () -- ^ The mouse up event sink. , mouseClickEventSignal :: SignalGen SDLEngine (Signal [(MouseButton, V2 Int)]) -- ^ The mouse click event signal. , mouseClickEventSink :: (MouseButton, V2 Int) -> IO () -- ^ The mouse click event sink. - + , mouseWheelEventSignal :: + SignalGen SDLEngine (Signal [V2 Int]) -- ^ The mouse wheel event signal. + , mouseWheelEventSink :: V2 Int -> IO () -- ^ The mouse wheel event sink. , keyboardDownEventSignal :: SignalGen SDLEngine (Signal [Key]) -- ^ The keyboard down event signal. , keyboardDownEventSink :: Key -> IO () -- ^ The keyboard down event sink. , keyboardUpEventSignal :: SignalGen SDLEngine (Signal [Key]) -- ^ The keyboard up event signal. @@ -153,6 +156,8 @@ instance Engine SDLEngine where -- | The SDL-specific mouse click signal. mouseClickSignal = mouseClickEventSignal + mouseWheelSignal = mouseWheelEventSignal + -- | The SDL-specific keyboard down signal. keyboardDownSignal = keyboardDownEventSignal @@ -214,6 +219,7 @@ startupWith config@SDLEngineConfig { .. } = do mouseDownEvent <- externalMulti mouseUpEvent <- externalMulti mouseClickEvent <- externalMulti + mouseWheelEvent <- externalMulti keyboardDownEvent <- externalMulti keyboardUpEvent <- externalMulti keyboardPressEvent <- externalMulti @@ -237,6 +243,8 @@ startupWith config@SDLEngineConfig { .. } = do , mouseUpEventSink = snd mouseUpEvent , mouseClickEventSignal = fst mouseClickEvent , mouseClickEventSink = snd mouseClickEvent + , mouseWheelEventSignal = fst mouseWheelEvent + , mouseWheelEventSink = snd mouseWheelEvent , keyboardDownEventSignal = fst keyboardDownEvent , keyboardDownEventSink = snd keyboardDownEvent @@ -519,6 +527,17 @@ sinkEvent engine (Event.MouseMotionEvent Event.MouseMotionEventData { .. }) = do return engine +-- Sink mouse wheel events as mouse wheels. +sinkEvent engine (Event.MouseWheelEvent Event.MouseWheelEventData {..}) = do + mouseWheelEventSink engine pos' + + return engine + where + pos = fromIntegral <$> mouseWheelEventPos + pos' = case mouseWheelEventDirection of + ScrollNormal -> pos + ScrollFlipped -> pos * V2 (-1) (-1) + -- Sink keyboard events into the relevant Elerea sinks. -- -- Note that keyboard up and press are the same for the time being. diff --git a/src/Helm/Mouse.hs b/src/Helm/Mouse.hs index e19a017..139b207 100644 --- a/src/Helm/Mouse.hs +++ b/src/Helm/Mouse.hs @@ -8,6 +8,7 @@ module Helm.Mouse , clicks , downs , ups + , wheels ) where import FRP.Elerea.Param (input, snapshot) @@ -60,3 +61,13 @@ ups f = Sub $ do engine <- input >>= snapshot fmap (fmap (uncurry f)) <$> mouseUpSignal engine + +-- | Subscribe to mouse wheel events and map to a game action +wheels + :: Engine e + => (V2 Int -> a) -- ^ The function to map a mouse wheel and wheel direction to an action. + -> Sub e a -- ^ The mapped subscription +wheels f = Sub $ do + engine <- input >>= snapshot + + fmap (fmap f) <$> mouseWheelSignal engine diff --git a/stack.yaml b/stack.yaml index 3548259..a304230 100644 --- a/stack.yaml +++ b/stack.yaml @@ -4,5 +4,5 @@ packages: extra-deps: - elerea-2.9.0 - text-1.2.2.0 - - sdl2-2.1.3 + - sdl2-2.2.0 resolver: lts-8.18