warcaby

import Data.List
import System.IO


data Color = Black | White deriving (Show,Eq)
data Pawn = Man | King deriving (Show,Eq)
data F = F Color Pawn | Empty deriving (Show,Eq)

type State = Color
type Board = [[(F,(Int,Int))]]
type Positions = [(F,(Int,Int))]

figureToChar :: (F,(Int,Int)) -> Char

figureToChar x
    | kind == (F Black Man) = 'b'
    | kind == (F White Man) = 'w'
    | kind == (F Black King) = 'B'
    | kind == (F White King) = 'W'
    | kind == (Empty) = '.'
    where kind = fst x

size :: Int
size = 8
currentPlayer :: State
currentPlayer = White
board :: Board
board = [[(Empty,(1,1)),(F Black Man,(1,2)),(Empty,(1,3)),(F Black Man,(1,4)),(Empty,(1,5)),(F Black Man,(1,6)),(Empty,(1,7)),(F Black Man,(1,8))],
        [(F Black Man,(2,1)),(Empty,(2,2)),(F Black Man,(2,3)),(Empty,(2,4)),(F Black Man,(2,5)),(Empty,(2,6)),(F Black Man,(2,7)),(Empty,(2,8))],
        [(Empty,(3,1)),(F Black Man,(3,2)),(Empty,(3,3)),(F Black Man,(3,4)),(Empty,(3,5)),(F Black Man,(3,6)),(Empty,(3,7)),(F Black Man,(3,8))],
        [(Empty,(4,1)),(Empty,(4,2)),(Empty,(4,3)),(Empty,(4,4)),(Empty,(4,5)),(Empty,(4,6)),(Empty,(4,7)),(Empty,(4,8))],
        [(Empty,(5,1)),(Empty,(5,2)),(Empty,(5,3)),(Empty,(5,4)),(Empty,(5,5)),(Empty,(5,6)),(Empty,(5,7)),(Empty,(5,8))],
        [(F White Man,(6,1)),(Empty,(6,2)),(F White Man,(6,3)),(Empty,(6,4)),(F White Man,(6,5)),(Empty,(6,6)),(F White Man,(6,7)),(Empty,(6,8))],
        [(Empty,(7,1)),(F White Man,(7,2)),(Empty,(7,3)),(F White Man,(7,4)),(Empty,(7,5)),(F White Man,(7,6)),(Empty,(7,7)),(F White Man,(7,8))],
        [(F White Man,(8,1)),(Empty,(8,2)),(F White Man,(8,3)),(Empty,(8,4)),(F White Man,(8,5)),(Empty,(8,6)),(F White Man,(8,7)),(Empty,(8,8))]]
whitePositions :: Positions
whitePositions = [(F White Man,(6,1)),(F White Man,(6,3)),(F White Man,(6,5)),(F White Man,(6,7)),
                 (F White Man,(7,2)),(F White Man,(7,4)),(F White Man,(7,6)),(F White Man,(7,8)),
                 (F White Man,(8,1)),(F White Man,(8,3)),(F White Man,(8,5)),(F White Man,(8,7))]

blackPositions :: Positions
blackPositions = [(F Black Man,(1,2)),(F Black Man,(1,4)),(F Black Man,(1,6)),(F Black Man,(1,8)),
                 (F Black Man,(2,1)),(F Black Man,(2,3)),(F Black Man,(2,5)),(F Black Man,(2,7)),
                 (F Black Man,(3,2)),(F Black Man,(3,4)),(F Black Man,(3,6)),(F Black Man,(3,8))]

getPossibleMoves :: (F,(Int,Int)) -> [(Int,Int)]
getPossibleMoves x = case fst x of
    F Black Man -> if snd (snd x) == 1
        then [(fst(snd x) + 1,snd (snd x) + 1)]
        else if snd (snd x) == 8
            then [(fst(snd x) + 1,snd (snd x) - 1)]
        else
            [(fst(snd x) + 1,snd (snd x) - 1),(fst(snd x) + 1,snd (snd x) + 1)]
    F White Man -> if snd (snd x) == 1
        then [(fst(snd x) - 1,snd (snd x) + 1)]
        else if snd (snd x) == 8
            then [(fst(snd x) - 1,snd (snd x) - 1)]
        else
            [(fst(snd x) - 1,snd (snd x) - 1),(fst(snd x) + 1,snd (snd x) + 1)]
    Empty -> []

checkMove :: (Int,Int) -> Positions -> Bool
checkMove x y
    | null y = False
    | (snd (head y)) == x = True
    | otherwise = checkMove x (tail y)

filterPossibleMoves :: [(Int,Int)] -> Positions -> [(Int,Int)]
filterPossibleMoves x y
    | null x = []
    | checkMove (head x) y = [head x] ++ filterPossibleMoves (tail x) y
    | otherwise = filterPossibleMoves (tail x) y

mappedMoves :: [[(Int,Int)]]
mappedMoves = map getPossibleMoves whitePositions

filteredMoves :: [[(Int,Int)]]
filteredMoves = map (filterPossibleMoves mappedMoves whitePositions)

showBoardLine :: [(F,(Int,Int))] -> String
showBoardLine x = map figureToChar x ++ "\n"

showBoard :: Board -> String
showBoard = concatMap showBoardLine

showInitBoard :: IO()
showInitBoard = putStrLn $ showBoard board


main :: IO ()
main = do
    putStrLn "Checkers starting"
    showInitBoard