fixed map

- map is now displayed correctly
- camera is adjusted
- created ProgramState as TVar for concurrent reading/writing

Pioneers.cabal

@@ -15,7 +15,9 @@ executable Pioneers
                   containers >=0.5 && <0.6,
                   array >=0.4.0 && <0.5,
                   random >=1.0.1 && <1.1,
-                  random >=1.0.1 && <1.1
+                  random >=1.0.1 && <1.1,
+                  text >=0.11.3 && <0.12,
+                  stm >=2.4.2 && <2.5
   ghc-options:     -Wall
   other-modules:   
                    Map.Coordinates,

src/Main.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE BangPatterns #-}
 module Main where
 
 import qualified Graphics.UI.Gtk as Gtk
@@ -13,12 +14,32 @@ import Map.Map
 
 import Data.Maybe (fromMaybe)
 import Debug.Trace
+import Data.IntSet as IS
+import Data.IORef
+
+import Prelude as P
+import Control.Monad
+import Control.Concurrent
+import Control.Concurrent.STM
+
+data ProgramState = PS { keysPressed :: IntSet
+                       , px          :: GLfloat
+                       , py          :: GLfloat
+                       , pz          :: GLfloat
+                       , heading     :: GLfloat
+                       , pitch       :: GLfloat
+                       , dx          :: GLfloat
+                       , dz          :: GLfloat
+                       , dheading    :: GLfloat
+                       , dpitch      :: GLfloat }
 
 animationWaitTime = 3   :: Int
 canvasWidth = 640       :: Int
 canvasHeight = 480      :: Int
 
 
+-- TODO: Put render-stuff in render-module 
+
 glTexCoord2f (x,y) = texCoord (TexCoord2 x y :: TexCoord2 GLfloat)
 glVertex3f (x,y,z) = vertex (Vertex3 x y z :: Vertex3 GLfloat)
 glNormal3f (x,y,z) = normal (Normal3 x y z :: Normal3 GLfloat)
@@ -27,10 +48,10 @@ glNormal3f (x,y,z) = normal (Normal3 x y z :: Normal3 GLfloat)
 prepareRenderTile :: PlayMap -> ((Int,Int),MapEntry) -> (Vector3 GLfloat, Color3 GLfloat, [Vertex3 GLfloat])
 prepareRenderTile m (c@(cx,cz),(_,t)) = 
                         (
-                        if even cz then
+                        if even cx then
-                                Vector3 (3*(fromIntegral cx)) 0.0 ((fromIntegral cz))
+                                Vector3 (1.5*(fromIntegral cx)) 0.0 (2*(fromIntegral cz))
                         else
-                                Vector3 (3*(fromIntegral cx)+1.5) 0.0 ((fromIntegral cz))
+                                Vector3 (1.5*(fromIntegral cx)) 0.0 (2*(fromIntegral cz)-1)
                         ,
                         case t of
                                 Water -> Color3 0.5 0.5 1 :: Color3 GLfloat 
@@ -58,28 +79,30 @@ drawSphere = do
                 (Sphere 1.0 48 48)
                 
 -- OpenGL polygon-function for drawing stuff.
-display :: PlayMap -> IO ()
+display :: TVar ProgramState -> PlayMap -> IO ()
-display t =
+display state t =
   let 
-     tiles = map (prepareRenderTile t) (A.assocs t)
+     tiles = P.map (prepareRenderTile t) (A.assocs t)
   in
       do
-      loadIdentity
+        ps@PS { 
-      GL.rotate (60) (Vector3 1.0 0.0 0.0 :: Vector3 GLfloat)
+          px       = px
-      --GL.rotate (-20) (Vector3 0.0 1.0 0.0 :: Vector3 GLfloat)
+        , py       = py
-      translate (Vector3 (-15) (-10) (-15)::Vector3 GLfloat)
+        , pz       = pz
-      position (Light 0) $= Vertex4 0.0 0.0 (20.0) 1.0
+        , pitch    = pitch
+        , heading  = heading }
+                <- readTVarIO state
+        loadIdentity
+        GL.rotate pitch (Vector3 1.0 0.0 0.0 :: Vector3 GLfloat)
+        GL.rotate heading (Vector3 0.0 1.0 0.0 :: Vector3 GLfloat)
+        translate (Vector3 (-px) (-py) (-pz)::Vector3 GLfloat)
 
-      -- Instead of glBegin ... glEnd there is renderPrimitive.
+        position (Light 0) $= Vertex4 0.0 0.0 (20.0) 1.0
-      --trace (show tiles) $ 
+
-      mapM_ renderTile tiles
+        -- Instead of glBegin ... glEnd there is renderPrimitive.
-      return ()
+        --trace (show tiles) $ 
-      {- color (Color3 1 1 1 :: Color3 GLfloat)
+        mapM_ renderTile tiles
-      renderPrimitive LineLoop $ do
+        return ()
-        vertex (Vertex3 0.25 0.25 0.0 :: Vertex3 GLfloat)
-        vertex (Vertex3 0.75 0.25 0.0 :: Vertex3 GLfloat)
-        vertex (Vertex3 0.75 0.75 0.0 :: Vertex3 GLfloat)
-        vertex (Vertex3 0.25 0.75 0.0 :: Vertex3 GLfloat) -}
 
 --Adjust size to given dimensions
 reconfigure :: Int -> Int -> IO (Int, Int)
@@ -105,14 +128,26 @@ reshape dims = do
   let (w, h) = if width <= height
                 then (fromIntegral height, fromIntegral width )
                 else (fromIntegral width,  fromIntegral height)
-  perspective 60.0 (fromIntegral canvasWidth / fromIntegral canvasHeight) 1.0 20.0
+  -- open, aspect-ratio, near-plane, far-plane
+  perspective 60.0 (fromIntegral canvasWidth / fromIntegral canvasHeight) 1.0 100.0
   matrixMode $= Modelview 0
   loadIdentity
 
 main :: IO ()
 main = do
-  terrain <- testmap
+  ! terrain <- testmap
-  Gtk.initGUI
+  -- create TVar using unsafePerformIO -> currently no other thread -> OK
+  state <- newTVarIO $ PS {    keysPressed = IS.empty
+                             , px          = 7.5
+                             , py          = 20
+                             , pz          = 15
+                             , heading     = 0
+                             , pitch       = 60
+                             , dx          = 0
+                             , dz          = 0
+                             , dheading    = 0
+                             , dpitch      = 0}
+  trace (show terrain) Gtk.initGUI
   -- Initialise the Gtk+ OpenGL extension
   -- (including reading various command line parameters)
   GtkGL.initGL
@@ -166,7 +201,7 @@ main = do
   Gtk.onExpose canvas $ \_ -> do
     GtkGL.withGLDrawingArea canvas $ \glwindow -> do
       GL.clear [GL.DepthBuffer, GL.ColorBuffer]
-      display terrain
+      display state terrain
       GtkGL.glDrawableSwapBuffers glwindow
     return True
  

src/Map/Coordinates.hs

@@ -77,11 +77,11 @@ getTileVertices heights t = let p = (listArray (0,5) hexagon)
                                   ]
 
 getHeight :: PlayMap -> TileVertex -> Tile -> Float
-getHeight pm v t@(_,ty) =
+getHeight pm v t@(tx,_) =
         let 
                 h = heightLookup pm
                 ! tileheight = h t
-                ! y = if even ty then 1 else 0
+                ! y = if even tx then 0 else -1
         in
         case v of
                 VertexNW -> let
@@ -110,7 +110,7 @@ getHeight pm v t@(_,ty) =
                            in  (sw + nw + tileheight) / 3.0
 
 heightLookup :: PlayMap -> Tile -> Float
-heightLookup hs t@(x,y) = if inRange (bounds hs) t then h else 0
+heightLookup hs t = if inRange (bounds hs) t then h else 0
                 where 
                         (h,_) = hs ! t
 

src/Map/Map.hs

@@ -1,9 +1,12 @@
+{-# LANGUAGE OverloadedStrings #-}
 module Map.Map 
 
 where
 
 import System.Random
 import Data.Array.IArray
+import Data.Text as T 
+import Prelude as P
 
 data TileType =
         Grass
@@ -19,33 +22,36 @@ type MapEntry = (
 
 type PlayMap = Array (Int, Int) MapEntry
 
-testMapTemplate :: [[String]]
+-- if writing in ASCII-Format transpose so i,j -> y,x
-testMapTemplate = [
+-- row-minor -> row-major
-                ["~~~~~~~~~~"],
+testMapTemplate :: [Text]
-                ["~~SSSSSS~~"],
+testMapTemplate = T.transpose [
-                ["~SSGGGGS~~"],
+                "~~~~~~~~~~",
-                ["~SSGGMMS~~"],
+                "~~SSSSSS~~",
-                ["~SGGMMS~~~"],
+                "~SSGGGGS~~",
-                ["~SGMMMS~~~"],
+                "~SSGGMMS~~",
-                ["~GGGGGGS~~"],
+                "~SGGMMS~~~",
-                ["~SGGGGGS~~"],
+                "~SGMMMS~~~",
-                ["~~SSSS~~~~"],
+                "~GGGGGGS~~",
-                ["~~~~~~~~~~"]
+                "~SGGGGGS~~",
+                "~~SSSS~~~~",
+                "~~~~~~~~~~"
                 ]
 
 testmap :: IO PlayMap
 testmap = do
                 g <- getStdGen
-                rawMap <- return $ map (parseTemplate (randoms g)) (concat $ concat testMapTemplate)
+                rawMap <- return $ parseTemplate (randoms g) (T.concat testMapTemplate)
                 return $ listArray ((0,0),(9,9)) rawMap
 
 
-parseTemplate :: [Int] -> Char -> MapEntry
+parseTemplate :: [Int] -> Text -> [MapEntry]
-parseTemplate (r:_) t = 
+parseTemplate (r:rs) t = 
-        case t of
+        (case T.head t of
                 '~' -> (0, Water)
                 'S' -> (0, Sand)
-                'G' -> ((fromIntegral $ r `mod` 3)/3,Grass)
+                'G' -> (fromIntegral (r `mod` 3) / 3,Grass)
-                'M' -> ((fromIntegral $ r `mod` 3 + 2)/3, Mountain)
+                'M' -> (fromIntegral (r `mod` 3 + 2) / 3, Mountain)
                 _ -> error "invalid template format for map"
-parseTemplate [] _ = error "out of randoms..."
+         ):parseTemplate rs (T.tail t)
+parseTemplate [] _ = error "out of randoms.."