commit
89329023ad
4 changed files with 40 additions and 5 deletions
|
@ -45,6 +45,7 @@ library
|
|||
-- , Affection.Actor
|
||||
-- , Affection.Animation
|
||||
, Affection.Util
|
||||
, Affection.MessageBus
|
||||
default-extensions: OverloadedStrings
|
||||
|
||||
-- Modules included in this library but not exported.
|
||||
|
@ -60,7 +61,7 @@ library
|
|||
default-language: Haskell2010
|
||||
ghc-options: -Wall
|
||||
-- Other library packages from which modules are imported.
|
||||
build-depends: base >=4.9
|
||||
build-depends: base >=4.9 && <4.11
|
||||
, sdl2
|
||||
, text
|
||||
, mtl
|
||||
|
@ -73,6 +74,7 @@ library
|
|||
, glib
|
||||
, bytestring
|
||||
, OpenGL
|
||||
, stm
|
||||
-- , sdl2-image
|
||||
|
||||
-- executable example00
|
||||
|
|
9
notes/TODO.md
Normal file
9
notes/TODO.md
Normal file
|
@ -0,0 +1,9 @@
|
|||
# TODO
|
||||
|
||||
Implement following things in approximately this Order:
|
||||
|
||||
* Message bus
|
||||
* Console
|
||||
* GUI
|
||||
* Framework
|
||||
* Everything else
|
|
@ -8,6 +8,8 @@ module Affection
|
|||
-- , withWindow
|
||||
-- , withDefaultWindow
|
||||
, delaySec
|
||||
, get
|
||||
, put
|
||||
, module A
|
||||
) where
|
||||
|
||||
|
@ -23,7 +25,6 @@ import Data.IORef
|
|||
import System.Clock
|
||||
|
||||
import Control.Monad.Loops
|
||||
import qualified Control.Monad.Parallel as MP
|
||||
import Control.Monad.State
|
||||
|
||||
import Foreign.C.Types (CInt(..))
|
||||
|
@ -40,6 +41,7 @@ import Affection.MouseInteractable as A
|
|||
-- import Affection.Actor as A
|
||||
-- import Affection.Animation as A
|
||||
import Affection.Util as A
|
||||
import Affection.MessageBus as A
|
||||
|
||||
import Graphics.Rendering.OpenGL as GL (clear, flush, ClearBuffer(..))
|
||||
|
||||
|
@ -133,8 +135,8 @@ withAffection AffectionConfig{..} = do
|
|||
-- Measure time difference form last run
|
||||
now <- liftIO $ getTime Monotonic
|
||||
let lastTime = sysTime ad
|
||||
-- -- clean draw requests from last run
|
||||
-- MP.mapM_ (invalidateDrawRequest (drawStride ad) (drawCPP ad)) (drawStack ad)
|
||||
-- clean draw requests from last run
|
||||
-- mapM_ (invalidateDrawRequest (drawStride ad) (drawCPP ad)) (drawStack ad)
|
||||
-- clean the renderer form last time
|
||||
-- SDL.clear renderer
|
||||
-- compute dt and update elapsedTime
|
||||
|
@ -157,7 +159,7 @@ withAffection AffectionConfig{..} = do
|
|||
-- handle all new draw requests
|
||||
ad2 <- get
|
||||
-- clear <- catMaybes <$>
|
||||
-- MP.mapM (handleDrawRequest (drawStride ad) (drawCPP ad)) (drawStack ad2)
|
||||
-- mapM (handleDrawRequest (drawStride ad) (drawCPP ad)) (drawStack ad2)
|
||||
-- -- save all draw requests to clear in next run
|
||||
-- put $ ad2
|
||||
-- { drawStack = clear }
|
||||
|
|
22
src/Affection/MessageBus.hs
Normal file
22
src/Affection/MessageBus.hs
Normal file
|
@ -0,0 +1,22 @@
|
|||
module Affection.MessageBus where
|
||||
|
||||
import Control.Concurrent.STM as STM
|
||||
|
||||
import Data.IORef
|
||||
|
||||
class Message msg where
|
||||
msgPayload :: msg -> Maybe a
|
||||
|
||||
type Channel msg = TChan msg
|
||||
|
||||
class Participant prt where
|
||||
partChannel :: (Message msg) => prt -> IORef (Channel msg)
|
||||
|
||||
partConnectChannel :: (Message msg) => prt -> (Channel msg) -> IO ()
|
||||
|
||||
partListen :: (Message msg) => prt -> IO msg
|
||||
|
||||
partBroadcast :: (Message msg) => prt -> msg -> IO ()
|
||||
|
||||
newBroadcastChannel :: IO (Channel msg)
|
||||
newBroadcastChannel = atomically $ newBroadcastTChan
|
Loading…
Reference in a new issue