start laying out types

src/Types/Application.hs

@@ -0,0 +1,58 @@
+module Types.Application where
+
+import Affection
+
+import qualified SDL
+
+import Control.Concurrent.STM.TMVar
+
+import qualified Data.Map.Strict as M
+
+-- internal imports
+
+import Types.Subsystems
+
+data GameData = GameData
+  { gameState             :: TVar State
+  , gameCurrentLevel      :: Tvar Level
+  , gameSubsystems        :: Subsystems
+  , gameActionTranslation :: TVar ActionTranslation
+  , gameEnded             :: TVar Bool
+  }
+
+data State
+  = Running
+  | Paused
+  deriving (Enum, Eq, Show)
+
+data Level
+  = MainMenu
+  | DNAMenu
+  | Sewer01
+  | Sewer02
+  | Sewer03
+  | Sewer04
+  | Alley01
+  | Alley02
+  | Alley03
+  | Alley04
+  | Lab01
+  | Lab02
+  | Lab03
+  | Lab04
+  | Highway01
+  | Highway02
+  | Highway03
+  | Highway04
+  | Complex01
+  | Complex02
+  | Complex03
+  | Complex04
+  | Base01
+  | Base01
+  | Base01
+  | Base01
+  | Test
+  deriving (Enum, Eq, Show)
+
+type ActionTranslation = M.Map SDL.Keycode Action

src/Types/Subsystems.hs

@@ -0,0 +1,89 @@
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE MutliParamTypeClasses #-}
+module Types.Subsystems where
+
+import Affection
+
+import Control.Concurrent.STM.TVar
+
+data Subsystems = Subsystems
+  { subWindow     :: SubWindow
+  , subMouse      :: SubMouse
+  , subKeyboard   :: SubKeyboard
+  , subTranslator :: SubTranslator
+  }
+
+newtype SubWindow = SubWindow (TVar [(UUID, WindowMessage -> Affection ())])
+newtype SubMouse = SubMouse (TVar [(UUID, MouseMessage -> Affection ())])
+newtype SubKeyboard = SubKeyboard (TVar [(UUID, KeyboardMessage -> Affection ())])
+newtype SubTranslator = SubTranslator (TVar [(UUID, TranslatorMessage -> Affection ())])
+
+instance Participant SubWindow where
+  type Mesg SubWindow = WindowMessage
+
+  partSubscribers (SubWindow t) = generalSubscribers t
+
+  partSubscribe (SubWindow t) = generalSubscribe t
+
+  partUnSubscribe (SubWindow t) = generalUnSubscribe t
+
+instance SDLSubsystem SubWindow where
+  consumeSDLEvents = consumeSDLWindowEvents
+
+instance Participant SubMouse where
+  type Mesg SubMouse = MouseMessage
+
+  partSubscribers (SubMouse t) = generalSubscribers t
+
+  partSubscribe (SubMouse t) = generalSubscribe t
+
+  partUnSubscribe (SubMouse t) = generalUnSubscribe t
+
+instance SDLSubsystem SubMouse where
+  consumeSDLEvents = consumeSDLMouseEvents
+
+instance Participant SubKeyboard where
+  type Mesg SubKeyboard = KeyboardMessage
+
+  partSubscribers (SubKeyboard t) = generalSubscribers t
+
+  partSubscribe (SubKeyboard t) = generalSubscribe t
+
+  partUnSubscribe (SubKeyboard t) = generalUnSubscribe t
+
+instance SDLSubsystem SubKeyboard where
+  consumeSDLEvents = consumeSDLKeyboardEvents
+
+instance Participant SubTranslator where
+  type Mesg SubTranslator = TranslatorMessage
+
+  partSubscribers (SubTranslator t) = generalSubscribers t
+
+  partSubscribe (SubTranslator t) = generalSubscribe t
+
+  partUnSubscribe (SubTranslator t) = generalUnSubscribe t
+
+generalSubscribers
+  :: TVar [(UUID, msg -> Affection ())]
+  -> Affection [(msg -> Affection ())]
+generalSubscribers t = do
+  subTups <- liftIO $ readTVarIO t
+  return $ map snd subTups
+
+generalSubscribe
+  :: TVar [(UUID, msg -> Affection ())]
+  -> (msg -> Affection ())
+  -> Affection UUID
+generalSubscribe t funct = do
+  uu <- genUUID
+  liftIO $ atomically $ modifyTVar' t ((uu, funct) :)
+  return uu
+
+generalUnSubscribe
+  :: TVar [(UUID, msg -> Affection ())]
+  -> UUID
+  -> Affection ()
+generalUnSubscribe t uu =
+  liftIO $ atomically $ modifyTVar' t (filter (`filterMsg` uu))
+  where
+    filterMsg (u, _) p = u /= p