{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} module Types.UserData where import Affection import Control.Concurrent.STM import NanoVG hiding (V2(..), V3(..)) import qualified Data.Map.Strict as M import qualified Data.Text as T import Data.Matrix import Data.Ecstasy import Control.Concurrent.MVar import Types.Map import Types.StateData import Types.ImgId import Types.Direction import Types.Animation data UserData = UserData { state :: State , subsystems :: Subsystems , assetImages :: M.Map ImgId Image , assetFonts :: M.Map FontId T.Text , assetAnimations :: M.Map AnimId Animation , nano :: Context , uuid :: [UUID] , worldState :: SystemState Entity IO , stateData :: StateData } data State = Menu | Test data FontId = FontBedstead deriving (Show, Eq, Ord, Enum) data Entity f = Entity { pos :: Component f 'Field (V2 Double) , gridPos :: Component f 'Field (V2 Int) , vel :: Component f 'Field (V2 Double) , velFact :: Component f 'Field Double , rot :: Component f 'Field Direction , obstacle :: Component f 'Field (Boundaries Double) , player :: Component f 'Unique () , npcState :: Component f 'Field NPCState , anim :: Component f 'Field AnimState } deriving (Generic) data NPCState = NPCWalking { npcWalkPath :: [V2 Int] } | NPCStanding { npcStandTime :: Double , npcFuturePath :: MVar [V2 Int] } data Subsystems = Subsystems { subWindow :: Window , subMouse :: Mouse } newtype Window = Window (TVar [(UUID, WindowMessage -> Affection UserData())]) newtype Mouse = Mouse (TVar [(UUID, MouseMessage -> Affection UserData ())]) instance Participant Window UserData where type Mesg Window UserData = WindowMessage partSubscribers (Window t) = generalSubscribers t partSubscribe (Window t) = generalSubscribe t partUnSubscribe (Window t) = generalUnSubscribe t instance SDLSubsystem Window UserData where consumeSDLEvents = consumeSDLWindowEvents instance Participant Mouse UserData where type Mesg Mouse UserData = MouseMessage partSubscribers (Mouse t) = generalSubscribers t partSubscribe (Mouse t) = generalSubscribe t partUnSubscribe (Mouse t) = generalUnSubscribe t instance SDLSubsystem Mouse UserData where consumeSDLEvents = consumeSDLMouseEvents generalSubscribers :: TVar [(UUID, msg -> Affection UserData ())] -> Affection UserData [(msg -> Affection UserData ())] generalSubscribers t = do subTups <- liftIO $ readTVarIO t return $ map snd subTups generalSubscribe :: TVar [(UUID, msg -> Affection UserData ())] -> (msg -> Affection UserData ()) -> Affection UserData UUID generalSubscribe t funct = do uu <- genUUID liftIO $ atomically $ modifyTVar' t ((uu, funct) :) return uu generalUnSubscribe :: TVar [(UUID, msg -> Affection UserData ())] -> UUID -> Affection UserData () generalUnSubscribe t uu = liftIO $ atomically $ modifyTVar' t (filter (`filterMsg` uu)) where filterMsg (u, _) p = u /= p