module Game.LambdaHack.Common.Point
( X, Y, Point(..), maxLevelDimExponent
, chessDist, euclidDistSq, adjacent, inside, bla, fromTo
) where
import Control.Exception.Assert.Sugar
import Data.Binary
import Data.Bits (unsafeShiftL, unsafeShiftR, (.&.))
import Data.Int (Int32)
type X = Int
type Y = Int
data Point = Point
{ px :: !X
, py :: !Y
}
deriving (Eq, Ord)
instance Show Point where
show (Point x y) = show (x, y)
instance Binary Point where
put = put . (fromIntegral :: Int -> Int32) . fromEnum
get = fmap (toEnum . (fromIntegral :: Int32 -> Int)) get
instance Enum Point where
fromEnum = fromEnumPoint
toEnum = toEnumPoint
maxLevelDimExponent :: Int
maxLevelDimExponent = 16
maxLevelDim :: Int
maxLevelDim = 2 ^ maxLevelDimExponent 1
fromEnumPoint :: Point -> Int
fromEnumPoint (Point x y) =
assert (x >= 0 && y >= 0 `blame` "invalid point coordinates"
`twith` (x, y))
$ x + unsafeShiftL y maxLevelDimExponent
toEnumPoint :: Int -> Point
toEnumPoint n =
Point (n .&. maxLevelDim) (unsafeShiftR n maxLevelDimExponent)
chessDist :: Point -> Point -> Int
chessDist (Point x0 y0) (Point x1 y1) = max (abs (x1 x0)) (abs (y1 y0))
euclidDistSq :: Point -> Point -> Int
euclidDistSq (Point x0 y0) (Point x1 y1) =
let square n = n ^ (2 :: Int)
in square (x1 x0) + square (y1 y0)
adjacent :: Point -> Point -> Bool
adjacent s t = chessDist s t == 1
inside :: Point -> (X, Y, X, Y) -> Bool
inside (Point x y) (x0, y0, x1, y1) = x1 >= x && x >= x0 && y1 >= y && y >= y0
bla :: X -> Y -> Int -> Point -> Point -> Maybe [Point]
bla lxsize lysize eps source target =
if source == target then Nothing
else Just $
let inBounds p@(Point x y) =
lxsize > x && x >= 0 && lysize > y && y >= 0 && p /= source
in takeWhile inBounds $ tail $ blaXY eps source target
blaXY :: Int -> Point -> Point -> [Point]
blaXY eps (Point x0 y0) (Point x1 y1) =
let (dx, dy) = (x1 x0, y1 y0)
xyStep b (x, y) = (x + signum dx, y + signum dy * b)
yxStep b (x, y) = (x + signum dx * b, y + signum dy)
(p, q, step) | abs dx > abs dy = (abs dy, abs dx, xyStep)
| otherwise = (abs dx, abs dy, yxStep)
bw = balancedWord p q (eps `mod` max 1 q)
walk w xy = xy : walk (tail w) (step (head w) xy)
in map (uncurry Point) $ walk bw (x0, y0)
balancedWord :: Int -> Int -> Int -> [Int]
balancedWord p q eps | eps + p < q = 0 : balancedWord p q (eps + p)
balancedWord p q eps = 1 : balancedWord p q (eps + p q)
fromTo :: Point -> Point -> [Point]
fromTo (Point x0 y0) (Point x1 y1) =
let fromTo1 :: Int -> Int -> [Int]
fromTo1 z0 z1
| z0 <= z1 = [z0..z1]
| otherwise = [z0,z01..z1]
result
| x0 == x1 = map (\ y -> Point x0 y) (fromTo1 y0 y1)
| y0 == y1 = map (\ x -> Point x y0) (fromTo1 x0 x1)
| otherwise = assert `failure` "diagonal fromTo"
`twith` ((x0, y0), (x1, y1))
in result