1
Fork 0
This commit is contained in:
Tibo De Peuter 2022-11-15 09:28:10 +01:00
parent 0825c64da0
commit 8d9186963f
2 changed files with 113 additions and 27 deletions

26
lib/Patience.hs Normal file
View file

@ -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

View file

@ -90,6 +90,45 @@ initGame = Game {
selector = initSelector 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 ----------------------------- --------------------------- Change cards -----------------------------
-- Show the first of a stack of cards. -- Show the first of a stack of cards.
@ -98,9 +137,10 @@ showFirst [] = []
showFirst (c:cs) = showCard c : cs showFirst (c:cs) = showCard c : cs
-- Rotate the pile n times. -- Rotate the pile n times.
rotatePile :: Board -> Board rotatePile :: Game -> Game
rotatePile b = b { pile = tail ++ head } rotatePile g@Game{ board = b } = g{ board = rotatedBoard }
where (head,tail) = splitAt rotateStep $ pile b where rotatedBoard = b{ pile = tail ++ head }
(head, tail) = splitAt rotateStep $ pile b
-- Check if a card can be placed ontop of a gameStack. -- Check if a card can be placed ontop of a gameStack.
canPlayOn :: Card -> Stack -> Bool canPlayOn :: Card -> Stack -> Bool
@ -135,29 +175,45 @@ moveToES from to
where (diff,removed) = splitAt 1 from where (diff,removed) = splitAt 1 from
added = diff ++ to 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 --------------------------------- ------------------------------ 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. -- Check if moving in a direction is legal.
isLegalMove :: Direction -> Game -> Bool isLegalMove :: Direction -> Game -> Bool
isLegalMove dir g = isInPile coord || isInEnding coord || isInGame coord g 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 } | isLegalMove dir g = g{ selector = move dir s }
| otherwise = g | otherwise = g
-- Toggle selector. (Wrapper) -- Toggle selector. If a card was already selected, try to move it.
toggleSelector :: Game -> Game 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. -- Handle all the inputs necessary for patience.
handleInputs :: Event -> Game -> Game handleInputs :: Event -> Game -> Game
@ -181,5 +240,6 @@ handleInputs = composeInputHandler [
handleLeft (moveSelector L), handleLeft (moveSelector L),
handleRight (moveSelector R), handleRight (moveSelector R),
handleSpace toggleSelector handleSpace toggleSelector,
handleEnter rotatePile
] ]