Merge remote-tracking branch 'origin/Mapping' into tessallation
Conflicts: src/Map/Graphics.hs
This commit is contained in:
commit
89c624012f
@ -11,7 +11,6 @@ getMapBufferObject
|
||||
)
|
||||
where
|
||||
|
||||
import System.Random
|
||||
import Data.Array.IArray
|
||||
import Data.Text as T
|
||||
import Prelude as P
|
||||
@ -39,12 +38,11 @@ type MapEntry = (
|
||||
Height,
|
||||
TileType
|
||||
)
|
||||
|
||||
type GraphicsMap = Array (Int, Int) MapEntry
|
||||
|
||||
-- extract graphics information from Playmap
|
||||
convertToGraphicsMap :: PlayMap -> GraphicsMap
|
||||
convertToGraphicsMap map = array (bounds map) [(i, graphicsyfy (map!i))| i <- indices map]
|
||||
convertToGraphicsMap mp = array (bounds mp) [(i, graphicsyfy (mp ! i))| i <- indices mp]
|
||||
where
|
||||
graphicsyfy :: Node -> MapEntry
|
||||
graphicsyfy (Minimal _ ) = (0, Grass)
|
||||
@ -78,23 +76,19 @@ fgVertexIndex = (ToFloat, mapVertexArrayDescriptor 3 7) --vertex after normal
|
||||
|
||||
getMapBufferObject :: IO (BufferObject, NumArrayIndices)
|
||||
getMapBufferObject = do
|
||||
map' <- return $ convertToGraphicsMap mapCenterMountain
|
||||
! map' <- return $ generateTriangles map'
|
||||
len <- return $ fromIntegral $ P.length map' `div` numComponents
|
||||
myMap' <- return $ convertToGraphicsMap mapCenterMountain
|
||||
! myMap <- return $ generateTriangles myMap'
|
||||
len <- return $ fromIntegral $ P.length myMap `div` numComponents
|
||||
putStrLn $ P.unwords ["num verts in map:",show len]
|
||||
bo <- genObjectName -- create a new buffer
|
||||
bindBuffer ArrayBuffer $= Just bo -- bind buffer
|
||||
withArray map' $ \buffer ->
|
||||
bufferData ArrayBuffer $= (fromIntegral $ sizeOf (0 :: GLfloat)*P.length map',
|
||||
withArray myMap $ \buffer ->
|
||||
bufferData ArrayBuffer $= (fromIntegral $ sizeOf (0 :: GLfloat) * P.length myMap,
|
||||
buffer,
|
||||
StaticDraw)
|
||||
checkError "initBuffer"
|
||||
return (bo,len)
|
||||
|
||||
prettyMap :: [GLfloat] -> [(GLfloat,GLfloat,GLfloat,GLfloat,GLfloat,GLfloat,GLfloat,GLfloat,GLfloat,GLfloat)]
|
||||
prettyMap (a:b:c:d:x:y:z:u:v:w:ms) = (a,b,c,d,x,y,z,u,v,w):(prettyMap ms)
|
||||
prettyMap _ = []
|
||||
|
||||
--generateTriangles :: PlayMap -> [GLfloat]
|
||||
generateTriangles :: GraphicsMap -> [GLfloat]
|
||||
generateTriangles map' =
|
||||
@ -178,7 +172,7 @@ normalLookup map' x y = normalize $ normN + normNE + normSE + normS + normSW + n
|
||||
vW
|
||||
| even x = coordLookup (x-2,y ) $ heightLookup map' (x-2,y )
|
||||
| otherwise = coordLookup (x-2,y ) $ heightLookup map' (x-2,y )
|
||||
eo = if even x then 1 else -1
|
||||
-- eo = if even x then 1 else -1
|
||||
|
||||
heightLookup :: GraphicsMap -> (Int,Int) -> GLfloat
|
||||
heightLookup hs t = if inRange (bounds hs) t then fromRational $ toRational h else 0.0
|
||||
@ -204,66 +198,3 @@ coordLookup (x,z) y =
|
||||
V3 (fromIntegral $ x `div` 2) y (fromIntegral (2 * z) * lineHeight)
|
||||
else
|
||||
V3 (fromIntegral (x `div` 2) + 0.5) y (fromIntegral (2 * z + 1) * lineHeight)
|
||||
|
||||
|
||||
-- if writing in ASCII-Format transpose so i,j -> y,x
|
||||
-- row-minor -> row-major
|
||||
testMapTemplate :: [Text]
|
||||
testMapTemplate = repText 2 $ T.transpose [
|
||||
"~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~",
|
||||
"~~~SSSSSSSSSSSSSS~~~~~SSSSSSSSSSSSSS~~~~",
|
||||
"~~SSGGGGGGGSGSGGS~~~~SSGGGGGGGSGSGGS~~~~",
|
||||
"~~SSGGGGGGMSGSGGS~~~~SSGGGGGGMSGSGGS~~~~",
|
||||
"~~SGGGGGGMMMGGGS~~~S~SGGGGGGMMMGGGS~~~S~",
|
||||
"~~SGGGMGMMMMMGGS~~~SSSGGGMGMMMMMGGS~~~SS",
|
||||
"~~GGGGGGGGGGGGGGS~~~~GGGGGGGGGGGGGGS~~~~",
|
||||
"~~SGGGGGGGGGGGGGS~~~~SGGGGGGGGGGGGGS~~~~",
|
||||
"~~~SSSSGGGSSSSS~~~~~~~SSSSGGGSSSSS~~~~~~",
|
||||
"~~~~~~SGGGGS~~~~~~~~~~~~~SGGGGS~~~~~~~~~",
|
||||
"~~~~~SSGGGGSS~~~~~~~~~~~SSGGGGSS~~~~~~~~",
|
||||
"~~~SSSGGGGGGSSSSS~~~~~SSSGGGGGGSSSSS~~~~",
|
||||
"~~SSGSGSGGGSGSGGS~~~~SSGSGSGGGSGSGGS~~~~",
|
||||
"~~SSGSGSGGMSGSGMS~~~~SSGSGSGMMMMMSSS~~~~",
|
||||
"~~SGGMMMMGGGGGGS~~~~~SGGGGGGMMMMMSS~~~~~",
|
||||
"~~SGMMMMMGGGGSSS~~~~~SGGGGGGMMMMMSS~~~~~",
|
||||
"~~GGMMMMMGGGSSSSS~~~~GGGGGGGGGGSSSSS~~~~",
|
||||
"~~SGGGGGGGSSSSSSS~~~~SGGGGGGGSSSSSSS~~~~",
|
||||
"~~~SSSSSSSSSSSS~~~~~~~SSSSSSSSSSSS~~~~~~",
|
||||
"~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"
|
||||
]
|
||||
|
||||
repText :: Int -> [a] -> [a]
|
||||
repText a (t:[]) = P.replicate a t
|
||||
repText a ts = P.concat $ P.map (repText' a) ts
|
||||
where
|
||||
repText' :: Int -> a -> [a]
|
||||
repText' a x = repText a [x]
|
||||
|
||||
testMapTemplate2 :: [Text]
|
||||
testMapTemplate2 = T.transpose [
|
||||
"~~~~~~~~~~~~"
|
||||
]
|
||||
|
||||
testmap :: IO GraphicsMap
|
||||
testmap = do
|
||||
g <- getStdGen
|
||||
rawMap <- return $ parseTemplate (randoms g) (T.concat testMapTemplate)
|
||||
return $ listArray ((0,0),(79,19)) rawMap
|
||||
|
||||
testmap2 :: IO GraphicsMap
|
||||
testmap2 = do
|
||||
g <- getStdGen
|
||||
rawMap <- return $ parseTemplate (randoms g) (T.concat testMapTemplate2)
|
||||
return $ listArray ((0,0),(9,0)) rawMap
|
||||
|
||||
|
||||
parseTemplate :: [Int] -> Text -> [MapEntry]
|
||||
parseTemplate (r:rs) t =
|
||||
(case T.head t of
|
||||
'~' -> (0, Ocean)
|
||||
'S' -> (0, Beach)
|
||||
'G' -> (fromIntegral (r `mod` 10)/10.0,Grass)
|
||||
'M' -> (fromIntegral ((r `mod` 10) + 20)/10.0, Mountain)
|
||||
_ -> error "invalid template format for map"
|
||||
):parseTemplate rs (T.tail t)
|
||||
parseTemplate [] _ = error "out of randoms.."
|
||||
|
||||
@ -14,7 +14,7 @@ gauss2Dgeneral :: Floating q =>
|
||||
-> q -- ^ Coordinate in question on X
|
||||
-> q -- ^ Coordinate in question on Y
|
||||
-> q -- ^ elevation on coordinate in question
|
||||
gauss2Dgeneral amp x0 y0 sX sY x y = amp * exp(-(((x-x0)^2/(2 * sX^2))+((y-y0)^2/(2 * sY^2))))
|
||||
gauss2Dgeneral amp x0 y0 sX sY x y = amp * exp(-(((x-x0)^(2 :: Integer)/(2 * sX^(2 :: Integer)))+((y-y0)^(2 :: Integer)/(2 * sY^(2 :: Integer)))))
|
||||
|
||||
gauss2D :: Floating q => q -> q -> q
|
||||
gauss2D x y = gauss2Dgeneral 15 100.0 100.0 15.0 15.0 x y
|
||||
|
||||
Loading…
Reference in New Issue
Block a user