117 lines
2.6 KiB
Haskell
117 lines
2.6 KiB
Haskell
{-# 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 Data.Matrix
|
|
import Data.Ecstasy
|
|
|
|
import Types.Map
|
|
|
|
data UserData = UserData
|
|
{ state :: State
|
|
, subsystems :: Subsystems
|
|
, assetImages :: M.Map ImgId Image
|
|
, nano :: Context
|
|
, uuid :: [UUID]
|
|
, world :: Entity 'WorldOf
|
|
, worldState :: SystemState Entity
|
|
, stateData :: StateData
|
|
}
|
|
|
|
data State
|
|
= Menu
|
|
| Test
|
|
|
|
data StateData
|
|
= None
|
|
| MenuData
|
|
{ mapMat :: Matrix TileState
|
|
, initCoords :: (Int, Int)
|
|
}
|
|
|
|
data ImgId
|
|
= ImgFloor
|
|
|
|
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
|
|
, 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
|