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

-- | 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 [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.
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

-- 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{..} =
    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{..}

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

-- | The distance between two points in the chessboard metric.
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))

-- | Squared euclidean distance between two points.
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)

-- | Checks whether two points are adjacent on the map
-- (horizontally, vertically or diagonally).
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

-- | 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 the edge of the level. Gives @Nothing@ if the points are equal.
-- The target is given as @Point@ to permit aiming out of the level,
-- e.g., to get uniform distributions of directions for explosions
-- close to the edge of the level.
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

-- | 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.
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)

-- | See <http://roguebasin.roguelikedevelopment.org/index.php/index.php?title=Digital_lines>.
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)

-- | A list of all points on a straight vertical or straight horizontal line
-- between two points. Fails if no such line exists.
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