-- | Basic operations on 2D vectors represented in an efficient, -- but not unique, way. module Game.LambdaHack.Vector ( Vector, toVector, shift, shiftBounded, moves, movesWidth , isUnit, euclidDistSq, diagonal, neg, towards, displacement , displacePath, shiftPath ) where import Data.Binary import Game.LambdaHack.PointXY import Game.LambdaHack.VectorXY import Game.LambdaHack.Area import Game.LambdaHack.Point import Game.LambdaHack.Utils.Assert -- | 2D vectors represented as offsets in the linear framebuffer -- indexed by 'Point'. -- -- A newtype is used to prevent mixing up the type with @Point@ itself. -- Note that the offset representations of a vector is usually not unique. -- E.g., for vectors of length 1 in the chessboard metric, used to denote -- geographical directions, the representations are pairwise distinct -- if and only if the level width and height are at least 3. newtype Vector = Vector Int deriving (Show, Eq) instance Binary Vector where put (Vector dir) = put dir get = fmap Vector get -- | Converts a vector in cartesian representation into @Vector@. toVector :: X -> VectorXY -> Vector toVector lxsize (VectorXY (x, y)) = Vector $ x + y * lxsize isUnitXY :: VectorXY -> Bool isUnitXY v = chessDistXY v == 1 -- | Tells if a vector has length 1 in the chessboard metric. isUnit :: X -> Vector -> Bool isUnit lxsize = isUnitXY . fromDir lxsize -- | Converts a unit vector in cartesian representation into @Vector@. toDir :: X -> VectorXY -> Vector toDir lxsize v@(VectorXY (x, y)) = assert (lxsize >= 3 && isUnitXY v `blame` (lxsize, v)) $ Vector $ x + y * lxsize -- | Converts a unit vector in the offset representation -- into the cartesian representation. Arbitrary vectors can't be -- converted uniquely. fromDir :: X -> Vector -> VectorXY fromDir lxsize (Vector dir) = assert (lxsize >= 3 && isUnitXY res && fst len1 + snd len1 * lxsize == dir `blame` (lxsize, dir, res)) $ res where (x, y) = (dir `mod` lxsize, dir `div` lxsize) -- Pick the vector's canonical form of length 1: len1 = if x > 1 then (x - lxsize, y + 1) else (x, y) res = VectorXY len1 -- | Translate a point by a vector. -- -- Particularly simple and fast implementation in the linear representation. shift :: Point -> Vector -> Point shift loc (Vector dir) = loc + dir -- | Translate a point by a vector, but only if the result fits in an area. shiftBounded :: X -> Area -> Point -> Vector -> Point shiftBounded lxsize area loc dir = let res = shift loc dir in if inside lxsize res area then res else loc -- | Vectors of all unit moves, clockwise, starting north-west. moves :: X -> [Vector] moves lxsize = map (toDir lxsize) movesXY -- | Vectors of all unit moves, clockwise, starting north-west, -- parameterized by level width. movesWidth :: [X -> Vector] movesWidth = map (flip toDir) movesXY -- | Squared euclidean distance between two unit vectors. euclidDistSq :: X -> Vector -> Vector -> Int euclidDistSq lxsize dir0 dir1 | VectorXY (x0, y0) <- fromDir lxsize dir0 , VectorXY (x1, y1) <- fromDir lxsize dir1 = euclidDistSqXY $ VectorXY (x1 - x0, y1 - y0) -- | Checks whether a unit vector is a diagonal direction, -- as opposed to cardinal. diagonal :: X -> Vector -> Bool diagonal lxsize dir | VectorXY (x, y) <- fromDir lxsize dir = x * y /= 0 -- | Reverse an arbirary vector. neg :: Vector -> Vector neg (Vector dir) = Vector (-dir) -- TODO: use bla for that -- | Given a vector of arbitrary non-zero length, produce a unit vector -- that points in the same direction (in the chessboard metric). -- Of several equally good directions it picks one of those that visually -- (in the euclidean metric) maximally align with the original vector. normalize :: X -> VectorXY -> Vector normalize lxsize v@(VectorXY (dx, dy)) = assert (dx /= 0 || dy /= 0 `blame` (dx, dy)) $ let angle :: Double angle = atan (fromIntegral dy / fromIntegral dx) / (pi / 2) dxy | angle <= -0.75 = (0, -1) | angle <= -0.25 = (1, -1) | angle <= 0.25 = (1, 0) | angle <= 0.75 = (1, 1) | angle <= 1.25 = (0, 1) | otherwise = assert `failure` (lxsize, dx, dy, angle) rxy = if dx >= 0 then VectorXY dxy else negXY $ VectorXY dxy in assert ((if isUnitXY v then v == rxy else True) `blame` (v, rxy)) $ toDir lxsize rxy -- TODO: Perhaps produce all acceptable directions and let AI choose. -- That would also eliminate the Doubles. Or only directions from bla? -- Smart monster could really use all dirs to be less predictable, -- but it wouldn't look as natural as bla, so for less smart bla is better. -- | Given two distinct locations, determine the direction (a unit vector) -- in which one should move from the first in order to get closer -- to the second. Ignores obstacles. Of several equally good directions -- (in the chessboard metric) it picks one of those that visually -- (in the euclidean metric) maximally align with the vector between -- the two points.. towards :: X -> Point -> Point -> Vector towards lxsize loc0 loc1 = assert (loc0 /= loc1 `blame` (loc0, loc1)) $ let v = displacementXYZ lxsize loc0 loc1 in normalize lxsize v -- | A vector from a point to another. We have -- -- > shift loc1 (displacement loc1 loc2) == loc2 -- -- Particularly simple and fast implementation in the linear representation. displacement :: Point -> Point -> Vector displacement loc1 loc2 = Vector $ loc2 - loc1 -- | A list of vectors between a list of points. displacePath :: [Point] -> [Vector] displacePath [] = [] displacePath lp1@(_ : lp2) = map (uncurry displacement) $ zip lp1 lp2 -- | A list of points that a list of vectors leads to. shiftPath :: Point -> [Vector] -> [Point] shiftPath _ [] = [] shiftPath start (v : vs) = let next = shift start v in next : shiftPath next vs