module Map.Map where import Map.Types import Data.Array (bounds, (!)) import Data.List (sort, group) -- WARNING: Does NOT Check for neighbours exceeding maximum map coordinates yet. unsafeGiveNeighbours :: (Int, Int) -- ^ original coordinates -> [(Int,Int)] -- ^ list of neighbours unsafeGiveNeighbours (x,z) = filter (not . negative) allNs where allNs = if even z then [(x+1,z), (x-1,z), (x,z+1), (x,z-1), (x+1,z+1), (x+1,z-1)] else [(x+1,z), (x-1,z), (x,z+1), (x,z-1), (x-1,z+1), (x-1,z-1)] negative :: (Int, Int) -> Bool negative (a,b) = a < 0 || b < 0 giveNeighbours :: PlayMap -- ^ Map on which to find neighbours -> (Int, Int) -- ^ original coordinates -> [(Int, Int)] -- ^ list of neighbours giveNeighbours mp (x,z) = filter (not . outOfBounds mp) allNs where allNs = if even z then [(x+1,z), (x-1,z), (x,z+1), (x,z-1), (x+1,z+1), (x+1,z-1)] else [(x+1,z), (x-1,z), (x,z+1), (x,z-1), (x-1,z+1), (x-1,z-1)] outOfBounds :: PlayMap -> (Int, Int) -> Bool outOfBounds mp' (a,b) = let (lo,hi) = bounds mp' in a < fst lo || b < snd lo || a > fst hi || b > snd hi giveNeighbourhood :: PlayMap -- ^ map on which to find neighbourhood -> Int -- ^ iterative -> (Int, Int) -- ^ original coordinates -> [(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 -- | Calculates the height of any given point on the map. -- Does not add camera distance to ground to that. giveMapHeight :: PlayMap -> (Double, Double) -> Double giveMapHeight mop (x,z) | outsideMap (x,z) = 0.0 | otherwise = sum $ map (\(p,d) -> (hlu p) * (1 - (d / totald))) tups where outsideMap :: (Double, Double) -> Bool outsideMap (mx, mz) = let ((a,b),(c,d)) = bounds mop fr = fromIntegral in mx < (fr a) || mx > (fr c) || mz < (fr b) || mz > (fr d) -- Height LookUp on PlayMap hlu :: (Int, Int) -> Double hlu (k,j) = let (Node _ (_,_,y) _ _ _ _ _ _) = mop ! (k,j) in y -- reference Points ff = (floor x, floor z) :: (Int, Int) fc = (floor x, ceiling z) :: (Int, Int) cf = (ceiling x, floor z) :: (Int, Int) cc = (ceiling x, ceiling z) :: (Int, Int) -- tupels with reference point and distance tups = map (\t -> (t, dist (x,z) t)) [ff,fc,cf,cc] -- total distance of all for reference point from the point in question totald = sum $ map (\(_,d) -> d) tups -- Real distance on PlayMap dist :: (Double, Double) -> (Int, Int) -> Double dist (x1,z1) pmp = let xf = x1 - realx zf = z1 - realz in sqrt $ xf*xf + zf*zf where realx = (\(Node _ (nx,_,_) _ _ _ _ _ _) -> nx) (mop ! pmp) realz = (\(Node _ (_,nz,_) _ _ _ _ _ _) -> nz) (mop ! pmp) -- removing duplicates in O(n log n), losing order and adding Ord requirement remdups :: Ord a => [a] -> [a] remdups = map head . group . sort