diff --git a/src/Map/Combinators.hs b/src/Map/Combinators.hs index 3e143c2..9dabb89 100644 --- a/src/Map/Combinators.hs +++ b/src/Map/Combinators.hs @@ -8,13 +8,13 @@ import System.Random -- preliminary infix 5 ->- -(->-) :: (PlayMap -> PlayMap) -> (PlayMap -> PlayMap) -> (PlayMap -> PlayMap) -f ->- g = (g . f) +(->-) :: (PlayMap -> PlayMap) -> (PlayMap -> PlayMap) -> PlayMap -> PlayMap +f ->- g = g . f -- also preliminary infix 5 -<- -(-<-) :: (PlayMap -> PlayMap) -> (PlayMap -> PlayMap) -> (PlayMap -> PlayMap) -f -<- g = (f . g) +(-<-) :: (PlayMap -> PlayMap) -> (PlayMap -> PlayMap) -> PlayMap -> PlayMap +f -<- g = f . g lake :: Int -> PlayMap -> PlayMap lake = undefined @@ -40,7 +40,7 @@ gaussMountain seed mp = aplByPlace (liftUp c) (\(_,_) -> True) mp -- 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) + 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) diff --git a/src/Map/Creation.hs b/src/Map/Creation.hs index 04d018d..d677cdd 100644 --- a/src/Map/Creation.hs +++ b/src/Map/Creation.hs @@ -31,8 +31,7 @@ aplByNode :: (Node -> Node) -> (Node -> Bool) -> PlayMap -> PlayMap aplByNode f g mp = array (bounds mp) (map (\(ab,c) -> (if g c then (ab, f c) else (ab,c))) (assocs mp)) aplAll :: [a -> a] -> a -> a -aplAll [] m = m -aplAll (f:fs) m = aplAll fs $ f m +aplAll fs m = foldl (\ m f -> f m) m fs -- general 3D-Gaussian gauss3Dgeneral :: Floating q => diff --git a/src/Map/Graphics.hs b/src/Map/Graphics.hs index bf1dcfe..5cc198a 100644 --- a/src/Map/Graphics.hs +++ b/src/Map/Graphics.hs @@ -27,6 +27,7 @@ import Foreign.Storable (sizeOf) import Foreign.Ptr (Ptr, nullPtr, plusPtr) import Render.Misc (checkError) import Linear +import Control.Arrow ((***)) import Map.Types import Map.StaticMaps @@ -43,7 +44,7 @@ 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)) +convertToStripeMap mp = array (stripify l, stripify u) (map (stripify *** strp) (assocs mp)) where (l,u) = bounds mp @@ -77,7 +78,7 @@ bufferObjectPtr = plusPtr (nullPtr :: Ptr GLfloat) . fromIntegral mapVertexArrayDescriptor :: NumComponents -> NumComponents -> VertexArrayDescriptor GLfloat mapVertexArrayDescriptor count' offset = - VertexArrayDescriptor count' Float mapStride (bufferObjectPtr ((fromIntegral offset)*sizeOf (0 :: GLfloat)) ) --(fromIntegral numComponents * offset)) + VertexArrayDescriptor count' Float mapStride (bufferObjectPtr (fromIntegral offset * sizeOf (0 :: GLfloat)) ) --(fromIntegral numComponents * offset)) fgColorIndex :: (IntegerHandling, VertexArrayDescriptor GLfloat) fgColorIndex = (ToFloat, mapVertexArrayDescriptor 4 0) --color first diff --git a/src/Map/Map.hs b/src/Map/Map.hs index b88a3b8..e358cee 100644 --- a/src/Map/Map.hs +++ b/src/Map/Map.hs @@ -34,7 +34,7 @@ giveNeighbourhood :: PlayMap -- ^ map on which to find neighbourhood -> [(Int, Int)] -- ^ neighbourhood giveNeighbourhood _ 0 (a,b) = [(a,b)] giveNeighbourhood mp n (a,b) = let ns = giveNeighbours mp (a,b) in - remdups . concat $ ns:(map (giveNeighbourhood mp (n-1)) ns) + remdups . concat $ ns : map (giveNeighbourhood mp (n-1)) ns -- removing duplicates in O(n log n), losing order and adding Ord requirement remdups :: Ord a => [a] -> [a] diff --git a/src/Map/StaticMaps.hs b/src/Map/StaticMaps.hs index 9507a82..74ea371 100644 --- a/src/Map/StaticMaps.hs +++ b/src/Map/StaticMaps.hs @@ -7,17 +7,17 @@ import Map.Creation -- 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]] +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] + 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) @@ -28,7 +28,7 @@ mapCenterMountain = array ((0,0),(199,199)) nodes -- 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 +_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 @@ -38,14 +38,13 @@ _noisyMap = \x y -> gauss3Dgeneral 15 100.0 100.0 15.0 15.0 x y 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]] + 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)) + height a b = _noisyMap (fromIntegral a) (fromIntegral b) diff --git a/src/Map/Types.hs b/src/Map/Types.hs index 66ddb4a..c62837f 100644 --- a/src/Map/Types.hs +++ b/src/Map/Types.hs @@ -20,7 +20,7 @@ data PlayerInfo = NoPlayer instance Show PlayerInfo where show (NoPlayer) = "not occupied" - show (Occupied i) = "occupied by player " ++ (show i) + show (Occupied i) = "occupied by player " ++ show i -- | Path info, is this node part of a path and if so, where does it lead? data PathInfo = NoPath @@ -34,7 +34,7 @@ data ResInfo = Plain instance Show ResInfo where show (Plain) = "no resources" - show (ResInfo res amt) = "Resource: " ++ (show res) ++ "," ++ (show amt) + show (ResInfo res amt) = "Resource: " ++ show res ++ "," ++ show amt -- | What commodities are currently stored here? type StorInfo = [(Commodity,Amount)] @@ -49,7 +49,7 @@ data BuildInfo = BStruc Structure | BLarge instance Show BuildInfo where - show (BStruc s) = "Structure: " ++ (show s) + show (BStruc s) = "Structure: " ++ show s show (BNothing) = "no Structure possible" show (BFlag) = "only flags possible" show (BMine) = "mines possible"