haddock & small fix

- some haddock in renderer
- small fix in gamestate-handling function
This commit is contained in:
Nicole Dresselhaus 2014-05-18 07:30:19 +02:00
parent bb75883f7d
commit f6e52d732c
No known key found for this signature in database
GPG Key ID: BC16D887851A1A80
3 changed files with 27 additions and 14 deletions

View File

@ -1,5 +1,5 @@
{-# LANGUAGE BangPatterns, InstanceSigs, ExistentialQuantification #-} {-# LANGUAGE BangPatterns, InstanceSigs, ExistentialQuantification #-}
module Render.Render where module Render.Render (initBuffer, initMapShader, initBuffer, initHud, initRendering, render) where
import qualified Data.ByteString as B import qualified Data.ByteString as B
import Foreign.Marshal.Array (withArray) import Foreign.Marshal.Array (withArray)

View File

@ -1,4 +1,5 @@
{-# LANGUAGE RankNTypes #-} {-# LANGUAGE RankNTypes #-}
-- | Types specific to Rendering-Issues
module Render.Types (createFlatCam, createSphereCam, Camera, GLCamera(..)) where module Render.Types (createFlatCam, createSphereCam, Camera, GLCamera(..)) where
import Linear import Linear
@ -12,18 +13,22 @@ import qualified Debug.Trace as D
type Distance = Double type Distance = Double
type Pitch = Double type Pitch = Double
type Yaw = Double type Yaw = Double
class GLCamera a where
getCam :: a -> Distance -> Pitch -> Yaw -> M44 CFloat
moveBy :: a -> (Position -> Position) -> PlayMap -> a
move :: a -> Position -> PlayMap -> a
type Position = (Double, Double)
type Radius = Double type Radius = Double
type Height = Double type Height = Double
-- | a Typclass for different Cameras
class GLCamera a where
-- | Gets the current Camera-Matrix for a given Cam, Distance Pitch and Yaw
getCam :: a -> Distance -> Pitch -> Yaw -> M44 CFloat
-- | Moves the Camera-Target on a projected 2D-plane
moveBy :: a -> (Position -> Position) -> PlayMap -> a
-- | Moves the Camera-Target to an absoloute position
move :: a -> Position -> PlayMap -> a
-- | Alias for a camera-position onto the 2d-plane it moves on
type Position = (Double, Double)
-- | Camera-Type. Either a Camera onto a 2D-flat-map or a spherical map
data Camera = Flat Position Height data Camera = Flat Position Height
| Sphere Position Radius | Sphere Position Radius
@ -35,7 +40,9 @@ createFlatCam x z map' = Flat (x,z) (giveMapHeight map' (x, z))
createSphereCam :: Double -> Double -> Double -> Camera createSphereCam :: Double -> Double -> Double -> Camera
createSphereCam p a = Sphere (p,a) createSphereCam p a = Sphere (p,a)
-- | our Camera is indeed a GLCamera that we can use
--
-- TODO: Sphere-Cam still undefined
instance GLCamera Camera where instance GLCamera Camera where
getCam (Flat (x',z') y') dist' xa' ya' = getCam (Flat (x',z') y') dist' xa' ya' =
lookAt (cpos ^+^ at') at' up lookAt (cpos ^+^ at') at' up
@ -82,6 +89,7 @@ instance GLCamera Camera where
y = giveMapHeight map (x,z) y = giveMapHeight map (x,z)
move c (x', z') map = moveBy c (\(x,z) -> (x+x',z+z')) map move c (x', z') map = moveBy c (\(x,z) -> (x+x',z+z')) map
-- | converting spherical to cartesian coordinates
sphereToCart :: (Floating a) => a -> a -> a -> V3 a sphereToCart :: (Floating a) => a -> a -> a -> V3 a
sphereToCart r inc az = V3 sphereToCart r inc az = V3
(r * (sin inc) * (cos az)) (r * (sin inc) * (cos az))

View File

@ -192,15 +192,20 @@ $(makeLenses ''UIState)
-- helper-functions for types -- helper-functions for types
-- | atomically change gamestate on condition -- | atomically change gamestate on condition
changeIfGamestate :: (GameState -> Bool) -> (GameState -> GameState) -> Pioneers () changeIfGamestate :: (GameState -> Bool) -> (GameState -> GameState) -> Pioneers Bool
changeIfGamestate cond f = do changeIfGamestate cond f = do
state <- get state <- get
liftIO $ atomically $ do liftIO $ atomically $ do
game' <- readTVar (state ^. game) game' <- readTVar (state ^. game)
when (cond game') (writeTVar (state ^. game) (f game')) let cond' = cond game'
when cond' (writeTVar (state ^. game) (f game'))
return cond'
-- | atomically change gamestate -- | atomically change gamestate
changeGamestate :: (GameState -> GameState) -> Pioneers () changeGamestate :: (GameState -> GameState) -> Pioneers ()
changeGamestate = changeIfGamestate (const True) changeGamestate = do
--forget implied result - is True anyway
_ <- changeIfGamestate (const True)
return ()