From 230e31bf635690103e19222b4a25cdce04b1d27b Mon Sep 17 00:00:00 2001 From: Stefan Dresselhaus Date: Sat, 17 May 2014 12:57:49 +0200 Subject: [PATCH] changed TMVar to TVar - compiles & runs again --- src/Main.hs | 20 ++++++++++---------- src/Render/Render.hs | 4 ++-- src/Types.hs | 6 +++--- src/UI/Callbacks.hs | 8 ++++---- 4 files changed, 19 insertions(+), 19 deletions(-) diff --git a/src/Main.hs b/src/Main.hs index e5f9328..f4d401c 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -13,7 +13,7 @@ import Control.Arrow ((***)) -- data consistency/conversion import Control.Concurrent (threadDelay) import Control.Concurrent.STM (TQueue, newTQueueIO, atomically) -import Control.Concurrent.STM.TMVar (newTMVarIO, takeTMVar, putTMVar, readTMVar) +import Control.Concurrent.STM.TVar (newTVarIO, writeTVar, readTVar) import Control.Monad.RWS.Strict (ask, evalRWST, get, liftIO, modify) import Data.Functor ((<$>)) @@ -100,14 +100,14 @@ main = far = 500 --far plane ratio = fromIntegral fbWidth / fromIntegral fbHeight frust = createFrustum fov near far ratio - cam' <- newTMVarIO CameraState + cam' <- newTVarIO CameraState { _xAngle = pi/6 , _yAngle = pi/2 , _zDist = 10 , _frustum = frust , _camObject = createFlatCam 25 25 curMap } - game' <- newTMVarIO GameState + game' <- newTVarIO GameState { _currentMap = curMap } glHud' <- initHud @@ -210,16 +210,16 @@ run = do newYAngle' = sodya + myrot/100 liftIO $ atomically $ do - cam <- takeTMVar (state ^. camera) + cam <- readTVar (state ^. camera) cam' <- return $ (xAngle .~ newXAngle) . (yAngle .~ newYAngle) $ cam - putTMVar (state ^. camera) cam' + writeTVar (state ^. camera) cam' -- get cursor-keys - if pressed --TODO: Add sin/cos from stateYAngle (kxrot, kyrot) <- fmap (join (***) fromIntegral) getArrowMovement liftIO $ atomically $ do - cam <- takeTMVar (state ^. camera) - game' <- readTMVar (state ^. game) + cam <- readTVar (state ^. camera) + game' <- readTVar (state ^. game) let multc = cos $ cam ^. yAngle mults = sin $ cam ^. yAngle @@ -228,7 +228,7 @@ run = do mody y' = y' + 0.2 * kxrot * mults - 0.2 * kyrot * multc cam' <- return $ camObject %~ (\c -> moveBy c (\(x,y) -> (modx x,mody y)) (game' ^. currentMap)) $ cam - putTMVar (state ^. camera) cam' + writeTVar (state ^. camera) cam' {- --modify the state with all that happened in mt time. @@ -299,9 +299,9 @@ adjustWindow = do frust = createFrustum fov near far ratio liftIO $ glViewport 0 0 (fromIntegral fbWidth) (fromIntegral fbHeight) liftIO $ atomically $ do - cam <- readTMVar (state ^. camera) + cam <- readTVar (state ^. camera) cam' <- return $ frustum .~ frust $ cam - putTMVar (state ^. camera) cam' + writeTVar (state ^. camera) cam' rb <- liftIO $ do -- bind ints to CInt for lateron. let fbCWidth = (fromInteger.toInteger) fbWidth diff --git a/src/Render/Render.hs b/src/Render/Render.hs index ee91b27..59fe4ed 100644 --- a/src/Render/Render.hs +++ b/src/Render/Render.hs @@ -12,7 +12,7 @@ import qualified Linear as L import Control.Lens ((^.)) import Control.Monad.RWS.Strict (liftIO) import qualified Control.Monad.RWS.Strict as RWS (get) -import Control.Concurrent.STM.TMVar (readTMVar) +import Control.Concurrent.STM.TVar (readTVarIO) import Control.Concurrent.STM (atomically) import Data.Distributive (distribute, collect) -- FFI @@ -366,7 +366,7 @@ drawMap = do render :: Pioneers () render = do state <- RWS.get - cam <- liftIO $ atomically $ readTMVar (state ^. camera) + cam <- liftIO $ readTVarIO (state ^. camera) let xa = cam ^. xAngle ya = cam ^. yAngle frust = cam ^. Types.frustum diff --git a/src/Types.hs b/src/Types.hs index c722d11..cbdba50 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -1,7 +1,7 @@ {-# LANGUAGE TemplateHaskell #-} module Types where -import Control.Concurrent.STM (TQueue, TMVar) +import Control.Concurrent.STM (TQueue, TVar) import qualified Graphics.Rendering.OpenGL.GL as GL import Graphics.UI.SDL as SDL (Event, Window) import Foreign.C (CFloat) @@ -161,12 +161,12 @@ data UIState = UIState data State = State { _window :: !WindowState - , _camera :: TMVar CameraState + , _camera :: TVar CameraState , _io :: !IOState , _mouse :: !MouseState , _keyboard :: !KeyboardState , _gl :: !GLState - , _game :: TMVar GameState + , _game :: TVar GameState , _ui :: !UIState } diff --git a/src/UI/Callbacks.hs b/src/UI/Callbacks.hs index 9ce6cc5..6b5d7f3 100644 --- a/src/UI/Callbacks.hs +++ b/src/UI/Callbacks.hs @@ -13,7 +13,7 @@ import Data.Maybe import Foreign.Marshal.Array (pokeArray) import Foreign.Marshal.Alloc (allocaBytes) import qualified Graphics.UI.SDL as SDL -import Control.Concurrent.STM.TMVar (readTMVar, takeTMVar, putTMVar) +import Control.Concurrent.STM.TVar (readTVar, readTVarIO, writeTVar) import Control.Concurrent.STM (atomically) @@ -108,7 +108,7 @@ eventCallback e = do if state ^. mouse.isDown && not (state ^. mouse.isDragging) then do - cam <- liftIO $ atomically $ readTMVar (state ^. camera) + cam <- liftIO $ readTVarIO (state ^. camera) modify $ (mouse.isDragging .~ True) . (mouse.dragStartX .~ fromIntegral x) . (mouse.dragStartY .~ fromIntegral y) @@ -139,11 +139,11 @@ eventCallback e = do do state <- get liftIO $ atomically $ do - cam <- takeTMVar (state ^. camera) + cam <- readTVar (state ^. camera) let zDist' = (cam ^. zDist) + realToFrac (negate vscroll) zDist'' = curb (env ^. zDistClosest) (env ^. zDistFarthest) zDist' cam' <- return $ zDist .~ zDist'' $ cam - putTMVar (state ^. camera) cam' + writeTVar (state ^. camera) cam' -- there is more (joystic, touchInterface, ...), but currently ignored SDL.Quit -> modify $ window.shouldClose .~ True