    {-# 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
    $c== :: Point -> Point -> Bool
    == :: Point -> Point -> Bool
    $c/= :: Point -> Point -> Bool
    /= :: 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
    $ccompare :: Point -> Point -> Ordering
    compare :: Point -> Point -> Ordering
    $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
    >= :: Point -> Point -> Bool
    $cmax :: Point -> Point -> Point
    max :: Point -> Point -> Point
    $cmin :: Point -> Point -> Point
    min :: Point -> Point -> 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
    $cfrom :: forall x. Point -> Rep Point x
    from :: forall x. Point -> Rep Point x
    $cto :: forall x. Rep Point x -> Point
    to :: forall x. Rep Point x -> Point
    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 a b. (a -> b) -> Get a -> Get b
    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
    px :: Point -> X
    py :: Point -> X
    px :: X
    py :: 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
           assert (px >= 0 && py >= 0 && px < xsize
                  `blame` "invalid point coordinates"
                  `swith` (px, 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
    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
        n <- Gen X
    getSize
        Point <$> choose (0, min n (xsize - 1))
              <*> choose (0, 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. HasCallStack => [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. HasCallStack => [a] -> [a]
    tail [X]
    w) (X -> (X, X) -> (X, X)
    step ([X] -> X
    forall a. HasCallStack => [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. HasCallStack => 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