#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
|
||||
}
|
||||
|
||||
------------------- 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
|
||||
]
|
||||
|
|
Reference in a new issue