{-# 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.ReachPoint 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 StateData = None | MenuData { mapMat :: Matrix TileState , initCoords :: (Int, Int) , imgMat :: Matrix (Maybe ImgId) , reachPoints :: [ReachPoint] } data ImgId = ImgEmpty -- TODO: Find better solution thatn empty image. | ImgWallAsc | ImgWallDesc | ImgWallCornerN | ImgWallCornerE | ImgWallCornerS | ImgWallCornerW | ImgWallTNE | ImgWallTSE | ImgWallTSW | ImgWallTNW | ImgWallCross | ImgMiscBox1 | ImgMiscTable1 | ImgMiscTable2 | ImgMiscTable3 | ImgMiscTable4 | ImgMiscTableCorner -- | ImgIntrNE -- | ImgIntrE -- | ImgIntrSE -- | ImgIntrS -- | ImgIntrSW -- | ImgIntrW -- | ImgIntrNW -- | ImgIntrN deriving (Show, Eq, Ord, Enum) isWall :: ImgId -> Bool isWall ImgMiscBox1 = False isWall ImgMiscTable1 = False isWall ImgMiscTable2 = False isWall ImgMiscTable3 = False isWall ImgMiscTable4 = False isWall ImgMiscTableCorner = False isWall _ = True imgObstacle :: Maybe ImgId -> [(Boundaries Double)] imgObstacle (Just ImgMiscBox1) = [Boundaries (0.2, 0.34) (0.8, 1)] imgObstacle (Just ImgWallAsc) = [Boundaries (0.34, 0) (0.66, 1)] imgObstacle (Just ImgWallDesc) = [Boundaries (0, 0.34) (1, 0.66)] imgObstacle (Just ImgWallCornerN) = [ Boundaries (0, 0.34) (0.66, 0.66) , Boundaries (0.34, 0.34) (0.66, 1) ] imgObstacle (Just ImgWallCornerE) = [ Boundaries (0.34, 0.34) (1, 0.66) , Boundaries (0.34, 0.34) (0.66, 1) ] imgObstacle (Just ImgWallCornerS) = [ Boundaries (0.34, 0.34) (1, 0.66) , Boundaries (0.34, 0) (0.66, 0.66) ] imgObstacle (Just ImgWallCornerW) = [ Boundaries (0, 0.34) (0.66, 0.66) , Boundaries (0.34, 0) (0.66, 0.66) ] imgObstacle (Just ImgWallTNE) = [ Boundaries (0, 0.34) (1, 0.66) , Boundaries (0.34, 0.34) (0.66, 1) ] imgObstacle (Just ImgWallTSW) = [ Boundaries (0, 0.34) (1, 0.66) , Boundaries (0.34, 0) (0.66, 0.66) ] imgObstacle (Just ImgWallTSE) = [ Boundaries (0.34, 0) (0.66, 1) , Boundaries (0.34, 0.34) (1, 0.66) ] imgObstacle (Just ImgWallTNW) = [ Boundaries (0.34, 0) (0.66, 1) , Boundaries (0, 0.34) (0.66, 0.66) ] imgObstacle (Just ImgWallCross) = [ Boundaries (0.34, 0) (0.66, 1) , Boundaries (0, 0.34) (1, 0.66) ] imgObstacle (Just ImgMiscTable1) = [ Boundaries (0, 0.34) (1, 1) ] imgObstacle (Just ImgMiscTable2) = [ Boundaries (0, 0) (0.63, 1) ] imgObstacle (Just ImgMiscTable3) = [ Boundaries (0, 0) (1, 0.63) ] imgObstacle (Just ImgMiscTable4) = [ Boundaries (0.34, 0) (1, 1) ] imgObstacle (Just ImgMiscTableCorner) = [ Boundaries (0, 0) (0.63, 1) , Boundaries (0, 0.34) (1, 1) ] imgObstacle _ = [] data FontId = FontBedstead deriving (Show, Eq, Ord, Enum) data Direction = NE | E | SE | S | SW | W | NW | N deriving (Show, Eq, Ord, Enum) -- dirToImgId :: Direction -> ImgId -- dirToImgId E = ImgIntrE -- dirToImgId SE = ImgIntrSE -- dirToImgId S = ImgIntrS -- dirToImgId SW = ImgIntrSW -- dirToImgId W = ImgIntrW -- dirToImgId NW = ImgIntrNW -- dirToImgId N = ImgIntrN -- dirToImgId NE = ImgIntrNE 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 -- ANIMATIONS data AnimId = AnimId { aiVariation :: Int , aiName :: String -- CHANGE ME !!! , aiDirection :: Direction } deriving (Show, Eq, Ord) data AnimState = AnimState { asId :: AnimId , asCurrentFrame :: Int , asElapsedTime :: Double } deriving (Show) data AnimPlayback = APLoop | APOnce data Animation = Animation { animDuration :: Double , animSprites :: [Image] , animPlay :: AnimPlayback } data AnimationConfig = AnimationConfig { animConfOffset :: (Int, Int) , animConfSize :: (Int, Int) , animConfCount :: Int , animConfDuration :: Double , animConfPlay :: AnimPlayback }