{-# LANGUAGE DeriveGeneric #-}
module Game.LambdaHack.Common.Point
( Point(..), PointI
, chessDist, euclidDistSq, adjacent, bla, fromTo
, originPoint
, speedupHackXSize
#ifdef EXPOSE_INTERNAL
, blaXY, balancedWord
#endif
) where
import Prelude ()
import Game.LambdaHack.Core.Prelude
import Data.Binary
import Data.Int (Int32)
import qualified Data.Primitive.PrimArray as PA
import GHC.Generics (Generic)
import Game.LambdaHack.Definition.Defs
speedupHackXSize :: PA.PrimArray X
{-# NOINLINE speedupHackXSize #-}
speedupHackXSize :: PrimArray X
speedupHackXSize = [X] -> PrimArray X
forall a. Prim a => [a] -> PrimArray a
PA.primArrayFromList [80]
data Point = Point
{ Point -> X
px :: X
, Point -> X
py :: Y
}
deriving (Point -> Point -> Bool
(Point -> Point -> Bool) -> (Point -> Point -> Bool) -> Eq Point
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Point -> Point -> Bool
$c/= :: Point -> Point -> Bool
== :: Point -> Point -> Bool
$c== :: Point -> Point -> Bool
Eq, Eq Point
Eq Point =>
(Point -> Point -> Ordering)
-> (Point -> Point -> Bool)
-> (Point -> Point -> Bool)
-> (Point -> Point -> Bool)
-> (Point -> Point -> Bool)
-> (Point -> Point -> Point)
-> (Point -> Point -> Point)
-> Ord Point
Point -> Point -> Bool
Point -> Point -> Ordering
Point -> Point -> Point
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Point -> Point -> Point
$cmin :: Point -> Point -> Point
max :: Point -> Point -> Point
$cmax :: Point -> Point -> Point
>= :: Point -> Point -> Bool
$c>= :: Point -> Point -> Bool
> :: Point -> Point -> Bool
$c> :: Point -> Point -> Bool
<= :: Point -> Point -> Bool
$c<= :: Point -> Point -> Bool
< :: Point -> Point -> Bool
$c< :: Point -> Point -> Bool
compare :: Point -> Point -> Ordering
$ccompare :: Point -> Point -> Ordering
$cp1Ord :: Eq Point
Ord, (forall x. Point -> Rep Point x)
-> (forall x. Rep Point x -> Point) -> Generic Point
forall x. Rep Point x -> Point
forall x. Point -> Rep Point x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Point x -> Point
$cfrom :: forall x. Point -> Rep Point x
Generic)
instance Show Point where
show :: Point -> String
show (Point x :: X
x y :: X
y) = (X, X) -> String
forall a. Show a => a -> String
show (X
x, X
y)
instance Binary Point where
put :: Point -> Put
put = Int32 -> Put
forall t. Binary t => t -> Put
put (Int32 -> Put) -> (Point -> Int32) -> Point -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (X -> Int32
forall a b. (Integral a, Integral b, Bits a, Bits b) => a -> b
toIntegralCrash :: Int -> Int32) (X -> Int32) -> (Point -> X) -> Point -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point -> X
forall a. Enum a => a -> X
fromEnum
get :: Get Point
get = (Int32 -> Point) -> Get Int32 -> Get Point
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (X -> Point
forall a. Enum a => X -> a
toEnum (X -> Point) -> (Int32 -> X) -> Int32 -> Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int32 -> X
forall a b.
(Integral a, Integral b, IsIntSubType a b ~ 'True) =>
a -> b
intCast :: Int32 -> Int)) Get Int32
forall t. Binary t => Get t
get
instance Enum Point where
fromEnum :: Point -> X
fromEnum Point{..} =
let !xsize :: X
xsize = PrimArray X -> X -> X
forall a. Prim a => PrimArray a -> X -> a
PA.indexPrimArray PrimArray X
speedupHackXSize 0
in
#ifdef WITH_EXPENSIVE_ASSERTIONS
Bool -> X -> X
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (X
px X -> X -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 Bool -> Bool -> Bool
&& X
py X -> X -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 Bool -> Bool -> Bool
&& X
px X -> X -> Bool
forall a. Ord a => a -> a -> Bool
< X
xsize
Bool -> (String, (X, X)) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` "invalid point coordinates"
String -> (X, X) -> (String, (X, X))
forall v. String -> v -> (String, v)
`swith` (X
px, X
py))
#endif
(X
px X -> X -> X
forall a. Num a => a -> a -> a
+ X
py X -> X -> X
forall a. Num a => a -> a -> a
* X
xsize)
toEnum :: X -> Point
toEnum n :: X
n = let !xsize :: X
xsize = PrimArray X -> X -> X
forall a. Prim a => PrimArray a -> X -> a
PA.indexPrimArray PrimArray X
speedupHackXSize 0
(py :: X
py, px :: X
px) = X
n X -> X -> (X, X)
forall a. Integral a => a -> a -> (a, a)
`quotRem` X
xsize
in $WPoint :: X -> X -> Point
Point{..}
type PointI = Int
chessDist :: Point -> Point -> Int
chessDist :: Point -> Point -> X
chessDist (Point x0 :: X
x0 y0 :: X
y0) (Point x1 :: X
x1 y1 :: X
y1) = X -> X -> X
forall a. Ord a => a -> a -> a
max (X -> X
forall a. Num a => a -> a
abs (X
x1 X -> X -> X
forall a. Num a => a -> a -> a
- X
x0)) (X -> X
forall a. Num a => a -> a
abs (X
y1 X -> X -> X
forall a. Num a => a -> a -> a
- X
y0))
euclidDistSq :: Point -> Point -> Int
euclidDistSq :: Point -> Point -> X
euclidDistSq (Point x0 :: X
x0 y0 :: X
y0) (Point x1 :: X
x1 y1 :: X
y1) =
(X
x1 X -> X -> X
forall a. Num a => a -> a -> a
- X
x0) X -> X -> X
forall a b. (Num a, Integral b) => a -> b -> a
^ (2 :: Int) X -> X -> X
forall a. Num a => a -> a -> a
+ (X
y1 X -> X -> X
forall a. Num a => a -> a -> a
- X
y0) X -> X -> X
forall a b. (Num a, Integral b) => a -> b -> a
^ (2 :: Int)
adjacent :: Point -> Point -> Bool
{-# INLINE adjacent #-}
adjacent :: Point -> Point -> Bool
adjacent s :: Point
s t :: Point
t = Point -> Point -> X
chessDist Point
s Point
t X -> X -> Bool
forall a. Eq a => a -> a -> Bool
== 1
bla :: X -> Y -> Int -> Point -> Point -> Maybe [Point]
bla :: X -> X -> X -> Point -> Point -> Maybe [Point]
bla rXmax :: X
rXmax rYmax :: X
rYmax eps :: X
eps source :: Point
source target :: Point
target =
if Point
source Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
target then Maybe [Point]
forall a. Maybe a
Nothing
else [Point] -> Maybe [Point]
forall a. a -> Maybe a
Just ([Point] -> Maybe [Point]) -> [Point] -> Maybe [Point]
forall a b. (a -> b) -> a -> b
$
let inBounds :: Point -> Bool
inBounds p :: Point
p@(Point x :: X
x y :: X
y) =
X
rXmax X -> X -> Bool
forall a. Ord a => a -> a -> Bool
> X
x Bool -> Bool -> Bool
&& X
x X -> X -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 Bool -> Bool -> Bool
&& X
rYmax X -> X -> Bool
forall a. Ord a => a -> a -> Bool
> X
y Bool -> Bool -> Bool
&& X
y X -> X -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 Bool -> Bool -> Bool
&& Point
p Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
/= Point
source
in (Point -> Bool) -> [Point] -> [Point]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile Point -> Bool
inBounds ([Point] -> [Point]) -> [Point] -> [Point]
forall a b. (a -> b) -> a -> b
$ [Point] -> [Point]
forall a. [a] -> [a]
tail ([Point] -> [Point]) -> [Point] -> [Point]
forall a b. (a -> b) -> a -> b
$ X -> Point -> Point -> [Point]
blaXY X
eps Point
source Point
target
blaXY :: Int -> Point -> Point -> [Point]
blaXY :: X -> Point -> Point -> [Point]
blaXY eps :: X
eps (Point x0 :: X
x0 y0 :: X
y0) (Point x1 :: X
x1 y1 :: X
y1) =
let (dx :: X
dx, dy :: X
dy) = (X
x1 X -> X -> X
forall a. Num a => a -> a -> a
- X
x0, X
y1 X -> X -> X
forall a. Num a => a -> a -> a
- X
y0)
xyStep :: X -> (X, X) -> (X, X)
xyStep b :: X
b (x :: X
x, y :: X
y) = (X
x X -> X -> X
forall a. Num a => a -> a -> a
+ X -> X
forall a. Num a => a -> a
signum X
dx, X
y X -> X -> X
forall a. Num a => a -> a -> a
+ X -> X
forall a. Num a => a -> a
signum X
dy X -> X -> X
forall a. Num a => a -> a -> a
* X
b)
yxStep :: X -> (X, X) -> (X, X)
yxStep b :: X
b (x :: X
x, y :: X
y) = (X
x X -> X -> X
forall a. Num a => a -> a -> a
+ X -> X
forall a. Num a => a -> a
signum X
dx X -> X -> X
forall a. Num a => a -> a -> a
* X
b, X
y X -> X -> X
forall a. Num a => a -> a -> a
+ X -> X
forall a. Num a => a -> a
signum X
dy)
(p :: X
p, q :: X
q, step :: X -> (X, X) -> (X, X)
step) | X -> X
forall a. Num a => a -> a
abs X
dx X -> X -> Bool
forall a. Ord a => a -> a -> Bool
> X -> X
forall a. Num a => a -> a
abs X
dy = (X -> X
forall a. Num a => a -> a
abs X
dy, X -> X
forall a. Num a => a -> a
abs X
dx, X -> (X, X) -> (X, X)
xyStep)
| Bool
otherwise = (X -> X
forall a. Num a => a -> a
abs X
dx, X -> X
forall a. Num a => a -> a
abs X
dy, X -> (X, X) -> (X, X)
yxStep)
bw :: [X]
bw = X -> X -> X -> [X]
balancedWord X
p X
q (X
eps X -> X -> X
forall a. Integral a => a -> a -> a
`mod` X -> X -> X
forall a. Ord a => a -> a -> a
max 1 X
q)
walk :: [X] -> (X, X) -> [(X, X)]
walk w :: [X]
w xy :: (X, X)
xy = (X, X)
xy (X, X) -> [(X, X)] -> [(X, X)]
forall a. a -> [a] -> [a]
: [X] -> (X, X) -> [(X, X)]
walk ([X] -> [X]
forall a. [a] -> [a]
tail [X]
w) (X -> (X, X) -> (X, X)
step ([X] -> X
forall a. [a] -> a
head [X]
w) (X, X)
xy)
in ((X, X) -> Point) -> [(X, X)] -> [Point]
forall a b. (a -> b) -> [a] -> [b]
map ((X -> X -> Point) -> (X, X) -> Point
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry X -> X -> Point
Point) ([(X, X)] -> [Point]) -> [(X, X)] -> [Point]
forall a b. (a -> b) -> a -> b
$ [X] -> (X, X) -> [(X, X)]
walk [X]
bw (X
x0, X
y0)
balancedWord :: Int -> Int -> Int -> [Int]
balancedWord :: X -> X -> X -> [X]
balancedWord p :: X
p q :: X
q eps :: X
eps | X
eps X -> X -> X
forall a. Num a => a -> a -> a
+ X
p X -> X -> Bool
forall a. Ord a => a -> a -> Bool
< X
q = 0 X -> [X] -> [X]
forall a. a -> [a] -> [a]
: X -> X -> X -> [X]
balancedWord X
p X
q (X
eps X -> X -> X
forall a. Num a => a -> a -> a
+ X
p)
balancedWord p :: X
p q :: X
q eps :: X
eps = 1 X -> [X] -> [X]
forall a. a -> [a] -> [a]
: X -> X -> X -> [X]
balancedWord X
p X
q (X
eps X -> X -> X
forall a. Num a => a -> a -> a
+ X
p X -> X -> X
forall a. Num a => a -> a -> a
- X
q)
fromTo :: Point -> Point -> [Point]
fromTo :: Point -> Point -> [Point]
fromTo (Point x0 :: X
x0 y0 :: X
y0) (Point x1 :: X
x1 y1 :: X
y1) =
let fromTo1 :: Int -> Int -> [Int]
fromTo1 :: X -> X -> [X]
fromTo1 z0 :: X
z0 z1 :: X
z1
| X
z0 X -> X -> Bool
forall a. Ord a => a -> a -> Bool
<= X
z1 = [X
z0..X
z1]
| Bool
otherwise = [X
z0,X
z0X -> X -> X
forall a. Num a => a -> a -> a
-1..X
z1]
result :: [Point]
result
| X
x0 X -> X -> Bool
forall a. Eq a => a -> a -> Bool
== X
x1 = (X -> Point) -> [X] -> [Point]
forall a b. (a -> b) -> [a] -> [b]
map (X -> X -> Point
Point X
x0) (X -> X -> [X]
fromTo1 X
y0 X
y1)
| X
y0 X -> X -> Bool
forall a. Eq a => a -> a -> Bool
== X
y1 = (X -> Point) -> [X] -> [Point]
forall a b. (a -> b) -> [a] -> [b]
map (X -> X -> Point
`Point` X
y0) (X -> X -> [X]
fromTo1 X
x0 X
x1)
| Bool
otherwise = String -> [Point]
forall a. (?callStack::CallStack) => String -> a
error (String -> [Point]) -> String -> [Point]
forall a b. (a -> b) -> a -> b
$ "diagonal fromTo"
String -> ((X, X), (X, X)) -> String
forall v. Show v => String -> v -> String
`showFailure` ((X
x0, X
y0), (X
x1, X
y1))
in [Point]
result
originPoint :: Point
originPoint :: Point
originPoint = X -> X -> Point
Point 0 0