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

added primitive map-render

Browse Source 
- added primitive map-template
- window now renders correctly
- height-calculation is still a bit off
This commit is contained in:
Nicole Dresselhaus 2013-12-29 06:03:32 +01:00
parent 8bca5a82df
commit 65934809d5
4 changed files with 186 additions and 76 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
Pioneers.cabal
View File

@ -13,7 +13,11 @@ executable Pioneers
OpenGL >=2.8.0 && <2.9, OpenGL >=2.8.0 && <2.9,
gtkglext >=0.12, gtkglext >=0.12,
containers >=0.5 && <0.6, containers >=0.5 && <0.6,
array >=0.4.0 && <0.5 array >=0.4.0 && <0.5,
random >=1.0.1 && <1.1,
random >=1.0.1 && <1.1
ghc-options: -Wall ghc-options: -Wall
other-modules: Map.Coordinates other-modules:
Map.Coordinates,
Map.Map

89
src/Main.hs
View File

@ -6,26 +6,80 @@ import qualified Graphics.UI.Gtk.OpenGL as GtkGL
import Graphics.Rendering.OpenGL as GL import Graphics.Rendering.OpenGL as GL
import qualified Graphics.UI.Gtk.Gdk.Events as Event import qualified Graphics.UI.Gtk.Gdk.Events as Event
import qualified Data.Array.IArray as A
import Map.Coordinates import Map.Coordinates
import Map.Map
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import Debug.Trace
animationWaitTime = 3 animationWaitTime = 3 :: Int
canvasWidth = 640 canvasWidth = 640 :: Int
canvasHeight = 480 canvasHeight = 480 :: Int
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)
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))
else
Vector3 (3*(fromIntegral cx)+1.5) 0.0 ((fromIntegral cz))
,
case t of
Water -> Color3 0.5 0.5 1 :: Color3 GLfloat
Grass -> Color3 0.3 0.9 0.1 :: Color3 GLfloat
Sand -> Color3 0.9 0.85 0.7 :: Color3 GLfloat
Mountain -> Color3 0.5 0.5 0.5 :: Color3 GLfloat
,getTileVertices m c)
renderTile :: (Vector3 GLfloat, Color3 GLfloat, [Vertex3 GLfloat]) -> IO ()
renderTile (coord,c,ts) =
preservingMatrix $ do
color c
translate coord
_ <- renderPrimitive Polygon $ do
glNormal3f(0.0,0.0,1.0)
mapM vertex ts
return ()
drawSphere = do
renderQuadric (QuadricStyle
(Just Smooth)
GenerateTextureCoordinates
Outside
FillStyle)
(Sphere 1.0 48 48)
-- OpenGL polygon-function for drawing stuff. -- OpenGL polygon-function for drawing stuff.
display :: IO () display :: PlayMap -> IO ()
display = do display t =
loadIdentity let
-- Instead of glBegin ... glEnd there is renderPrimitive. tiles = map (prepareRenderTile t) (A.assocs t)
color (Color3 1 1 1 :: Color3 GLfloat) in
renderPrimitive Polygon $ do do
vertex (Vertex3 0.25 0.25 0.0 :: Vertex3 GLfloat) loadIdentity
vertex (Vertex3 0.75 0.25 0.0 :: Vertex3 GLfloat) GL.rotate (60) (Vector3 1.0 0.0 0.0 :: Vector3 GLfloat)
vertex (Vertex3 0.75 0.75 0.0 :: Vertex3 GLfloat) --GL.rotate (-20) (Vector3 0.0 1.0 0.0 :: Vector3 GLfloat)
vertex (Vertex3 0.25 0.75 0.0 :: Vertex3 GLfloat) translate (Vector3 (-15) (-10) (-15)::Vector3 GLfloat)
position (Light 0) $= Vertex4 0.0 0.0 (2.0) 1.0
-- 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) -}
--Adjust size to given dimensions --Adjust size to given dimensions
reconfigure :: Int -> Int -> IO (Int, Int) reconfigure :: Int -> Int -> IO (Int, Int)
@ -57,6 +111,7 @@ reshape dims = do
main :: IO () main :: IO ()
main = do main = do
terrain <- testmap
Gtk.initGUI Gtk.initGUI
-- Initialise the Gtk+ OpenGL extension -- Initialise the Gtk+ OpenGL extension
-- (including reading various command line parameters) -- (including reading various command line parameters)
@ -77,18 +132,20 @@ main = do
-- (We can't initialise these things earlier since the GL resources that -- (We can't initialise these things earlier since the GL resources that
-- we are using wouldn't heve been setup yet) -- we are using wouldn't heve been setup yet)
Gtk.onRealize canvas $ GtkGL.withGLDrawingArea canvas $ \_ -> do Gtk.onRealize canvas $ GtkGL.withGLDrawingArea canvas $ \_ -> do
clearColor $= (Color4 0.0 0.0 0.0 0.0) reconfigure canvasWidth canvasHeight
return ()
{-clearColor $= (Color4 0.0 0.0 0.0 0.0)
matrixMode $= Projection matrixMode $= Projection
loadIdentity loadIdentity
ortho 0.0 1.0 0.0 1.0 (-1.0) 1.0 ortho 0.0 1.0 0.0 1.0 (-1.0) 1.0
depthFunc $= Just Less depthFunc $= Just Less
drawBuffer $= BackBuffers drawBuffer $= BackBuffers-}
-- Set the repaint handler -- Set the repaint handler
Gtk.onExpose canvas $ \_ -> do Gtk.onExpose canvas $ \_ -> do
GtkGL.withGLDrawingArea canvas $ \glwindow -> do GtkGL.withGLDrawingArea canvas $ \glwindow -> do
GL.clear [GL.DepthBuffer, GL.ColorBuffer] GL.clear [GL.DepthBuffer, GL.ColorBuffer]
display display terrain
GtkGL.glDrawableSwapBuffers glwindow GtkGL.glDrawableSwapBuffers glwindow
return True return True

114
src/Map/Coordinates.hs
View File

@ -2,7 +2,10 @@
module Map.Coordinates module Map.Coordinates
--exports.. --exports..
(getTileVertices) (
getTileVertices,
Tile
)
where where
@ -12,16 +15,15 @@ import qualified Data.Map as M ((!))
import Data.Maybe import Data.Maybe
import Prelude as P import Prelude as P
import Data.Array.IArray as A import Data.Array.IArray as A
import Map.Map as PMap
import Debug.Trace
type Coordinates = (Int, Int)
type Coordinates = (Integer, Integer)
type Pos = (Float, Float) type Pos = (Float, Float)
-- | a Tile is 1 unit in size. Due to hexagonality the real rendered Area is less. -- | a Tile is 1 unit in size. Due to hexagonality the real rendered Area is less.
type Tile = Coordinates type Tile = Coordinates
-- | The heights of a Map in a random accessible way.
type MapHeights = Map Coordinates Int
instance Num Tile where instance Num Tile where
(i,j) + (x,y) = (i+x, j+y) (i,j) + (x,y) = (i+x, j+y)
@ -30,7 +32,7 @@ instance Num Tile where
negate (x,y) = (negate x, negate y) negate (x,y) = (negate x, negate y)
abs (x,y) = (abs x, abs y) abs (x,y) = (abs x, abs y)
signum (_,_) = undefined signum (_,_) = undefined
fromInteger a = (a,a) fromInteger a = (fromIntegral a,fromIntegral a)
instance Num Pos where instance Num Pos where
(i,j) + (x,y) = (i+x, j+y) (i,j) + (x,y) = (i+x, j+y)
@ -41,9 +43,6 @@ instance Num Pos where
signum (_,_) = undefined signum (_,_) = undefined
fromInteger a = (fromIntegral a, fromIntegral a) fromInteger a = (fromIntegral a, fromIntegral a)
tileToPos :: Tile -> Pos
tileToPos (x,y) = (fromIntegral x, fromIntegral y)
data Neighbours = data Neighbours =
North North
| South | South
@ -63,67 +62,66 @@ data TileVertex =
| VertexW | VertexW
deriving (Show, Eq, Ord) deriving (Show, Eq, Ord)
--getGrid :: Coordinates -> Coordinates -> []
getTileVertices :: MapHeights -> Tile -> [Vertex3 GLfloat] getTileVertices :: PlayMap -> Tile -> [Vertex3 GLfloat]
getTileVertices heights t = let p = (listArray (0,5) $ P.map (+ tileToPos t) hexagon)::Array Int (Float,Float) in getTileVertices heights t = let p = (listArray (0,5) hexagon)
P.map floatToVertex $ ::Array Int (Float,Float) in
P.map floatToVertex $
[ [
(fst $ p ! 0, snd $ p ! 0,fromMaybe 0.0 $ getHeight heights VertexNW t), (fst $ p ! 0, getHeight heights VertexNW t, snd $ p ! 0),
(fst $ p ! 1, snd $ p ! 1,fromMaybe 0.0 $ getHeight heights VertexNW t), (fst $ p ! 1, getHeight heights VertexNE t, snd $ p ! 1),
(fst $ p ! 2, snd $ p ! 2,fromMaybe 0.0 $ getHeight heights VertexNW t), (fst $ p ! 2, getHeight heights VertexE t, snd $ p ! 2),
(fst $ p ! 3, snd $ p ! 3,fromMaybe 0.0 $ getHeight heights VertexNW t), (fst $ p ! 3, getHeight heights VertexSE t, snd $ p ! 3),
(fst $ p ! 4, snd $ p ! 4,fromMaybe 0.0 $ getHeight heights VertexNW t), (fst $ p ! 4, getHeight heights VertexSW t, snd $ p ! 4),
(fst $ p ! 5, snd $ p ! 5,fromMaybe 0.0 $ getHeight heights VertexNW t) (fst $ p ! 5, getHeight heights VertexW t, snd $ p ! 5)
] ]
getHeight :: MapHeights -> TileVertex -> Tile -> Maybe Float getHeight :: PlayMap -> TileVertex -> Tile -> Float
getHeight h v t@(_,ty) = getHeight pm v t@(_,ty) =
let let
! tileheight = fmap fromIntegral $ M.lookup t h h = heightLookup pm
! y = if even ty then -1 else 0 ! tileheight = h t
! y = if even ty then 1 else 0
in in
case v of case v of
VertexNW -> do VertexNW -> let
c <- tileheight n = h (t+(0,-1))
n <- M.lookup (t+(0,-1)) h nw = h (t+(-1,y))
nw <- M.lookup (t+(-1,y)) h in (n + nw + tileheight) / 3.0
return $ (fromIntegral $ n+nw+c) / 3.0 VertexNE -> let
VertexNE -> do n = h (t+(0,-1))
c <- tileheight ne = h (t+(1,y))
n <- M.lookup (t+(0,-1)) h in (n + ne + tileheight) / 3.0
ne <- M.lookup (t+(1,y)) h VertexE -> let
return $ (fromIntegral $ n+ne+c) / 3.0 ne = h (t+(1,y))
VertexE -> do se = h (t+(1,y+1))
c <- tileheight in (ne + se + tileheight) / 3.0
ne <- M.lookup (t+(1,y)) h VertexSE -> let
se <- M.lookup (t+(1,y+1)) h s = h (t+(0,1))
return $ (fromIntegral $ ne+se+c) / 3.0 se = h (t+(1,y+1))
VertexSE -> do in (s + se + tileheight) / 3.0
c <- tileheight VertexSW -> let
s <- M.lookup (t+(0,1)) h s = h (t+(0,1))
se <- M.lookup (t+(1,y+1)) h sw = h (t+(-1,y+1))
return $ (fromIntegral $ s+se+c) / 3.0 in (s + sw + tileheight) / 3.0
VertexSW -> do VertexW -> let
c <- tileheight sw = h (t+(-1,y+1))
s <- M.lookup (t+(0,1)) h nw = h(t+(-1,y))
sw <- M.lookup (t+(-1,y+1)) h in (sw + nw + tileheight) / 3.0
return $ (fromIntegral $ s+sw+c) / 3.0
VertexW -> do
c <- tileheight
sw <- M.lookup (t+(-1,y+1)) h
nw <- M.lookup (t+(-1,y)) h
return $ (fromIntegral $ sw+nw+c) / 3.0
heightLookup :: PlayMap -> Tile -> Float
heightLookup hs t@(x,y) = if inRange (bounds hs) t then h else 0
where
(h,_) = hs ! t
hexagon :: [(Float,Float)] hexagon :: [(Float,Float)]
hexagon = [ hexagon = [
(0.2,0), (-0.5,-1),
(0.6,0), (0.5,-1),
(1,0),
(0.5,1), (0.5,1),
(1,0.6), (-0.5,1),
(1,0.2), (-1,0)
(0.5,0)
] ]

51
src/Map/Map.hs Normal file
View File

@ -0,0 +1,51 @@
module Map.Map
where
import System.Random
import Data.Array.IArray
data TileType =
Grass
| Sand
| Water
| Mountain
deriving (Show, Eq)
type MapEntry = (
Float, -- ^ Height
TileType
)
type PlayMap = Array (Int, Int) MapEntry
testMapTemplate :: [[String]]
testMapTemplate = [
["~~~~~~~~~~"],
["~~SSSSSS~~"],
["~SSGGGGS~~"],
["~SSGGMMS~~"],
["~SGGMMS~~~"],
["~SGMMMS~~~"],
["~GGGGGGS~~"],
["~SGGGGGS~~"],
["~~SSSS~~~~"],
["~~~~~~~~~~"]
]
testmap :: IO PlayMap
testmap = do
g <- getStdGen
rawMap <- return $ map (parseTemplate (randoms g)) (concat $ concat testMapTemplate)
return $ listArray ((0,0),(9,9)) rawMap
parseTemplate :: [Int] -> Char -> MapEntry
parseTemplate (r:_) t =
case t of
'~' -> (0, Water)
'S' -> (0, Sand)
'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..."