aboutsummaryrefslogtreecommitdiff
path: root/specs/Specs/AppEventSpec.hs
blob: 9da4c87b82324f1657cf390a796b159fe08db58a (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
module Specs.AppEventSpec where

import Chelleport (eventHandler)
import Chelleport.Types
import qualified SDL
import SDL.Internal.Numbered (FromNumber (fromNumber))
import Test.Hspec
import Unsafe.Coerce (unsafeCoerce)

test :: SpecWith ()
test = do
  describe "#eventHandler" $ do
    let mkEvent payload = SDL.Event {SDL.eventTimestamp = 0, SDL.eventPayload = payload}
    let mkKeyboardEvent key motion modifier =
          mkEvent $
            SDL.KeyboardEvent $
              SDL.KeyboardEventData
                { SDL.keyboardEventWindow = unsafeCoerce (0 :: Integer),
                  SDL.keyboardEventRepeat = False,
                  SDL.keyboardEventKeysym =
                    SDL.Keysym
                      { SDL.keysymScancode = SDL.Scancode0,
                        SDL.keysymModifier = modifier,
                        SDL.keysymKeycode = key
                      },
                  SDL.keyboardEventKeyMotion = motion
                }
    let defaultMod = fromNumber 0

    context "when window quit event is triggered" $ do
      it "shuts down app" $ do
        let action = eventHandler $ mkEvent SDL.QuitEvent
        action `shouldBe` Just ShutdownApp

    context "when escape key is pressed" $ do
      it "shuts down app" $ do
        let action = eventHandler $ mkKeyboardEvent SDL.KeycodeEscape SDL.Pressed defaultMod
        action `shouldBe` Just ShutdownApp

    context "when space key is pressed" $ do
      it "triggers left mouse button click" $ do
        let action = eventHandler $ mkKeyboardEvent SDL.KeycodeSpace SDL.Pressed defaultMod
        action `shouldBe` Just (TriggerMouseClick LeftClick)

      context "when pressed with right shift" $ do
        it "chains left mouse button click" $ do
          let action = eventHandler $ mkKeyboardEvent SDL.KeycodeSpace SDL.Pressed (defaultMod {SDL.keyModifierRightShift = True})
          action `shouldBe` Just (ChainMouseClick LeftClick)

      context "when pressed with left shift" $ do
        it "chains left mouse button click" $ do
          let action = eventHandler $ mkKeyboardEvent SDL.KeycodeSpace SDL.Pressed (defaultMod {SDL.keyModifierLeftShift = True})
          action `shouldBe` Just (ChainMouseClick LeftClick)

    context "when minus key is pressed" $ do
      it "triggers left mouse button click" $ do
        let action = eventHandler $ mkKeyboardEvent SDL.KeycodeMinus SDL.Pressed defaultMod
        action `shouldBe` Just (TriggerMouseClick RightClick)

      context "when pressed with right shift" $ do
        it "chains right mouse button click" $ do
          let action = eventHandler $ mkKeyboardEvent SDL.KeycodeMinus SDL.Pressed (defaultMod {SDL.keyModifierRightShift = True})
          action `shouldBe` Just (ChainMouseClick RightClick)

      context "when pressed with left shift" $ do
        it "chains right mouse button click" $ do
          let action = eventHandler $ mkKeyboardEvent SDL.KeycodeMinus SDL.Pressed (defaultMod {SDL.keyModifierLeftShift = True})
          action `shouldBe` Just (ChainMouseClick RightClick)

    context "when tab key is pressed" $ do
      it "resets key state" $ do
        let action = eventHandler $ mkKeyboardEvent SDL.KeycodeTab SDL.Pressed defaultMod
        action `shouldBe` Just ResetKeys

    context "when backspace key is pressed" $ do
      it "resets key state" $ do
        let action = eventHandler $ mkKeyboardEvent SDL.KeycodeBackspace SDL.Pressed defaultMod
        action `shouldBe` Just ResetKeys

    context "when an alphanumeric key (excluding Q) is pressed" $ do
      it "calls key input handler" $ do
        eventHandler (mkKeyboardEvent SDL.KeycodeA SDL.Pressed defaultMod) `shouldBe` Just (HandleKeyInput SDL.KeycodeA)
        eventHandler (mkKeyboardEvent SDL.KeycodeQ SDL.Pressed defaultMod) `shouldBe` Just (HandleKeyInput SDL.KeycodeQ)
        eventHandler (mkKeyboardEvent SDL.Keycode9 SDL.Pressed defaultMod) `shouldBe` Just (HandleKeyInput SDL.Keycode9)

    context "when shift key is pressed" $ do
      it "enables shift" $ do
        let action = eventHandler $ mkKeyboardEvent SDL.KeycodeRShift SDL.Pressed defaultMod
        action `shouldBe` Just (UpdateShiftState True)

    context "when shift key is released" $ do
      it "disabled shift" $ do
        let action = eventHandler $ mkKeyboardEvent SDL.KeycodeRShift SDL.Released defaultMod
        action `shouldBe` Just (UpdateShiftState False)