canvas/app/Types/UserData.hs

99 lines
2.4 KiB
Haskell
Raw Normal View History

2020-02-06 04:10:10 +00:00
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
2020-02-05 06:21:39 +00:00
module Types.UserData where
import Affection
2020-02-07 23:15:53 +00:00
import qualified Graphics.Rendering.OpenGL as GL
2020-02-05 06:21:39 +00:00
import Control.Concurrent.STM
import qualified SDL
import qualified Data.Map.Strict as M
2020-02-07 23:15:53 +00:00
import Linear
2020-02-06 04:10:10 +00:00
import Codec.Picture
2020-02-07 04:50:19 +00:00
-- internal imports
import Types.Sprite
2020-02-07 13:57:09 +00:00
import Classes.Renderable
2020-02-05 06:21:39 +00:00
data UserData = UserData
2020-02-07 06:51:31 +00:00
{ udSubsystems :: Subsystems
, udRenderAssets :: RenderAssets
2020-02-05 06:21:39 +00:00
}
2020-02-06 04:10:10 +00:00
2020-02-07 06:51:31 +00:00
data RenderAssets = RenderAssets
{ assetSprites :: AssetDetails SpriteRenderObjects SpriteShaderObjects Sprite
}
data Renderable dat => AssetDetails vo so dat = AssetDetails
{ adVertObj :: vo
, adShadObj :: so
2020-02-07 23:15:53 +00:00
, adTextObj :: M.Map AssetId GL.TextureObject
, adDataObj :: M.Map AssetId [dat]
2020-02-07 06:51:31 +00:00
}
type AssetId = String
2020-02-06 04:10:10 +00:00
data Subsystems = Subsystems
{ subWindow :: SubWindow
, subMouse :: SubMouse
}
newtype SubWindow = SubWindow (TVar [(UUID, WindowMessage -> Affection UserData ())])
newtype SubMouse = SubMouse (TVar [(UUID, MouseMessage -> Affection UserData ())])
instance Participant SubWindow UserData where
type Mesg SubWindow UserData = WindowMessage
partSubscribers (SubWindow t) = genericSubscribers t
partSubscribe (SubWindow t) = genericSubscribe t
partUnSubscribe (SubWindow t) = genericUnSubscribe t
instance SDLSubsystem SubWindow UserData where
consumeSDLEvents = consumeSDLWindowEvents
instance Participant SubMouse UserData where
type Mesg SubMouse UserData = MouseMessage
partSubscribers (SubMouse t) = genericSubscribers t
partSubscribe (SubMouse t) = genericSubscribe t
partUnSubscribe (SubMouse t) = genericUnSubscribe t
instance SDLSubsystem SubMouse UserData where
consumeSDLEvents = consumeSDLMouseEvents
genericSubscribers
:: TVar [(UUID, msg -> Affection UserData ())]
-> Affection UserData [(msg -> Affection UserData ())]
genericSubscribers t = do
subTups <- liftIO $ readTVarIO t
return $ map snd subTups
genericSubscribe
:: TVar [(UUID, msg -> Affection UserData ())]
-> (msg -> Affection UserData ())
-> Affection UserData UUID
genericSubscribe t funct = do
uu <- genUUID
liftIO $ atomically $ modifyTVar' t ((uu, funct) :)
return uu
genericUnSubscribe
:: TVar [(UUID, msg -> Affection UserData ())]
-> UUID
-> Affection UserData ()
genericUnSubscribe t uu =
liftIO $ atomically $ modifyTVar' t (filter (`filterMsg` uu))
where
filterMsg (u, _) p = u /= p