{-# 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 Types.Map data UserData = UserData { state :: State , subsystems :: Subsystems , assetImages :: M.Map ImgId Image , assetFonts :: M.Map FontId T.Text , nano :: Context , uuid :: [UUID] , worldState :: SystemState Entity , stateData :: StateData } data State = Menu | Test data StateData = None | MenuData { mapMat :: Matrix TileState , initCoords :: (Int, Int) , imgMat :: Matrix (Maybe ImgId) } data ImgId = ImgWallAsc | ImgWallDesc | ImgWallCornerN | ImgWallCornerE | ImgWallCornerS | ImgWallCornerW | ImgWallTNE | ImgWallTSE | ImgWallTSW | ImgWallTNW | ImgWallCross | ImgMiscBox1 deriving (Show, Eq, Ord, Enum) isWall :: ImgId -> Bool isWall ImgMiscBox1 = False isWall _ = True imgObstacle :: Maybe ImgId -> [(Boundaries Double)] imgObstacle (Just ImgMiscBox1) = [Boundaries (0.2, 0.34) (0.8, 1)] imgObstacle (Just ImgWallAsc) = [Boundaries (0.37, 0) (0.63, 1)] imgObstacle (Just ImgWallDesc) = [Boundaries (0, 0.37) (1, 0.63)] imgObstacle (Just ImgWallCornerN) = [ Boundaries (0, 0.37) (0.63, 0.63) , Boundaries (0.37, 0.37) (0.63, 1) ] imgObstacle (Just ImgWallCornerE) = [ Boundaries (0.37, 0.37) (1, 0.63) , Boundaries (0.37, 0.37) (0.63, 1) ] imgObstacle (Just ImgWallCornerS) = [ Boundaries (0.37, 0.37) (1, 0.63) , Boundaries (0.37, 0) (0.63, 0.63) ] imgObstacle (Just ImgWallCornerW) = [ Boundaries (0, 0.37) (0.63, 0.63) , Boundaries (0.37, 0) (0.63, 0.63) ] imgObstacle (Just ImgWallTNE) = [ Boundaries (0, 0.37) (1, 0.63) , Boundaries (0.37, 0.37) (0.63, 1) ] imgObstacle (Just ImgWallTSW) = [ Boundaries (0, 0.37) (1, 0.63) , Boundaries (0.37, 0) (0.63, 0.63) ] imgObstacle (Just ImgWallTSE) = [ Boundaries (0.37, 0) (0.63, 1) , Boundaries (0.37, 0.37) (1, 0.63) ] imgObstacle (Just ImgWallTNW) = [ Boundaries (0.37, 0) (0.63, 1) , Boundaries (0, 0.37) (0.63, 0.63) ] imgObstacle (Just ImgWallCross) = [ Boundaries (0.37, 0) (0.63, 1) , Boundaries (0, 0.37) (1, 0.63) ] imgObstacle _ = [] data FontId = FontBedstead deriving (Show, Eq, Ord, Enum) data Direction = N | W | S | E | NW | SW | NE | SE data Entity f = Entity { pos :: Component f 'Field (V2 Double) , gridPos :: Component f 'Field (V2 Int) , vel :: Component f 'Field (V2 Double) , rot :: Component f 'Field Direction , obstacle :: Component f 'Field (Boundaries Double) , player :: Component f 'Unique Bool } deriving (Generic) 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