Drezil/pioneers
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Merge branch 'tessallation' into iqm

Browse Source
This commit is contained in:
Nicole Dresselhaus 2014-05-19 19:59:43 +02:00
commit 3dc26c45eb
4 changed files with 60 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/Render/Render.hs
View File

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

28
src/Render/Types.hs
View File

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

25
src/Types.hs
View File

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

36
src/UI/UIBase.hs
View File

@ -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
-> Pixel -- ^screen position
-> GUIWidget m -- ^widget the event is invoked on
-> m (GUIWidget m) -- ^widget after the event and the possibly altered mouse handler
_onMousePress :: MouseButton -- the pressed button
-> Pixel -- screen position
-> GUIWidget m -- widget the event is invoked on
-> 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
-> Pixel -- ^screen position
-> GUIWidget m -- ^widget the event is invoked on
-> m (GUIWidget m) -- ^widget after the event and the altered handler
_onMouseRelease :: MouseButton -- the released button
-> Pixel -- screen position
-> GUIWidget m -- widget the event is invoked on
-> 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
-> GUIWidget m -- ^widget the event is invoked on
-> m (GUIWidget m) -- ^widget after the event and the altered handler
_onMouseMove :: Pixel -- screen position
-> GUIWidget m -- widget the event is invoked on
-> 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
-> GUIWidget m -- ^widget the event is invoked on
-> m (GUIWidget m) -- ^widget after the event and the altered handler
_onMouseEnter :: Pixel -- screen position
-> GUIWidget m -- widget the event is invoked on
-> 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
-> GUIWidget m -- ^widget the event is invoked on
-> m (GUIWidget m) -- ^widget after the event and the altered handler
_onMouseLeave :: Pixel -- screen position
-> GUIWidget m -- widget the event is invoked on
-> 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@.