diff --git a/src/Render/Render.hs b/src/Render/Render.hs index 59fe4ed..0cd5464 100644 --- a/src/Render/Render.hs +++ b/src/Render/Render.hs @@ -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) diff --git a/src/Render/Types.hs b/src/Render/Types.hs index 5191322..db778df 100644 --- a/src/Render/Types.hs +++ b/src/Render/Types.hs @@ -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)) diff --git a/src/Types.hs b/src/Types.hs index 7a27ed9..dae0916 100644 --- a/src/Types.hs +++ b/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 ()