#16 Fix
This commit is contained in:
parent
0825c64da0
commit
8d9186963f
2 changed files with 113 additions and 27 deletions
26
lib/Patience.hs
Normal file
26
lib/Patience.hs
Normal 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
|
|
@ -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
|
||||||
]
|
]
|
||||||
|
|
Reference in a new issue