pioneers/src/Map/Map.hs

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
    z' = z * 2/(sqrt 3)

    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
    refs :: [(Int, Int)]
    refs = remdups $ map clmp $ map (tadd (floor x, floor z')) mods
      where
        mods = [(-1,-1),(-1,2),(0,0),(0,1),(1,0),(1,1),(2,-1),(2,2)]
        tadd (a,b) (c,d) = (a+b,c+d)

    -- tupels with reference point and distance
    tups = map (\t -> (t, dist (x,z') t)) refs

    -- total distance of all for reference point from the point in question
    totald = sum $ map (\(_,d) -> d) tups

    -- clamp, as she is programmed
    clamp :: (Ord a) => a -> a -> a -> a
    clamp mn mx = max mn . min mx

    -- clamp for tupels
    clmp :: (Int, Int) -> (Int, Int)
    clmp (a,b) = let ((xmin,zmin),(xmax,zmax)) = bounds mop
                 in  ((clamp (xmin+2) (xmax-2) a),(clamp (zmin+2) (zmax-2) b))

    -- 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