Drezil/pioneers
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

hlint all around

Browse Source
This commit is contained in:
Jonas Betzendahl 2014-04-25 15:58:25 +02:00
parent a727131f13
commit 60fd217233
6 changed files with 29 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
src/Map/Combinators.hs
View File

@ -8,13 +8,13 @@ import System.Random
-- preliminary -- preliminary
infix 5 ->- infix 5 ->-
(->-) :: (PlayMap -> PlayMap) -> (PlayMap -> PlayMap) -> (PlayMap -> PlayMap) (->-) :: (PlayMap -> PlayMap) -> (PlayMap -> PlayMap) -> PlayMap -> PlayMap
f ->- g = (g . f) f ->- g = g . f
-- also preliminary -- also preliminary
infix 5 -<- infix 5 -<-
(-<-) :: (PlayMap -> PlayMap) -> (PlayMap -> PlayMap) -> (PlayMap -> PlayMap) (-<-) :: (PlayMap -> PlayMap) -> (PlayMap -> PlayMap) -> PlayMap -> PlayMap
f -<- g = (f . g) f -<- g = f . g
lake :: Int -> PlayMap -> PlayMap lake :: Int -> PlayMap -> PlayMap
lake = undefined 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 -- TODO: Fix Lambda to True with sensible function, maybe rework giveNeighbourhood in Map.Map
liftUp :: (Int, Int) -> Node -> Node liftUp :: (Int, Int) -> Node -> Node
liftUp (gx,gz) (Full (x,z) y _ b pl pa r s) = let y_neu = max y e 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) 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 [] 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) where e = gauss3Dgeneral amp (fi gx) (fi gz) sig sig (fi x) (fi z)

3
src/Map/Creation.hs
View File

@ -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)) 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 :: [a -> a] -> a -> a
aplAll [] m = m aplAll fs m = foldl (\ m f -> f m) m fs
aplAll (f:fs) m = aplAll fs $ f m
-- general 3D-Gaussian -- general 3D-Gaussian
gauss3Dgeneral :: Floating q => gauss3Dgeneral :: Floating q =>

5
src/Map/Graphics.hs
View File

@ -27,6 +27,7 @@ import Foreign.Storable (sizeOf)
import Foreign.Ptr (Ptr, nullPtr, plusPtr) import Foreign.Ptr (Ptr, nullPtr, plusPtr)
import Render.Misc (checkError) import Render.Misc (checkError)
import Linear import Linear
import Control.Arrow ((***))
import Map.Types import Map.Types
import Map.StaticMaps import Map.StaticMaps
@ -43,7 +44,7 @@ type GraphicsMap = Array (Int, Int) MapEntry
-- converts from classical x/z to striped version of a map -- converts from classical x/z to striped version of a map
convertToStripeMap :: PlayMap -> PlayMap 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 where
(l,u) = bounds mp (l,u) = bounds mp
@ -77,7 +78,7 @@ bufferObjectPtr = plusPtr (nullPtr :: Ptr GLfloat) . fromIntegral
mapVertexArrayDescriptor :: NumComponents -> NumComponents -> VertexArrayDescriptor GLfloat mapVertexArrayDescriptor :: NumComponents -> NumComponents -> VertexArrayDescriptor GLfloat
mapVertexArrayDescriptor count' offset = 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 :: (IntegerHandling, VertexArrayDescriptor GLfloat)
fgColorIndex = (ToFloat, mapVertexArrayDescriptor 4 0) --color first fgColorIndex = (ToFloat, mapVertexArrayDescriptor 4 0) --color first

2
src/Map/Map.hs
View File

@ -34,7 +34,7 @@ giveNeighbourhood :: PlayMap -- ^ map on which to find neighbourhood
-> [(Int, Int)] -- ^ neighbourhood -> [(Int, Int)] -- ^ neighbourhood
giveNeighbourhood _ 0 (a,b) = [(a,b)] giveNeighbourhood _ 0 (a,b) = [(a,b)]
giveNeighbourhood mp n (a,b) = let ns = giveNeighbours mp (a,b) in 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 -- removing duplicates in O(n log n), losing order and adding Ord requirement
remdups :: Ord a => [a] -> [a] remdups :: Ord a => [a] -> [a]

21
src/Map/StaticMaps.hs
View File

@ -7,17 +7,17 @@ import Map.Creation
-- entirely empty map, only uses the minimal constructor -- entirely empty map, only uses the minimal constructor
mapEmpty :: PlayMap 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 :: PlayMap
mapCenterMountain = array ((0,0),(199,199)) 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..199], b <- [0..199], (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..199], b <- [0..199], (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..199], b <- [0..199], (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..199], b <- [0..199], (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..199], b <- [0..199], (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 = gauss3D (fromIntegral x) (fromIntegral y) 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 -- small helper for some hills. Should be replaced by multi-layer perlin-noise
-- TODO: Replace as given in comment. -- TODO: Replace as given in comment.
_noisyMap :: (Floating q) => q -> q -> q _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 10.0 10.0 10.0 10.0 x y
+ gauss3Dgeneral 5 150.0 120.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 + 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 :: PlayMap
mapNoise = array ((0,0),(199,199)) nodes mapNoise = array ((0,0),(199,199)) nodes
where where
nodes = [((a,b), (Full nodes = [((a,b), Full (a,b)
(a,b)
(height a b) (height a b)
(heightToTerrain GrassIslandMap $ height a b) (heightToTerrain GrassIslandMap $ height a b)
BNothing BNothing
NoPlayer NoPlayer
NoPath NoPath
Plain Plain
[])) | a <- [0..199], b <- [0..199]] []) | a <- [0..199], b <- [0..199]]
where where
height a b = (_noisyMap (fromIntegral a) (fromIntegral b)) height a b = _noisyMap (fromIntegral a) (fromIntegral b)

6
src/Map/Types.hs
View File

@ -20,7 +20,7 @@ data PlayerInfo = NoPlayer
instance Show PlayerInfo where instance Show PlayerInfo where
show (NoPlayer) = "not occupied" 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? -- | Path info, is this node part of a path and if so, where does it lead?
data PathInfo = NoPath data PathInfo = NoPath
@ -34,7 +34,7 @@ data ResInfo = Plain
instance Show ResInfo where instance Show ResInfo where
show (Plain) = "no resources" 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? -- | What commodities are currently stored here?
type StorInfo = [(Commodity,Amount)] type StorInfo = [(Commodity,Amount)]
@ -49,7 +49,7 @@ data BuildInfo = BStruc Structure
| BLarge | BLarge
instance Show BuildInfo where instance Show BuildInfo where
show (BStruc s) = "Structure: " ++ (show s) show (BStruc s) = "Structure: " ++ show s
show (BNothing) = "no Structure possible" show (BNothing) = "no Structure possible"
show (BFlag) = "only flags possible" show (BFlag) = "only flags possible"
show (BMine) = "mines possible" show (BMine) = "mines possible"