cam now moves with height.

- cam still has NaN-Issues

src/Main.hs

@@ -43,6 +43,7 @@ import           Render.Render                        (initRendering,
 import           Render.Types
 import           UI.Callbacks
 import           Map.Graphics
+import           Map.Creation                          (exportedMap)
 import           Types
 import           Importer.IQM.Parser
 --import           Data.Attoparsec.Char8 (parseTest)
@@ -53,7 +54,7 @@ import           Importer.IQM.Parser
 --------------------------------------------------------------------------------
 
 testParser :: String -> IO ()
-testParser a = putStrLn . show  =<< parseIQM a
+testParser a = print  =<< parseIQM a
 {-do
         f <- B.readFile a
         putStrLn "reading in:"
@@ -85,7 +86,8 @@ main =
         (SDL.Size fbWidth fbHeight) <- SDL.glGetDrawableSize window'
         initRendering
         --generate map vertices
-        glMap' <- initMapShader 4 =<< getMapBufferObject
+        curMap <- exportedMap
+        glMap' <- initMapShader 4 =<< getMapBufferObject curMap
         eventQueue <- newTQueueIO :: IO (TQueue SDL.Event)
         now <- getCurrentTime
         --font <- TTF.openFont "fonts/ttf-04B_03B_/04B_03B_.TTF" 10
@@ -125,7 +127,7 @@ main =
                         , _yAngle              = pi/2
                         , _zDist               = 10
                         , _frustum             = frust
-                        , _camObject           = createFlatCam 25 25
+                        , _camObject           = createFlatCam 25 25 curMap
                         }
               , _io                  = IOState
                         { _clock               = now
@@ -153,7 +155,7 @@ main =
                         , _glFramebuffer       = frameBuffer
                         }
               , _game                = GameState
-                        {
+                        { _currentMap          = curMap
                         }
               , _ui                  = UIState
                         { _uiHasChanged        = True
@@ -216,7 +218,7 @@ run = do
                      - 0.2 * kyrot * mults
         mody y' = y' + 0.2 * kxrot * mults
                      - 0.2 * kyrot * multc
-    modify $ camera.camObject %~ (\c -> moveBy c (\(x,y) -> (modx x,mody y)))
+    modify $ camera.camObject %~ (\c -> moveBy c (\(x,y) -> (modx x,mody y)) (state ^. game.currentMap))
 
     {-
     --modify the state with all that happened in mt time.

src/Map/Graphics.hs

@@ -85,9 +85,8 @@ fgNormalIndex = (ToFloat, mapVertexArrayDescriptor 3 4) --normal after color
 fgVertexIndex :: (IntegerHandling, VertexArrayDescriptor GLfloat)
 fgVertexIndex = (ToFloat, mapVertexArrayDescriptor 3 7) --vertex after normal
 
-getMapBufferObject :: IO (BufferObject, NumArrayIndices)
+getMapBufferObject :: PlayMap -> IO (BufferObject, NumArrayIndices)
-getMapBufferObject = do
+getMapBufferObject eMap = do
-        eMap    <- exportedMap
         myMap'  <- return $ convertToGraphicsMap $ convertToStripeMap eMap
         ! myMap <- return $ generateTriangles myMap'
         len <- return $ fromIntegral $ P.length myMap `div` numComponents

src/Map/Types.hs

@@ -1,8 +1,6 @@
 module Map.Types
 where
 
-import Types
-
 import Data.Array
 
 type PlayMap = Array (Xindex, Zindex) Node 
@@ -71,3 +69,64 @@ data TileType   = Ocean
 -- TODO: Record Syntax?
 data Node = Node (Xindex, Zindex) (XCoord, ZCoord, YCoord) TileType BuildInfo PlayerInfo PathInfo ResInfo StorInfo
           deriving (Show)
+
+data Structure = Flag           -- Flag
+               | Woodcutter     -- Huts
+               | Forester
+               | Stonemason
+               | Fisher
+               | Hunter
+               | Barracks
+               | Guardhouse
+               | LookoutTower
+               | Well
+               | Sawmill        -- Houses
+               | Slaughterhouse
+               | Mill
+               | Bakery
+               | IronSmelter
+               | Metalworks
+               | Armory
+               | Mint
+               | Shipyard
+               | Brewery
+               | Storehouse
+               | Watchtower
+               | Catapult
+               | GoldMine       -- Mines
+               | IronMine
+               | GraniteMine
+               | CoalMine
+               | Farm           -- Castles
+               | PigFarm
+               | DonkeyBreeder
+               | Harbor
+               | Fortress
+               deriving (Show, Eq)
+
+data Amount    = Infinite   -- Neverending supply
+               | Finite Int -- Finite supply
+
+-- Extremely preliminary, expand when needed
+data Commodity = WoodPlank
+               | Sword
+               | Fish
+               deriving Eq
+
+data Resource  = Coal
+               | Iron
+               | Gold
+               | Granite
+               | Water
+               | Fishes
+               deriving (Show, Eq)
+
+instance Show Amount where
+    show (Infinite) = "inexhaustable supply"
+    show (Finite n) = show n ++ " left"
+
+instance Show Commodity where
+    show WoodPlank = "wooden plank"
+    show Sword     = "sword"
+    show Fish      = "fish"
+

src/Render/Render.hs

@@ -24,6 +24,7 @@ import           Render.Types
 import           Graphics.GLUtil.BufferObjects              (makeBuffer)
 import		 Importer.IQM.Parser
 import           Importer.IQM.Types
+import           Map.Map                               (giveMapHeight)
 
 mapVertexShaderFile :: String
 mapVertexShaderFile = "shaders/map/vertex.shader"

src/Render/Types.hs

@@ -4,6 +4,10 @@ module Render.Types (createFlatCam, createSphereCam, Camera, GLCamera(..)) where
 import Linear
 import Foreign.C (CFloat)
 import Render.Misc (lookAt)
+import Map.Map (giveMapHeight)
+import Map.Types (PlayMap)
+import GHC.Float
+import qualified Debug.Trace as D
 
 type Distance = Double
 type Pitch = Double
@@ -11,30 +15,32 @@ type Yaw = Double
 
 class GLCamera a where
   getCam :: a -> Distance -> Pitch -> Yaw -> M44 CFloat
-  moveBy :: a -> (Position -> Position) -> a
+  moveBy :: a -> (Position -> Position) -> PlayMap -> a
-  move   :: a -> Position -> a
+  move   :: a -> Position -> PlayMap -> a
 
 type Position = (Double, Double)
 
 type Radius = Double
 
-data Camera = Flat Position
+type Height = Double
+
+data Camera = Flat Position Height
             | Sphere Position Radius
 
 -- | create a Flatcam-Camera starting at given x/z-Coordinates
-createFlatCam :: Double -> Double -> Camera
+createFlatCam :: Double -> Double -> PlayMap -> Camera
-createFlatCam x z = Flat (x,z)
+createFlatCam x z map' = Flat (x,z) (float2Double $ giveMapHeight map' (double2Float x,double2Float z))
 
 -- | create a Flatcam-Camera starting at given pitch/azimuth/radius
 createSphereCam :: Double -> Double -> Double -> Camera
-createSphereCam p a r = Sphere (p,a) r
+createSphereCam p a = Sphere (p,a)
 
 
 instance GLCamera Camera where
-  getCam (Flat (x',z')) dist' xa' ya' =
+  getCam (Flat (x',z') y') dist' xa' ya' =
         lookAt (cpos ^+^ at') at' up
                      where
-                        at'   = V3 x 0 z
+                        at'   = V3 x y z
                         cpos  = crot !* (V3 0 0 (-dist))
                         crot  = (
                                 (fromQuaternion $ axisAngle upmap (xa::CFloat))
@@ -44,6 +50,7 @@ instance GLCamera Camera where
                         upmap = ((fromQuaternion $ axisAngle (V3 0 1 0) (ya::CFloat)) :: M33 CFloat)
                                 !* (V3 1 0 0)
                         x     = realToFrac x'
+                        y     = realToFrac y'
                         z     = realToFrac z'
                         dist  = realToFrac dist'
                         xa    = realToFrac xa'
@@ -68,12 +75,16 @@ instance GLCamera Camera where
                         dist  = realToFrac dist'
                         xa    = realToFrac xa'
                         ya    = realToFrac ya'
-  moveBy (Sphere (inc, az) r) f = undefined
+  moveBy (Sphere (inc, az) r) f map = undefined
-  moveBy (Flat (x', z')) f = Flat (f (x',z'))
+  moveBy (Flat (x', z') y) f map = Flat (x,z) (float2Double y)
-  move c (x', z') = moveBy c (\(x,z) -> (x+x',z+z'))
+				where
+					(x,z) = f (x', z')
+					y = giveMapHeight map (fc x,fc z)
+					fc = double2Float
+  move c (x', z') map = moveBy c (\(x,z) -> (x+x',z+z')) map
 
 sphereToCart :: (Floating a) => a -> a -> a -> V3 a
 sphereToCart r inc az = V3
                                    (r * (sin inc) * (cos az))
                                    (r * (sin inc) * (sin az))
-                                   (r * (cos inc))
+                                   (r * (cos inc))

src/Types.hs

@@ -15,6 +15,7 @@ import Graphics.Rendering.OpenGL.GL.Texturing.Objects (TextureObject)
 import Render.Types
 import Importer.IQM.Types
 import UI.UIBase
+import Map.Types (PlayMap)
 
 data Coord3D a = Coord3D a a a
 
@@ -56,7 +57,7 @@ data IOState = IOState
     }
 
 data GameState = GameState
-    {
+    { _currentMap          :: !PlayMap
     }
 
 data MouseState = MouseState
@@ -186,63 +187,3 @@ $(makeLenses ''Position)
 $(makeLenses ''Env)
 $(makeLenses ''UIState)
 
-data Structure = Flag           -- Flag
-               | Woodcutter     -- Huts
-               | Forester
-               | Stonemason
-               | Fisher
-               | Hunter
-               | Barracks
-               | Guardhouse
-               | LookoutTower
-               | Well
-               | Sawmill        -- Houses
-               | Slaughterhouse
-               | Mill
-               | Bakery
-               | IronSmelter
-               | Metalworks
-               | Armory
-               | Mint
-               | Shipyard
-               | Brewery
-               | Storehouse
-               | Watchtower
-               | Catapult
-               | GoldMine       -- Mines
-               | IronMine
-               | GraniteMine
-               | CoalMine
-               | Farm           -- Castles
-               | PigFarm
-               | DonkeyBreeder
-               | Harbor
-               | Fortress
-               deriving (Show, Eq)
-
-data Amount    = Infinite   -- Neverending supply
-               | Finite Int -- Finite supply
-
--- Extremely preliminary, expand when needed
-data Commodity = WoodPlank
-               | Sword
-               | Fish
-               deriving Eq
-
-data Resource  = Coal
-               | Iron
-               | Gold
-               | Granite
-               | Water
-               | Fishes
-               deriving (Show, Eq)
-
-instance Show Amount where
-    show (Infinite) = "inexhaustable supply"
-    show (Finite n) = show n ++ " left"
-
-instance Show Commodity where
-    show WoodPlank = "wooden plank"
-    show Sword     = "sword"
-    show Fish      = "fish"
-