{-# 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