tracer/src/Types/UserData.hs

210 lines
5 KiB
Haskell
Raw Normal View History

2018-02-07 00:18:16 +00:00
{-# 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
2018-03-01 22:33:08 +00:00
import qualified Data.Text as T
import Data.Matrix
2018-02-07 00:18:16 +00:00
import Data.Ecstasy
import Types.Map
2018-02-07 00:18:16 +00:00
data UserData = UserData
{ state :: State
, subsystems :: Subsystems
, assetImages :: M.Map ImgId Image
2018-03-01 22:33:08 +00:00
, assetFonts :: M.Map FontId T.Text
2018-02-07 00:18:16 +00:00
, nano :: Context
, uuid :: [UUID]
, worldState :: SystemState Entity
, stateData :: StateData
2018-02-07 00:18:16 +00:00
}
data State
= Menu
| Test
data StateData
= None
| MenuData
{ mapMat :: Matrix TileState
2018-02-23 12:07:24 +00:00
, initCoords :: (Int, Int)
2018-03-02 01:10:35 +00:00
, imgMat :: Matrix (Maybe ImgId)
}
2018-02-07 00:18:16 +00:00
data ImgId
2018-03-31 21:22:10 +00:00
= ImgEmpty -- TODO: Find better solution thatn empty image.
| ImgWallAsc
2018-02-27 19:35:08 +00:00
| ImgWallDesc
| ImgWallCornerN
| ImgWallCornerE
| ImgWallCornerS
| ImgWallCornerW
| ImgWallTNE
| ImgWallTSE
| ImgWallTSW
| ImgWallTNW
| ImgWallCross
2018-03-03 16:03:17 +00:00
| ImgMiscBox1
2018-03-31 21:22:10 +00:00
| ImgMiscTable1
| ImgMiscTable2
2018-04-11 18:01:41 +00:00
| ImgMiscTable3
| ImgMiscTable4
2018-03-31 21:22:10 +00:00
| ImgMiscTableCorner
2018-02-27 19:35:08 +00:00
deriving (Show, Eq, Ord, Enum)
2018-02-07 00:18:16 +00:00
2018-03-03 16:03:17 +00:00
isWall :: ImgId -> Bool
isWall ImgMiscBox1 = False
2018-03-31 21:22:10 +00:00
isWall ImgMiscTable1 = False
isWall ImgMiscTable2 = False
2018-04-11 18:01:41 +00:00
isWall ImgMiscTable3 = False
isWall ImgMiscTable4 = False
2018-03-31 21:22:10 +00:00
isWall ImgMiscTableCorner = False
2018-03-03 16:03:17 +00:00
isWall _ = True
2018-03-04 21:24:30 +00:00
2018-03-05 20:11:38 +00:00
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)]
2018-03-05 20:11:38 +00:00
imgObstacle (Just ImgWallCornerN) =
[ Boundaries (0, 0.34) (0.66, 0.66)
, Boundaries (0.34, 0.34) (0.66, 1)
2018-03-05 20:11:38 +00:00
]
imgObstacle (Just ImgWallCornerE) =
[ Boundaries (0.34, 0.34) (1, 0.66)
, Boundaries (0.34, 0.34) (0.66, 1)
2018-03-05 20:11:38 +00:00
]
imgObstacle (Just ImgWallCornerS) =
[ Boundaries (0.34, 0.34) (1, 0.66)
, Boundaries (0.34, 0) (0.66, 0.66)
2018-03-05 20:11:38 +00:00
]
imgObstacle (Just ImgWallCornerW) =
[ Boundaries (0, 0.34) (0.66, 0.66)
, Boundaries (0.34, 0) (0.66, 0.66)
2018-03-05 20:11:38 +00:00
]
imgObstacle (Just ImgWallTNE) =
[ Boundaries (0, 0.34) (1, 0.66)
, Boundaries (0.34, 0.34) (0.66, 1)
2018-03-05 20:11:38 +00:00
]
imgObstacle (Just ImgWallTSW) =
[ Boundaries (0, 0.34) (1, 0.66)
, Boundaries (0.34, 0) (0.66, 0.66)
2018-03-05 20:11:38 +00:00
]
imgObstacle (Just ImgWallTSE) =
[ Boundaries (0.34, 0) (0.66, 1)
, Boundaries (0.34, 0.34) (1, 0.66)
2018-03-05 20:11:38 +00:00
]
imgObstacle (Just ImgWallTNW) =
[ Boundaries (0.34, 0) (0.66, 1)
, Boundaries (0, 0.34) (0.66, 0.66)
2018-03-05 20:11:38 +00:00
]
imgObstacle (Just ImgWallCross) =
[ Boundaries (0.34, 0) (0.66, 1)
, Boundaries (0, 0.34) (1, 0.66)
2018-03-05 20:11:38 +00:00
]
2018-03-31 21:22:10 +00:00
imgObstacle (Just ImgMiscTable1) =
[ Boundaries (0, 0.34) (1, 1)
]
imgObstacle (Just ImgMiscTable2) =
[ Boundaries (0, 0) (0.63, 1)
]
2018-04-11 18:01:41 +00:00
imgObstacle (Just ImgMiscTable3) =
[ Boundaries (0, 0) (1, 0.63)
]
imgObstacle (Just ImgMiscTable4) =
[ Boundaries (0.34, 0) (1, 1)
]
2018-03-31 21:22:10 +00:00
imgObstacle (Just ImgMiscTableCorner) =
[ Boundaries (0, 0) (0.63, 1)
, Boundaries (0, 0.34) (1, 1)
]
2018-03-05 20:11:38 +00:00
imgObstacle _ = []
2018-03-03 16:03:17 +00:00
2018-03-01 22:33:08 +00:00
data FontId
= FontBedstead
deriving (Show, Eq, Ord, Enum)
2018-02-07 00:18:16 +00:00
data Direction
= N
| W
| S
| E
| NW
| SW
| NE
| SE
data Entity f = Entity
2018-03-03 16:03:17 +00:00
{ 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
2018-02-07 00:18:16 +00:00
}
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
2018-02-18 02:11:41 +00:00
uu <- genUUID
liftIO $ atomically $ modifyTVar' t ((uu, funct) :)
return uu
2018-02-07 00:18:16 +00:00
generalUnSubscribe
:: TVar [(UUID, msg -> Affection UserData ())]
-> UUID
-> Affection UserData ()
2018-02-18 02:11:41 +00:00
generalUnSubscribe t uu =
liftIO $ atomically $ modifyTVar' t (filter (`filterMsg` uu))
2018-02-07 00:18:16 +00:00
where
filterMsg (u, _) p = u /= p