haddock & small fix
- some haddock in renderer - small fix in gamestate-handling function
This commit is contained in:
parent
bb75883f7d
commit
f6e52d732c
@ -1,5 +1,5 @@
|
||||
{-# 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 Foreign.Marshal.Array (withArray)
|
||||
|
@ -1,4 +1,5 @@
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
-- | Types specific to Rendering-Issues
|
||||
module Render.Types (createFlatCam, createSphereCam, Camera, GLCamera(..)) where
|
||||
|
||||
import Linear
|
||||
@ -12,18 +13,22 @@ import qualified Debug.Trace as D
|
||||
type Distance = Double
|
||||
type Pitch = 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 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
|
||||
| Sphere Position Radius
|
||||
|
||||
@ -35,7 +40,9 @@ createFlatCam x z map' = Flat (x,z) (giveMapHeight map' (x, z))
|
||||
createSphereCam :: Double -> Double -> Double -> Camera
|
||||
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
|
||||
getCam (Flat (x',z') y') dist' xa' ya' =
|
||||
lookAt (cpos ^+^ at') at' up
|
||||
@ -82,6 +89,7 @@ instance GLCamera Camera where
|
||||
y = giveMapHeight map (x,z)
|
||||
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 r inc az = V3
|
||||
(r * (sin inc) * (cos az))
|
||||
|
11
src/Types.hs
11
src/Types.hs
@ -192,15 +192,20 @@ $(makeLenses ''UIState)
|
||||
-- helper-functions for types
|
||||
|
||||
-- | atomically change gamestate on condition
|
||||
changeIfGamestate :: (GameState -> Bool) -> (GameState -> GameState) -> Pioneers ()
|
||||
changeIfGamestate :: (GameState -> Bool) -> (GameState -> GameState) -> Pioneers Bool
|
||||
changeIfGamestate cond f = do
|
||||
state <- get
|
||||
liftIO $ atomically $ do
|
||||
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
|
||||
changeGamestate :: (GameState -> GameState) -> Pioneers ()
|
||||
changeGamestate = changeIfGamestate (const True)
|
||||
changeGamestate = do
|
||||
--forget implied result - is True anyway
|
||||
_ <- changeIfGamestate (const True)
|
||||
return ()
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user