prepare for joypad control

src/Init.hs

@@ -28,9 +28,10 @@ foreign import ccall unsafe "glewInit"
 init :: IO UserData
 init = do
   subs <- Subsystems
-    <$> (Window <$> newTVarIO [])
-    <*> (Mouse <$> newTVarIO [])
-    <*> (Keyboard <$> newTVarIO [])
+    <$> (SubWindow <$> newTVarIO [])
+    <*> (SubMouse <$> newTVarIO [])
+    <*> (SubKeyboard <$> newTVarIO [])
+    <*> (SubJoypad <$> newTVarIO [])
   _ <- glewInit
   nvg <- createGL3 (S.fromList [NanoVG.Debug, Antialias, StencilStrokes])
   return UserData

src/Main.hs

@@ -56,7 +56,7 @@ pre = do
   -- _ <- SDL.glSetAttribute SDL.SDL_GL_SHARE_WITH_CURRENT_CONTEXT 1
   threadCtx <- SDL.glCreateContext (drawWindow ad)
   SDL.glMakeCurrent (drawWindow ad) (glContext ad)
-  let Subsystems w m k = subsystems ud
+  let Subsystems w m k j = subsystems ud
   _ <- partSubscribe w (fitViewport (1280/720))
   _ <- partSubscribe w exitOnWindowClose
   _ <- partSubscribe k toggleFullScreen
@@ -75,10 +75,11 @@ quitGame (MsgKeyboardEvent _ _ SDL.Pressed False sym)
     ad <- A.get
     ud <- getAffection
     when (state ud == Main WorldMap || state ud == Main MindMap) $ do
-      let Subsystems w m k = subsystems ud
+      let Subsystems w m k j = subsystems ud
       mapM_ (partUnSubscribe w) (uuid ud)
       mapM_ (partUnSubscribe m) (uuid ud)
       mapM_ (partUnSubscribe k) (uuid ud)
+      mapM_ (partUnSubscribe j) (uuid ud)
       SDL.glMakeCurrent (drawWindow ad) (glContext ad)
       (ws, _) <- yieldSystemT (0, defStorage) (return ())
       putAffection ud

src/MainGame/WorldMap.hs

@@ -45,7 +45,7 @@ loadMap :: Affection UserData ()
 loadMap = do
   ud <- getAffection
   ad <- get
-  let (Subsystems _ m k) = subsystems ud
+  let (Subsystems _ m k _) = subsystems ud
   uu1 <- partSubscribe m movePlayer
   uu2 <- partSubscribe k changeMaps
   uu3 <- partSubscribe m playerInteract

src/StateMachine.hs

@@ -26,18 +26,22 @@ instance StateMachine State UserData where
   smDraw Load = drawLoad
 
   smEvent _ evs = do
-    Subsystems w m k <- subsystems <$> getAffection
-    _ <- consumeSDLEvents k =<< consumeSDLEvents w =<< consumeSDLEvents m evs
+    Subsystems w m k j <- subsystems <$> getAffection
+    _ <- consumeSDLEvents j =<<
+      consumeSDLEvents k =<<
+      consumeSDLEvents w =<<
+      consumeSDLEvents m evs
     return ()
 
   smClean _ = do
     ud <- getAffection
-    let Subsystems w m k = subsystems ud
+    let Subsystems w m k j = subsystems ud
         toClean            = uuid ud
     mapM_ (\u -> do
       partUnSubscribe w u
       partUnSubscribe m u
       partUnSubscribe k u
+      partUnSubscribe j u
       ) toClean
     putAffection ud
       { uuid = []

src/Types/UserData.hs

@@ -53,51 +53,65 @@ data SubMain
   deriving (Eq)
 
 data Subsystems = Subsystems
-  { subWindow   :: Types.UserData.Window
-  , subMouse    :: Mouse
-  , subkeyboard :: Keyboard
+  { subWindow   :: SubWindow
+  , subMouse    :: SubMouse
+  , subkeyboard :: SubKeyboard
+  , subJoypad   :: SubJoypad
   }
 
-newtype Window = Window (TVar [(UUID, WindowMessage -> Affection UserData())])
-newtype Mouse = Mouse (TVar [(UUID, MouseMessage -> Affection UserData ())])
-newtype Keyboard = Keyboard (TVar [(UUID, KeyboardMessage -> Affection UserData ())])
+newtype SubWindow   = SubWindow (TVar [(UUID, WindowMessage -> Affection UserData())])
+newtype SubMouse    = SubMouse (TVar [(UUID, MouseMessage -> Affection UserData ())])
+newtype SubKeyboard = SubKeyboard (TVar [(UUID, KeyboardMessage -> Affection UserData ())])
+newtype SubJoypad   = SubJoypad (TVar [(UUID, JoystickMessage -> Affection UserData ())])
 
-instance Participant Types.UserData.Window UserData where
-  type Mesg Types.UserData.Window UserData = WindowMessage
+instance Participant SubWindow UserData where
+  type Mesg SubWindow UserData = WindowMessage
 
-  partSubscribers (Window t) = generalSubscribers t
+  partSubscribers (SubWindow t) = generalSubscribers t
 
-  partSubscribe (Window t) = generalSubscribe t
+  partSubscribe (SubWindow t) = generalSubscribe t
 
-  partUnSubscribe (Window t) = generalUnSubscribe t
+  partUnSubscribe (SubWindow t) = generalUnSubscribe t
 
-instance SDLSubsystem Types.UserData.Window UserData where
+instance SDLSubsystem SubWindow UserData where
   consumeSDLEvents = consumeSDLWindowEvents
 
-instance Participant Mouse UserData where
-  type Mesg Mouse UserData = MouseMessage
+instance Participant SubMouse UserData where
+  type Mesg SubMouse UserData = MouseMessage
 
-  partSubscribers (Mouse t) = generalSubscribers t
+  partSubscribers (SubMouse t) = generalSubscribers t
 
-  partSubscribe (Mouse t) = generalSubscribe t
+  partSubscribe (SubMouse t) = generalSubscribe t
 
-  partUnSubscribe (Mouse t) = generalUnSubscribe t
+  partUnSubscribe (SubMouse t) = generalUnSubscribe t
 
-instance SDLSubsystem Mouse UserData where
+instance SDLSubsystem SubMouse UserData where
   consumeSDLEvents = consumeSDLMouseEvents
 
-instance Participant Keyboard UserData where
-  type Mesg Keyboard UserData = KeyboardMessage
+instance Participant SubKeyboard UserData where
+  type Mesg SubKeyboard UserData = KeyboardMessage
 
-  partSubscribers (Keyboard t) = generalSubscribers t
+  partSubscribers (SubKeyboard t) = generalSubscribers t
 
-  partSubscribe (Keyboard t) = generalSubscribe t
+  partSubscribe (SubKeyboard t) = generalSubscribe t
 
-  partUnSubscribe (Keyboard t) = generalUnSubscribe t
+  partUnSubscribe (SubKeyboard t) = generalUnSubscribe t
 
-instance SDLSubsystem Keyboard UserData where
+instance SDLSubsystem SubKeyboard UserData where
   consumeSDLEvents = consumeSDLKeyboardEvents
 
+instance Participant SubJoypad UserData where
+  type Mesg SubJoypad UserData = JoystickMessage
+
+  partSubscribers (SubJoypad t) = generalSubscribers t
+
+  partSubscribe (SubJoypad t) = generalSubscribe t
+
+  partUnSubscribe (SubJoypad t) = generalUnSubscribe t
+
+instance SDLSubsystem SubJoypad UserData where
+  consumeSDLEvents = consumeSDLJoystickEvents
+
 generalSubscribers
   :: TVar [(UUID, msg -> Affection UserData ())]
   -> Affection UserData [(msg -> Affection UserData ())]