From 5be241916389a7b6ca28f371be5cb7d515ccfa10 Mon Sep 17 00:00:00 2001 From: Tibo De Peuter Date: Mon, 14 Nov 2022 20:25:57 +0100 Subject: [PATCH 1/6] #1 Toggle selection --- lib/PatienceBoard.hs | 128 +++++++++++++++++++++++++++++++++++++------ lib/Selector.hs | 90 ++++++++++++++++++++++++++++++ 2 files changed, 201 insertions(+), 17 deletions(-) create mode 100644 lib/Selector.hs diff --git a/lib/PatienceBoard.hs b/lib/PatienceBoard.hs index 3253241..6785968 100644 --- a/lib/PatienceBoard.hs +++ b/lib/PatienceBoard.hs @@ -1,10 +1,27 @@ module PatienceBoard -( Board +( Game (..) +, Board (..) +, amountOfGameStacks +, amountOfEndingStacks -,initBoard +, handleInputs +, initGame ) where import CardDeck +import Selector + +import InputHandler + +----------------------------- Constants ------------------------------ + +-- Prepresentation of a Patience game +data Game = Game { + -- The playboard + board :: Board, + -- The selector + selector :: Selector +} deriving (Show) -- Representation of a Patience board data Board = Board { @@ -16,27 +33,104 @@ data Board = Board { pile :: Stack } deriving (Show) --- Show the first of a stack of cards. -showFirst :: Stack -> Stack -showFirst (c:cs) = (showCard c):cs +amountOfGameStacks :: Int +amountOfGameStacks = 7 + +amountOfEndingStacks :: Int +amountOfEndingStacks = 4 + +rotateStep :: Int +rotateStep = 3 + +------------------------------- Init --------------------------------- -- Split a full deck into 7 gameStacks and one pile of unused cards. splitDeck :: Stack -> [Stack] -splitDeck = reverse . splitDeck' 7 +splitDeck = reverse . splitDeck' amountOfGameStacks where splitDeck' :: Int -> Stack -> [Stack] splitDeck' 0 cs = [cs] splitDeck' n cs = let (stack,rest) = splitAt n cs - in (showFirst stack):(splitDeck' (n - 1) rest) + in showFirst stack : splitDeck' (n - 1) rest --- Return the initial board consisting of a stack of yet-to-be-turned --- cards and 7 stacks of increasingly large amount of cards (1, ..., 7) +-- The initial board consisting of a stack of yet-to-be-turned cards +-- and n stacks of increasingly large amount of cards (1, ..., n) initBoard :: Board -initBoard = let pile:stacks = splitDeck generateShuffledDeck - in Board { - gameStacks = stacks, - endingStacks = [[],[],[],[]], - pile = pile - } +initBoard = Board { + gameStacks = stacks, + endingStacks = replicate amountOfEndingStacks [], + pile = map showCard pile + } + where pile:stacks = splitDeck generateShuffledDeck -moveBetweenStacks :: Stack -> Int -> Stack -> Stack -moveBetweenStacks from index to = undefined +-- The initial state of the playboard, with a board and a cursor. +initGame :: Game +initGame = Game { + board = initBoard, + selector = initSelector +} + +--------------------------- Change cards ----------------------------- + +-- Show the first of a stack of cards. +showFirst :: Stack -> Stack +showFirst [] = [] +showFirst (c:cs) = showCard c : cs + +-- Rotate the pile n times. +rotatePile :: Board -> Board +rotatePile b = b { pile = tail ++ head } + where (head,tail) = splitAt rotateStep $ pile b + +-- Check if a card can be placed ontop of a gameStack. +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] + predValue = fromEnum v1 + 1 == fromEnum v2 +canPlayOn _ _ = False + +-- Check if a card can be played ontop of an EndingStack. +canFinishOn :: Card -> Stack -> Bool +canFinishOn (_,Ace,_) [] = True +canFinishOn (t1,v1,_) ((t2,v2,_):cs) = sameType && succValue + where sameType = t1 == t2 + succValue = fromEnum v1 == fromEnum v2 + 1 +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 + | 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 + | canFinishOn (head from) to = (showFirst removed, added) + | otherwise = (from,to) + where (diff,removed) = splitAt 1 from + added = diff ++ to + +------------------------------ Input --------------------------------- + +-- Move the selector of the game. (Wrapper) +moveSelector :: Direction -> Game -> Game +moveSelector dir g@Game{ selector = s } = g{ selector = move dir s } + +-- Toggle selector. (Wrapper) +toggleSelector :: Game -> Game +toggleSelector g@Game{ selector = s } = g{ selector = toggleSelection s } + +-- Handle all the inputs necessary for patience. +handleInputs :: Event -> Game -> Game +handleInputs = composeInputHandler [ + handleUp (moveSelector U), + handleDown (moveSelector D), + handleLeft (moveSelector L), + handleRight (moveSelector R), + + handleSpace toggleSelector + ] diff --git a/lib/Selector.hs b/lib/Selector.hs new file mode 100644 index 0000000..97218e8 --- /dev/null +++ b/lib/Selector.hs @@ -0,0 +1,90 @@ +module Selector +( Selector (..) +, Direction (..) + +, initSelector +, move +, moveBy +, select +, deselect +, toggleSelection + +, moveUp +, moveDown +, moveLeft +, moveRight +) where + +---------------------------------------------------------------------- +-- Base of a general purpose selector. -- +-- Can be used to show a selector, move up, down, left and right, -- +-- to 'hold' the currently selected card and remember that held. -- +-- card. -- +---------------------------------------------------------------------- + +----------------------------- Constants ------------------------------ + +-- A position on the playboard. +type Coordinate = (Int, Int) + +-- The direction in which the selector can move. +data Direction = U | D | L | R deriving (Show) + +diff = [(0,1), (0,-1), (-1,0), (1,0)] + +-- A selector can highlight a coordinate. +data Selector = Selector { + -- The current position of the selector. + position :: Coordinate, + -- The card(s) that the selector currently holds. + selected :: Maybe Coordinate +} deriving (Show) + +---------------------------------------------------------------------- + +-- Get the default selector. +initSelector :: Selector +initSelector = Selector { + position = (0,0), + selected = Nothing +} + +-- Sum two coordinates. +sumCoords :: Coordinate -> Coordinate -> Coordinate +sumCoords (x, y) (a, b) = (x + a, y + b) + +-- Move the selector by a given coordinate. +moveBy :: Coordinate -> Selector -> Selector +moveBy c1 s@Selector{ position = c2 } = s{ position = sumCoords c1 c2 } + +-- Move the selector one position into the the given direction. +move :: Direction -> Selector -> Selector +move U = moveBy (head diff) +move D = moveBy (diff !! 1) +move L = moveBy (diff !! 2) +move R = moveBy (diff !! 3) + +select :: Selector -> Selector +select s@Selector{ position = pos } = s{ selected = Just pos } + +deselect :: Selector -> Selector +deselect s = s{ selected = Nothing } + +toggleSelection :: Selector -> Selector +toggleSelection s@Selector{ selected = Nothing } = select s +toggleSelection s = deselect s + +---------------------------------------------------------------------- + +-- Move the selector up one position. +moveUp :: Selector -> Selector +moveUp = move U +-- Move the selector down one position. +moveDown :: Selector -> Selector +moveDown = move D +-- Move the selector left one position. +moveLeft :: Selector -> Selector +moveLeft = move L +-- Move the selector right one position. +moveRight :: Selector -> Selector +moveRight = move R From d0b708db62725b90f28334471eb46132b295d1a5 Mon Sep 17 00:00:00 2001 From: Tibo De Peuter Date: Mon, 14 Nov 2022 21:35:35 +0100 Subject: [PATCH 2/6] #12 Add zone move constraints --- lib/PatienceBoard.hs | 51 +++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 48 insertions(+), 3 deletions(-) diff --git a/lib/PatienceBoard.hs b/lib/PatienceBoard.hs index 6785968..e3dfd91 100644 --- a/lib/PatienceBoard.hs +++ b/lib/PatienceBoard.hs @@ -3,6 +3,9 @@ module PatienceBoard , Board (..) , amountOfGameStacks , amountOfEndingStacks +, gameStacksCoord +, endingStacksCoord +, pileCoord , handleInputs , initGame @@ -39,6 +42,20 @@ amountOfGameStacks = 7 amountOfEndingStacks :: Int amountOfEndingStacks = 4 +-- Coordinate of the GameStacks +gameStacksCoord :: Coordinate +gameStacksCoord = (0, 0) + +-- Coordinate of the EndingStacks +endingStacksCoord :: Coordinate +endingStacksCoord = (x, 1) + where x = amountOfGameStacks - amountOfEndingStacks + +-- Coordinate of the Pile +pileCoord :: Coordinate +pileCoord = (0, 1) + +-- Step size to rotate the pile of the game rotateStep :: Int rotateStep = 3 @@ -86,7 +103,7 @@ 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] - predValue = fromEnum v1 + 1 == fromEnum v2 + predValue = succ v1 == v2 canPlayOn _ _ = False -- Check if a card can be played ontop of an EndingStack. @@ -94,7 +111,7 @@ canFinishOn :: Card -> Stack -> Bool canFinishOn (_,Ace,_) [] = True canFinishOn (t1,v1,_) ((t2,v2,_):cs) = sameType && succValue where sameType = t1 == t2 - succValue = fromEnum v1 == fromEnum v2 + 1 + succValue = v1 == succ v2 canFinishOn _ _ = False -- Move a card to a GameStack. Move all the cards below the given card @@ -116,9 +133,37 @@ moveToES from to ------------------------------ Input --------------------------------- +-- Check if a coordinate is in the pile. +isInPile :: Coordinate -> Bool +isInPile = (pileCoord == ) + +-- Check if a coordinate is in an endingStack. +isInEnding :: Coordinate -> Bool +isInEnding (x, y) = leftBound && rightBound && yCheck + where leftBound = fst endingStacksCoord <= x + rightBound = x < amountOfGameStacks + yCheck = y == snd endingStacksCoord + +-- Check if a coordinate is in a GameStack. +isInGame :: Coordinate -> Game -> Bool +isInGame (x, y) g = horizontalCheck && verticalCheck + where horizontalCheck = leftBound && rightBound + verticalCheck = upBound && downBound + leftBound = fst gameStacksCoord <= x + rightBound = x < amountOfGameStacks + upBound = y <= snd gameStacksCoord + downBound = negate y < length (gameStacks (board g) !! x) + +-- Check if moving in a direction is legal. +isLegalMove :: Direction -> Game -> Bool +isLegalMove dir g = isInPile coord || isInEnding coord || isInGame coord g + where coord = position $ move dir $ selector g + -- Move the selector of the game. (Wrapper) moveSelector :: Direction -> Game -> Game -moveSelector dir g@Game{ selector = s } = g{ selector = move dir s } +moveSelector dir g@Game{ selector = s } + | isLegalMove dir g = g{ selector = move dir s } + | otherwise = g -- Toggle selector. (Wrapper) toggleSelector :: Game -> Game From 0825c64da0603ee3dc19696ce5a391bec364438f Mon Sep 17 00:00:00 2001 From: Tibo De Peuter Date: Mon, 14 Nov 2022 22:05:25 +0100 Subject: [PATCH 3/6] #12 Fix rendering of zones --- lib/PatienceBoard.hs | 4 ++ lib/PatienceRenderer.hs | 117 ++++++++++++++++++++++++++++++++++++++++ 2 files changed, 121 insertions(+) create mode 100644 lib/PatienceRenderer.hs diff --git a/lib/PatienceBoard.hs b/lib/PatienceBoard.hs index e3dfd91..63f9eac 100644 --- a/lib/PatienceBoard.hs +++ b/lib/PatienceBoard.hs @@ -9,6 +9,10 @@ module PatienceBoard , handleInputs , initGame + +, isInGame +, isInEnding +, isInPile ) where import CardDeck diff --git a/lib/PatienceRenderer.hs b/lib/PatienceRenderer.hs new file mode 100644 index 0000000..8af09c6 --- /dev/null +++ b/lib/PatienceRenderer.hs @@ -0,0 +1,117 @@ +module PatienceRenderer +( render +, getWindow +) where + +import PatienceBoard +import Selector + +import CardRenderer +import PNGRenderer +import SelectorRenderer + +import InputHandler + +import Graphics.Gloss( + Display(..) + , green + , play + ) + +----------------------------- Constants ------------------------------ + +-- Distance between cards that are on top of each other +cardDistance :: Float +cardDistance = 20 + +-- Distance between neighbouring stacks +stackDistance :: Float +stackDistance = 10 + +-- Distance between different zones of the board +zoneDistance :: Float +zoneDistance = 25 + +---------------------------------------------------------------------- + +-- Render the GameStacks zone. +renderGS :: Board -> Picture +renderGS = renderStacks stackDistance (negate cardDistance) . gameStacks + +-- Render the EndingStacks zone. +renderES :: Board -> Picture +renderES = renderStacks stackDistance 0 . endingStacks + +-- X axis render difference for EndingStacks +esXDiff :: Float +esXDiff = fromIntegral esX * cardDistance + where cardDistance = cardWidth + stackDistance + (esX, _) = endingStacksCoord + +-- Y axis render difference for EndingStacks +esYDiff :: Float +esYDiff = fromIntegral esY * (zoneDistance + cardHeight) + where (_, esY) = endingStacksCoord + +-- Render the Pile zone. +renderPile :: Board -> Picture +renderPile = renderStack 0 . pile + +-- X axis render difference for Pile +pileXDiff :: Float +pileXDiff = 0 + +-- Y axis render difference for Pile +pileYDiff :: Float +pileYDiff = esYDiff + +-- Get the diff based on a coordinate because different 'zones' have +-- different offsets. +getDiff :: Coordinate -> (Float, Float) +getDiff coord + | isInEnding coord = (width, esYDiff) + | isInPile coord = (pileXDiff, pileYDiff) + | otherwise = (width, cardDistance) + where width = cardWidth + stackDistance + +-- The board consists of three parts: +-- the gamestacks, the endingstacks and the pile. +-- Pile is located at (0,1). +-- EndingStacks are located at (n,1) - see calculations. +-- GameStacks are located at (0,0). +renderBoard :: Board -> Picture +renderBoard board = compose [ + pile, + endingStacks, + gameStacks + ] + where pile = translate pileXDiff pileYDiff $ renderPile board + endingStacks = translate esXDiff esYDiff $ renderES board + gameStacks = renderGS board + +-- Render the PatienceGameSelector. +renderPSelector :: Selector -> Picture +renderPSelector ps = compose [ + selector, + selected + ] + where selector = renderSelector xd1 yd1 ps + selected = renderSelected xd2 yd2 ps + (xd1, yd1) = getDiff (position ps) + (xd2, yd2) = getDiff $ getSelected ps + +getSelected :: Selector -> Coordinate +getSelected s@Selector{ selected = Just c } = c +getSelected s@Selector{ selected = Nothing } = (0,0) + +render :: Game -> Picture +render game = translate centerX centerY $ compose [ + renderBoard $ board game, + renderPSelector $ selector game + ] + where centerX = negate $ (cardWidth + stackDistance) * (fromIntegral amountOfGameStacks - 1) / 2 + centerY = 0 -- TODO Different center + +-- The default window to play patience. +getWindow :: Display +getWindow = InWindow "Patience" (1200,800) (50,50) From 8d9186963fa591898102b7d2e11a137183caca2d Mon Sep 17 00:00:00 2001 From: Tibo De Peuter Date: Tue, 15 Nov 2022 09:28:10 +0100 Subject: [PATCH 4/6] #16 Fix --- lib/Patience.hs | 26 ++++++++++ lib/PatienceBoard.hs | 114 +++++++++++++++++++++++++++++++++---------- 2 files changed, 113 insertions(+), 27 deletions(-) create mode 100644 lib/Patience.hs diff --git a/lib/Patience.hs b/lib/Patience.hs new file mode 100644 index 0000000..021da57 --- /dev/null +++ b/lib/Patience.hs @@ -0,0 +1,26 @@ +module Patience +( playPatience +) where + +import PatienceBoard +import PatienceRenderer + +import Graphics.Gloss (green, play) + +--------------------------------------------------------------------- +-- Single module to play patience. -- +-- Includes all logic and rendering. -- +--------------------------------------------------------------------- + +----------------------------- Constants ------------------------------ + +-- Framerate of the game +type FPS = Int + +--------------------------------------------------------------------- + +-- Play a game of patience. +playPatience :: FPS -> IO() +playPatience fps = do play window green fps initGame render handleInputs step + where window = getWindow + step _ g = g diff --git a/lib/PatienceBoard.hs b/lib/PatienceBoard.hs index 63f9eac..492f375 100644 --- a/lib/PatienceBoard.hs +++ b/lib/PatienceBoard.hs @@ -90,6 +90,45 @@ initGame = Game { selector = initSelector } +------------------- Coordinate to Card conversion -------------------- + +-- Check if a coordinate is in the pile. +isInPile :: Coordinate -> Bool +isInPile = (pileCoord == ) + +-- Check if a coordinate is in an endingStack. +isInEnding :: Coordinate -> Bool +isInEnding (x, y) = leftBound && rightBound && yCheck + where leftBound = fst endingStacksCoord <= x + rightBound = x < amountOfGameStacks + yCheck = y == snd endingStacksCoord + +-- Check if a coordinate is in a GameStack. +isInGame :: Coordinate -> Game -> Bool +isInGame (x, y) g = horizontalCheck && verticalCheck + where horizontalCheck = leftBound && rightBound + verticalCheck = upBound && downBound + leftBound = fst gameStacksCoord <= x + rightBound = x < amountOfGameStacks + upBound = y <= snd gameStacksCoord + downBound = negate y < length (gameStacks (board g) !! x) + +-- Based on a coordinate, return a stack. +getStackFromCoord :: Game -> Coordinate -> Stack +getStackFromCoord game (x, y) + | isInPile (x, y) = pile $ board game + | isInEnding (x, y) = endingStacks (board game) !! (x - (amountOfGameStacks - amountOfEndingStacks)) + | isInGame (x, y) game = gameStacks (board game) !! x + | otherwise = pile $ board game + +-- Based on a coordinate, return a card. +getCardFromCoord :: Game -> Coordinate -> Card +getCardFromCoord game (x, y) + | isInPile (x, y) = head $ pile (board game) + | isInEnding (x, y) = head $ endingStacks (board game) !! (x - (amountOfGameStacks - amountOfEndingStacks)) + | isInGame (x, y) game = (gameStacks (board game) !! x ) !! negate y + | otherwise = (NoneType, NoneValue, Hidden) + --------------------------- Change cards ----------------------------- -- Show the first of a stack of cards. @@ -98,9 +137,10 @@ showFirst [] = [] showFirst (c:cs) = showCard c : cs -- Rotate the pile n times. -rotatePile :: Board -> Board -rotatePile b = b { pile = tail ++ head } - where (head,tail) = splitAt rotateStep $ pile b +rotatePile :: Game -> Game +rotatePile g@Game{ board = b } = g{ board = rotatedBoard } + where rotatedBoard = b{ pile = tail ++ head } + (head, tail) = splitAt rotateStep $ pile b -- Check if a card can be placed ontop of a gameStack. canPlayOn :: Card -> Stack -> Bool @@ -135,29 +175,45 @@ moveToES from to where (diff,removed) = splitAt 1 from added = diff ++ to +-- 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 } + +-- 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 + ------------------------------ Input --------------------------------- --- Check if a coordinate is in the pile. -isInPile :: Coordinate -> Bool -isInPile = (pileCoord == ) - --- Check if a coordinate is in an endingStack. -isInEnding :: Coordinate -> Bool -isInEnding (x, y) = leftBound && rightBound && yCheck - where leftBound = fst endingStacksCoord <= x - rightBound = x < amountOfGameStacks - yCheck = y == snd endingStacksCoord - --- Check if a coordinate is in a GameStack. -isInGame :: Coordinate -> Game -> Bool -isInGame (x, y) g = horizontalCheck && verticalCheck - where horizontalCheck = leftBound && rightBound - verticalCheck = upBound && downBound - leftBound = fst gameStacksCoord <= x - rightBound = x < amountOfGameStacks - upBound = y <= snd gameStacksCoord - downBound = negate y < length (gameStacks (board g) !! x) - -- Check if moving in a direction is legal. isLegalMove :: Direction -> Game -> Bool isLegalMove dir g = isInPile coord || isInEnding coord || isInGame coord g @@ -169,9 +225,12 @@ moveSelector dir g@Game{ selector = s } | isLegalMove dir g = g{ selector = move dir s } | otherwise = g --- Toggle selector. (Wrapper) +-- Toggle selector. If a card was already selected, try to move it. toggleSelector :: Game -> Game -toggleSelector g@Game{ selector = s } = g{ selector = toggleSelection s } +toggleSelector g@Game{ selector = s@Selector{ selected = Nothing } } = toggled + where toggled = g{ selector = toggleSelection s } +toggleSelector g@Game{ selector = s@Selector{ selected = Just coord } } = moved + where moved = moveCard g{ selector = toggleSelection s } (getSelected s) (position s) -- Handle all the inputs necessary for patience. handleInputs :: Event -> Game -> Game @@ -181,5 +240,6 @@ handleInputs = composeInputHandler [ handleLeft (moveSelector L), handleRight (moveSelector R), - handleSpace toggleSelector + handleSpace toggleSelector, + handleEnter rotatePile ] From df3b6ae092585782a1262578bee6dd71dce6413c Mon Sep 17 00:00:00 2001 From: Tibo De Peuter Date: Tue, 15 Nov 2022 12:31:31 +0100 Subject: [PATCH 5/6] #1 Redid all the logic --- lib/PatienceBoard.hs | 164 ++++++++++++++++++++++++++++++++++--------- 1 file changed, 131 insertions(+), 33 deletions(-) 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. From 6dbedddb7b720180086ae549dd4a167bcb3060f8 Mon Sep 17 00:00:00 2001 From: Tibo De Peuter Date: Tue, 15 Nov 2022 17:05:06 +0100 Subject: [PATCH 6/6] #1 Handle all inputs --- lib/PatienceBoard.hs | 65 ++++++++++++++++---------------------------- 1 file changed, 24 insertions(+), 41 deletions(-) diff --git a/lib/PatienceBoard.hs b/lib/PatienceBoard.hs index 54edbca..c33d1f6 100644 --- a/lib/PatienceBoard.hs +++ b/lib/PatienceBoard.hs @@ -115,7 +115,9 @@ isInGame (x, y) g = horizontalCheck && verticalCheck leftBound = fst gameStacksCoord <= x rightBound = x < amountOfGameStacks upBound = y <= snd gameStacksCoord - downBound = negate y < length (gameStacks (board g) !! x) + xStack = gameStacks (board g) !! x + downBound = zero || negate y < length xStack + zero = y == 0 && length xStack == 0 -- Get the zone number from a coordinate. getZoneFromCoord :: Game -> Coordinate -> Zone @@ -155,50 +157,31 @@ rotatePile g@Game{ board = b } = g{ board = rotatedBoard } (head, tail) = splitAt rotateStep $ pile b -- Check if a card can be placed ontop of a gameStack. -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] +canPlayOn :: Stack -> Int -> Stack -> Bool +canPlayOn [] _ _ = False +canPlayOn cs index [] = v1 == King && vis == Visible + where (_,v1,vis) = cs !! index +canPlayOn cs index ((t2,v2,_):_) = differentColor && predValue && visibility + where (t1,v1,vis) = cs !! index + differentColor = t1 /= t2 && (fromEnum t1 + fromEnum t2) `elem` [1,2,4,5] predValue = succ v1 == v2 -canPlayOn _ _ = False + visibility = vis == Visible -- Check if a card can be played ontop of an EndingStack. -canFinishOn :: Card -> Stack -> Bool -canFinishOn (_,Ace,_) [] = True -canFinishOn (t1,v1,_) ((t2,v2,_):cs) = sameType && succValue - where sameType = t1 == t2 +canFinishOn :: Stack -> Int -> Stack -> Bool +canFinishOn [] _ _ = False +canFinishOn cs index [] = v1 == Ace && vis == Visible + where (_,v1,vis) = cs !! index +canFinishOn cs index ((t2,v2,_):_) = sameType && succValue && visibility + where (t1,v1,vis) = cs !! index + sameType = t1 == t2 succValue = v1 == succ v2 -canFinishOn _ _ = False - --- Move a card to a GameStack. Move all the cards below the given card --- on the 'from' stack as well. -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 :: 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 + visibility = vis == Visible -- Move from one gameStack to another. moveGS2GS :: Coordinate -> Int -> Board -> Board moveGS2GS fromCoord toStackNr board - | canPlayOn (from !! (index - 1)) to = newBoard + | canPlayOn from (index - 1) to = newBoard | otherwise = board where (fromStackNr, negIndex) = fromCoord fromAmount = length from @@ -214,7 +197,7 @@ moveGS2GS fromCoord toStackNr board moveGS2ES :: Coordinate -> Int -> Board -> Board moveGS2ES fromCoord toIndex board - | canFinishOn (head from) to = newBoard + | canFinishOn from 0 to = newBoard | otherwise = board where (fromIndex, _) = fromCoord oldGS = gameStacks board @@ -230,7 +213,7 @@ moveGS2ES fromCoord toIndex board -- Move a card between pile and endingStacks. moveP2ES :: Coordinate -> Int -> Board -> Board moveP2ES _ toIndex board - | canFinishOn (head oldPile) to = newBoard + | canFinishOn oldPile 0 to = newBoard | otherwise = board where oldPile = pile board oldES = endingStacks board @@ -243,7 +226,7 @@ moveP2ES _ toIndex board -- Move a card between pile and gameStacks. moveP2GS :: Coordinate -> Int -> Board -> Board moveP2GS _ toStackNr board - | canPlayOn (head oldPile) to = newBoard + | canPlayOn oldPile 0 to = newBoard | otherwise = board where oldPile = pile board oldGS = gameStacks board @@ -255,7 +238,7 @@ moveP2GS _ toStackNr board moveES2GS :: Coordinate -> Int -> Board -> Board moveES2GS fromCoord toStackNr board - | canPlayOn (head from) to = newBoard + | canPlayOn from 0 to = newBoard | otherwise = board where (tempIndex, _) = fromCoord fromIndex = tempIndex - (amountOfGameStacks - amountOfEndingStacks)