#1 Toggle selection

lib/PatienceBoard.hs

@@ -1,10 +1,27 @@
 module PatienceBoard
-( Board
+( Game (..)
+, Board (..)
+, amountOfGameStacks
+, amountOfEndingStacks
 
-,initBoard
+, handleInputs
+, initGame
 ) where
 
 import CardDeck
+import Selector
+
+import InputHandler
+
+----------------------------- Constants ------------------------------
+
+-- Prepresentation of a Patience game
+data Game = Game {
+    -- The playboard
+    board :: Board,
+    -- The selector
+    selector :: Selector
+} deriving (Show)
 
 -- Representation of a Patience board
 data Board = Board {
@@ -16,27 +33,104 @@ data Board = Board {
     pile         :: Stack
 } deriving (Show)
 
--- Show the first of a stack of cards.
+amountOfGameStacks :: Int
-showFirst :: Stack -> Stack
+amountOfGameStacks = 7
-showFirst (c:cs) = (showCard c):cs
+
+amountOfEndingStacks :: Int
+amountOfEndingStacks = 4
+
+rotateStep :: Int
+rotateStep = 3
+
+------------------------------- Init ---------------------------------
 
 -- Split a full deck into 7 gameStacks and one pile of unused cards.
 splitDeck :: Stack -> [Stack]
-splitDeck = reverse . splitDeck' 7
+splitDeck = reverse . splitDeck' amountOfGameStacks
     where splitDeck' :: Int -> Stack -> [Stack]
           splitDeck' 0 cs  = [cs]
           splitDeck' n cs  = let (stack,rest) = splitAt n cs
-                             in (showFirst stack):(splitDeck' (n - 1) rest)
+                             in showFirst stack : splitDeck' (n - 1) rest
 
--- Return the initial board consisting of a stack of yet-to-be-turned
+-- The initial board consisting of a stack of yet-to-be-turned cards
--- cards and 7 stacks of increasingly large amount of cards (1, ..., 7)
+-- and n stacks of increasingly large amount of cards (1, ..., n)
 initBoard :: Board
-initBoard = let pile:stacks = splitDeck generateShuffledDeck
+initBoard = Board {
-            in Board {
+        gameStacks = stacks,
-                gameStacks = stacks,
+        endingStacks = replicate amountOfEndingStacks [],
-                endingStacks = [[],[],[],[]],
+        pile = map showCard pile
-                pile = pile
+    }
-            }
+    where pile:stacks = splitDeck generateShuffledDeck
 
-moveBetweenStacks :: Stack -> Int -> Stack -> Stack
+-- The initial state of the playboard, with a board and a cursor.
-moveBetweenStacks from index to = undefined 
+initGame :: Game
+initGame = Game {
+    board    = initBoard,
+    selector = initSelector
+}
+
+--------------------------- Change cards -----------------------------
+
+-- Show the first of a stack of cards.
+showFirst :: Stack -> Stack
+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
+
+-- Check if a card can be placed ontop of a gameStack.
+canPlayOn :: Card -> Stack -> Bool
+canPlayOn (_,King,_) []             = True
+canPlayOn (t1,v1,_)  ((t2,v2,_):cs) = differentColor && predValue
+    where differentColor = t1 /= t2 && fromEnum t1 + fromEnum t2 `elem` [1,2,4,5]
+          predValue      = fromEnum v1 + 1 == fromEnum v2
+canPlayOn _          _   = False
+
+-- Check if a card can be played ontop of an EndingStack.
+canFinishOn :: Card -> Stack -> Bool
+canFinishOn (_,Ace,_) []             = True
+canFinishOn (t1,v1,_) ((t2,v2,_):cs) = sameType && succValue
+    where sameType  = t1 == t2
+          succValue = fromEnum v1 == fromEnum v2 + 1
+canFinishOn _         _              = False
+
+-- Move a card to a GameStack. Move all the cards below the given card
+-- on the 'from' stack as well.
+moveToGS :: Stack -> Int -> Stack -> (Stack,Stack)
+moveToGS from index to
+    | canPlayOn (from !! index) to = (showFirst removed, added)
+    | otherwise = (from,to)
+    where (diff,removed) = splitAt (index + 1) from
+          added          = diff ++ to
+
+-- Move a card to an EndingStack. This can only be a single card at once.
+moveToES :: Stack -> Stack -> (Stack,Stack)
+moveToES from to
+    | canFinishOn (head from) to = (showFirst removed, added)
+    | otherwise = (from,to)
+    where (diff,removed) = splitAt 1 from
+          added          = diff ++ to
+
+------------------------------ Input ---------------------------------
+
+-- Move the selector of the game. (Wrapper)
+moveSelector :: Direction -> Game -> Game
+moveSelector dir g@Game{ selector = s } = g{ selector = move dir s }
+
+-- Toggle selector. (Wrapper)
+toggleSelector :: Game -> Game
+toggleSelector g@Game{ selector = s } = g{ selector = toggleSelection s }
+
+-- Handle all the inputs necessary for patience.
+handleInputs :: Event -> Game -> Game
+handleInputs = composeInputHandler [
+    handleUp    (moveSelector U), 
+    handleDown  (moveSelector D),
+    handleLeft  (moveSelector L),
+    handleRight (moveSelector R), 
+
+    handleSpace toggleSelector
+    ]

lib/Selector.hs

@@ -0,0 +1,90 @@
+module Selector
+( Selector (..)
+, Direction (..)
+
+, initSelector
+, move
+, moveBy
+, select
+, deselect
+, toggleSelection
+
+, moveUp
+, moveDown
+, moveLeft
+, moveRight
+) where
+
+----------------------------------------------------------------------
+-- Base of a general purpose selector.                              --
+-- Can be used to show a selector, move up, down, left and right,   --
+-- to 'hold' the currently selected card and remember that held.    -- 
+-- card.                                                            --
+----------------------------------------------------------------------
+
+----------------------------- Constants ------------------------------
+
+-- A position on the playboard.
+type Coordinate = (Int, Int)
+
+-- The direction in which the selector can move.
+data Direction = U | D | L | R deriving (Show)
+
+diff = [(0,1), (0,-1), (-1,0), (1,0)]
+
+-- A selector can highlight a coordinate.
+data Selector = Selector {
+    -- The current position of the selector.
+    position :: Coordinate,
+    -- The card(s) that the selector currently holds.
+    selected :: Maybe Coordinate
+} deriving (Show)
+
+----------------------------------------------------------------------
+
+-- Get the default selector.
+initSelector :: Selector
+initSelector = Selector {
+    position = (0,0),
+    selected = Nothing
+}
+
+-- Sum two coordinates.
+sumCoords :: Coordinate -> Coordinate -> Coordinate
+sumCoords (x, y) (a, b) = (x + a, y + b)
+
+-- Move the selector by a given coordinate.
+moveBy :: Coordinate -> Selector -> Selector
+moveBy c1 s@Selector{ position = c2 } = s{ position = sumCoords c1 c2 }
+
+-- Move the selector one position into the the given direction.
+move :: Direction -> Selector -> Selector
+move U = moveBy (head diff)
+move D = moveBy (diff !! 1)
+move L = moveBy (diff !! 2)
+move R = moveBy (diff !! 3)
+
+select :: Selector -> Selector
+select s@Selector{ position = pos } = s{ selected = Just pos }
+
+deselect :: Selector -> Selector
+deselect s = s{ selected = Nothing }
+
+toggleSelection :: Selector -> Selector
+toggleSelection s@Selector{ selected = Nothing } = select s
+toggleSelection s                                = deselect s
+
+----------------------------------------------------------------------
+
+-- Move the selector up one position.
+moveUp :: Selector -> Selector
+moveUp = move U
+-- Move the selector down one position.
+moveDown :: Selector -> Selector
+moveDown = move D
+-- Move the selector left one position.
+moveLeft :: Selector -> Selector
+moveLeft = move L
+-- Move the selector right one position.
+moveRight :: Selector -> Selector
+moveRight = move R