parent
7dc72ee211
commit
425bb6eee2
3 changed files with 44 additions and 44 deletions
|
|
@ -5,7 +5,7 @@ module Patience
|
|||
import PatienceBoard
|
||||
import PatienceRenderer
|
||||
|
||||
import Graphics.Gloss (green, play)
|
||||
import Graphics.Gloss (dim, green, play)
|
||||
|
||||
---------------------------------------------------------------------
|
||||
-- Single module to play patience. --
|
||||
|
|
@ -21,6 +21,19 @@ type FPS = Int
|
|||
|
||||
-- Play a game of patience.
|
||||
playPatience :: FPS -> IO()
|
||||
playPatience fps = do play window green fps initGame render handleInputs step
|
||||
playPatience fps = do play window bgcolor fps initGame render handleInputs step
|
||||
where window = getWindow
|
||||
step _ g = g
|
||||
bgcolor = dim green
|
||||
|
||||
---------------------------- Documentation ---------------------------
|
||||
-- The structure of this project is based on the Model-View- --
|
||||
-- Controller as known in Java. This clearly seperates different --
|
||||
-- functionality from each other. I also tried to put as much --
|
||||
-- functionality of the same thing into a single module. I always --
|
||||
-- asked myself: "Could I use this piece of code in a different --
|
||||
-- project?" If the answer was yes, there is now a module for it. --
|
||||
-- -*- --
|
||||
-- This block merely serves as a message to the person reviewing --
|
||||
-- this code. --
|
||||
----------------------------------------------------------------------
|
||||
|
|
|
|||
|
|
@ -28,7 +28,7 @@ data Game = Game {
|
|||
board :: Board,
|
||||
-- The selector
|
||||
selector :: Selector
|
||||
} deriving (Show)
|
||||
} deriving (Show, Eq)
|
||||
|
||||
-- Representation of a Patience board
|
||||
data Board = Board {
|
||||
|
|
@ -38,7 +38,7 @@ data Board = Board {
|
|||
endingStacks :: [Stack],
|
||||
-- Stack of cards that are not yet on the board
|
||||
pile :: Stack
|
||||
} deriving (Show)
|
||||
} deriving (Show, Eq)
|
||||
|
||||
-- The zones of the board. Represents either the pile, the endingStacks
|
||||
-- or the gameStacks. It can also be out of the board.
|
||||
|
|
@ -117,7 +117,7 @@ isInGame (x, y) g = horizontalCheck && verticalCheck
|
|||
upBound = y <= snd gameStacksCoord
|
||||
xStack = gameStacks (board g) !! x
|
||||
downBound = zero || negate y < length xStack
|
||||
zero = y == 0 && length xStack == 0
|
||||
zero = y == 0 && null xStack
|
||||
|
||||
-- Get the zone number from a coordinate.
|
||||
getZoneFromCoord :: Game -> Coordinate -> Zone
|
||||
|
|
@ -127,22 +127,6 @@ getZoneFromCoord game (x, y)
|
|||
| isInGame (x, y) game = GS
|
||||
| otherwise = Out
|
||||
|
||||
-- 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.
|
||||
|
|
@ -161,9 +145,9 @@ 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
|
||||
canPlayOn cs index ((t2,v2,vis2):_) = differentColor && predValue && visibility
|
||||
where (t1,v1,vis) = cs !! index
|
||||
differentColor = t1 /= t2 && (fromEnum t1 + fromEnum t2) `elem` [1,2,4,5]
|
||||
differentColor = not $ (t1,v1,vis) `matchColor` (t2,v2,vis2)
|
||||
predValue = succ v1 == v2
|
||||
visibility = vis == Visible
|
||||
|
||||
|
|
@ -194,7 +178,7 @@ moveGS2GS fromCoord toStackNr board
|
|||
tempGS = switchStack oldGS fromStackNr (showFirst newFrom)
|
||||
newGS = switchStack tempGS toStackNr newTo
|
||||
newBoard = board{ gameStacks = newGS }
|
||||
|
||||
-- Move from a gameStack to an endingStack.
|
||||
moveGS2ES :: Coordinate -> Int -> Board -> Board
|
||||
moveGS2ES fromCoord toIndex board
|
||||
| canFinishOn from 0 to = newBoard
|
||||
|
|
@ -236,6 +220,7 @@ moveP2GS _ toStackNr board
|
|||
newGS = switchStack oldGS toStackNr newGSStack
|
||||
newBoard = board{ gameStacks = newGS, pile = newPile }
|
||||
|
||||
-- Move a card from an endingStack to a gameStack.
|
||||
moveES2GS :: Coordinate -> Int -> Board -> Board
|
||||
moveES2GS fromCoord toStackNr board
|
||||
| canPlayOn from 0 to = newBoard
|
||||
|
|
@ -264,6 +249,7 @@ 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
|
||||
getStackFromZone _ Out _ = []
|
||||
|
||||
-- Move between to zones with two indexes
|
||||
getMoveFunction2 :: Zone -> Zone -> Coordinate -> Int -> Board -> Board
|
||||
|
|
@ -274,6 +260,7 @@ getMoveFunction2 GS ES coord index = moveGS2ES coord index
|
|||
getMoveFunction2 ES GS coord index = moveES2GS coord index
|
||||
getMoveFunction2 _ _ _ _ = id
|
||||
|
||||
-- Tranform the index based on the zone.
|
||||
transformIndex :: Zone -> Int -> Int
|
||||
transformIndex ES index = index - (amountOfGameStacks - amountOfEndingStacks)
|
||||
transformIndex Pile _ = 0
|
||||
|
|
@ -316,11 +303,13 @@ toggleSelector g@Game{ selector = s@Selector{ selected = Just coord } } = moved
|
|||
-- Handle all the inputs necessary for patience.
|
||||
handleInputs :: Event -> Game -> Game
|
||||
handleInputs = composeInputHandler [
|
||||
-- Selector movement
|
||||
handleUp (moveSelector U),
|
||||
handleDown (moveSelector D),
|
||||
handleLeft (moveSelector L),
|
||||
handleRight (moveSelector R),
|
||||
|
||||
-- Selection handling
|
||||
handleSpace toggleSelector,
|
||||
-- Pile rotation
|
||||
handleEnter rotatePile
|
||||
]
|
||||
|
|
|
|||
|
|
@ -3,6 +3,7 @@ module PatienceRenderer
|
|||
, getWindow
|
||||
) where
|
||||
|
||||
import CardDeck
|
||||
import PatienceBoard
|
||||
import Selector
|
||||
|
||||
|
|
@ -32,16 +33,6 @@ stackDistance = 10
|
|||
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
|
||||
|
|
@ -53,10 +44,6 @@ 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
|
||||
|
|
@ -65,6 +52,20 @@ pileXDiff = 0
|
|||
pileYDiff :: Float
|
||||
pileYDiff = esYDiff
|
||||
|
||||
----------------------------------------------------------------------
|
||||
|
||||
-- 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
|
||||
|
||||
-- Render the Pile zone.
|
||||
renderPile :: Board -> Picture
|
||||
renderPile = renderStack 0 . pile
|
||||
|
||||
-- Get the diff based on a coordinate because different 'zones' have
|
||||
-- different offsets.
|
||||
getDiff :: Coordinate -> (Float, Float)
|
||||
|
|
@ -100,17 +101,14 @@ renderPSelector ps = compose [
|
|||
(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 the patience game.
|
||||
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
|
||||
centerY = 0
|
||||
|
||||
-- The default window to play patience.
|
||||
getWindow :: Display
|
||||
|
|
|
|||
Reference in a new issue