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:
Stefan Dresselhaus
2013-12-29 06:03:32 +01:00
parent 8bca5a82df
commit 65934809d5
4 changed files with 186 additions and 76 deletions
Download Patch File Download Diff File Expand all files Collapse all files

114
src/Map/Coordinates.hs
View File

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