{-# LANGUAGE DeriveGeneric #-}
-- | Basic operations on 2D points represented as linear offsets.
module Game.LambdaHack.Common.Point
  ( Point(..), PointI
  , chessDist, euclidDistSq, adjacent, bresenhamsLineAlgorithm, fromTo
  , originPoint, insideP
  , speedupHackXSize
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , bresenhamsLineAlgorithmBegin, 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           Test.QuickCheck

import Game.LambdaHack.Definition.Defs

-- | This is a hack to pass the X size of the dungeon, defined
-- in game content, to the @Enum@ instances of @Point@ and @Vector@.
-- This is already slower and has higher allocation than
-- hardcoding the value, so passing the value explicitly to
-- a generalization of the @Enum@ conversions is out of the question.
-- Perhaps this can be done cleanly and efficiently at link-time
-- via Backpack, but it's probably not supported yet by GHCJS (not verified).
-- For now, we need to be careful never to modify this array,
-- except for setting it at program start before it's used for the first time.
-- Which is easy, because @Point@ is never mentioned in content definitions.
-- The @PrimArray@ has much smaller overhead than @IORef@
-- and reading from it looks cleaner, hence its use.
speedupHackXSize :: PA.PrimArray X
{-# NOINLINE speedupHackXSize #-}
speedupHackXSize :: PrimArray X
speedupHackXSize = [X] -> PrimArray X
forall a. Prim a => [a] -> PrimArray a
PA.primArrayFromList [X
80]  -- updated at program startup

-- | 2D points in cartesian representation. Coordinates grow to the right
-- and down, so that the (0, 0) point is in the top-left corner
-- of the screen. Coordinates are never negative
-- (unlike for 'Game.LambdaHack.Common.Vector.Vector')
-- and the @X@ coordinate never reaches the screen width as read
-- from 'speedupHackXSize'.
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, 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, Num b) => a -> b
fromIntegralWrap :: Int32 -> Int)) Get Int32
forall t. Binary t => Get t
get
    -- `fromIntegralWrap` is fine here, because we converted the integer
    -- in the opposite direction first, so it fits even in 31 bit `Int`

-- Note that @Ord@ on @Int@ is not monotonic wrt @Ord@ on @Point@.
-- We need to keep it that way, because we want close xs to have close indexes,
-- e.g., adjacent points in line to have adjacent enumerations,
-- because some of the screen layout and most of processing is line-by-line.
-- Consequently, one can use EM.fromDistinctAscList
-- on @(1, 8)..(10, 8)@, but not on @(1, 7)..(10, 9)@.
instance Enum Point where
  fromEnum :: Point -> X
fromEnum Point{X
py :: X
px :: X
py :: Point -> X
px :: Point -> X
..} =
    let !xsize :: X
xsize = PrimArray X -> X -> X
forall a. Prim a => PrimArray a -> X -> a
PA.indexPrimArray PrimArray X
speedupHackXSize X
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
>= X
0 Bool -> Bool -> Bool
&& X
py X -> X -> Bool
forall a. Ord a => a -> a -> Bool
>= X
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` String
"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 X
n = let !xsize :: X
xsize = PrimArray X -> X -> X
forall a. Prim a => PrimArray a -> X -> a
PA.indexPrimArray PrimArray X
speedupHackXSize X
0
                 (X
py, X
px) = X
n X -> X -> (X, X)
forall a. Integral a => a -> a -> (a, a)
`quotRem` X
xsize
             in Point :: X -> X -> Point
Point{X
px :: X
py :: X
py :: X
px :: X
..}

instance Arbitrary Point where
  arbitrary :: Gen Point
arbitrary = do
    let xsize :: X
xsize = PrimArray X -> X -> X
forall a. Prim a => PrimArray a -> X -> a
PA.indexPrimArray PrimArray X
speedupHackXSize X
0
    X
n <- Gen X
getSize
    X -> X -> Point
Point (X -> X -> Point) -> Gen X -> Gen (X -> Point)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (X, X) -> Gen X
forall a. Random a => (a, a) -> Gen a
choose (X
0, X -> X -> X
forall a. Ord a => a -> a -> a
min X
n (X
xsize X -> X -> X
forall a. Num a => a -> a -> a
- X
1))
          Gen (X -> Point) -> Gen X -> Gen Point
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (X, X) -> Gen X
forall a. Random a => (a, a) -> Gen a
choose (X
0, X
n)

-- | Enumeration representation of @Point@.
type PointI = Int

-- This is hidden from Haddock, but run by doctest:
-- $
-- prop> (toEnum :: PointI -> Point) (fromEnum p) == p
-- prop> \ (NonNegative i) -> (fromEnum :: Point -> PointI) (toEnum i) == i

-- | The distance between two points in the chessboard metric.
--
-- >>> chessDist (Point 0 0) (Point 0 0)
-- 0
-- >>> chessDist (Point (-1) 0) (Point 0 0)
-- 1
-- >>> chessDist (Point (-1) 0) (Point (-1) 1)
-- 1
-- >>> chessDist (Point (-1) 0) (Point 0 1)
-- 1
-- >>> chessDist (Point (-1) 0) (Point 1 1)
-- 2
--
-- prop> chessDist p1 p2 >= 0
-- prop> chessDist p1 p2 ^ (2 :: Int) <= euclidDistSq p1 p2
chessDist :: Point -> Point -> Int
chessDist :: Point -> Point -> X
chessDist (Point X
x0 X
y0) (Point X
x1 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))

-- | Squared euclidean distance between two points.
euclidDistSq :: Point -> Point -> Int
euclidDistSq :: Point -> Point -> X
euclidDistSq (Point X
x0 X
y0) (Point X
x1 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
^ (X
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
^ (X
2 :: Int)

-- | Checks whether two points are adjacent on the map
-- (horizontally, vertically or diagonally).
adjacent :: Point -> Point -> Bool
{-# INLINE adjacent #-}
adjacent :: Point -> Point -> Bool
adjacent Point
s Point
t = Point -> Point -> X
chessDist Point
s Point
t X -> X -> Bool
forall a. Eq a => a -> a -> Bool
== X
1

-- | Bresenham's line algorithm generalized to arbitrary starting @eps@
-- (@eps@ value of 0 gives the standard BLA).
-- Skips the source point and goes through the second point to infinity.
-- Gives @Nothing@ if the points are equal. The target is given as @Point@,
-- not @PointI@, to permit aiming out of the level, e.g., to get
-- uniform distributions of directions for explosions close to the edge
-- of the level.
--
-- >>> bresenhamsLineAlgorithm 0 (Point 0 0) (Point 0 0)
-- Nothing
-- >>> take 3 $ fromJust $ bresenhamsLineAlgorithm 0 (Point 0 0) (Point 1 0)
-- [(1,0),(2,0),(3,0)]
-- >>> take 3 $ fromJust $ bresenhamsLineAlgorithm 0 (Point 0 0) (Point 0 1)
-- [(0,1),(0,2),(0,3)]
-- >>> take 3 $ fromJust $ bresenhamsLineAlgorithm 0 (Point 0 0) (Point 1 1)
-- [(1,1),(2,2),(3,3)]
bresenhamsLineAlgorithm :: Int -> Point -> Point -> Maybe [Point]
bresenhamsLineAlgorithm :: X -> Point -> Point -> Maybe [Point]
bresenhamsLineAlgorithm X
eps Point
source 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
$ [Point] -> [Point]
forall a. [a] -> [a]
tail ([Point] -> [Point]) -> [Point] -> [Point]
forall a b. (a -> b) -> a -> b
$ X -> Point -> Point -> [Point]
bresenhamsLineAlgorithmBegin X
eps Point
source Point
target

-- | Bresenham's line algorithm generalized to arbitrary starting @eps@
-- (@eps@ value of 0 gives the standard BLA). Includes the source point
-- and goes through the target point to infinity.
--
-- >>> take 4 $ bresenhamsLineAlgorithmBegin 0 (Point 0 0) (Point 2 0)
-- [(0,0),(1,0),(2,0),(3,0)]
bresenhamsLineAlgorithmBegin :: Int -> Point -> Point -> [Point]
bresenhamsLineAlgorithmBegin :: X -> Point -> Point -> [Point]
bresenhamsLineAlgorithmBegin X
eps (Point X
x0 X
y0) (Point X
x1 X
y1) =
  let (X
dx, 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 X
b (X
x, 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 X
b (X
x, 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)
      (X
p, X
q, 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 X
1 X
q)
      walk :: [X] -> (X, X) -> [(X, X)]
walk [X]
w (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)

-- | See <http://roguebasin.roguelikedevelopment.org/index.php/index.php?title=Digital_lines>.
balancedWord :: Int -> Int -> Int -> [Int]
balancedWord :: X -> X -> X -> [X]
balancedWord X
p X
q 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 = X
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 X
p X
q X
eps               = X
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)

-- | A list of all points on a straight vertical or straight horizontal line
-- between two points. Fails if no such line exists.
--
-- >>> fromTo (Point 0 0) (Point 2 0)
-- [(0,0),(1,0),(2,0)]
fromTo :: Point -> Point -> [Point]
fromTo :: Point -> Point -> [Point]
fromTo (Point X
x0 X
y0) (Point X
x1 X
y1) =
 let fromTo1 :: Int -> Int -> [Int]
     fromTo1 :: X -> X -> [X]
fromTo1 X
z0 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
-X
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
$ String
"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 X
0 X
0

-- | Checks that a point belongs to an area.
insideP :: (X, Y, X, Y) -> Point -> Bool
{-# INLINE insideP #-}
insideP :: (X, X, X, X) -> Point -> Bool
insideP (X
x0, X
y0, X
x1, X
y1) (Point X
x X
y) = X
x1 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
>= X
x0 Bool -> Bool -> Bool
&& X
y1 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
>= X
y0