Merge branch 'tessallation' into iqm

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)

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

src/Types.hs

@@ -1,7 +1,7 @@
 {-# LANGUAGE TemplateHaskell #-}
 module Types where
 
-import           Control.Concurrent.STM               (TQueue, TVar)
+import           Control.Concurrent.STM               (TQueue, TVar, readTVar, writeTVar, atomically)
 import qualified Graphics.Rendering.OpenGL.GL         as GL
 import           Graphics.UI.SDL                      as SDL (Event, Window)
 import           Foreign.C                            (CFloat)
@@ -9,7 +9,8 @@ import qualified Data.HashMap.Strict                  as Map
 import           Data.Time                            (UTCTime)
 import Linear.Matrix (M44)
 import Linear (V3)
-import Control.Monad.RWS.Strict (RWST)
+import Control.Monad.RWS.Strict (RWST, liftIO, get)
+import Control.Monad (when)
 import Control.Lens
 import Graphics.Rendering.OpenGL.GL.Texturing.Objects (TextureObject)
 import Render.Types
@@ -188,3 +189,23 @@ $(makeLenses ''Position)
 $(makeLenses ''Env)
 $(makeLenses ''UIState)
 
+-- helper-functions for types
+
+-- | atomically change gamestate on condition
+changeIfGamestate :: (GameState -> Bool) -> (GameState -> GameState) -> Pioneers Bool
+changeIfGamestate cond f = do
+	state <- get
+	liftIO $ atomically $ do
+		game' <- readTVar (state ^. game)
+        let cond' = cond game'
+		when cond' (writeTVar (state ^. game) (f game'))
+        return cond'
+
+
+-- | atomically change gamestate
+changeGamestate :: (GameState -> GameState) -> Pioneers ()
+changeGamestate = do
+                    --forget implied result - is True anyway
+                    _ <- changeIfGamestate (const True)
+                    return ()
+

src/UI/UIBase.hs

@@ -122,19 +122,19 @@ data EventHandler m =
         --  A widget becomes mouse-active if no other button is currently pressed and the mouse
         --  coordinates are within the widget's extent ('isInside') until no button is pressed any
         --  more.
-        _onMousePress :: MouseButton       -- ^the pressed button
+        _onMousePress :: MouseButton       -- the pressed button
-                      -> Pixel             -- ^screen position
+                      -> Pixel             -- screen position
-                      -> GUIWidget m       -- ^widget the event is invoked on
+                      -> GUIWidget m       -- widget the event is invoked on
-                      -> m (GUIWidget m)   -- ^widget after the event and the possibly altered mouse handler
+                      -> m (GUIWidget m)   -- widget after the event and the possibly altered mouse handler
         ,
         -- |The function 'onMouseReleased' is called when a button is released
         --  while the widget is mouse-active.
         --  
         --  Thus, the mouse is either within the widget or outside while still dragging.
-        _onMouseRelease :: MouseButton       -- ^the released button
+        _onMouseRelease :: MouseButton       -- the released button
-                        -> Pixel             -- ^screen position
+                        -> Pixel             -- screen position
-                        -> GUIWidget m       -- ^widget the event is invoked on
+                        -> GUIWidget m       -- widget the event is invoked on
-                        -> m (GUIWidget m)   -- ^widget after the event and the altered handler
+                        -> m (GUIWidget m)   -- widget after the event and the altered handler
         }
     |
     -- |Handler to control the functionality of a 'GUIWidget' on mouse movement. 
@@ -144,22 +144,22 @@ data EventHandler m =
         --  widget's extent ('isInside') while no button is pressed or when the mouse is inside the
         --  widget's extent while another button loses its mouse-active state. Triggered after
         --  '_onMouseEnter'.
-        _onMouseMove :: Pixel             -- ^screen position
+        _onMouseMove :: Pixel             -- screen position
-                     -> GUIWidget m       -- ^widget the event is invoked on
+                     -> GUIWidget m       -- widget the event is invoked on
-                     -> m (GUIWidget m)   -- ^widget after the event and the altered handler
+                     -> m (GUIWidget m)   -- widget after the event and the altered handler
         ,
         -- |The function 'onMouseMove' is invoked when the mouse enters the
         --  widget's extent ('isInside') or when the mouse is inside the
         --  widget's extent while another button loses its mouse-active state..
-        _onMouseEnter :: Pixel           -- ^screen position
+        _onMouseEnter :: Pixel           -- screen position
-                      -> GUIWidget m     -- ^widget the event is invoked on
+                      -> GUIWidget m     -- widget the event is invoked on
-                      -> m (GUIWidget m) -- ^widget after the event and the altered handler
+                      -> m (GUIWidget m) -- widget after the event and the altered handler
         ,
         -- |The function 'onMouseLeave' is invoked when the mouse leaves the
         --  widget's extent ('isInside') while no other widget is mouse-active.
-        _onMouseLeave :: Pixel           -- ^screen position
+        _onMouseLeave :: Pixel           -- screen position
-                      -> GUIWidget m     -- ^widget the event is invoked on
+                      -> GUIWidget m     -- widget the event is invoked on
-                      -> m (GUIWidget m) -- ^widget after the event and the altered handler
+                      -> m (GUIWidget m) -- widget after the event and the altered handler
         }
     deriving ()
 
@@ -196,7 +196,7 @@ data GUIBaseProperties m = BaseProperties
     --  The default implementations tests if the point is within the rectangle specified by the 
     --  'getBoundary' function.
     _isInside :: GUIWidget m
-              -> Pixel  -- ^local coordinates
+              -> Pixel  -- local coordinates
               -> m Bool
     ,
     -- |The @_getPriority@ function returns the priority score of a @GUIWidget@.