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

fixed map

Browse Source 
- map is now displayed correctly
- camera is adjusted
- created ProgramState as TVar for concurrent reading/writing
This commit is contained in:
Nicole Dresselhaus 2013-12-29 14:39:01 +01:00
parent 14ce8c5986
commit 55a873022b
4 changed files with 91 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
Pioneers.cabal
View File

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

85
src/Main.hs
View File

@ -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
Vector3 (3*(fromIntegral cx)) 0.0 ((fromIntegral cz))
if even cx then
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 t =
display :: TVar ProgramState -> PlayMap -> IO ()
display state t =
let
tiles = map (prepareRenderTile t) (A.assocs t)
tiles = P.map (prepareRenderTile t) (A.assocs t)
in
do
loadIdentity
GL.rotate (60) (Vector3 1.0 0.0 0.0 :: Vector3 GLfloat)
--GL.rotate (-20) (Vector3 0.0 1.0 0.0 :: Vector3 GLfloat)
translate (Vector3 (-15) (-10) (-15)::Vector3 GLfloat)
position (Light 0) $= Vertex4 0.0 0.0 (20.0) 1.0
ps@PS {
px = px
, py = py
, pz = pz
, 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.
--trace (show tiles) $
mapM_ renderTile tiles
return ()
{- color (Color3 1 1 1 :: Color3 GLfloat)
renderPrimitive LineLoop $ do
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) -}
position (Light 0) $= Vertex4 0.0 0.0 (20.0) 1.0
-- Instead of glBegin ... glEnd there is renderPrimitive.
--trace (show tiles) $
mapM_ renderTile tiles
return ()
--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
Gtk.initGUI
! terrain <- testmap
-- 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

6
src/Map/Coordinates.hs
View File

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

44
src/Map/Map.hs
View File

@ -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]]
testMapTemplate = [
["~~~~~~~~~~"],
["~~SSSSSS~~"],
["~SSGGGGS~~"],
["~SSGGMMS~~"],
["~SGGMMS~~~"],
["~SGMMMS~~~"],
["~GGGGGGS~~"],
["~SGGGGGS~~"],
["~~SSSS~~~~"],
["~~~~~~~~~~"]
-- if writing in ASCII-Format transpose so i,j -> y,x
-- row-minor -> row-major
testMapTemplate :: [Text]
testMapTemplate = T.transpose [
"~~~~~~~~~~",
"~~SSSSSS~~",
"~SSGGGGS~~",
"~SSGGMMS~~",
"~SGGMMS~~~",
"~SGMMMS~~~",
"~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 (r:_) t =
case t of
parseTemplate :: [Int] -> Text -> [MapEntry]
parseTemplate (r:rs) t =
(case T.head t of
'~' -> (0, Water)
'S' -> (0, Sand)
'G' -> ((fromIntegral $ r `mod` 3)/3,Grass)
'M' -> ((fromIntegral $ r `mod` 3 + 2)/3, Mountain)
'G' -> (fromIntegral (r `mod` 3) / 3,Grass)
'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.."