#5 #6

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.                                                       --
+----------------------------------------------------------------------

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
     ]

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
+-- Render the patience game.
-getSelected s@Selector{ selected = Just c  } = c
-getSelected s@Selector{ selected = Nothing } = (0,0)
-
 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