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

Merge branch 'master' into iqm

Browse Source 
Conflicts:
	src/Render/Types.hs
This commit is contained in:
Stefan Dresselhaus
2014-05-17 12:59:35 +02:00
parent da3a334121 35364b50aa
commit 481a386e0e
9 changed files with 117 additions and 120 deletions
Download Patch File Download Diff File Expand all files Collapse all files

13
src/Render/Render.hs
View File

@ -12,6 +12,8 @@ import qualified Linear as L
import Control.Lens ((^.))
import Control.Monad.RWS.Strict (liftIO)
import qualified Control.Monad.RWS.Strict as RWS (get)
import Control.Concurrent.STM.TVar (readTVarIO)
import Control.Concurrent.STM (atomically)
import Data.Distributive (distribute, collect)
-- FFI
import Foreign (Ptr, castPtr, with)
@ -384,11 +386,12 @@ drawMap = do
render :: Pioneers ()
render = do
state <- RWS.get
let xa = state ^. camera.xAngle
ya = state ^. camera.yAngle
frust = state ^. camera.Types.frustum
camPos = state ^. camera.camObject
zDist' = state ^. camera.zDist
cam <- liftIO $ readTVarIO (state ^. camera)
let xa = cam ^. xAngle
ya = cam ^. yAngle
frust = cam ^. Types.frustum
camPos = cam ^. camObject
zDist' = cam ^. zDist
d = state ^. gl.glMap.mapShaderData
(UniformLocation proj) = shdrProjMatIndex d
(UniformLocation nmat) = shdrNormalMatIndex d

9
src/Render/Types.hs
View File

@ -29,7 +29,7 @@ data Camera = Flat Position Height
-- | create a Flatcam-Camera starting at given x/z-Coordinates
createFlatCam :: Double -> Double -> PlayMap -> Camera
createFlatCam x z map' = Flat (x,z) (float2Double $ giveMapHeight map' (double2Float x,double2Float z))
createFlatCam x z map' = Flat (x,z) (giveMapHeight map' (x, z))
-- | create a Flatcam-Camera starting at given pitch/azimuth/radius
createSphereCam :: Double -> Double -> Double -> Camera
@ -40,7 +40,7 @@ instance GLCamera Camera where
getCam (Flat (x',z') y') dist' xa' ya' =
lookAt (cpos ^+^ at') at' up
where
at' = V3 x (y+1) z
at' = V3 x (y+2) z
cpos = crot !* (V3 0 0 (-dist))
crot = (
(fromQuaternion $ axisAngle upmap (xa::CFloat))
@ -76,11 +76,10 @@ instance GLCamera Camera where
xa = realToFrac xa'
ya = realToFrac ya'
moveBy (Sphere (inc, az) r) f map = undefined
moveBy (Flat (x', z') y) f map = Flat (x,z) (float2Double y)
moveBy (Flat (x', z') y) f map = Flat (x,z) y
where
(x,z) = f (x', z')
y = giveMapHeight map (fc x,fc z)
fc = double2Float
y = giveMapHeight map (x,z)
move c (x', z') map = moveBy c (\(x,z) -> (x+x',z+z')) map
sphereToCart :: (Floating a) => a -> a -> a -> V3 a