Added stripify, TestMap now looking like it should (still not pretty, though), cleanup, docs
This commit is contained in:
parent
8d9cc3384d
commit
5d36bb5156
@ -12,7 +12,6 @@ getMapBufferObject
|
|||||||
where
|
where
|
||||||
|
|
||||||
import Data.Array.IArray
|
import Data.Array.IArray
|
||||||
import Data.Text as T
|
|
||||||
import Prelude as P
|
import Prelude as P
|
||||||
|
|
||||||
--import Graphics.Rendering.OpenGL.GL
|
--import Graphics.Rendering.OpenGL.GL
|
||||||
@ -40,6 +39,19 @@ type MapEntry = (
|
|||||||
)
|
)
|
||||||
type GraphicsMap = Array (Int, Int) MapEntry
|
type GraphicsMap = Array (Int, Int) MapEntry
|
||||||
|
|
||||||
|
-- converts from classical x/z to striped version of a map
|
||||||
|
convertToStripeMap :: PlayMap -> PlayMap
|
||||||
|
convertToStripeMap mp = array (stripify l, stripify u) (map (\(i,e) -> (stripify i,strp e)) (assocs mp))
|
||||||
|
where
|
||||||
|
(l,u) = bounds mp
|
||||||
|
|
||||||
|
stripify :: (Int,Int) -> (Int,Int)
|
||||||
|
stripify (x,z) = (if even z then 2*x else 2*x+1, z `div` 2)
|
||||||
|
|
||||||
|
strp :: Node -> Node
|
||||||
|
strp (Full xz y tt bi pli p ri si) = Full (stripify xz) y tt bi pli p ri si
|
||||||
|
strp (Minimal xz ) = Minimal (stripify xz)
|
||||||
|
|
||||||
-- extract graphics information from Playmap
|
-- extract graphics information from Playmap
|
||||||
convertToGraphicsMap :: PlayMap -> GraphicsMap
|
convertToGraphicsMap :: PlayMap -> GraphicsMap
|
||||||
convertToGraphicsMap mp = array (bounds mp) [(i, graphicsyfy (mp ! i))| i <- indices mp]
|
convertToGraphicsMap mp = array (bounds mp) [(i, graphicsyfy (mp ! i))| i <- indices mp]
|
||||||
@ -76,7 +88,7 @@ fgVertexIndex = (ToFloat, mapVertexArrayDescriptor 3 7) --vertex after normal
|
|||||||
|
|
||||||
getMapBufferObject :: IO (BufferObject, NumArrayIndices)
|
getMapBufferObject :: IO (BufferObject, NumArrayIndices)
|
||||||
getMapBufferObject = do
|
getMapBufferObject = do
|
||||||
myMap' <- return $ convertToGraphicsMap mapCenterMountain
|
myMap' <- return $ convertToGraphicsMap $ convertToStripeMap mapCenterMountain
|
||||||
! myMap <- return $ generateTriangles myMap'
|
! myMap <- return $ generateTriangles myMap'
|
||||||
len <- return $ fromIntegral $ P.length myMap `div` numComponents
|
len <- return $ fromIntegral $ P.length myMap `div` numComponents
|
||||||
putStrLn $ P.unwords ["num verts in map:",show len]
|
putStrLn $ P.unwords ["num verts in map:",show len]
|
||||||
|
@ -1,5 +1,4 @@
|
|||||||
module Map.Maps
|
module Map.Map where
|
||||||
where
|
|
||||||
|
|
||||||
import Map.Types
|
import Map.Types
|
||||||
|
|
@ -4,20 +4,24 @@ where
|
|||||||
import Map.Types
|
import Map.Types
|
||||||
import Data.Array
|
import Data.Array
|
||||||
|
|
||||||
-- general 2D-Gaussian
|
-- general 3D-Gaussian
|
||||||
gauss2Dgeneral :: Floating q =>
|
gauss3Dgeneral :: Floating q =>
|
||||||
q -- ^ Amplitude
|
q -- ^ Amplitude
|
||||||
-> q -- ^ Origin on X-Achsis
|
-> q -- ^ Origin on X-Achsis
|
||||||
-> q -- ^ Origin on Y-Achsis
|
-> q -- ^ Origin on Z-Achsis
|
||||||
-> q -- ^ Sigma on X
|
-> q -- ^ Sigma on X
|
||||||
-> q -- ^ Sigma on Y
|
-> q -- ^ Sigma on Z
|
||||||
-> q -- ^ Coordinate in question on X
|
-> q -- ^ Coordinate in question on X
|
||||||
-> q -- ^ Coordinate in question on Y
|
-> q -- ^ Coordinate in question on Z
|
||||||
-> q -- ^ elevation on coordinate in question
|
-> q -- ^ elevation on coordinate in question
|
||||||
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)))))
|
gauss3Dgeneral amp x0 z0 sX sZ x z = amp * exp(-(((x-x0)^(2 :: Integer)/(2 * sX^(2 :: Integer)))+((z-z0)^(2 :: Integer)/(2 * sZ^(2 :: Integer)))))
|
||||||
|
|
||||||
gauss2D :: Floating q => q -> q -> q
|
-- specialised 3D gaussian with an origin on 100/100, an amplitude of 15 and two sigmas of 15
|
||||||
gauss2D x y = gauss2Dgeneral 15 100.0 100.0 15.0 15.0 x y
|
gauss3D :: Floating q =>
|
||||||
|
q -- ^ X-Coordinate
|
||||||
|
-> q -- ^ Z-Coordinate
|
||||||
|
-> q -- ^ elevation on coordinate in quesion
|
||||||
|
gauss3D = gauss3Dgeneral 15 100.0 100.0 15.0 15.0
|
||||||
|
|
||||||
-- 2D Manhattan distance
|
-- 2D Manhattan distance
|
||||||
mnh2D :: (Int,Int) -> (Int,Int) -> Int
|
mnh2D :: (Int,Int) -> (Int,Int) -> Int
|
||||||
@ -25,22 +29,21 @@ mnh2D (a,b) (c,d) = abs (a-c) + abs (b-d)
|
|||||||
|
|
||||||
-- entirely empty map, only uses the minimal constructor
|
-- entirely empty map, only uses the minimal constructor
|
||||||
mapEmpty :: PlayMap
|
mapEmpty :: PlayMap
|
||||||
mapEmpty = array ((0,0), (200,200)) [((a,b), (Minimal (a,b))) | a <- [0..200], b <- [0..200]]
|
mapEmpty = array ((0,0), (199,199)) [((a,b), (Minimal (a,b))) | a <- [0..199], b <- [0..199]]
|
||||||
|
|
||||||
-- TODO: Stripify
|
-- TODO: Stripify
|
||||||
mapCenterMountain :: PlayMap
|
mapCenterMountain :: PlayMap
|
||||||
mapCenterMountain = array ((0,0),(200,200)) nodes
|
mapCenterMountain = array ((0,0),(199,199)) nodes
|
||||||
where
|
where
|
||||||
nodes = water ++ beach ++ grass ++ hill ++ mountain
|
nodes = water ++ beach ++ grass ++ hill ++ mountain
|
||||||
water = [((a,b), (Full (a,b) 0.0 Ocean BNothing NoPlayer NoPath Plain [])) | a <- [0..200], b <- [0..200], (m2d (a,b)) > 95]
|
water = [((a,b), (Full (a,b) 0.0 Ocean BNothing NoPlayer NoPath Plain [])) | a <- [0..199], b <- [0..199], (m2d (a,b)) > 95]
|
||||||
beach = [((a,b), (Full (a,b) (g2d a b) Beach BNothing NoPlayer NoPath Plain [])) | a <- [0..200], b <- [0..200], (m2d (a,b)) <= 95, (m2d (a,b)) > 75]
|
beach = [((a,b), (Full (a,b) (g2d a b) Beach BNothing NoPlayer NoPath Plain [])) | a <- [0..199], b <- [0..199], (m2d (a,b)) <= 95, (m2d (a,b)) > 75]
|
||||||
grass = [((a,b), (Full (a,b) (g2d a b) Grass BNothing NoPlayer NoPath Plain [])) | a <- [0..200], b <- [0..200], (m2d (a,b)) <= 75, (m2d (a,b)) > 25]
|
grass = [((a,b), (Full (a,b) (g2d a b) Grass BNothing NoPlayer NoPath Plain [])) | a <- [0..199], b <- [0..199], (m2d (a,b)) <= 75, (m2d (a,b)) > 25]
|
||||||
hill = [((a,b), (Full (a,b) (g2d a b) Hill BNothing NoPlayer NoPath Plain [])) | a <- [0..200], b <- [0..200], (m2d (a,b)) <= 25, (m2d (a,b)) > 10]
|
hill = [((a,b), (Full (a,b) (g2d a b) Hill BNothing NoPlayer NoPath Plain [])) | a <- [0..199], b <- [0..199], (m2d (a,b)) <= 25, (m2d (a,b)) > 10]
|
||||||
mountain = [((a,b), (Full (a,b) (g2d a b) Mountain BNothing NoPlayer NoPath Plain [])) | a <- [0..200], b <- [0..200], (m2d (a,b)) <= 10]
|
mountain = [((a,b), (Full (a,b) (g2d a b) Mountain BNothing NoPlayer NoPath Plain [])) | a <- [0..199], b <- [0..199], (m2d (a,b)) <= 10]
|
||||||
|
|
||||||
g2d :: Int -> Int -> Float
|
g2d :: Int -> Int -> Float
|
||||||
g2d x y = gauss2D (fromIntegral x) (fromIntegral y)
|
g2d x y = gauss3D (fromIntegral x) (fromIntegral y)
|
||||||
|
|
||||||
m2d :: (Int,Int) -> Int
|
m2d :: (Int,Int) -> Int
|
||||||
m2d (x,y) = mnh2D (x,y) (100,100)
|
m2d (x,y) = mnh2D (x,y) (100,100)
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user