diff --git a/lib/PatienceBoard.hs b/lib/PatienceBoard.hs index 492f375..54edbca 100644 --- a/lib/PatienceBoard.hs +++ b/lib/PatienceBoard.hs @@ -40,6 +40,10 @@ data Board = Board { pile :: Stack } deriving (Show) +-- The zones of the board. Represents either the pile, the endingStacks +-- or the gameStacks. It can also be out of the board. +data Zone = Pile | ES | GS | Out + amountOfGameStacks :: Int amountOfGameStacks = 7 @@ -113,6 +117,14 @@ isInGame (x, y) g = horizontalCheck && verticalCheck upBound = y <= snd gameStacksCoord downBound = negate y < length (gameStacks (board g) !! x) +-- Get the zone number from a coordinate. +getZoneFromCoord :: Game -> Coordinate -> Zone +getZoneFromCoord game (x, y) + | isInPile (x, y) = Pile + | isInEnding (x, y) = ES + | isInGame (x, y) game = GS + | otherwise = Out + -- Based on a coordinate, return a stack. getStackFromCoord :: Game -> Coordinate -> Stack getStackFromCoord game (x, y) @@ -146,7 +158,7 @@ rotatePile g@Game{ board = b } = g{ board = rotatedBoard } canPlayOn :: Card -> Stack -> Bool canPlayOn (_,King,_) [] = True canPlayOn (t1,v1,_) ((t2,v2,_):cs) = differentColor && predValue - where differentColor = t1 /= t2 && fromEnum t1 + fromEnum t2 `elem` [1,2,4,5] + where differentColor = t1 /= t2 && (fromEnum t1 + fromEnum t2) `elem` [1,2,4,5] predValue = succ v1 == v2 canPlayOn _ _ = False @@ -160,58 +172,144 @@ canFinishOn _ _ = False -- Move a card to a GameStack. Move all the cards below the given card -- on the 'from' stack as well. -moveToGS :: Stack -> Int -> Stack -> (Stack,Stack) -moveToGS from index to +moveBetweenGS :: Int -> Stack -> Stack -> (Stack,Stack) +moveBetweenGS index from to | canPlayOn (from !! index) to = (showFirst removed, added) | otherwise = (from,to) where (diff,removed) = splitAt (index + 1) from added = diff ++ to -- Move a card to an EndingStack. This can only be a single card at once. -moveToES :: Stack -> Stack -> (Stack,Stack) -moveToES from to +moveToES :: Int -> Stack -> Stack -> (Stack,Stack) +moveToES _ from to | canFinishOn (head from) to = (showFirst removed, added) | otherwise = (from,to) where (diff,removed) = splitAt 1 from added = diff ++ to +-- Move from an EndingStack to GameStack. +moveESToGS :: Int -> Stack -> Stack -> (Stack,Stack) +moveESToGS _ from to + | canPlayOn (head from) to = (cs, added) + | otherwise = (from, to) + where (c:cs) = from + added = c:to + +-- Move from one gameStack to another. +moveGS2GS :: Coordinate -> Int -> Board -> Board +moveGS2GS fromCoord toStackNr board + | canPlayOn (from !! (index - 1)) to = newBoard + | otherwise = board + where (fromStackNr, negIndex) = fromCoord + fromAmount = length from + oldGS = gameStacks board + from = oldGS !! fromStackNr + to = oldGS !! toStackNr + index = fromAmount - negate negIndex + (diff, newFrom) = splitAt index from + newTo = diff ++ to + tempGS = switchStack oldGS fromStackNr (showFirst newFrom) + newGS = switchStack tempGS toStackNr newTo + newBoard = board{ gameStacks = newGS } + +moveGS2ES :: Coordinate -> Int -> Board -> Board +moveGS2ES fromCoord toIndex board + | canFinishOn (head from) to = newBoard + | otherwise = board + where (fromIndex, _) = fromCoord + oldGS = gameStacks board + oldES = endingStacks board + from = oldGS !! fromIndex + to = oldES !! toIndex + (card:newGSStack) = from + newESStack = card:to + newGS = switchStack oldGS fromIndex (showFirst newGSStack) + newES = switchStack oldES toIndex newESStack + newBoard = board{ endingStacks = newES, gameStacks = newGS } + +-- Move a card between pile and endingStacks. +moveP2ES :: Coordinate -> Int -> Board -> Board +moveP2ES _ toIndex board + | canFinishOn (head oldPile) to = newBoard + | otherwise = board + where oldPile = pile board + oldES = endingStacks board + to = oldES !! toIndex + (card:newPile) = oldPile + newESStack = card:to + newES = switchStack oldES toIndex newESStack + newBoard = board{ pile = newPile, endingStacks = newES } + +-- Move a card between pile and gameStacks. +moveP2GS :: Coordinate -> Int -> Board -> Board +moveP2GS _ toStackNr board + | canPlayOn (head oldPile) to = newBoard + | otherwise = board + where oldPile = pile board + oldGS = gameStacks board + to = oldGS !! toStackNr + (card:newPile) = oldPile + newGSStack = card:to + newGS = switchStack oldGS toStackNr newGSStack + newBoard = board{ gameStacks = newGS, pile = newPile } + +moveES2GS :: Coordinate -> Int -> Board -> Board +moveES2GS fromCoord toStackNr board + | canPlayOn (head from) to = newBoard + | otherwise = board + where (tempIndex, _) = fromCoord + fromIndex = tempIndex - (amountOfGameStacks - amountOfEndingStacks) + oldES = endingStacks board + oldGS = gameStacks board + from = oldES !! fromIndex + to = oldGS !! toStackNr + (card:newESStack) = from + newGSStack = card:to + newES = switchStack oldES fromIndex newESStack + newGS = switchStack oldGS toStackNr newGSStack + newBoard = board{ gameStacks = newGS, endingStacks = newES } + + -- Switch a stack for another stack in a list of stacks. switchStack :: [Stack] -> Int -> Stack -> [Stack] switchStack ss index new = front ++ new:back where (front, back') = splitAt index ss back = tail back' --- Swap a stack in the Game for another stack. -updateStack :: Game -> Coordinate -> Stack -> Game -updateStack game (x, y) new - | isInEnding (x, y) = let originalBoard = board game - index = x - (amountOfGameStacks - amountOfEndingStacks) - newStack = switchStack (endingStacks originalBoard) index new - updatedBoard = originalBoard{ endingStacks = newStack } - in game{ board = updatedBoard } - | isInPile (x, y) = let originalBoard = board game - updatedBoard = originalBoard{ pile = new } - in game{ board = updatedBoard } - | otherwise = let originalBoard = board game - stackNr = x - index = negate y - newGameStacks = switchStack (gameStacks originalBoard) stackNr new - updatedBoard = originalBoard{ gameStacks = newGameStacks } - in game{ board = updatedBoard } +-- Get the stack that is located in the given zone at the given index. +getStackFromZone :: Game -> Zone -> Int -> Stack +getStackFromZone game Pile index = pile (board game) +getStackFromZone game ES index = endingStacks (board game) !! index +getStackFromZone game GS index = gameStacks (board game) !! index + +-- Move between to zones with two indexes +getMoveFunction2 :: Zone -> Zone -> Coordinate -> Int -> Board -> Board +getMoveFunction2 Pile ES coord index = moveP2ES coord index +getMoveFunction2 Pile GS coord index = moveP2GS coord index +getMoveFunction2 GS GS coord index = moveGS2GS coord index +getMoveFunction2 GS ES coord index = moveGS2ES coord index +getMoveFunction2 ES GS coord index = moveES2GS coord index +getMoveFunction2 _ _ _ _ = id + +transformIndex :: Zone -> Int -> Int +transformIndex ES index = index - (amountOfGameStacks - amountOfEndingStacks) +transformIndex Pile _ = 0 +transformIndex _ index = index -- Move a card from Coordinate to Coordinate. moveCard :: Game -> Coordinate -> Coordinate -> Game -moveCard game (x, y) (a, b) - | isInEnding (a, b) = let fromStack = getStackFromCoord game (x, y) - toStack = getStackFromCoord game (a, b) - (removed, added) = moveToES fromStack toStack - -- Swapping to old stack. - applyFirst = updateStack game (x, y) removed - -- Swapping the new stack. - result = updateStack applyFirst (a, b) added - in result - | otherwise = game - +moveCard game fromCoord toCoord = game{ board = newBoard } + where originalBoard = board game + (x, _) = fromCoord + (index, _) = toCoord + properIndex = transformIndex toZone index + fromZone = getZoneFromCoord game fromCoord + toZone = getZoneFromCoord game toCoord + fromStack = getStackFromZone game fromZone x + toStack = getStackFromZone game toZone x + moveFunction = getMoveFunction2 fromZone toZone fromCoord properIndex + newBoard = moveFunction originalBoard + ------------------------------ Input --------------------------------- -- Check if moving in a direction is legal.