From eb3ee975e8f4d9f3d9476b83f8f850746e011b51 Mon Sep 17 00:00:00 2001 From: Jonas Betzendahl Date: Thu, 15 May 2014 12:01:30 +0200 Subject: [PATCH] =?UTF-8?q?Restructured=20Node=20constructors.=20Ripples?= =?UTF-8?q?=20are=20getting=20worse!=20(=E2=95=AF=C2=B0=E2=96=A1=C2=B0?= =?UTF-8?q?=EF=BC=89=E2=95=AF=EF=B8=B5=20=E2=94=BB=E2=94=81=E2=94=BB?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Pioneers.cabal | 1 - src/Map/Creation.hs | 28 ++++++++++++------------- src/Map/Graphics.hs | 6 ++---- src/Map/Map.hs | 5 +---- src/Map/StaticMaps.hs | 49 ------------------------------------------- src/Map/Types.hs | 13 ++++++------ 6 files changed, 24 insertions(+), 78 deletions(-) delete mode 100644 src/Map/StaticMaps.hs diff --git a/Pioneers.cabal b/Pioneers.cabal index fadfec1..bf7c426 100644 --- a/Pioneers.cabal +++ b/Pioneers.cabal @@ -16,7 +16,6 @@ executable Pioneers Map.Types, Map.Graphics, Map.Creation, - Map.StaticMaps, Importer.IQM.Types, Importer.IQM.Parser, Render.Misc, diff --git a/src/Map/Creation.hs b/src/Map/Creation.hs index 554cb6c..c2304f0 100644 --- a/src/Map/Creation.hs +++ b/src/Map/Creation.hs @@ -2,7 +2,6 @@ module Map.Creation where import Map.Types -import Map.StaticMaps -- import Map.Map unused (for now) import Data.Array @@ -18,6 +17,10 @@ infix 5 -<- (-<-) :: (PlayMap -> PlayMap) -> (PlayMap -> PlayMap) -> PlayMap -> PlayMap f -<- g = f . g +-- entirely empty map, only uses the minimal constructor +mapEmpty :: PlayMap +mapEmpty = array ((0,0), (199,199)) [((a,b), Node (a,b) (fromIntegral a, (if even b then (fromIntegral b) else(fromIntegral b) - 0.5), 1) Grass BNothing NoPlayer NoPath Plain []) | a <- [0..199], b <- [0..199]] + exportedMap :: IO PlayMap exportedMap = do mounts <- mnt return $ aplAll mounts mapEmpty @@ -52,7 +55,7 @@ gauss3Dgeneral :: Floating q => -> q -- ^ Coordinate in question on X -> q -- ^ Coordinate in question on Z -> q -- ^ elevation on coordinate in question -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))))) +gauss3Dgeneral amp x0 z0 sX sZ x z = amp * exp(-(((x-x0)^(2 :: Int)/(2 * sX^(2 :: Int)))+((z-z0)^(2 :: Int)/(2 * sZ^(2 :: Int))))) -- specialised 3D gaussian with an origin on 100/100, an amplitude of 15 and two sigmas of 15 gauss3D :: Floating q => @@ -71,8 +74,8 @@ mnh2D (a,b) (c,d) = abs (a-c) + abs (b-d) -- TODO: Implement Desert-Generator heightToTerrain :: MapType -> YCoord -> TileType heightToTerrain GrassIslandMap y - | y < 0.1 = Ocean - | y < 1 = Beach + | y < 0.1 = Ocean + | y < 1 = Beach | y < 5 = Grass | y < 10 = Hill | otherwise = Mountain @@ -93,20 +96,17 @@ mnt = do g <- newStdGen gaussMountain :: Int -> PlayMap -> PlayMap gaussMountain seed mp = aplByPlace (liftUp c) (\(_,_) -> True) mp where - g = mkStdGen seed - c = let ((a,b), (x,y)) = bounds mp in (head (randomRs (a,x) g), (head (randomRs (b,y) g))) - amp = head $ randomRs (5.0, 20.0) g - sig = head $ randomRs (5.0, 25.0) g - fi = fromIntegral + gs = map mkStdGen (map (*seed) [1..]) + c = let ((a,b), (x,y)) = bounds mp in (head (randomRs (a,x) (gs !! 0)), (head (randomRs (b,y) (gs !! 1)))) + amp = head $ randomRs ((5.0, 20.0) :: (Float, Float)) (gs !! 2) + sig = head $ randomRs ((5.0, 25.0) :: (Float, Float)) (gs !! 3) htt = heightToTerrain -- TODO: Fix Lambda to True with sensible function, maybe rework giveNeighbourhood in Map.Map liftUp :: (Int, Int) -> Node -> Node - liftUp (gx,gz) (Full (x,z) y _ b pl pa r s) = let y_neu = max y e - in Full (x,z) y_neu (htt GrassIslandMap y_neu) b pl pa r s - where e = gauss3Dgeneral amp (fi gx) (fi gz) sig sig (fi x) (fi z) - liftUp (gx, gz) (Minimal (x,z)) = Full (x,z) e (htt GrassIslandMap e) BFlag NoPlayer NoPath Plain [] - where e = gauss3Dgeneral amp (fi gx) (fi gz) sig sig (fi x) (fi z) + liftUp (gx,gz) (Node (x,z) (rx,rz,y) _ b pl pa r s) = let y_neu = max y e + in Node (x,z) (rx, rz, y_neu) (htt GrassIslandMap y_neu) b pl pa r s + where e = gauss3Dgeneral amp (fromIntegral gx) (fromIntegral gz) sig sig rx rz -- | Makes sure the edges of the Map are mountain-free makeIsland :: PlayMap -> PlayMap diff --git a/src/Map/Graphics.hs b/src/Map/Graphics.hs index 858b1f4..a99348b 100644 --- a/src/Map/Graphics.hs +++ b/src/Map/Graphics.hs @@ -50,16 +50,14 @@ 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) +strp (Node i (x,z,y) tt bi pli p ri si) = Node (stripify i) (x,z,y) tt bi pli p ri si -- extract graphics information from Playmap convertToGraphicsMap :: PlayMap -> GraphicsMap convertToGraphicsMap mp = array (bounds mp) [(i, graphicsyfy (mp ! i))| i <- indices mp] where graphicsyfy :: Node -> MapEntry - graphicsyfy (Minimal _ ) = (1.0, Grass) - graphicsyfy (Full _ y t _ _ _ _ _ ) = (y, t) + graphicsyfy (Node _ (_,_,y) t _ _ _ _ _ ) = (y, t) lineHeight :: GLfloat lineHeight = 0.8660254 diff --git a/src/Map/Map.hs b/src/Map/Map.hs index ced09c0..53a0976 100644 --- a/src/Map/Map.hs +++ b/src/Map/Map.hs @@ -61,10 +61,7 @@ giveMapHeight mp (x,z) = let [a,b,c] = getTrianglePoints [tff,tfc,tcf,tcc] -- Height LookUp hlu :: (Int, Int) -> Float - hlu (k,j) = let node = mp ! (k,j) - in case node of - (Full _ y _ _ _ _ _ _) -> y - (Minimal _ ) -> 1.0 + hlu (k,j) = let (Node _ (_,_,y) _ _ _ _ _ _) = mp ! (k,j) in y ff = (floor x, floor z) :: (Int, Int) fc = (floor x, ceiling z) :: (Int, Int) diff --git a/src/Map/StaticMaps.hs b/src/Map/StaticMaps.hs deleted file mode 100644 index 5ef9942..0000000 --- a/src/Map/StaticMaps.hs +++ /dev/null @@ -1,49 +0,0 @@ -module Map.StaticMaps -where - -import Map.Types -import Data.Array - --- entirely empty map, only uses the minimal constructor -mapEmpty :: PlayMap -mapEmpty = array ((0,0), (199,199)) [((a,b), Minimal (a,b)) | a <- [0..199], b <- [0..199]] - ---mapCenterMountain :: PlayMap ---mapCenterMountain = array ((0,0),(199,199)) nodes --- where --- nodes = water ++ beach ++ grass ++ hill ++ mountain --- 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..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..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..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..199], b <- [0..199], m2d (a,b) <= 10] - --- g2d :: Int -> Int -> Float --- g2d x y = gauss3D (fromIntegral x) (fromIntegral y) - --- m2d :: (Int,Int) -> Int --- m2d (x,y) = mnh2D (x,y) (100,100) - --- small helper for some hills. Should be replaced by multi-layer perlin-noise --- TODO: Replace as given in comment. ---_noisyMap :: (Floating q) => q -> q -> q ---_noisyMap x y = gauss3Dgeneral 15 100.0 100.0 15.0 15.0 x y --- + gauss3Dgeneral 5 10.0 10.0 10.0 10.0 x y --- + gauss3Dgeneral 5 150.0 120.0 10.0 10.0 x y --- + gauss3Dgeneral 5 50.0 75.0 10.0 10.0 x y - --- generates a noisy map --- TODO: add real noise to a simple pattern ---mapNoise :: PlayMap ---mapNoise = array ((0,0),(199,199)) nodes --- where --- nodes = [((a,b), Full (a,b) --- (height a b) --- (heightToTerrain GrassIslandMap $ height a b) --- BNothing --- NoPlayer --- NoPath --- Plain --- []) | a <- [0..199], b <- [0..199]] --- where --- height a b = _noisyMap (fromIntegral a) (fromIntegral b) diff --git a/src/Map/Types.hs b/src/Map/Types.hs index c62837f..dd66236 100644 --- a/src/Map/Types.hs +++ b/src/Map/Types.hs @@ -5,10 +5,12 @@ import Types import Data.Array -type PlayMap = Array (XCoord, ZCoord) Node +type PlayMap = Array (Xindex, Zindex) Node -type XCoord = Int -type ZCoord = Int +type Xindex = Int +type Zindex = Int +type XCoord = Float +type ZCoord = Float type YCoord = Float data MapType = GrassIslandMap @@ -66,7 +68,6 @@ data TileType = Ocean | Mountain -- ^ Not accessible deriving (Show, Eq) --- TODO: Record Syntax -data Node = Full (XCoord, ZCoord) YCoord TileType BuildInfo PlayerInfo PathInfo ResInfo StorInfo - | Minimal (XCoord, ZCoord) -- defaults to empty green grass node on height 1 +-- TODO: Record Syntax? +data Node = Node (Xindex, Zindex) (XCoord, ZCoord, YCoord) TileType BuildInfo PlayerInfo PathInfo ResInfo StorInfo deriving (Show)