diff --git a/lib/PatienceBoard.hs b/lib/PatienceBoard.hs index 3253241..6785968 100644 --- a/lib/PatienceBoard.hs +++ b/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. -showFirst :: Stack -> Stack -showFirst (c:cs) = (showCard c):cs +amountOfGameStacks :: Int +amountOfGameStacks = 7 + +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 --- cards and 7 stacks of increasingly large amount of cards (1, ..., 7) +-- The initial board consisting of a stack of yet-to-be-turned cards +-- and n stacks of increasingly large amount of cards (1, ..., n) initBoard :: Board -initBoard = let pile:stacks = splitDeck generateShuffledDeck - in Board { - gameStacks = stacks, - endingStacks = [[],[],[],[]], - pile = pile - } +initBoard = Board { + gameStacks = stacks, + endingStacks = replicate amountOfEndingStacks [], + pile = map showCard pile + } + where pile:stacks = splitDeck generateShuffledDeck -moveBetweenStacks :: Stack -> Int -> Stack -> Stack -moveBetweenStacks from index to = undefined +-- The initial state of the playboard, with a board and a cursor. +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 + ] diff --git a/lib/Selector.hs b/lib/Selector.hs new file mode 100644 index 0000000..97218e8 --- /dev/null +++ b/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