module BishBosh.Cartesian.Coordinates(
Coordinates(
getX,
getY
),
ByCoordinates,
topLeft,
bottomRight,
nSquares,
radiusSquared,
extrapolate,
interpolate,
range,
getLogicalColourOfSquare,
kingsStartingCoordinates,
rooksStartingCoordinates,
measureDistance,
translate,
maybeTranslate,
translateX,
maybeTranslateX,
translateY,
maybeTranslateY,
getAdjacents,
advance,
retreat,
maybeRetreat,
mkCoordinates,
mkMaybeCoordinates,
fromIx,
mkRelativeCoordinates,
listArrayByCoordinates,
isPawnsFirstRank,
isEnPassantRank,
areSquaresIsochromatic
) where
import Control.Arrow((&&&))
import Data.Array.IArray((!))
import qualified BishBosh.Attribute.Direction as Attribute.Direction
import qualified BishBosh.Attribute.LogicalColour as Attribute.LogicalColour
import qualified BishBosh.Attribute.LogicalColourOfSquare as Attribute.LogicalColourOfSquare
import qualified BishBosh.Cartesian.Abscissa as Cartesian.Abscissa
import qualified BishBosh.Cartesian.Ordinate as Cartesian.Ordinate
import qualified BishBosh.Data.Exception as Data.Exception
import qualified BishBosh.Property.Opposable as Property.Opposable
import qualified BishBosh.Property.Reflectable as Property.Reflectable
import qualified BishBosh.Property.Rotatable as Property.Rotatable
import qualified BishBosh.Text.ShowList as Text.ShowList
import qualified BishBosh.Types as T
import qualified Control.DeepSeq
import qualified Control.Exception
import qualified Data.Array.IArray
import qualified Data.Maybe
import qualified Factory.Math.Power
data Coordinates x y = MkCoordinates {
getX :: x,
getY :: y
} deriving Eq
instance (
Control.DeepSeq.NFData x,
Control.DeepSeq.NFData y
) => Control.DeepSeq.NFData (Coordinates x y) where
rnf MkCoordinates { getX = x, getY = y } = Control.DeepSeq.rnf (x, y)
instance (Show x, Show y) => Show (Coordinates x y) where
showsPrec _ MkCoordinates { getX = x, getY = y } = shows (x, y)
instance (
Enum x,
Enum y,
Ord x,
Ord y,
Read x,
Read y
) => Read (Coordinates x y) where
readsPrec _ s = [
(coordinates, remainder) |
((x, y), remainder) <- reads s,
coordinates <- Data.Maybe.maybeToList $ mkMaybeCoordinates x y
]
instance (Ord x, Ord y) => Ord (Coordinates x y) where
MkCoordinates { getX = x, getY = y } `compare` MkCoordinates { getX = x', getY = y' } = (y, x) `compare` (y', x')
instance (Enum x, Enum y) => Bounded (Coordinates x y) where
minBound = MkCoordinates {
getX = Cartesian.Abscissa.xMin,
getY = Cartesian.Ordinate.yMin
}
maxBound = MkCoordinates {
getX = Cartesian.Abscissa.xMax,
getY = Cartesian.Ordinate.yMax
}
instance (
Enum x,
Enum y,
Ord x,
Ord y
) => Data.Array.IArray.Ix (Coordinates x y) where
range (lower, upper) = Control.Exception.assert (lower == minBound && upper == maxBound) range
inRange (lower, upper) coordinates = Control.Exception.assert (coordinates >= lower && coordinates <= upper) True
index (lower, upper) MkCoordinates {
getX = x,
getY = y
} = Control.Exception.assert (
lower == minBound && upper == maxBound
) $ fromIntegral Cartesian.Abscissa.xLength * (
fromEnum y Cartesian.Ordinate.yOrigin
) + (
fromEnum x Cartesian.Abscissa.xOrigin
)
instance Enum y => Property.Reflectable.ReflectableOnX (Coordinates x y) where
reflectOnX coordinates@MkCoordinates { getY = y } = coordinates { getY = Cartesian.Ordinate.reflect y }
instance Enum x => Property.Reflectable.ReflectableOnY (Coordinates x y) where
reflectOnY coordinates@MkCoordinates { getX = x } = coordinates { getX = Cartesian.Abscissa.reflect x }
instance (Enum x, Enum y) => Property.Rotatable.Rotatable (Coordinates x y) where
rotate90 = rotate Attribute.Direction.w
rotate180 = rotate Attribute.Direction.s
rotate270 = rotate Attribute.Direction.e
topLeft :: (Enum x, Enum y) => Coordinates x y
topLeft = MkCoordinates {
getX = Cartesian.Abscissa.xMin,
getY = Cartesian.Ordinate.yMax
}
bottomRight :: (Enum x, Enum y) => Coordinates x y
bottomRight = MkCoordinates {
getX = Cartesian.Abscissa.xMax,
getY = Cartesian.Ordinate.yMin
}
nSquares :: Int
nSquares = fromIntegral $ Cartesian.Abscissa.xLength * Cartesian.Ordinate.yLength
range :: (Enum x, Enum y) => [Coordinates x y]
range = [
MkCoordinates {
getX = x,
getY = y
} |
y <- Cartesian.Ordinate.yRange,
x <- Cartesian.Abscissa.xRange
]
inBounds :: (
Enum x,
Enum y,
Ord x,
Ord y
)
=> x
-> y
-> Bool
inBounds x y = Cartesian.Abscissa.inBounds x && Cartesian.Ordinate.inBounds y
mkCoordinates :: (
Enum x,
Enum y,
Ord x,
Ord y
)
=> x
-> y
-> Coordinates x y
mkCoordinates x y = Control.Exception.assert (inBounds x y) $ MkCoordinates x y
mkMaybeCoordinates :: (
Enum x,
Enum y,
Ord x,
Ord y
)
=> x
-> y
-> Maybe (Coordinates x y)
mkMaybeCoordinates x y
| inBounds x y = Just MkCoordinates { getX = x, getY = y }
| otherwise = Nothing
fromIx :: (Enum x, Enum y) => Int -> Coordinates x y
fromIx = (
\(y, x) -> MkCoordinates {
getX = toEnum $ x + Cartesian.Abscissa.xOrigin,
getY = toEnum $ y + Cartesian.Ordinate.yOrigin
}
) . (`divMod` fromIntegral Cartesian.Abscissa.xLength)
translate :: (
Enum x,
Enum y,
Ord x,
Ord y
) => ((x, y) -> (x, y)) -> Coordinates x y -> Coordinates x y
translate transformation MkCoordinates {
getX = x,
getY = y
} = uncurry mkCoordinates $ transformation (x, y)
maybeTranslate :: (
Enum x,
Enum y,
Ord x,
Ord y
)
=> ((x, y) -> (x, y))
-> Coordinates x y
-> Maybe (Coordinates x y)
maybeTranslate transformation MkCoordinates {
getX = x,
getY = y
} = uncurry mkMaybeCoordinates $ transformation (x, y)
translateX :: (Enum x, Ord x) => (x -> x) -> Transformation x y
translateX transformation coordinates@MkCoordinates { getX = x } = coordinates { getX = Cartesian.Abscissa.translate transformation x }
maybeTranslateX
:: (Enum x, Ord x)
=> (x -> x)
-> Coordinates x y
-> Maybe (Coordinates x y)
maybeTranslateX transformation coordinates@MkCoordinates { getX = x } = (\x' -> coordinates { getX = x' }) `fmap` Cartesian.Abscissa.maybeTranslate transformation x
translateY :: (Enum y, Ord y) => (y -> y) -> Transformation x y
translateY transformation coordinates@MkCoordinates { getY = y } = coordinates { getY = Cartesian.Ordinate.translate transformation y }
maybeTranslateY
:: (Enum y, Ord y)
=> (y -> y)
-> Coordinates x y
-> Maybe (Coordinates x y)
maybeTranslateY transformation coordinates@MkCoordinates { getY = y } = (\y' -> coordinates { getY = y' }) `fmap` Cartesian.Ordinate.maybeTranslate transformation y
mkRelativeCoordinates :: (
Enum x,
Enum y,
Ord x,
Ord y
)
=> ((x, y) -> (x, y))
-> Coordinates x y
mkRelativeCoordinates = (`translate` minBound)
advance
:: (Enum y, Ord y)
=> Attribute.LogicalColour.LogicalColour
-> Transformation x y
advance logicalColour = translateY $ if Attribute.LogicalColour.isBlack logicalColour
then pred
else succ
maybeAdvance
:: (Enum y, Ord y)
=> Attribute.LogicalColour.LogicalColour
-> Coordinates x y
-> Maybe (Coordinates x y)
maybeAdvance logicalColour = maybeTranslateY $ if Attribute.LogicalColour.isBlack logicalColour
then pred
else succ
retreat
:: (Enum y, Ord y)
=> Attribute.LogicalColour.LogicalColour
-> Transformation x y
retreat = advance . Property.Opposable.getOpposite
maybeRetreat
:: (Enum y, Ord y)
=> Attribute.LogicalColour.LogicalColour
-> Coordinates x y
-> Maybe (Coordinates x y)
maybeRetreat = maybeAdvance . Property.Opposable.getOpposite
getAdjacents :: (Enum x, Eq x) => Coordinates x y -> [Coordinates x y]
getAdjacents coordinates@MkCoordinates { getX = x } = map (\x' -> coordinates { getX = x' }) $ Cartesian.Abscissa.getAdjacents x
infix 6 >||<
(>||<) :: [x] -> [y] -> [Coordinates x y]
(x' : xs) >||< (y' : ys) = MkCoordinates { getX = x', getY = y' } : xs >||< ys
_ >||< _ = []
extrapolate
:: (Enum x, Enum y)
=> Attribute.Direction.Direction
-> Coordinates x y
-> [Coordinates x y]
extrapolate direction MkCoordinates {
getX = x,
getY = y
} = (
case Attribute.Direction.getXDirection direction of
GT -> [succ x .. Cartesian.Abscissa.xMax]
LT -> let startX = pred x in startX `seq` [startX, pred startX .. Cartesian.Abscissa.xMin]
EQ -> repeat x
) >||< (
case Attribute.Direction.getYDirection direction of
GT -> [succ y .. Cartesian.Ordinate.yMax]
LT -> let startY = pred y in startY `seq` [startY, pred startY .. Cartesian.Ordinate.yMin]
EQ -> repeat y
)
extrapolateInt :: Attribute.Direction.Direction -> Coordinates T.X T.Y -> [Coordinates T.X T.Y]
extrapolateInt direction coordinates = extrapolationsByCoordinatesByDirection ! coordinates ! direction
extrapolationsByCoordinatesByDirection :: (
Enum x,
Enum y,
Ord x,
Ord y
) => ByCoordinates x y (Attribute.Direction.ByDirection [Coordinates x y])
extrapolationsByCoordinatesByDirection = listArrayByCoordinates [
Attribute.Direction.listArrayByDirection [
(
case Attribute.Direction.getXDirection direction of
GT -> [succ x .. Cartesian.Abscissa.xMax]
LT -> let startX = pred x in startX `seq` [startX, pred startX .. Cartesian.Abscissa.xMin]
EQ -> repeat x
) >||< (
case Attribute.Direction.getYDirection direction of
GT -> [succ y .. Cartesian.Ordinate.yMax]
LT -> let startY = pred y in startY `seq` [startY, pred startY .. Cartesian.Ordinate.yMin]
EQ -> repeat y
) | direction <- Attribute.Direction.range
] | MkCoordinates { getX = x, getY = y } <- range
]
interpolate :: (
Enum x,
Enum y,
Ord x,
Ord y
)
=> Coordinates x y
-> Coordinates x y
-> [Coordinates x y]
interpolate source@MkCoordinates {
getX = x,
getY = y
} destination@MkCoordinates {
getX = x',
getY = y'
}
| source == destination = []
| otherwise = (
case x' `compare` x of
GT -> [succ x .. x']
LT -> let startX = pred x in startX `seq` [startX, pred startX .. x']
EQ -> repeat x
) >||< (
case y' `compare` y of
GT -> [succ y .. y']
LT -> let startY = pred y in startY `seq` [startY, pred startY .. y']
EQ -> repeat y
)
interpolateInt :: Coordinates T.X T.Y -> Coordinates T.X T.Y -> [Coordinates T.X T.Y]
interpolateInt coordinatesSource coordinatesDestination = interpolationsBySourceByDestination ! coordinatesSource ! coordinatesDestination
interpolationsBySourceByDestination :: (
Enum x,
Enum y,
Ord x,
Ord y
) => ByCoordinates x y (ByCoordinates x y [Coordinates x y])
interpolationsBySourceByDestination = listArrayByCoordinates [
listArrayByCoordinates [
if source == destination
then []
else (
case x' `compare` x of
GT -> [succ x .. x']
LT -> let startX = pred x in startX `seq` [startX, pred startX .. x']
EQ -> repeat x
) >||< (
case y' `compare` y of
GT -> [succ y .. y']
LT -> let startY = pred y in startY `seq` [startY, pred startY .. y']
EQ -> repeat y
)
| destination@MkCoordinates { getX = x', getY = y' } <- range
] | source@MkCoordinates { getX = x, getY = y } <- range
]
type Transformation x y = Coordinates x y -> Coordinates x y
rotate :: (Enum x, Enum y) => Attribute.Direction.Direction -> Transformation x y
rotate direction coordinates@MkCoordinates {
getX = x,
getY = y
} = case Attribute.Direction.getXDirection &&& Attribute.Direction.getYDirection $ direction of
(EQ, GT) -> coordinates
(LT, EQ) -> MkCoordinates {
getX = toEnum $ Cartesian.Abscissa.xOrigin + fromIntegral yDistance',
getY = toEnum $ Cartesian.Ordinate.yOrigin + fromIntegral xDistance
}
(EQ, LT) -> MkCoordinates {
getX = toEnum $ Cartesian.Abscissa.xOrigin + fromIntegral xDistance',
getY = toEnum $ Cartesian.Ordinate.yOrigin + fromIntegral yDistance'
}
(GT, EQ) -> MkCoordinates {
getX = toEnum $ Cartesian.Abscissa.xOrigin + fromIntegral yDistance,
getY = toEnum $ Cartesian.Ordinate.yOrigin + fromIntegral xDistance'
}
_ -> Control.Exception.throw . Data.Exception.mkRequestFailure . showString "BishBosh.Cartesian.Coordinates.rotate:\tunable to rotate to direction" . Text.ShowList.showsAssociation $ shows direction "."
where
xDistance, xDistance', yDistance, yDistance' :: T.Distance
xDistance = fromIntegral $ fromEnum x Cartesian.Abscissa.xOrigin
yDistance = fromIntegral $ fromEnum y Cartesian.Ordinate.yOrigin
xDistance' = pred Cartesian.Abscissa.xLength xDistance
yDistance' = pred Cartesian.Ordinate.yLength yDistance
measureDistance :: (
Enum x,
Enum y,
Num distance
)
=> Coordinates x y
-> Coordinates x y
-> (distance, distance)
measureDistance MkCoordinates {
getX = x,
getY = y
} MkCoordinates {
getX = x',
getY = y'
} = (fromIntegral $ fromEnum x' fromEnum x, fromIntegral $ fromEnum y' fromEnum y)
radiusSquared :: (
Fractional radiusSquared,
Integral x,
Integral y
) => ByCoordinates x y radiusSquared
radiusSquared = listArrayByCoordinates [
Factory.Math.Power.square (
fromIntegral (x :: T.X) Cartesian.Abscissa.centre
) + Factory.Math.Power.square (
fromIntegral (y :: T.Y) Cartesian.Ordinate.centre
) | MkCoordinates {
getX = x,
getY = y
} <- range
]
getLogicalColourOfSquare :: (Enum x, Enum y) => Coordinates x y -> Attribute.LogicalColourOfSquare.LogicalColourOfSquare
getLogicalColourOfSquare coordinates
| even xDistance == even yDistance = Attribute.LogicalColourOfSquare.black
| otherwise = Attribute.LogicalColourOfSquare.white
where
xDistance, yDistance :: T.Distance
(xDistance, yDistance) = measureDistance minBound coordinates
areSquaresIsochromatic :: (Enum x, Enum y) => [Coordinates x y] -> Bool
areSquaresIsochromatic = uncurry (||) . (all (== minBound) &&& all (== maxBound)) . map getLogicalColourOfSquare
kingsStartingCoordinates :: (Enum x, Enum y) => Attribute.LogicalColour.LogicalColour -> Coordinates x y
kingsStartingCoordinates logicalColour = MkCoordinates {
getX = toEnum $ Cartesian.Abscissa.xOrigin + 4,
getY = Cartesian.Ordinate.firstRank logicalColour
}
rooksStartingCoordinates :: (Enum x, Enum y) => Attribute.LogicalColour.LogicalColour -> [Coordinates x y]
rooksStartingCoordinates Attribute.LogicalColour.Black = [topLeft, maxBound]
rooksStartingCoordinates _ = [minBound, bottomRight]
isPawnsFirstRank
:: (Enum y, Eq y)
=> Attribute.LogicalColour.LogicalColour
-> Coordinates x y
-> Bool
isPawnsFirstRank logicalColour MkCoordinates { getY = y } = y == Cartesian.Ordinate.pawnsFirstRank logicalColour
isEnPassantRank
:: (Enum y, Eq y)
=> Attribute.LogicalColour.LogicalColour
-> Coordinates x y
-> Bool
isEnPassantRank logicalColour MkCoordinates { getY = y } = y == Cartesian.Ordinate.enPassantRank logicalColour
type ByCoordinates x y = Data.Array.IArray.Array (Coordinates x y)
listArrayByCoordinates :: (
Data.Array.IArray.IArray a e,
Enum x,
Enum y,
Ord x,
Ord y
) => [e] -> a (Coordinates x y) e
listArrayByCoordinates = Data.Array.IArray.listArray (minBound, maxBound)