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 #-}
|
{-# 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)
|
||||||
|
@ -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))
|
||||||
|
11
src/Types.hs
11
src/Types.hs
@ -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 ()
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user