module BishBosh.Component.Move(
NMoves,
NPlies,
Move(
getSource,
getDestination
),
tag,
nPliesPerMove,
castlingMovesByLogicalColour,
measureDistance,
interpolate,
getDeltaRadiusSquared,
mkMove,
isPawnDoubleAdvance
) where
import Control.Arrow((&&&))
import Data.Array.IArray((!))
import qualified BishBosh.Attribute.LogicalColour as Attribute.LogicalColour
import qualified BishBosh.Attribute.MoveType as Attribute.MoveType
import qualified BishBosh.Cartesian.Coordinates as Cartesian.Coordinates
import qualified BishBosh.Cartesian.Vector as Cartesian.Vector
import qualified BishBosh.Property.Opposable as Property.Opposable
import qualified BishBosh.Property.Orientated as Property.Orientated
import qualified BishBosh.Property.Reflectable as Property.Reflectable
import qualified BishBosh.Types as T
import qualified Control.Arrow
import qualified Control.DeepSeq
import qualified Control.Exception
import qualified Data.Ord
tag :: String
tag = "move"
type NMoves = Int
type NPlies = NMoves
nPliesPerMove :: NMoves
nPliesPerMove = 2
data Move x y = MkMove {
getSource :: Cartesian.Coordinates.Coordinates x y,
getDestination :: Cartesian.Coordinates.Coordinates x y
} deriving Eq
instance (Ord x, Ord y) => Ord (Move x y) where
move@MkMove { getSource = source } `compare` move'@MkMove { getSource = source' } = case source `compare` source' of
EQ -> Data.Ord.comparing getDestination move move'
ordering -> ordering
instance (Control.DeepSeq.NFData x, Control.DeepSeq.NFData y) => Control.DeepSeq.NFData (Move x y) where
rnf MkMove {
getSource = source,
getDestination = destination
} = Control.DeepSeq.rnf (source, destination)
instance (Show x, Show y) => Show (Move x y) where
showsPrec _ MkMove {
getSource = source,
getDestination = destination
} = shows (source, destination)
instance (
Enum x,
Enum y,
Ord x,
Ord y,
Read x,
Read y
) => Read (Move x y) where
readsPrec _ = map (Control.Arrow.first $ uncurry mkMove) . reads
instance Property.Opposable.Opposable (Move x y) where
getOpposite (MkMove source destination) = MkMove destination source
instance (Enum x, Enum y) => Property.Orientated.Orientated (Move x y) where
isDiagonal = (Property.Orientated.isDiagonal :: Cartesian.Vector.VectorInt -> Bool) . measureDistance
isParallel = (Property.Orientated.isParallel :: Cartesian.Vector.VectorInt -> Bool) . measureDistance
instance Enum y => Property.Reflectable.ReflectableOnX (Move x y) where
reflectOnX MkMove {
getSource = source,
getDestination = destination
} = MkMove {
getSource = Property.Reflectable.reflectOnX source,
getDestination = Property.Reflectable.reflectOnX destination
}
instance Enum x => Property.Reflectable.ReflectableOnY (Move x y) where
reflectOnY MkMove {
getSource = source,
getDestination = destination
} = MkMove {
getSource = Property.Reflectable.reflectOnY source,
getDestination = Property.Reflectable.reflectOnY destination
}
mkMove
:: (Eq x, Eq y)
=> Cartesian.Coordinates.Coordinates x y
-> Cartesian.Coordinates.Coordinates x y
-> Move x y
mkMove source destination = Control.Exception.assert (source /= destination) $ MkMove source destination
measureDistance :: (
Enum x,
Enum y,
Num distance,
Ord distance
) => Move x y -> Cartesian.Vector.Vector distance
measureDistance MkMove {
getSource = source,
getDestination = destination
} = Cartesian.Vector.measureDistance source destination
interpolate :: (
Enum x,
Enum y,
Ord x,
Ord y
) => Move x y -> [Cartesian.Coordinates.Coordinates x y]
interpolate move@MkMove {
getSource = source,
getDestination = destination
} = Control.Exception.assert (Property.Orientated.isStraight move) $ Cartesian.Coordinates.interpolate source destination
castlingMovesByLogicalColour :: (
Enum x,
Enum y,
Eq y,
Ord x
) => Attribute.LogicalColour.ByLogicalColour [(Attribute.MoveType.MoveType, Move x y, Move x y)]
castlingMovesByLogicalColour = Attribute.LogicalColour.listArrayByLogicalColour $ map (
\logicalColour -> let
kingsStartingCoordinates = Cartesian.Coordinates.kingsStartingCoordinates logicalColour
kingsMove translation = mkMove kingsStartingCoordinates $ translateX translation kingsStartingCoordinates
in [
(
Attribute.MoveType.shortCastle,
kingsMove (+ 2),
uncurry mkMove . (id &&& translateX (subtract 2)) $ if Attribute.LogicalColour.isBlack logicalColour
then maxBound
else Cartesian.Coordinates.bottomRight
), (
Attribute.MoveType.longCastle,
kingsMove $ subtract 2,
uncurry mkMove . (id &&& translateX (+ 3)) $ if Attribute.LogicalColour.isBlack logicalColour
then Cartesian.Coordinates.topLeft
else minBound
)
]
) Attribute.LogicalColour.range where
translateX :: (Enum x, Ord x) => (Int -> Int) -> Cartesian.Coordinates.Coordinates x y -> Cartesian.Coordinates.Coordinates x y
translateX translation = Cartesian.Coordinates.translateX $ toEnum . translation . fromEnum
isPawnDoubleAdvance
:: (Enum x, Enum y, Eq y)
=> Attribute.LogicalColour.LogicalColour
-> Move x y
-> Bool
isPawnDoubleAdvance logicalColour move = Cartesian.Coordinates.isPawnsFirstRank logicalColour (
getSource move
) && Cartesian.Vector.matchesPawnDoubleAdvance logicalColour (
measureDistance move :: Cartesian.Vector.VectorInt
)
getDeltaRadiusSquared :: (
Fractional radiusSquared,
Integral x,
Integral y
) => Move x y -> radiusSquared
getDeltaRadiusSquared MkMove {
getSource = source,
getDestination = destination
} = Cartesian.Coordinates.radiusSquared ! destination Cartesian.Coordinates.radiusSquared ! source