-----------------------------------------------------------------------------
-- |
-- Module      : Chess.Board.Direction
-- Copyright   : (c) Michael Szvetits, 2023
-- License     : BSD-3-Clause (see the file LICENSE)
-- Maintainer  : typedbyte@qualified.name
-- Stability   : stable
-- Portability : portable
--
-- Types and functions to represent and manipulate directions on a chess board.
-----------------------------------------------------------------------------
module Chess.Board.Direction where

-- | Represents a two-dimensional direction on a chess board.
data Direction = Direction
  { Direction -> Int
rowDelta :: Int
    -- ^ The row component of the direction.
  , Direction -> Int
columnDelta :: Int
    -- ^ The column component of the direction.
  }

-- | Yields the integral vector pointing to the left, where the leftmost column is labelled A.
left :: Direction
left :: Direction
left = Int -> Int -> Direction
Direction Int
0 (-Int
1)

-- | Yields the integral vector pointing to the right, where the leftmost column is labelled A.
right :: Direction
right :: Direction
right = Int -> Int -> Direction
Direction Int
0 Int
1

-- | Yields the integral vector pointing up, where the lowest row is labelled 1.
up :: Direction
up :: Direction
up = Int -> Int -> Direction
Direction Int
1 Int
0

-- | Yields the integral vector pointing down, where the lowest row is labelled 1.
down :: Direction
down :: Direction
down = Int -> Int -> Direction
Direction (-Int
1) Int
0

-- | Yields the four integral vectors in the directions up, right, down and left.
orthogonals :: [Direction]
orthogonals :: [Direction]
orthogonals = [Direction
up, Direction
right, Direction
down, Direction
left]

-- | Yields the four integral vectors in the directions left up, right up, right down and left down.
diagonals :: [Direction]
diagonals :: [Direction]
diagonals =
  [ Int -> Int -> Direction
Direction   Int
1  (-Int
1)
  , Int -> Int -> Direction
Direction   Int
1    Int
1
  , Int -> Int -> Direction
Direction (-Int
1)   Int
1
  , Int -> Int -> Direction
Direction (-Int
1) (-Int
1)
  ]

-- | Yields the combination of orthogonal and diagonal integral vectors.
principals :: [Direction]
principals :: [Direction]
principals = [Direction]
orthogonals forall a. [a] -> [a] -> [a]
++ [Direction]
diagonals

-- | Yields the eight directions a knight is able to jump, according to the standard rules.
jumps :: [Direction]
jumps :: [Direction]
jumps =
  [ Int -> Int -> Direction
Direction Int
row Int
column
    | Int
row    <- [-Int
1, Int
1, Int
2, -Int
2]
    , Int
column <- [-Int
1, Int
1, Int
2, -Int
2]
    , Int
row forall a. Eq a => a -> a -> Bool
/= Int
column
    , Int
row forall a. Eq a => a -> a -> Bool
/= -Int
column
  ]