module Game.LambdaHack.Common.Vector
( Vector, toVector, toDir, shift, shiftBounded, moves
, isUnit, euclidDistSq, diagonal, neg, towards, displacement
, displacePath, shiftPath
) where
import Data.Binary
import Game.LambdaHack.Common.Point
import Game.LambdaHack.Common.PointXY
import Game.LambdaHack.Common.VectorXY
import Control.Exception.Assert.Sugar
newtype Vector = Vector Int
deriving (Eq, Ord, Read)
instance Binary Vector where
put (Vector dir) = put dir
get = fmap Vector get
instance Show Vector where
show (Vector n) = show n
toVector :: X -> VectorXY -> Vector
toVector lxsize (VectorXY (x, y)) =
Vector $ x + y * lxsize
isUnitXY :: VectorXY -> Bool
isUnitXY v = chessDistXY v == 1
isUnit :: X -> Vector -> Bool
isUnit lxsize = isUnitXY . fromDir lxsize
toDir :: X -> VectorXY -> Vector
toDir lxsize v@(VectorXY (x, y)) =
assert (lxsize >= 3 && isUnitXY v `blame` "ambiguous XY vector conversion"
`twith` (lxsize, v)) $
Vector $ x + y * lxsize
fromDir :: X -> Vector -> VectorXY
fromDir lxsize (Vector dir) =
assert (lxsize >= 3 && isUnitXY res &&
fst len1 + snd len1 * lxsize == dir
`blame` "ambiguous vector conversion" `twith` (lxsize, dir, res))
res
where
(x, y) = (dir `mod` lxsize, dir `div` lxsize)
len1 = if x > 1
then (x lxsize, y + 1)
else (x, y)
res = VectorXY len1
shift :: Point -> Vector -> Point
shift p (Vector dir) = toEnum $ fromEnum p + dir
shiftBounded :: X -> (X, Y, X, Y) -> Point -> Vector -> Point
shiftBounded lxsize area pos dir =
let res = shift pos dir
in if inside lxsize res area then res else pos
moves :: X -> [Vector]
moves lxsize = map (toDir lxsize) movesXY
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)
diagonal :: X -> Vector -> Bool
diagonal lxsize dir | VectorXY (x, y) <- fromDir lxsize dir =
x * y /= 0
neg :: Vector -> Vector
neg (Vector dir) = Vector (dir)
normalize :: X -> VectorXY -> Vector
normalize lxsize v@(VectorXY (dx, dy)) =
assert (dx /= 0 || dy /= 0 `blame` "can't normalize zero" `twith` (dx, dy)) $
let angle :: Double
angle = atan (fromIntegral dy / fromIntegral dx) / (pi / 2)
dxy | angle <= 0.75 && angle >= 1.25 = (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` "impossible angle"
`twith` (lxsize, dx, dy, angle)
rxy = if dx >= 0
then VectorXY dxy
else negXY $ VectorXY dxy
in assert (not (isUnitXY v) || v == rxy
`blame` "unit vector gets untrivially normalized"
`twith` (v, rxy))
$ toDir lxsize rxy
towards :: X -> Point -> Point -> Vector
towards lxsize pos0 pos1 =
assert (pos0 /= pos1 `blame` "towards self" `twith` (pos0, pos1)) $
let v = displacementXYZ lxsize pos0 pos1
in normalize lxsize v
displacement :: Point -> Point -> Vector
displacement pos1 pos2 = Vector $ fromEnum pos2 fromEnum pos1
displacePath :: [Point] -> [Vector]
displacePath [] = []
displacePath lp1@(_ : lp2) = zipWith displacement lp1 lp2
shiftPath :: Point -> [Vector] -> [Point]
shiftPath _ [] = []
shiftPath start (v : vs) =
let next = shift start v
in next : shiftPath next vs