Drezil/pioneers
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

changed TMVar to TVar

Browse Source 
- compiles & runs again
This commit is contained in:
Nicole Dresselhaus 2014-05-17 12:57:49 +02:00
parent 27d7873595
commit 230e31bf63
No known key found for this signature in database
GPG Key ID: BC16D887851A1A80
4 changed files with 19 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
src/Main.hs
View File

@ -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

4
src/Render/Render.hs
View File

@ -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

6
src/Types.hs
View File

@ -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
}

8
src/UI/Callbacks.hs
View File

@ -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