Browse files

Preliminary support for western chess boards.

At the moment, all it can do is convert squares to and from algebraic
notation.
  • Loading branch information...
1 parent 5ce1058 commit aa26672fc0aca4e0c0ffbdc9fcbbd56245c016db @malcolmt committed Oct 31, 2011
Showing with 116 additions and 15 deletions.
  1. +50 −0 src/ChessTools/Board/Western.hs
  2. +20 −15 src/ChessTools/Test/Suite.hs
  3. +46 −0 src/ChessTools/Test/WesternBoard.hs
View
50 src/ChessTools/Board/Western.hs
@@ -0,0 +1,50 @@
+{- | Routines for examining moves and board positions in western-style chess.
+ -}
+
+module ChessTools.Board.Western (
+ algebraicToIndex
+ , indexToAlgebraic
+) where
+
+
+import Data.Char (ord, chr)
+
+import ChessTools.Board
+
+
+westernBoardSize :: BoardSize
+westernBoardSize = BoardSize 8 8 2
+
+coveringIndices :: CoveringIndexList
+coveringIndices = repIndexList westernBoardSize
+
+-- | Converts a square name, such as /"e5"/ to an index into a board array.
+-- Returns 'Nothing' if the provided string is invalid (too long or not a
+-- reference to a legal square).
+algebraicToIndex :: [Char] -> Maybe Int
+algebraicToIndex cs
+ | length cs /= 2 = Nothing
+ | file < 0 || file > 7 = Nothing
+ | rank < 0 || rank > 7 = Nothing
+ | otherwise = Just . squareToIndex westernBoardSize $ Square (file, rank)
+ where f:r:[] = cs
+ file = ord f - ord 'a'
+ rank = ord r - ord '1'
+
+-- | Converts an index into a board array back into an algebraic notation
+-- square designation, such as "/e5/".
+
+-- FIXME: How to handle errors? How to even detect errors? (I don't want
+-- indexToSquare having to go through Maybe all the time, since it will be
+-- called all over the place.)
+indexToAlgebraic :: Int -> Maybe [Char]
+indexToAlgebraic x = Just $ chr (f + ord 'a') : chr (r + ord '1') : []
+ where Square (f, r) = indexToSquare westernBoardSize x
+
+-- kingMoves
+-- queenMoves
+-- rookMoves
+-- bishopMoves
+-- knightMoves
+-- pawnMoves
+
View
35 src/ChessTools/Test/Suite.hs
@@ -10,26 +10,31 @@ import Test.Framework (defaultMain, testGroup)
import Test.Framework.Providers.QuickCheck2 (testProperty)
import ChessTools.Test.Board
+import ChessTools.Test.WesternBoard
main = defaultMain tests
tests = [
- testGroup "Board arrays" [
- testProperty "index to square" prop_index_to_square_inverse,
- testProperty "square to index" prop_square_to_index_inverse,
- testProperty "indices increase" prop_index_increases_with_square,
- testProperty "array size" prop_board_array_size
- ],
- testGroup "Lookup arrays" [
- testProperty "repIndexList represents"
- prop_repIndexList_is_representative,
- testProperty "file lookup 1" prop_check_file_distance_1,
- testProperty "file lookup 2" prop_check_file_distance_2,
- testProperty "rank lookup 1" prop_check_rank_distance_1,
- testProperty "rank lookup 2" prop_check_rank_distance_2,
- testProperty "square lookup 1" prop_check_square_distance_1,
- testProperty "square lookup 2" prop_check_square_distance_2
+ testGroup "Board arrays" [
+ testProperty "index to square" prop_index_to_square_inverse
+ , testProperty "square to index" prop_square_to_index_inverse
+ , testProperty "indices increase" prop_index_increases_with_square
+ , testProperty "array size" prop_board_array_size
+ ]
+ , testGroup "Lookup arrays" [
+ testProperty "repIndexList represents"
+ prop_repIndexList_is_representative
+ , testProperty "file lookup 1" prop_check_file_distance_1
+ , testProperty "file lookup 2" prop_check_file_distance_2
+ , testProperty "rank lookup 1" prop_check_rank_distance_1
+ , testProperty "rank lookup 2" prop_check_rank_distance_2
+ , testProperty "square lookup 1" prop_check_square_distance_1
+ , testProperty "square lookup 2" prop_check_square_distance_2
+ ]
+ , testGroup "Western notation" [
+ testProperty "good algebraic squares" prop_goodAlgebraicSquares
+ , testProperty "bad algebraic squares" prop_badAlgebraicSquares
]
]
View
46 src/ChessTools/Test/WesternBoard.hs
@@ -0,0 +1,46 @@
+module ChessTools.Test.WesternBoard
+where
+
+import Data.Char (ord, chr)
+import Test.QuickCheck
+
+import ChessTools.Board.Western
+
+pairToCoords :: Int -> Int -> [Char]
+pairToCoords f r = chr (f + ord 'a') : chr (r + ord '1') : []
+
+validAlgebraicSquaresGen :: Gen [Char]
+validAlgebraicSquaresGen = do
+ file <- choose (0, 7)
+ rank <- choose (0, 7)
+ return $ pairToCoords file rank
+
+invalidAlgebraicSquaresGen :: Gen [Char]
+invalidAlgebraicSquaresGen =
+ oneof [badFile, badRank, longName]
+ where badFile = do
+ file <- oneof [choose (-10, -1), choose (8, 12)]
+ rank <- choose (-3, 10)
+ return $ pairToCoords file rank
+
+ badRank = do
+ file <- choose (-3, 10)
+ rank <- oneof [choose (-10, -1), choose (8, 12)]
+ return $ pairToCoords file rank
+
+ longName = do
+ x <- choose ('a', 'z')
+ c <- validAlgebraicSquaresGen
+ return $ c ++ [x]
+
+
+prop_goodAlgebraicSquares = forAll validAlgebraicSquaresGen $ \s ->
+ case algebraicToIndex s of
+ Nothing -> False
+ _ -> True
+
+prop_badAlgebraicSquares = forAll invalidAlgebraicSquaresGen $ \s ->
+ case algebraicToIndex s of
+ Nothing -> True
+ _ -> False
+

0 comments on commit aa26672

Please sign in to comment.