From 33c9a877d22c2f8a560769aa984c3906e096cb17 Mon Sep 17 00:00:00 2001 From: Tibo De Peuter Date: Mon, 14 Nov 2022 18:20:43 +0100 Subject: [PATCH 01/20] #1 Handle multiple key input --- lib/InputHandler.hs | 60 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 60 insertions(+) create mode 100644 lib/InputHandler.hs diff --git a/lib/InputHandler.hs b/lib/InputHandler.hs new file mode 100644 index 0000000..9c04223 --- /dev/null +++ b/lib/InputHandler.hs @@ -0,0 +1,60 @@ +module InputHandler +( Event + +, handleInput +, composeInputHandler + +, handleSpace +, handleEnter +, handleUp +, handleDown +, handleLeft +, handleRight +) where + +import Graphics.Gloss +import qualified Graphics.Gloss.Interface.IO.Game as Game + +----------------------------- Constants ------------------------------ + +-- Something that happens, most often a keypress +type Event = Game.Event + +---------------------------------------------------------------------- + +-- Handle input by taking a keyCheck function that checks wheter or not +-- a key is being presse +handleInput :: Game.SpecialKey -> (a -> a) -> Event -> a -> a +handleInput key convert ev currentState + | isKey key ev = convert currentState + | otherwise = currentState + +-- Compose multiple InputHandlers into one combined InputHandler. +composeInputHandler :: [Event -> a -> a] -> Event -> a -> a +composeInputHandler (ih:ihs) ev a = composeInputHandler ihs ev (ih ev a) +composeInputHandler [] ev a = a + +-- Check if the requested key is pressed. +isKey :: Game.SpecialKey -> Event -> Bool +isKey k1 (Game.EventKey (Game.SpecialKey k2) Game.Down _ _) = k1 == k2 +isKey _ _ = False + +------------------ A couple of default inputhandlers ----------------- + +handleSpace :: (a -> a) -> Event -> a -> a +handleSpace = handleInput Game.KeySpace + +handleEnter :: (a -> a) -> Event -> a -> a +handleEnter = handleInput Game.KeyEnter + +handleUp :: (a -> a) -> Event -> a -> a +handleUp = handleInput Game.KeyUp + +handleDown :: (a -> a) -> Event -> a -> a +handleDown = handleInput Game.KeyDown + +handleLeft :: (a -> a) -> Event -> a -> a +handleLeft = handleInput Game.KeyLeft + +handleRight :: (a -> a) -> Event -> a -> a +handleRight = handleInput Game.KeyRight From bb16551cb8c68a7033f40d951f3bc6f6324fa8fc Mon Sep 17 00:00:00 2001 From: Tibo De Peuter Date: Mon, 14 Nov 2022 18:25:38 +0100 Subject: [PATCH 02/20] #9 Polishing shuffle --- lib/Shuffle.hs | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/lib/Shuffle.hs b/lib/Shuffle.hs index 6f349c6..c8a34cf 100644 --- a/lib/Shuffle.hs +++ b/lib/Shuffle.hs @@ -1,12 +1,18 @@ -module Shuffle ( - shuffle +module Shuffle +( shuffle ) where import Data.List import System.Random +----------------------------- Constants ------------------------------ + +-- The seed used to generate random numbers. +seed :: Int seed = 20 +---------------------------------------------------------------------- + -- Shuffle a list of values. shuffle :: [a] -> [a] shuffle l = map (l !!) $ generateIndices $ length l @@ -19,6 +25,5 @@ generateIndices size = take size uniqueList uniqueList = nub randomList -- Generate a random generator --- TODO Écht random maken? randomGen :: StdGen randomGen = mkStdGen seed From fd92ba9d8faf209f9d45b112e5dda76b30efd27f Mon Sep 17 00:00:00 2001 From: Tibo De Peuter Date: Mon, 14 Nov 2022 18:25:38 +0100 Subject: [PATCH 03/20] #9 Polishing shuffle --- lib/Shuffle.hs | 16 +++++++++++++--- 1 file changed, 13 insertions(+), 3 deletions(-) diff --git a/lib/Shuffle.hs b/lib/Shuffle.hs index 6f349c6..14f8919 100644 --- a/lib/Shuffle.hs +++ b/lib/Shuffle.hs @@ -1,12 +1,23 @@ -module Shuffle ( - shuffle +module Shuffle +( shuffle ) where import Data.List import System.Random +---------------------------------------------------------------------- +-- Shuffle a list so that the elements of the list are randomly -- +-- perumated. -- +---------------------------------------------------------------------- + +----------------------------- Constants ------------------------------ + +-- The seed used to generate random numbers. +seed :: Int seed = 20 +---------------------------------------------------------------------- + -- Shuffle a list of values. shuffle :: [a] -> [a] shuffle l = map (l !!) $ generateIndices $ length l @@ -19,6 +30,5 @@ generateIndices size = take size uniqueList uniqueList = nub randomList -- Generate a random generator --- TODO Écht random maken? randomGen :: StdGen randomGen = mkStdGen seed From 31ddddeded37bc0e68af688b37b6e1c0e8117bb6 Mon Sep 17 00:00:00 2001 From: Tibo De Peuter Date: Mon, 14 Nov 2022 19:19:02 +0100 Subject: [PATCH 04/20] Polish PNGRenderer --- lib/PNGRenderer.hs | 38 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 38 insertions(+) create mode 100644 lib/PNGRenderer.hs diff --git a/lib/PNGRenderer.hs b/lib/PNGRenderer.hs new file mode 100644 index 0000000..8c342dd --- /dev/null +++ b/lib/PNGRenderer.hs @@ -0,0 +1,38 @@ +module PNGRenderer +( Picture + +, renderPNG +, compose +, translate +, blank +) where + +import Data.Maybe +import System.IO.Unsafe +import qualified Graphics.Gloss as Gloss +import Graphics.Gloss.Juicy + +---------------------------------------------------------------------- +-- Render a file using Gloss.Picture. Compose multiple images into -- +-- one. -- +---------------------------------------------------------------------- + +----------------------------- Constants ------------------------------ + +type Picture = Gloss.Picture + +---------------------------------------------------------------------- + +-- Turn a path to a .png file into a Picture. +renderPNG :: FilePath -> Picture +renderPNG = fromJust . unsafePerformIO . loadJuicyPNG + +-- An empty picture +blank :: Picture +blank = Gloss.Blank + +translate :: Float -> Float -> Picture -> Picture +translate = Gloss.translate + +compose :: [Picture] -> Picture +compose = Gloss.Pictures From b7f0b468921c293bb63ee5dde0b606ff16b76c56 Mon Sep 17 00:00:00 2001 From: tdpeuter Date: Mon, 14 Nov 2022 19:24:04 +0100 Subject: [PATCH 05/20] revert bb16551cb8c68a7033f40d951f3bc6f6324fa8fc revert #9 Polishing shuffle --- lib/Shuffle.hs | 11 +++-------- 1 file changed, 3 insertions(+), 8 deletions(-) diff --git a/lib/Shuffle.hs b/lib/Shuffle.hs index c8a34cf..6f349c6 100644 --- a/lib/Shuffle.hs +++ b/lib/Shuffle.hs @@ -1,18 +1,12 @@ -module Shuffle -( shuffle +module Shuffle ( + shuffle ) where import Data.List import System.Random ------------------------------ Constants ------------------------------ - --- The seed used to generate random numbers. -seed :: Int seed = 20 ----------------------------------------------------------------------- - -- Shuffle a list of values. shuffle :: [a] -> [a] shuffle l = map (l !!) $ generateIndices $ length l @@ -25,5 +19,6 @@ generateIndices size = take size uniqueList uniqueList = nub randomList -- Generate a random generator +-- TODO Écht random maken? randomGen :: StdGen randomGen = mkStdGen seed From 5be241916389a7b6ca28f371be5cb7d515ccfa10 Mon Sep 17 00:00:00 2001 From: Tibo De Peuter Date: Mon, 14 Nov 2022 20:25:57 +0100 Subject: [PATCH 06/20] #1 Toggle selection --- lib/PatienceBoard.hs | 128 +++++++++++++++++++++++++++++++++++++------ lib/Selector.hs | 90 ++++++++++++++++++++++++++++++ 2 files changed, 201 insertions(+), 17 deletions(-) create mode 100644 lib/Selector.hs 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 From d0b708db62725b90f28334471eb46132b295d1a5 Mon Sep 17 00:00:00 2001 From: Tibo De Peuter Date: Mon, 14 Nov 2022 21:35:35 +0100 Subject: [PATCH 07/20] #12 Add zone move constraints --- lib/PatienceBoard.hs | 51 +++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 48 insertions(+), 3 deletions(-) diff --git a/lib/PatienceBoard.hs b/lib/PatienceBoard.hs index 6785968..e3dfd91 100644 --- a/lib/PatienceBoard.hs +++ b/lib/PatienceBoard.hs @@ -3,6 +3,9 @@ module PatienceBoard , Board (..) , amountOfGameStacks , amountOfEndingStacks +, gameStacksCoord +, endingStacksCoord +, pileCoord , handleInputs , initGame @@ -39,6 +42,20 @@ amountOfGameStacks = 7 amountOfEndingStacks :: Int amountOfEndingStacks = 4 +-- Coordinate of the GameStacks +gameStacksCoord :: Coordinate +gameStacksCoord = (0, 0) + +-- Coordinate of the EndingStacks +endingStacksCoord :: Coordinate +endingStacksCoord = (x, 1) + where x = amountOfGameStacks - amountOfEndingStacks + +-- Coordinate of the Pile +pileCoord :: Coordinate +pileCoord = (0, 1) + +-- Step size to rotate the pile of the game rotateStep :: Int rotateStep = 3 @@ -86,7 +103,7 @@ 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 + predValue = succ v1 == v2 canPlayOn _ _ = False -- Check if a card can be played ontop of an EndingStack. @@ -94,7 +111,7 @@ 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 + succValue = v1 == succ v2 canFinishOn _ _ = False -- Move a card to a GameStack. Move all the cards below the given card @@ -116,9 +133,37 @@ moveToES from to ------------------------------ Input --------------------------------- +-- Check if a coordinate is in the pile. +isInPile :: Coordinate -> Bool +isInPile = (pileCoord == ) + +-- Check if a coordinate is in an endingStack. +isInEnding :: Coordinate -> Bool +isInEnding (x, y) = leftBound && rightBound && yCheck + where leftBound = fst endingStacksCoord <= x + rightBound = x < amountOfGameStacks + yCheck = y == snd endingStacksCoord + +-- Check if a coordinate is in a GameStack. +isInGame :: Coordinate -> Game -> Bool +isInGame (x, y) g = horizontalCheck && verticalCheck + where horizontalCheck = leftBound && rightBound + verticalCheck = upBound && downBound + leftBound = fst gameStacksCoord <= x + rightBound = x < amountOfGameStacks + upBound = y <= snd gameStacksCoord + downBound = negate y < length (gameStacks (board g) !! x) + +-- Check if moving in a direction is legal. +isLegalMove :: Direction -> Game -> Bool +isLegalMove dir g = isInPile coord || isInEnding coord || isInGame coord g + where coord = position $ move dir $ selector g + -- Move the selector of the game. (Wrapper) moveSelector :: Direction -> Game -> Game -moveSelector dir g@Game{ selector = s } = g{ selector = move dir s } +moveSelector dir g@Game{ selector = s } + | isLegalMove dir g = g{ selector = move dir s } + | otherwise = g -- Toggle selector. (Wrapper) toggleSelector :: Game -> Game From 0825c64da0603ee3dc19696ce5a391bec364438f Mon Sep 17 00:00:00 2001 From: Tibo De Peuter Date: Mon, 14 Nov 2022 22:05:25 +0100 Subject: [PATCH 08/20] #12 Fix rendering of zones --- lib/PatienceBoard.hs | 4 ++ lib/PatienceRenderer.hs | 117 ++++++++++++++++++++++++++++++++++++++++ 2 files changed, 121 insertions(+) create mode 100644 lib/PatienceRenderer.hs diff --git a/lib/PatienceBoard.hs b/lib/PatienceBoard.hs index e3dfd91..63f9eac 100644 --- a/lib/PatienceBoard.hs +++ b/lib/PatienceBoard.hs @@ -9,6 +9,10 @@ module PatienceBoard , handleInputs , initGame + +, isInGame +, isInEnding +, isInPile ) where import CardDeck diff --git a/lib/PatienceRenderer.hs b/lib/PatienceRenderer.hs new file mode 100644 index 0000000..8af09c6 --- /dev/null +++ b/lib/PatienceRenderer.hs @@ -0,0 +1,117 @@ +module PatienceRenderer +( render +, getWindow +) where + +import PatienceBoard +import Selector + +import CardRenderer +import PNGRenderer +import SelectorRenderer + +import InputHandler + +import Graphics.Gloss( + Display(..) + , green + , play + ) + +----------------------------- Constants ------------------------------ + +-- Distance between cards that are on top of each other +cardDistance :: Float +cardDistance = 20 + +-- Distance between neighbouring stacks +stackDistance :: Float +stackDistance = 10 + +-- Distance between different zones of the board +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 + where cardDistance = cardWidth + stackDistance + (esX, _) = endingStacksCoord + +-- Y axis render difference for EndingStacks +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 + +-- Y axis render difference for Pile +pileYDiff :: Float +pileYDiff = esYDiff + +-- Get the diff based on a coordinate because different 'zones' have +-- different offsets. +getDiff :: Coordinate -> (Float, Float) +getDiff coord + | isInEnding coord = (width, esYDiff) + | isInPile coord = (pileXDiff, pileYDiff) + | otherwise = (width, cardDistance) + where width = cardWidth + stackDistance + +-- The board consists of three parts: +-- the gamestacks, the endingstacks and the pile. +-- Pile is located at (0,1). +-- EndingStacks are located at (n,1) - see calculations. +-- GameStacks are located at (0,0). +renderBoard :: Board -> Picture +renderBoard board = compose [ + pile, + endingStacks, + gameStacks + ] + where pile = translate pileXDiff pileYDiff $ renderPile board + endingStacks = translate esXDiff esYDiff $ renderES board + gameStacks = renderGS board + +-- Render the PatienceGameSelector. +renderPSelector :: Selector -> Picture +renderPSelector ps = compose [ + selector, + selected + ] + where selector = renderSelector xd1 yd1 ps + selected = renderSelected xd2 yd2 ps + (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 :: 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 + +-- The default window to play patience. +getWindow :: Display +getWindow = InWindow "Patience" (1200,800) (50,50) From 8d9186963fa591898102b7d2e11a137183caca2d Mon Sep 17 00:00:00 2001 From: Tibo De Peuter Date: Tue, 15 Nov 2022 09:28:10 +0100 Subject: [PATCH 09/20] #16 Fix --- lib/Patience.hs | 26 ++++++++++ lib/PatienceBoard.hs | 114 +++++++++++++++++++++++++++++++++---------- 2 files changed, 113 insertions(+), 27 deletions(-) create mode 100644 lib/Patience.hs diff --git a/lib/Patience.hs b/lib/Patience.hs new file mode 100644 index 0000000..021da57 --- /dev/null +++ b/lib/Patience.hs @@ -0,0 +1,26 @@ +module Patience +( playPatience +) where + +import PatienceBoard +import PatienceRenderer + +import Graphics.Gloss (green, play) + +--------------------------------------------------------------------- +-- Single module to play patience. -- +-- Includes all logic and rendering. -- +--------------------------------------------------------------------- + +----------------------------- Constants ------------------------------ + +-- Framerate of the game +type FPS = Int + +--------------------------------------------------------------------- + +-- Play a game of patience. +playPatience :: FPS -> IO() +playPatience fps = do play window green fps initGame render handleInputs step + where window = getWindow + step _ g = g diff --git a/lib/PatienceBoard.hs b/lib/PatienceBoard.hs index 63f9eac..492f375 100644 --- a/lib/PatienceBoard.hs +++ b/lib/PatienceBoard.hs @@ -90,6 +90,45 @@ initGame = Game { selector = initSelector } +------------------- Coordinate to Card conversion -------------------- + +-- Check if a coordinate is in the pile. +isInPile :: Coordinate -> Bool +isInPile = (pileCoord == ) + +-- Check if a coordinate is in an endingStack. +isInEnding :: Coordinate -> Bool +isInEnding (x, y) = leftBound && rightBound && yCheck + where leftBound = fst endingStacksCoord <= x + rightBound = x < amountOfGameStacks + yCheck = y == snd endingStacksCoord + +-- Check if a coordinate is in a GameStack. +isInGame :: Coordinate -> Game -> Bool +isInGame (x, y) g = horizontalCheck && verticalCheck + where horizontalCheck = leftBound && rightBound + verticalCheck = upBound && downBound + leftBound = fst gameStacksCoord <= x + rightBound = x < amountOfGameStacks + upBound = y <= snd gameStacksCoord + downBound = negate y < length (gameStacks (board g) !! x) + +-- 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. @@ -98,9 +137,10 @@ 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 +rotatePile :: Game -> Game +rotatePile g@Game{ board = b } = g{ board = rotatedBoard } + where rotatedBoard = b{ pile = tail ++ head } + (head, tail) = splitAt rotateStep $ pile b -- Check if a card can be placed ontop of a gameStack. canPlayOn :: Card -> Stack -> Bool @@ -135,29 +175,45 @@ moveToES from to where (diff,removed) = splitAt 1 from added = diff ++ to +-- Switch a stack for another stack in a list of stacks. +switchStack :: [Stack] -> Int -> Stack -> [Stack] +switchStack ss index new = front ++ new:back + where (front, back') = splitAt index ss + back = tail back' + +-- Swap a stack in the Game for another stack. +updateStack :: Game -> Coordinate -> Stack -> Game +updateStack game (x, y) new + | isInEnding (x, y) = let originalBoard = board game + index = x - (amountOfGameStacks - amountOfEndingStacks) + newStack = switchStack (endingStacks originalBoard) index new + updatedBoard = originalBoard{ endingStacks = newStack } + in game{ board = updatedBoard } + | isInPile (x, y) = let originalBoard = board game + updatedBoard = originalBoard{ pile = new } + in game{ board = updatedBoard } + | otherwise = let originalBoard = board game + stackNr = x + index = negate y + newGameStacks = switchStack (gameStacks originalBoard) stackNr new + updatedBoard = originalBoard{ gameStacks = newGameStacks } + in game{ board = updatedBoard } + +-- Move a card from Coordinate to Coordinate. +moveCard :: Game -> Coordinate -> Coordinate -> Game +moveCard game (x, y) (a, b) + | isInEnding (a, b) = let fromStack = getStackFromCoord game (x, y) + toStack = getStackFromCoord game (a, b) + (removed, added) = moveToES fromStack toStack + -- Swapping to old stack. + applyFirst = updateStack game (x, y) removed + -- Swapping the new stack. + result = updateStack applyFirst (a, b) added + in result + | otherwise = game + ------------------------------ Input --------------------------------- --- Check if a coordinate is in the pile. -isInPile :: Coordinate -> Bool -isInPile = (pileCoord == ) - --- Check if a coordinate is in an endingStack. -isInEnding :: Coordinate -> Bool -isInEnding (x, y) = leftBound && rightBound && yCheck - where leftBound = fst endingStacksCoord <= x - rightBound = x < amountOfGameStacks - yCheck = y == snd endingStacksCoord - --- Check if a coordinate is in a GameStack. -isInGame :: Coordinate -> Game -> Bool -isInGame (x, y) g = horizontalCheck && verticalCheck - where horizontalCheck = leftBound && rightBound - verticalCheck = upBound && downBound - leftBound = fst gameStacksCoord <= x - rightBound = x < amountOfGameStacks - upBound = y <= snd gameStacksCoord - downBound = negate y < length (gameStacks (board g) !! x) - -- Check if moving in a direction is legal. isLegalMove :: Direction -> Game -> Bool isLegalMove dir g = isInPile coord || isInEnding coord || isInGame coord g @@ -169,9 +225,12 @@ moveSelector dir g@Game{ selector = s } | isLegalMove dir g = g{ selector = move dir s } | otherwise = g --- Toggle selector. (Wrapper) +-- Toggle selector. If a card was already selected, try to move it. toggleSelector :: Game -> Game -toggleSelector g@Game{ selector = s } = g{ selector = toggleSelection s } +toggleSelector g@Game{ selector = s@Selector{ selected = Nothing } } = toggled + where toggled = g{ selector = toggleSelection s } +toggleSelector g@Game{ selector = s@Selector{ selected = Just coord } } = moved + where moved = moveCard g{ selector = toggleSelection s } (getSelected s) (position s) -- Handle all the inputs necessary for patience. handleInputs :: Event -> Game -> Game @@ -181,5 +240,6 @@ handleInputs = composeInputHandler [ handleLeft (moveSelector L), handleRight (moveSelector R), - handleSpace toggleSelector + handleSpace toggleSelector, + handleEnter rotatePile ] From df3b6ae092585782a1262578bee6dd71dce6413c Mon Sep 17 00:00:00 2001 From: Tibo De Peuter Date: Tue, 15 Nov 2022 12:31:31 +0100 Subject: [PATCH 10/20] #1 Redid all the logic --- lib/PatienceBoard.hs | 164 ++++++++++++++++++++++++++++++++++--------- 1 file changed, 131 insertions(+), 33 deletions(-) diff --git a/lib/PatienceBoard.hs b/lib/PatienceBoard.hs index 492f375..54edbca 100644 --- a/lib/PatienceBoard.hs +++ b/lib/PatienceBoard.hs @@ -40,6 +40,10 @@ data Board = Board { pile :: Stack } deriving (Show) +-- The zones of the board. Represents either the pile, the endingStacks +-- or the gameStacks. It can also be out of the board. +data Zone = Pile | ES | GS | Out + amountOfGameStacks :: Int amountOfGameStacks = 7 @@ -113,6 +117,14 @@ isInGame (x, y) g = horizontalCheck && verticalCheck upBound = y <= snd gameStacksCoord downBound = negate y < length (gameStacks (board g) !! x) +-- Get the zone number from a coordinate. +getZoneFromCoord :: Game -> Coordinate -> Zone +getZoneFromCoord game (x, y) + | isInPile (x, y) = Pile + | isInEnding (x, y) = ES + | isInGame (x, y) game = GS + | otherwise = Out + -- Based on a coordinate, return a stack. getStackFromCoord :: Game -> Coordinate -> Stack getStackFromCoord game (x, y) @@ -146,7 +158,7 @@ rotatePile g@Game{ board = b } = g{ board = rotatedBoard } 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] + where differentColor = t1 /= t2 && (fromEnum t1 + fromEnum t2) `elem` [1,2,4,5] predValue = succ v1 == v2 canPlayOn _ _ = False @@ -160,58 +172,144 @@ 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 +moveBetweenGS :: Int -> Stack -> Stack -> (Stack,Stack) +moveBetweenGS index from 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 +moveToES :: Int -> 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 +-- Move from an EndingStack to GameStack. +moveESToGS :: Int -> Stack -> Stack -> (Stack,Stack) +moveESToGS _ from to + | canPlayOn (head from) to = (cs, added) + | otherwise = (from, to) + where (c:cs) = from + added = c:to + +-- Move from one gameStack to another. +moveGS2GS :: Coordinate -> Int -> Board -> Board +moveGS2GS fromCoord toStackNr board + | canPlayOn (from !! (index - 1)) to = newBoard + | otherwise = board + where (fromStackNr, negIndex) = fromCoord + fromAmount = length from + oldGS = gameStacks board + from = oldGS !! fromStackNr + to = oldGS !! toStackNr + index = fromAmount - negate negIndex + (diff, newFrom) = splitAt index from + newTo = diff ++ to + tempGS = switchStack oldGS fromStackNr (showFirst newFrom) + newGS = switchStack tempGS toStackNr newTo + newBoard = board{ gameStacks = newGS } + +moveGS2ES :: Coordinate -> Int -> Board -> Board +moveGS2ES fromCoord toIndex board + | canFinishOn (head from) to = newBoard + | otherwise = board + where (fromIndex, _) = fromCoord + oldGS = gameStacks board + oldES = endingStacks board + from = oldGS !! fromIndex + to = oldES !! toIndex + (card:newGSStack) = from + newESStack = card:to + newGS = switchStack oldGS fromIndex (showFirst newGSStack) + newES = switchStack oldES toIndex newESStack + newBoard = board{ endingStacks = newES, gameStacks = newGS } + +-- Move a card between pile and endingStacks. +moveP2ES :: Coordinate -> Int -> Board -> Board +moveP2ES _ toIndex board + | canFinishOn (head oldPile) to = newBoard + | otherwise = board + where oldPile = pile board + oldES = endingStacks board + to = oldES !! toIndex + (card:newPile) = oldPile + newESStack = card:to + newES = switchStack oldES toIndex newESStack + newBoard = board{ pile = newPile, endingStacks = newES } + +-- Move a card between pile and gameStacks. +moveP2GS :: Coordinate -> Int -> Board -> Board +moveP2GS _ toStackNr board + | canPlayOn (head oldPile) to = newBoard + | otherwise = board + where oldPile = pile board + oldGS = gameStacks board + to = oldGS !! toStackNr + (card:newPile) = oldPile + newGSStack = card:to + newGS = switchStack oldGS toStackNr newGSStack + newBoard = board{ gameStacks = newGS, pile = newPile } + +moveES2GS :: Coordinate -> Int -> Board -> Board +moveES2GS fromCoord toStackNr board + | canPlayOn (head from) to = newBoard + | otherwise = board + where (tempIndex, _) = fromCoord + fromIndex = tempIndex - (amountOfGameStacks - amountOfEndingStacks) + oldES = endingStacks board + oldGS = gameStacks board + from = oldES !! fromIndex + to = oldGS !! toStackNr + (card:newESStack) = from + newGSStack = card:to + newES = switchStack oldES fromIndex newESStack + newGS = switchStack oldGS toStackNr newGSStack + newBoard = board{ gameStacks = newGS, endingStacks = newES } + + -- Switch a stack for another stack in a list of stacks. switchStack :: [Stack] -> Int -> Stack -> [Stack] switchStack ss index new = front ++ new:back where (front, back') = splitAt index ss back = tail back' --- Swap a stack in the Game for another stack. -updateStack :: Game -> Coordinate -> Stack -> Game -updateStack game (x, y) new - | isInEnding (x, y) = let originalBoard = board game - index = x - (amountOfGameStacks - amountOfEndingStacks) - newStack = switchStack (endingStacks originalBoard) index new - updatedBoard = originalBoard{ endingStacks = newStack } - in game{ board = updatedBoard } - | isInPile (x, y) = let originalBoard = board game - updatedBoard = originalBoard{ pile = new } - in game{ board = updatedBoard } - | otherwise = let originalBoard = board game - stackNr = x - index = negate y - newGameStacks = switchStack (gameStacks originalBoard) stackNr new - updatedBoard = originalBoard{ gameStacks = newGameStacks } - in game{ board = updatedBoard } +-- Get the stack that is located in the given zone at the given index. +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 + +-- Move between to zones with two indexes +getMoveFunction2 :: Zone -> Zone -> Coordinate -> Int -> Board -> Board +getMoveFunction2 Pile ES coord index = moveP2ES coord index +getMoveFunction2 Pile GS coord index = moveP2GS coord index +getMoveFunction2 GS GS coord index = moveGS2GS coord index +getMoveFunction2 GS ES coord index = moveGS2ES coord index +getMoveFunction2 ES GS coord index = moveES2GS coord index +getMoveFunction2 _ _ _ _ = id + +transformIndex :: Zone -> Int -> Int +transformIndex ES index = index - (amountOfGameStacks - amountOfEndingStacks) +transformIndex Pile _ = 0 +transformIndex _ index = index -- Move a card from Coordinate to Coordinate. moveCard :: Game -> Coordinate -> Coordinate -> Game -moveCard game (x, y) (a, b) - | isInEnding (a, b) = let fromStack = getStackFromCoord game (x, y) - toStack = getStackFromCoord game (a, b) - (removed, added) = moveToES fromStack toStack - -- Swapping to old stack. - applyFirst = updateStack game (x, y) removed - -- Swapping the new stack. - result = updateStack applyFirst (a, b) added - in result - | otherwise = game - +moveCard game fromCoord toCoord = game{ board = newBoard } + where originalBoard = board game + (x, _) = fromCoord + (index, _) = toCoord + properIndex = transformIndex toZone index + fromZone = getZoneFromCoord game fromCoord + toZone = getZoneFromCoord game toCoord + fromStack = getStackFromZone game fromZone x + toStack = getStackFromZone game toZone x + moveFunction = getMoveFunction2 fromZone toZone fromCoord properIndex + newBoard = moveFunction originalBoard + ------------------------------ Input --------------------------------- -- Check if moving in a direction is legal. From 6dbedddb7b720180086ae549dd4a167bcb3060f8 Mon Sep 17 00:00:00 2001 From: Tibo De Peuter Date: Tue, 15 Nov 2022 17:05:06 +0100 Subject: [PATCH 11/20] #1 Handle all inputs --- lib/PatienceBoard.hs | 65 ++++++++++++++++---------------------------- 1 file changed, 24 insertions(+), 41 deletions(-) diff --git a/lib/PatienceBoard.hs b/lib/PatienceBoard.hs index 54edbca..c33d1f6 100644 --- a/lib/PatienceBoard.hs +++ b/lib/PatienceBoard.hs @@ -115,7 +115,9 @@ isInGame (x, y) g = horizontalCheck && verticalCheck leftBound = fst gameStacksCoord <= x rightBound = x < amountOfGameStacks upBound = y <= snd gameStacksCoord - downBound = negate y < length (gameStacks (board g) !! x) + xStack = gameStacks (board g) !! x + downBound = zero || negate y < length xStack + zero = y == 0 && length xStack == 0 -- Get the zone number from a coordinate. getZoneFromCoord :: Game -> Coordinate -> Zone @@ -155,50 +157,31 @@ rotatePile g@Game{ board = b } = g{ board = rotatedBoard } (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] +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 + where (t1,v1,vis) = cs !! index + differentColor = t1 /= t2 && (fromEnum t1 + fromEnum t2) `elem` [1,2,4,5] predValue = succ v1 == v2 -canPlayOn _ _ = False + visibility = vis == Visible -- 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 +canFinishOn :: Stack -> Int -> Stack -> Bool +canFinishOn [] _ _ = False +canFinishOn cs index [] = v1 == Ace && vis == Visible + where (_,v1,vis) = cs !! index +canFinishOn cs index ((t2,v2,_):_) = sameType && succValue && visibility + where (t1,v1,vis) = cs !! index + sameType = t1 == t2 succValue = v1 == succ v2 -canFinishOn _ _ = False - --- Move a card to a GameStack. Move all the cards below the given card --- on the 'from' stack as well. -moveBetweenGS :: Int -> Stack -> Stack -> (Stack,Stack) -moveBetweenGS index from 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 :: Int -> 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 - --- Move from an EndingStack to GameStack. -moveESToGS :: Int -> Stack -> Stack -> (Stack,Stack) -moveESToGS _ from to - | canPlayOn (head from) to = (cs, added) - | otherwise = (from, to) - where (c:cs) = from - added = c:to + visibility = vis == Visible -- Move from one gameStack to another. moveGS2GS :: Coordinate -> Int -> Board -> Board moveGS2GS fromCoord toStackNr board - | canPlayOn (from !! (index - 1)) to = newBoard + | canPlayOn from (index - 1) to = newBoard | otherwise = board where (fromStackNr, negIndex) = fromCoord fromAmount = length from @@ -214,7 +197,7 @@ moveGS2GS fromCoord toStackNr board moveGS2ES :: Coordinate -> Int -> Board -> Board moveGS2ES fromCoord toIndex board - | canFinishOn (head from) to = newBoard + | canFinishOn from 0 to = newBoard | otherwise = board where (fromIndex, _) = fromCoord oldGS = gameStacks board @@ -230,7 +213,7 @@ moveGS2ES fromCoord toIndex board -- Move a card between pile and endingStacks. moveP2ES :: Coordinate -> Int -> Board -> Board moveP2ES _ toIndex board - | canFinishOn (head oldPile) to = newBoard + | canFinishOn oldPile 0 to = newBoard | otherwise = board where oldPile = pile board oldES = endingStacks board @@ -243,7 +226,7 @@ moveP2ES _ toIndex board -- Move a card between pile and gameStacks. moveP2GS :: Coordinate -> Int -> Board -> Board moveP2GS _ toStackNr board - | canPlayOn (head oldPile) to = newBoard + | canPlayOn oldPile 0 to = newBoard | otherwise = board where oldPile = pile board oldGS = gameStacks board @@ -255,7 +238,7 @@ moveP2GS _ toStackNr board moveES2GS :: Coordinate -> Int -> Board -> Board moveES2GS fromCoord toStackNr board - | canPlayOn (head from) to = newBoard + | canPlayOn from 0 to = newBoard | otherwise = board where (tempIndex, _) = fromCoord fromIndex = tempIndex - (amountOfGameStacks - amountOfEndingStacks) From 68facc87f5bf9330d3ef1a889bd8b45f46d4cd8a Mon Sep 17 00:00:00 2001 From: Tibo De Peuter Date: Tue, 15 Nov 2022 21:14:48 +0100 Subject: [PATCH 12/20] Fixed some cards having different resolutions --- lib/assets/hearts/heart-4.png | Bin 2849 -> 4251 bytes lib/assets/hearts/heart-A.png | Bin 2736 -> 4040 bytes lib/assets/selected.png | Bin 1161 -> 1771 bytes lib/assets/selector.png | Bin 1206 -> 1979 bytes 4 files changed, 0 insertions(+), 0 deletions(-) diff --git a/lib/assets/hearts/heart-4.png b/lib/assets/hearts/heart-4.png index d60544632e1a204ac747794a56c29765f2f45a15..a14dc61a188e66cf17b86a12ac9068ad54bca322 100644 GIT binary patch literal 4251 zcmb`K*FPH$pv4oENX=TYRViYRqKLghqiWWs_NF#P%vwQOE4CITEw!oLB2|srwfEjZ zO7*AQ-hbde-G_6|=kt9%FXtp18t71i*}wn*fEuo=Y4k6h{wWbe{?CPd#1{bops%}z zhM~KoBLEf?#!S}E^W z)_CNT#GJF##z|!KiE=F1A83kbtyf?7$Go;!Pgc5aI$urb7? zhzImyIV}7Vy;>S!MUsCMdGm=SUvAa0?_&8P@@5_ICB)AX```Ch##g39R6Fy0!VZ+9 zWU6_Ax$uM9bj{n2Ke>!KtV7$YyP&zoQGd#sGc~j2eU2qn7p>wQl9rIt$LBgM%D@vE zH`3M$X!*YeDE)LT0ssJ#^Zym_#@KfO0H7I%YpR)q+8!3UW||Bzf2Cz*YGgO$Qlk>F zOsT5K*^Lvl)D~&XNvblnyf5Kc`_5Tg+3oY4rHPAv0;8tnWR6*KSra22LzTYKZ88(a zN67f7Z8=0^N29c&^nAz>vF*a-S0W}tu`s%1bn#usJlw_OBlmIjt_b3*$DECEMWum7 z@ndBl3~BW4w2Fsi)h;#SW}-=TqLMg0R}tBJb2CbOj9_u|px|FfPbbxOm!`X!S`Klu ze3Lw4G?_Q6J3yabtiz@dxWfYrCuY8WtZYF8kx<3He_x?LU5oI{8JgeBTFIeq3EKbp z?R4|I^N+%ZQjvcGEgGDXy%yTgU(MYVG$#Jr9Vd~?7;mC!f(i={$DgbZJ^`5cE4`t)wlUa6E9}R`@UwhdNtU^<-lgEx4Yi&>uw>caQ6h;3Fh$G*$ zDB7r}_K1i$KiDmIV&s*AjGSi~8=%jluZ2#(3CtGWViJtJBJ^n$M_CdR4n`u+P~nSh zic+*gRa6gFZ{y_aVL(AX%AIX#Q?VBzC{Du>x)MW^ zsm%F{T6@LlNp+8|;;~4>bLX?PmRaqMt%Adll4!AUw0Yxb@O(0HFWcPt)l2&bFi8~~ zB^>cGaId__{**sgW}6Viw<{~WefV!;wL zFcYVtEV48Zz{5jhT>7Be*jiWb<{HuCuc6*6zd?uAl;TBxaT$~1Q348n?4ILbR1)va zQ!sU!wz>D-&}u|bj>oSm+{Z1SIwEk_<5^DyS^}mVW7X30cBWRW>OqUuMmAhZgptmK>CA$X2}OE2oB4*R#HsK{3|VIHA59Wn z5?y-^&uUqDTfz({2d&F1C?;-02P#8(ERw ze}@7M69)A_$GQEejP~~SwFBy>tv~WurPEjyCi8w21sucN-G$@lqotmgO9pH~8eI@) z3TLd#D2PMga$a=U0SCJ*KCg9IHnD{T~{{#tKtl!i{;1iqW)gR=!$0)IXdEIWVJeT8-61VSO0`}2uM!+Y_m4XJihQM)37xA zP?y|uDYATVJ2Jh6irZ(N`K}-en7owOoBpx80XRKT$@DDhb~LlNHy+|ydRO*NbCYic z;ZABP$T8p5 z+V{G-Y8?D~F`rk{qu51!HAqV9w6w4>cD@6!=rG%ub=A6WK&&#rbPd^Jwu>3c4(Xo+ zB3I6q!(26|pl`j7y65NcNrG&udFc>EvyFEpyjU|<=Qs_?sLmpi6yzIVe07pQaZ;&* zbN($4HZD!oYvf9}@<$3#jUBgIkW!;xfW6|;pqSYR9voWKvOaiqq5~9nj+*4A(`4#1 z^LSRfpYN%8)MdWW@SP}_E9&~G-&i`d*Qr9_5~V>Hpf|k_)`veTXw?7RzJH*4IPv%w z859-^{ShuYO1dUE5|B|*62Ed3Nl+6it8*@iY99>Sevp=LvF+!{>Hm|)HnhDr3RxF5 zHa;upFX4FeS4*r*Ce1sD5St)NdrC^?$o$Sy*H_S!(cJp(bK)46ND{%c5~ajHK})xV zUg)=tKO9ngA27mnSIx&l_Bc0{umXmuj}=$Uc$`x78@sl&Z*d&Q+;xSAY(46jN^ib2 zy0htOb!)iMHp-Tn3n3H>oLL@xC>(C-F?8W-uMJDzOj^BTMAk`oO$QK?+3C%-(|l_k zS~iGrohy7wTB0<&cLaj0nZkZv!uD4vK&uM=+-$v|16Lr07E?zw8Z*F?W|C#i0 zoI%$W@GeXE3ALQ&(vK`?=N^*fYC#Yq#5qDApoaQ%{b%q8@`Sy*!!p2{ zf%Jh=NyxHjm8b=G<#ZXg(5fcHw|r~3PGC1q9Cx>n;Xv7Sla2*5^{7Qk;;W`a^LD=- zuKk%}-t`5s)_Q3SpzafYwp_-7D~xR6y!YEkrR&~G+q#$7qcet>sO3mZ7vw(C5aZ)F zxcq_Z`ZRTMPF2SNudewbtLeL#?D%~WM=lsonxSN;2_5~pjpNtIz%H7_M;QW}8pvLS zruaq{tP}B{#^64B4&ux0Bp2AEAB`1|6?Cihf{xOXALOHx+@Z8YV6C z?2FC(%@RMXZoL|#1dz?2EJg5gN97&QU&3@EcK9^U@1eCy-4>P}F_C5!_%sNqa~5P% zpr&02ElTe`OXtLGu+UQtiE#037>K{2FMlRc1%k zm1&g4rc#j~K+~z=$7(YDs15EHbwRTH<{$fOf{azj{|^h!9F4#8E?pLWq{3Ddszd1FU2Gbs}AG% zSktvm;7P)0^6{s=z5MB5MqYB*TXJL5z*E_*d?JZesNT-WVAX`fM6HwgW!?cz?ZQ{=QW^OI0>~J)tRcz$w}q zJm`B#M^+^gFcjyCzAcfYPHBQj*mZW^UqycDyc1u}i0v+PsvBo19oF>?-la(VWP*|= zBFEX_tJfD&zRErLY^ z!=bMkp+ZY>z^4FR&YMRi$~LXXyR2rE14A*W_Kx4#=C=OGNnp~FqG&yjqU6{lDszL;CR~PhOVxy)iy_GCW_jMx7L4f zo31UYuCA6m+aAeytL)uQrJ&rIxD5$FAjFWq;-=CEjvou`a zM7`tJ{FD^104w1Ngs``d_PXD%bzDH#<)wjD*!$Glv8$CVP!#xzibLM8J>hdyX$w$7(&k?8E^4OZL6_8@{>_+fG745ZU=xwe>{L#}9jISn`u> rvAp5FiJfK1o?FD{jPAkH7dJr0^#Q%<6LOh1h3!xWUSv9<+xK&xBBkB-;^ihQLX!1DSB}@3qLJ62p`)NTN*$X$eP8Qu+u7ZP ziHHb+K}P20+D=YIG5%EBy88MZN`82)>zFtmk9YQ5{goY5MTUNNl;~pRVh@8Ii!$SWd#s+2K5NVi_6vwAtgI_@r9)JGI zDkyq=WV=LFxtPGQvm+qeKnYYnfE2uIr{o`CzQ~M`qL?k=3Wj$?Mc1wM3*W8@D=FE? zED0t1omc)14O+TxUP~`-z1$KN%|giFW!DN0e#~YXeB$lAsFSHEe`fPgsqoCEjc@5k zi~^O&jd@P4`U?Pu`;GXkzTi4gnV6`?vGl#Ze3`BDEWDj@yxFV*VM%}edNtvoaPxb2 z#H8iNIY#cXsq@$jpadQqvOiMjfX5F5S3@MROd8OdgM|eWZG&CGp27O&v~C3T>$s?G z*vgvfbJO6q`VU_d_{qD<^77U0RstGAX03C}`Uzs#QBm&FdtRtnarSFU_c3|`9Wop* zff;e#-4PX5mjuOs?#8w%XeK{Hv=ZmL?3eU1O2GrNFu;6g$xV_Bhe`-Tkfy*_RUnL! zLt8RMH7d?f;buHf;`?kPeB-|`5&iDDJ`+5mlY7Z@T;oO z)aS=5iyIrz*Rt`7Tf~baAwM(I%ehnQQ>g9eNbXS#F>mqw64m-DBddfFg@ooMG{kB^ z14dhdZWlILE~H!KBogRS_xw^9dy(1M!HB9FBkaW84{bwtJzGq$^O|O_yR2X_S7Q6} zH$T~n+t$8E&IAdaRefx+DX2vYi|B@D-MqQ_ngX0bP1K>VhhC?NL;f%kPWdP3SAjbP z+Abx{i;36XT=|^6t=XfnS^T-o<6cS&_|KB7eMsa?T1I-2a=vDhjyGj>?exF|U-n#N zZvJpv%k#bKR@M4gwspq{sO#Ebp}9p7W&3raak3 zx>Jml(Dyu(SX+3Dhet{Z0$GYDzby{?l!+%rC0;QX*By*H(gcQrvYsORWT)TsM69)I8cQAQ0=ktfi4hKhxWzAzs6 zT&AHmN;2Yx0wl&u9CsepB?!5&YRI9WHKC$yzxteezW+@1I7*&v20u;avMG%xYOitpaf%b*ChnGh+{n47x8v7?@q(piQ; zxs2ahJ`Z%_nq+%=jjPNmB0XETTluEFr~Q-Edpj zQT)xDiGp70_lH33F;8yN-ZXf|l)^WA4AK-f{UB;T=3INgUG|mVrW&^vUgA#|Q2sEt z$%p;M@4k%JB(*QEG}+c^>t^zGcN=wIqls3Dm=?PP=&KtmET^I|d=yG1rJ} z%EV-qfU5E`+?JhtmRNAX!eR-TGHthl4q6ucFf(2(9;09I$@(*nM1pS8XLDJUEvg6ZW9wc&CD>=>b=vxa+mp-N}M56 zUg$kqQ{-g8M}k;+S%TQeCCN!(5H2UdgaSd$EzV?D|p_b)V_`A5Q}| z>=UuHb@O+{ntK$E$4;e?;wQUyKlmQk)Vn{;57P-bZ{AG0K^1?PFvAybQ$}7bqyQ!SmPcZ1q8FB$j1k=0e6WE)Nz@(s7y2M!@mr{9)w??@#7-)P0QgHxZOnFR_?|H1;)5x;U-O<vHgFgN3)8ge|9OMl|7^)-Q)a+3`qcpyiZ31 zh(XoZEpDdh(X1KK#zQZTD@DR)@_g)(0MO9bm=p3P1j>_$wz6_p}$?5(WOkBL^ffD<%X!SsC`C9<&MhpV*Wo}EbHh^lbB9Mqeb&b%2}Aa2DgC`wx&?r!_PLN*GRbi-BNgK`$aunS z?qV@oQ_1_gVEjVzCWVreNQtU+DRUl5$1+C4iAN8H-M=yR)`o3*be&&1=_Dg-{7e2saUO9JJnDl)GDRqPl-5P1e$}GSP003AKaG34i^!}?f5W`UnGUS0rzZ0>{HZu5@@kWYzi8K?p_9W2zldL1vuJZ-bHYD<`5zU?+$+-5YL zMli{!TU{4}VwDnDFBm(S8<|t^APM9JO~N&aeO*a=n6m4#=;YF2_=ylEukdbMma%7% zJUUkGpK;&sty^Xiux&BqOLX)^w0yzl%6_C}YOP~xE$Q<7LMYedi#q-vljxbyZyD6$ z(D06RS$95)M#fnMwVaxyz{suV7^}3(IQS^ZgZurnBOu1!s)3psp+6_v*%sOpI@VVE z=_F>xa$#(GtaS$cOgEbFOe)zlTi)Es9+K~zH+FH%8h=_T`(y~$W6bI(M4z!P%<)#< z&9WwjXnCp_D1WjN6MLGwhL3ZhEuq9;cJP&Gt$BSsSviTn+yL}Pg*w-skLKC^b~wuF zJ`9pjMn4Nf{Z?)n3WfIE*Y)b*^|Apx|ctS*Cvl z)N|U@@QK*4wXAV~`TONF%2sbc9A&p7YA=G)vFkp9jN8-o+l&9OSKod7`gj4h9Nzr! zPc}gfaqp?>l|bO=wY+8A%n-|2y^hD$==Vf~fTWzG?e&Do$;qm=;6>Zpx0gmYrUH5z z9~oF$vhL2eJU-rA$=NI86B50U3pmT&L!Gp9Qm(#mgzK2t9^UaH46@SEO6Ch`! zzjmNA(h?P7ZbApLcW@vscgF=xJlEEU*s^eSlisF7klI7yJ@kaoxuv5)q=pS+7CyC; zA0yvtd0HOwnK!tovkQOjiq$;)wLiAIP_q{iUhLB5Ju&K4uK6TpMK6ZGUIWvs*B5Z{ z`xJTj08Z^8i31sgJgDoh%sayOQCkybM9{3&{Coy>YrH#=FTI9n$t zGVYBf6e>bcEU;I<_bXIsu`R2^LqFtoH|XH3(M4-3N53uU9EK+lU;;%qaT2D*mH+T* zI@^BTl(VZI7id;4)!Lb-QFT2U*O~^1d>ySy|F-nXoKLmq^>#Dc*SBH>VZAH?-I6zn zrzSrM>xjl93=1<>sS~aQ=?tAx}sMhe^w2;N0+Y$FO=VVOb=f}G|y+s}(qGT(5 z>1|kDGb3;#J32h$iVv=;fPoVrZVfU+k$vgBH5^hIINib?MakTV8E(F$(*NjJXyPb~Ym7ny<{w0KKVi5c)_IvwVQ2Nz5gg~B3k(FO zyofuNa&Dh0<(^~k>m*RRcujZIePwq;O%Hjg1kP$J&>INUx)S1(z5hHS&~FZ@`R%*d{H-TKE|Zp5AObNv4~t#h5eM(GM?Xe{oP$7Ysj#{-l#Y|oiT(OY$~8<;30sm1oW0eMP|>xKZC9FWR2a(CSEzK4dV1s9Do0f_UpK|TZSxQ(19Hz03sr#x#?UgS?KCV~XYW8~O*nnDo`=p~%CSkm`w)kC$ zpL;9z^!K5i0=tN&U)f-nCr!&e{?!a-Fg$uI_cF8@CSIs*v#Y#~U)0<38Wo(pvGROiM#Ug~C5&c`04g-mUQRCnHB69pT?-pfi8|M5#sjY`vZ9x%|-rGchsU2|*LGhk;E!$fKPm zQw7NOnBJvpZl1r^oji8WY@DNq^x66osV5=8BCk5pHZ+7w9rN&*pEIvdYjEn2{>Aw5 zE^M#c4Aa9fa7DbDqs?B+#PEdvi>f(iqM^qTQ*zk(#d)PLlRrsm)<|kWp7K;7-iYJR z+Q~{hFA1(p$0?{)3qq7sSb==+MNwwzO(olf)rUP28~%vJVm$YB`u!o+4!c(oQ4Gaf z9zE{wd1EmKmePA#-J=P;rAeni>>E9LCz*lxhljv259J;KA=M6jM8&wCX8BF|U_P!8!eSIN zT7Nr#L%Le_cZUWn2iNG9uJd48RxjOUZ7K~NDUobrS;T5+PV7nKV&9CfDQ7iwHEG=~ z*{wXbgYpw1&P2zfmZDYUZWfD(%W{Y$U@08*2uD7lNw&o>Rg~>cx}JC{Be*P~)BT#o zQkjyGr&b!9bc#Z4B^gXR+S+Hecv*&gAdzEV6t-5MoNnZwwlmX;vlt?xrp-XLN%#wBSRXOp8_^dp z6N&CS_B@JTiC>E*N_lE`WAG@aoW%V>uM)1dCY9I#{|ZXS)m?7@<_MhPe1FIE=wLJ> z-)A)ci9aMom9s?FKdnZj#JBsUAxLC>0E|G!J9bNr#nW3dqdYBNG-^mncmvWxhs0UC zb*aI$a>c$(2a0Y`nEsjn<}eod^j{ffg)op&Qq57+ie)#6JLlmT$V-33Ey^U^N8MRq zJ&BA{OX!;C(Y~Lh8V|Nns~~xItOO1?4ur*%Jeu^+Oh3G~gk~L0+>or{pLl6DR2`?O z$|mOnerBj>_*)n!ZQ(lcLL63{qxnB4)@BUsN;1}AC=mOX1A^7-+&2Ed zD4Z-;IMhw`izI_-XYIx({Yvron}ia9b}wfpVVXj!*kVqZ#<&=U{gz5|L&^8OM;B6A z1OpCRd;86smU5tUVc-W>i39s80Yp`9($nmr>ijt+1CwE zcYi%5z4z?rj<$jVi?>+sC~O{KHJB$;R9Lu`FXz$J7Syg7 zv|D(u!cpRe8_4YWehNKHdwsp)SP@~QKw4OKx!H@6kDJ>-9T$oZ?XJG4%dTeSj3;wBlH?{4e4rMEB7z=Aj4#eJUdJmrYVSV!Z literal 2736 zcmaJ@X*d*&79MMuFxg2lWiSTu*>?@e5;69&XDp$Z$TE|4#?n_z2E*9 z5apl0sV@Nl@EBN_UU!Hp*eFB?3r$>(@64k#h$tmCL*j?c%Oy~DmwfR>iK3nP1$`scNWhXFH9-Spz5^&V@j?uNkoI#y-o(9iAB zYDgqfT|Tt$fRQW7ycap~z`b*dMvqpO2MY-am7B~Yu<4y{(TkF%JX2mjnt0*l?1oB9$Dj?~r0^fe)yHE3 zgi#|mL@Pc+AceIIVOUAKn{~0ySTro@+?$B0K=bAULgeNYR{yLmNA;f9_gk%$*ROY` zCTX~iCj|2$)({*Zc$&Sp_tLf5S?XGz|G22B)o6ogCV{Q(ako-)gQsrWp8h?>$&*GL z@LR8_Mj0`>L6jAr57din+Je4*ZR;r|x>z3yuD&aZc$#E8A+8)3)7#@W?8 z*GE@!@j?cWAAyJKvP?x3{75P0~t5bUZ@t0-$2RPat*Gs$RffGf?=z+;s7 z^DFwt%3ok=*5}>ol*8S1eu_5I$>W9zLv38r*O302+OE3GE2;DV>K z+%i`ByGov4qyz`1HBSsnFEc*>nqh^e@HxKJ5G=&2`IFmEPePq+78W~>$-%){KZ%}X zNdw(4O+Kp7shY7?lCHqZxU$$^>R%#68M9Re;d+LLfY{%{vCIpxhu|+wr2KFFa-~$x z$!hKz@qfWd`K1l&65@u(2RElg%Bzl#5BN2AYk|9$8P`0{>pc$O4U`!&;x7`l40rIyBAKE1(;>vc`wetzo1k)dUo!I3&0w1 z5>V%n8F#;fM~p>K%RKxsBYrM+3~xz7xN;l)CM&sxg10(r!OzvHlp9Z^Mom?~*495( z%SZ@|d;5$L5rtfQrNUktoVv42TzgZI-~|_WC*k)8FYmO?EW03Tw>(FNRShNc>>_bm zvb9QZ%p{S!qIN3Nbo7}7#Vq`iE_?G_(X<=0xP(oBvE<{dal6Nt;i92wSf}}+!oH%v zS1!P{$|-RVFAvN9zErNOc#gkPt^KN5mlpSg)9K;WRyW<3o<>UEiQKD|1q2)Awp$zO zb1^_p-bB~>c~a1P+t$Jd@|{#_#D!pj28x^`)4IH37xj%pUf$L}OK)1A5<_rwAVY4c zfSo;SAZeGk`!2e7(pJ&Ni1T6qqDLjf;g$7dx!re%jN|p%@kWEk)lI7>{&d;sxf6EQha!2 zB+uRirg!(ZrC85~&aQ{NmVdhL>QsK1`=?f6TBl*bkLjy4_bTNp>(8~*6`Bnr?gv<} zh%RWqLRzWgKK_y^IN}cCD#%#u3aag9d@j`#{MZ&M=?K;fhNi)PVYPLKh!?v5W!H1; za)ju?2-YkH6m=O|f=&2Tq_NOnp}(~_?x&O!s;kq>B0v*<&AcN*d|c~|a9aV$VI((C;;F&ni<^n> zEHhVv3J($CyIH2(*U_mge@Htv+F+n*dQ4w=sGX?R?&@D=>Ky&=0OI(81+{dx+Kx&p zA^YV$cG`MR{==Rme$EU^!nhOLC>X*;tD^12%qOhOY+}c!KK!KUpF}lmNXWC@0maj_VxP4Tkjzc0U5E5Q~{M*|UnHl@hTb#Md>A{XMk4nvea`}R%O|2>eg2;X|Fb#&kD?quNJf8>FwNgnE_E~y2?8pwn95S9usn0<~5HS^U+qXRj&5`mKT_Ai@OSIAUq^2SW_@oj^+ z9*#+XlB1(z@Yi-7;nzr+9r_TRKjLb=XTkyVhz45d>=KFp`|m#tkCq7IzPZ;G?>0R< zSd9Gap@`K+n|Pn1-|NpC+uI95AdqU8y2QS|zVaQ$-uU>qO31W&PTyALD+{hVr7-cE zTrBbQ=r}e*);^Z=QicVqV`XZAqcS`|U_bDi4Ir;;d-0tPYKcoPa?^LFDdfbDXFkHK z2((au)+iKaosaeq`N8kSQc|~B2}$sbhlHS$hjic={h^DjgY4`o$zN4Q6&lq`_(D#( zgRQ^#H&9H#X;DRVR*p}X35t90)XT*@t4^tqJ16}1e57V*F9v`1Z2~NA*qGAbUWxw! DQo$Ev diff --git a/lib/assets/selected.png b/lib/assets/selected.png index 011c55d8b02b583f20a106cfeee70109c353adfe..69c78763d66c3e84760ba40acddf5644aa507204 100644 GIT binary patch literal 1771 zcmeH{`#%#30LAA~SO|Gu6Grh_#Z6u*^4djS4JFCrGK4U%8AF5_A(Z#CLbv6SyCH-t znz%!l_hVzRG_M)+n8$Vhiu=p`;d{>K{Cdvkb5icumfZ;!V zqL%{IX8{1NAYT)cJHDQt0Dx*%cvhQbm!UNANn@%^6C1&UT zj!rjm&w~U;X}s$9rW2OTz^2OzHg5t^11Lz&cM20}oq%&pz>ObsjzC$^k!$6zpeQn8 zCUqkp5z@S%>MFISnY#aaqjV$g5}&w%W0V?|?@Lmgn|N!%7H^`1ZOukP=&cFWmPSMe zg4Bp3?nIKUr%1yj0y(fiA5~GH9RFJe#PYs_^veg?q$9Ra%wCo1v!2Wj6Cp>?sni8I zkp_s1^}EO+>%GfzBq+Ds4Cv24#$ID~>DM!G(GB@n! zX=Po303(H=-RLEbR?0R@>pQf5Na>(>OM*E)OB?JNJY2(mU?aO-&*QJdM}qAC?5$zR zw9VXBXh@bQx?Uu!O@CY)AURBD$NLr)rmuf{TRSP1AdxXZp46j->l|;}PAX@AxUkDO zM7d;KLyql@I|a+o^PKDFgtw#61JZMnK65X{P9b9n9kvtjaqRwpbj1GV#~qvV$KA~s zrvO>y%nEGT_y_-XOs9$fX2nx6l=7@;kzhS3U;Rnf?}-~BrHi&Df!J=1wTfxxd)`RT z)YkNlXzFx#;b`B;LkYQ7d@YGdJA2Uw=4!s-gh}pL%#vaJ-+~kg)`_{uZ;}?RcI+T3ef-C8&9JFX60N4x`S0HB2Yyj#3gT$w;uQ zvu6E4aB>M=KEg{N=@o_9@9@*@~0y_oUTxLx= z9?0lUa`+r{P>q>|9oBdmvc7;VHwhU10z(O@&0nKK3_4Xt^$3k&_g(DF2=3L_k|U|q zAdIbn1%moEa>d?4&mX=ZY7kvW9U;L2TQWnnk$UKc0_;Ke<-TWkyGzo^ZRk4b>37#( zmV_I2$`wZ_c1&3%qpXPYLo%Sc%ZhBjaP<~;EQ{#d2M3jOHW5+E_?=ev?ig?dhDP*O zEdt*+#W83+`MWr&&}nc*pn7(xwG+-+=-_P!oUvH|6`Yu)bMC^)D_7hm9ttpRrp~F9 zL@r^M2c$=0t{$Ouk~?S*8D5)J!{PHqFT|O6@zww?`2(HKZ;DbaO7_jJ6t? zQn7rK$7hw~hF+(uTUqqU?pXnN)3o9!Ac4l_-BlOLo$ z&?ykIVDVune98Uhen|uG1I7(ZI!xQ0IOcBZUc5;mbJje@XALV4zKzU&eISP;ab?8@ zb&pxgoDV!d@cZi9uc(HF{sfXNF$-5_J+&VYo-JyVolP({y`M~(bZqp@`+U|Sx$K{0C zBlcBI`B{GahQyy&zwd|7_NghFe_C2MPT$f_*eRl`fo%hu%<1`d-$l&#&3}|8+I{Wp zm)LXnZ$GR_+`}i+-*CMl|Fb&Kkbhq-!dFFY=u-=ynZ3;-RARr-<=^uziaWl375Hp* z^xAprY);o45q^JMk73B*L3?@4DaIQ7B-@ zr*zEm$f%$~QqqFC@+Gn>jey}K%Y63Flfc;*UxlsOzWUs$?AZ0}|i{W#wv&i(kd;f5LWOA=pP{vER}Z|kqj(#~gf zkBh`79lDsrbBF2L=gVo`!I#T-2Hb2jHQs!#HLW|G`?2YR-4-nu7}L7-cWpns^JM6{ zpC7;8-?{VT!jqwPzf;@4d-bI|bIjFfVQ`qW?0RGO(bY;By((+^)c^b_X>RxQF?+E0 z`_whgpUP)9pY2)sw&&%f<01!~I37CRsIK6g!E*0R{LR*dYkOt_(ZRK`+1>}-`~SbF zH{?{@(y+bp_5Z^`rCS;H2s^#7Fa6cOW{-)lKlAkl@m06ihFxpucjh>KwE2<(L*}ew z2fPnNK2RxOkzkiyqi6@VWBakNg74FuSm*S5uk`v6iAW3~AO=mVsu9>B z%tS8xJ|>Dxhx&tAX1T%#>e@lP%rvKJhyRv z9pA1#p1A;nRDOLqpkRruZ zxpM8mC%17xm$$b)gw<{>0L0jPM*{#-Gyk&9-1Y<>0Fe3VU~7%U`mfxdb_$Ns=&@oD zG{Yd)7xJI)Y5&>XP>_jN_sOI-anCT7*}oB$(v;MM)-rTwaJb(uqiln5^=t0n6_Ph0 zwtB`FOZL%-J=$*)TQ(@7Lc^4ogilUuTf6WpjrId#r-w2QHozLoXH5dPp_$u%tywpgLLzvGwj43?XKdh;jkWt9*4t<7u zVEbaeZ^5Iixs_!>b?kV}b~c5oHmVZ7FM5=bO)@qOvquHA&Xf}zUmq1|{GXPaPA4lb zehNM!dE`+i*V|+&0|J_9;cs7kDLmVZg4BP#YJzajpGfy3wx$>ve~(FEH{zcWDK!lZ zOT&CV-)L}fkQYt%Rm%ztw#g7lOP{s(dF`)Eor^kr?AQn#4wnShAstzI$vf75bnyx3_aWbT-;Z*DP~lff+Eh7!j?zF7tejX zoSHMgZ?lPUYbDTXxMj85>%(d%66F6JFJf`I+|tR(Nh9G5tzAzd!G(-3q*qi_;6%cx zS-h ztlzC->OC7|`Yj_<6F}nF4Tl~6WhEu?`neCz6*1p2fM;D?I#G?DCVPo(eji56@#)~R zwjw&6F3Pm2X7E43BDJKnwY7DeoSgK&kpq_#<1mAn8`oRayD(&5U2R?6PEu#5ZpnMT z70YbX^0C7kZ!{X6WoT%)s>vAH8Q{6XncV*E*;u-dx$=r|^g6dACnx7lSZF9~E{Y6Q zq(BR3+$drks%GGF!^o0#9a14QEUfY(3dLVgJ;Gfs2{MPjo8GJ(-{lpqdqLG&#f-*W zext^8LGVMuOA|?o%N1c|l|o>L6%zB(KL%aGTpVHriDhJlDVojfQjXKKiA| z<>9}V?>Fvw=v$;lEgcBqQ?nzM?WWukDIENiE6owtqF7ef>Wp3#9ns~1^QV`x!kfPN zwlLe6NfSTg$9Q>$$tly%H@oyxMkkud0~_&tcf;hVl&Bs}ii2rD_0}Z-91t$HO*R2( F{{W->rQ-kq literal 1206 zcmeAS@N?(olHy`uVBq!ia0vp^DL~xH!3HGP{)#OIQk(@IkwBX10SGgixmfoC1tm*d zBT9nv(@M${i&7cN%ggmL^RkPR6AM!H@{7`Ezq65IU|@0fba4!+nDh3=`D~d|nPVTn z`$*mJE%V=c^TrFsa@SjOM}nFhHwbzD-dn|GnaQJ=!Ts$@^InY(0ZvifCvOUqS{ph9 zfTFwSROFL!_5(r*Gg1f3#I%i9R6 zcusPBp#7lvQJMDE^^HdboW2(neEDJ7@sYVNaEaxEcL(>fKL~kNAX#Dkze}TQ*Ho{k z*Q@sabKe?OD|NikyuQ~qe*JZ6pUYpqeEasT)o*!mVSawTLHWtl1kN7WxH+X zO8Xys^Z%TMkZWLhS=qO+!qrnRpE+|zSK)u9jM4+Uf`0`;Ys0PsrS54L?c5|KCG|_s z_j2c%7vCi;X761Qw)$`6o2aK(pU3qdJuvgllAx6~x_L{BR)=W$7cHJR<8OXsWbOat zjmZ=DUuXWeIH0Gwqfo$*PwANB5sMB9cEQIANir^@f_zG9Y-PXCtdaOxy;qv~?3*Q* zU(V6Xn_u+0#45dLaT<@!DZi+-*LFS%)7l=ky4246mp0qGRQ0)j&mSE+bSR=Qd+Oyo zckZ0doV9PB^!@Gz&j-)nlvGsw$Xk82YX63}UTNv+>Qa)DJ1^&LUtZ)s*>D4&%^APj zZ@-l+zPKaqMw_a!on75t{~q=O`h^?|+3%d#zv5<2UCipM`@TMYz2Dg0{y#7Q?7p01 zX8)?VM!Drew-X10if57ZjMMR=u7TTwR{jZFfBk*<>Z|I7GUff1?}e9Mf6cor^VcCz zqBilp&%pLOW}A#t1cSv?Nj;{=2dr;ufB*K4?Xt;SkIN;GZfw)rZu;PbZ1I=FDlHdS zmo?u0e>f<0D^Cok;-6Xzi>j1VRnH>HA2Jndcii=Q%J{*PmdKI;Vst00yQV AG5`Po From 7e2448c8b9637db74500c6fe2215ec8c9080a666 Mon Sep 17 00:00:00 2001 From: Tibo De Peuter Date: Tue, 15 Nov 2022 21:59:29 +0100 Subject: [PATCH 13/20] #15 Write tests --- patience.cabal | 8 +++---- test/PatienceTest.hs | 52 +++++++++++++++++++++++++++++++++++++++++++ test/VoorbeeldTest.hs | 11 --------- 3 files changed, 56 insertions(+), 15 deletions(-) create mode 100644 test/PatienceTest.hs delete mode 100644 test/VoorbeeldTest.hs diff --git a/patience.cabal b/patience.cabal index 214f1fa..eac70b7 100644 --- a/patience.cabal +++ b/patience.cabal @@ -6,18 +6,18 @@ build-type: Simple library hs-source-dirs: lib - build-depends: base >= 4.7 && <5, random >= 1.1 && < 1.4 - exposed-modules: CardDeck, PatienceBoard, Shuffle + build-depends: base >= 4.7 && <5, gloss >= 1.11 && < 1.14, gloss-juicy >= 0.2.3, random >= 1.1 && < 1.4 + exposed-modules: CardDeck, CardRenderer, InputHandler, Patience, PatienceBoard, PatienceRenderer, PNGRenderer, Selector, SelectorRenderer, Shuffle executable patience main-is: Main.hs hs-source-dirs: src default-language: Haskell2010 - build-depends: base >= 4.7 && <5, gloss >= 1.11 && < 1.14, gloss-juicy >= 0.2.3, patience + build-depends: base >= 4.7 && <5, gloss >= 1.11 && < 1.14, patience test-suite patience-test type: exitcode-stdio-1.0 - main-is: VoorbeeldTest.hs + main-is: PatienceTest.hs hs-source-dirs: test default-language: Haskell2010 build-depends: base >=4.7 && <5, hspec <= 2.10.6, patience diff --git a/test/PatienceTest.hs b/test/PatienceTest.hs new file mode 100644 index 0000000..795b750 --- /dev/null +++ b/test/PatienceTest.hs @@ -0,0 +1,52 @@ +import Test.Hspec + +import CardDeck +import PatienceBoard +import Selector + +main :: IO () +main = hspec $ do + describe "Testing CardDeck" $ do + it "generateDeck generates a full sized deck" $ do + length generateDeck == 52 + + it "showCard shows card" $ do + showCard (Hearts, Ace, Hidden) `shouldBe` (Hearts, Ace, Visible) + showCard (Clubs, King, Visible) `shouldBe` (Clubs, King, Visible) + + it "hideCard hides card" $ do + hideCard (Hearts, King, Hidden) `shouldBe` (Hearts, King, Hidden) + hideCard (Spades, Ace, Visible) `shouldBe` (Spades, Ace, Hidden) + + it "flipCard flips card" $ do + flipCard (Hearts, Ace, Hidden) `shouldBe` (Hearts, Ace, Visible) + flipCard (Hearts, Ace, Visible) `shouldBe` (Hearts, Ace, Hidden) + + it "matchType checks types" $ do + matchType (Hearts, Ace, Visible) (Hearts, King, Hidden) `shouldBe` True + matchType (Hearts, Ace, Visible) (Clubs, Ace, Visible) `shouldBe` False + matchType (NoneType, Ace, Hidden) (Spades, King, Hidden) `shouldBe` False + + it "matchColor checks colors" $ do + matchColor (Hearts, Ace, Visible) (Hearts, King, Hidden) `shouldBe` True + matchColor (Hearts, Ace, Visible) (Diamonds, King, Hidden) `shouldBe` True + matchColor (Spades, King, Hidden) (Clubs, Two, Visible) `shouldBe` True + matchColor (Spades, King, Hidden) (Hearts, Three, Visible) `shouldBe` False + matchColor (Diamonds, Four, Visible) (Clubs, Five, Hidden) `shouldBe` False + + describe "Testing PatienceBoard" $ do + it "Starts with empty endingStacks" $ do + endingStacks (board initGame) `shouldBe` [[],[],[],[]] + it "Check size of pile at start of game" $ do + length (pile (board initGame)) `shouldBe` foldl (-) 52 [0 .. amountOfGameStacks] + it "First gameStack should be smallest" $ do + length (head (gameStacks (board initGame))) `shouldBe` 1 + it "Last gameStack should be biggest" $ do + length (gameStacks (board initGame) !! (amountOfGameStacks - 1)) `shouldBe` amountOfGameStacks + + describe "Testing Selector" $ do + it "initSelector is empty" $ do + selected initSelector `shouldBe` Nothing + it "select selects" $ do + selected (toggleSelection initSelector) `shouldBe` Just (0,0) + diff --git a/test/VoorbeeldTest.hs b/test/VoorbeeldTest.hs deleted file mode 100644 index 2b94edb..0000000 --- a/test/VoorbeeldTest.hs +++ /dev/null @@ -1,11 +0,0 @@ -import Test.Hspec - -import VoorbeeldModule (hoi, hallo) - -main :: IO () -main = hspec $ do - it "Returns correct string for hoi" $ do - hoi `shouldBe` "Hoi" - - it "Returns correct string for hallo" $ do - hallo `shouldBe` "Hallo" From 91770a48fb1cebab8cab6575336761536c93e11a Mon Sep 17 00:00:00 2001 From: Tibo De Peuter Date: Tue, 15 Nov 2022 22:38:00 +0100 Subject: [PATCH 14/20] #18 Optimes rendering by caching PNGs --- lib/CardRenderer.hs | 86 +++++++++++++++++++++++++++++++++++++++++ lib/SelectorRenderer.hs | 39 +++++++++++++++++++ 2 files changed, 125 insertions(+) create mode 100644 lib/CardRenderer.hs create mode 100644 lib/SelectorRenderer.hs diff --git a/lib/CardRenderer.hs b/lib/CardRenderer.hs new file mode 100644 index 0000000..10bced8 --- /dev/null +++ b/lib/CardRenderer.hs @@ -0,0 +1,86 @@ +module CardRenderer +( cardHeight +, cardWidth + +, renderCard +, renderStack +, renderStacks +) where + +import CardDeck +import PNGRenderer + +----------------------------- Constants ------------------------------ + +-- The asset directory +assetDir :: [Char] +assetDir = "./lib/assets/" + +cardWidth :: Float +cardWidth = 100 + +cardHeight :: Float +cardHeight = 134 + +-- Map of all (rendered) cards +cardRenders :: [Picture] +cardRenders = back:placeHolder:deck + where deck = map (renderCard' . showCard) generateDeck + back = renderPNG $ assetDir ++ "back.png" + placeHolder = renderPNG $ assetDir ++ "placeholder.png" + +amountOfValues :: Int +amountOfValues = length $ init $ enumFrom Ace + +---------------------------------------------------------------------- + +-- Render a card using renderPNG. +renderCard' :: Card -> Picture +renderCard' (_,_,Hidden) = renderPNG $ assetDir ++ "back.png" +renderCard' (ctype,cvalue,_) = renderPNG $ file_dir ++ file_name + where typestring = cardTypeToString ctype + valuestring = cardTypeToChar cvalue + file_dir = assetDir ++ typestring ++ "s/" + file_name = typestring ++ "-" ++ valuestring ++ ".png" + +-- Render a card using the cached cards. +renderCard :: Card -> Picture +renderCard (_, _, Hidden) = head cardRenders +renderCard (cType, cValue, _) = cardRenders !! index + where index = 2 + t * amountOfValues + v + t = fromEnum cType + v = fromEnum cValue + +-- Spread cards out, by moving each card a distance x over the x-axis +-- and y over the y-axis. +spread :: Float -> Float -> [Picture] -> [Picture] +spread x y = zipWith shift [0 .. ] + where shift index = translate (x * index) (y * index) + +-- Render all cards of a stack with a card inset of given value. +renderStack :: Float -> Stack -> Picture +renderStack _ [] = cardRenders !! 1 +renderStack cardDist stack = compose spreadOutStack + where renderedStack = map renderCard $ reverse stack + spreadOutStack = spread 0 cardDist renderedStack + +-- Render all cards of multiple stacks, with a given distance between +-- all stacks and a different distance between cards. +renderStacks :: Float -> Float -> [Stack] -> Picture +renderStacks stackDist cardDist = compose . spreadOutStacks + where renderedStacks = map (renderStack cardDist) + spreadOutStacks = spread (stackDist + cardWidth) 0 . renderedStacks + +cardTypeToString :: CardType -> [Char] +cardTypeToString Clubs = "club" +cardTypeToString Diamonds = "diamond" +cardTypeToString Hearts = "heart" +cardTypeToString Spades = "spade" +cardTypeToString _ = "" + +cardTypeToChar :: CardValue -> [Char] +cardTypeToChar Ace = "A" +cardTypeToChar Jack = "J" +cardTypeToChar Queen = "Q" +cardTypeToChar King = "K" +cardTypeToChar a = show $ 1 + fromEnum a diff --git a/lib/SelectorRenderer.hs b/lib/SelectorRenderer.hs new file mode 100644 index 0000000..4bc38fb --- /dev/null +++ b/lib/SelectorRenderer.hs @@ -0,0 +1,39 @@ +module SelectorRenderer +( renderSelector +, renderSelected +) where + +import Selector +import PNGRenderer + +----------------------------- Constants ------------------------------ + +selectorFilePath :: FilePath +selectorFilePath = "./lib/assets/selector.png" + +selectedFilePath :: FilePath +selectedFilePath = "./lib/assets/selected.png" + +selectorRenders :: (Picture, Picture) +selectorRenders = ( + renderPNG selectorFilePath, + renderPNG selectedFilePath + ) + +---------------------------------------------------------------------- + +-- Render the outline of the selector. The offset for every value 1 +-- in the coordinate must be given. +renderSelector :: Float -> Float -> Selector -> Picture +renderSelector a b Selector{ position = (x,y) } = translate fx fy render + where fx = fromIntegral x * a + fy = fromIntegral y * b + render = fst selectorRenders + +-- Render the selected piece if any. +renderSelected :: Float -> Float -> Selector -> Picture +renderSelected a b Selector{ selected = Just (x, y) } = translate fx fy render + where fx = fromIntegral x * a + fy = fromIntegral y * b + render = snd selectorRenders +renderSelected _ _ _ = blank From 9bb31d9673148d65acb29f627a7f3df7c47020f4 Mon Sep 17 00:00:00 2001 From: Tibo De Peuter Date: Tue, 15 Nov 2022 22:44:06 +0100 Subject: [PATCH 15/20] #2 Polish CardDeck --- lib/CardDeck.hs | 39 ++++++++++++++++++++++++++++++++++++--- 1 file changed, 36 insertions(+), 3 deletions(-) diff --git a/lib/CardDeck.hs b/lib/CardDeck.hs index b98d32e..982688f 100644 --- a/lib/CardDeck.hs +++ b/lib/CardDeck.hs @@ -1,17 +1,31 @@ module CardDeck ( Card -, CardStatus(..) +, CardType (..) +, CardValue (..) +, CardStatus (..) , Stack , generateDeck , generateShuffledDeck + , showCard , hideCard , flipCard +, matchType +, matchValue +, matchColor ) where import Shuffle +---------------------------------------------------------------------- +-- Representation of the Standard 52-card deck. -- +-- Extra support for handling piles of cards, hiding and showing -- +-- cards and checking if two match given a property. -- +---------------------------------------------------------------------- + +----------------------------- Constants ------------------------------ + -- Colors of cards data CardType = Clubs | Diamonds @@ -39,7 +53,7 @@ data CardValue = Ace data CardStatus = Hidden | Visible - deriving (Show) + deriving (Show, Eq) -- A card has a type and a value and is either shown or hidden. type Card = (CardType, CardValue, CardStatus) @@ -47,21 +61,40 @@ type Card = (CardType, CardValue, CardStatus) -- A stack of cards type Stack = [Card] --- Generate a standard 52-card deck, given by CardValue and CardType +---------------------------------------------------------------------- + +-- Generate a standard 52-card deck, with values by CardValue and types +-- by CardType. Cards are hidden by default. generateDeck :: Stack generateDeck = [(cType, cValue, Hidden) | cType <- types, cValue <- values] where types = init $ enumFrom Clubs values = init $ enumFrom Ace +-- Generate a standard 52-card deck and shuffle all cards randomly. generateShuffledDeck :: Stack generateShuffledDeck = shuffle generateDeck +-- Show a card. showCard :: Card -> Card showCard (t, v, _) = (t,v,Visible) +-- Hide a card. hideCard :: Card -> Card hideCard (t, v, _) = (t,v,Hidden) +-- Flip the card. If it was visible, it is now hidden and vice versa. flipCard :: Card -> Card flipCard c@(_, _, Visible) = hideCard c flipCard c@(_, _, Hidden) = showCard c + +-- Check if two cards match type. +matchType :: Card -> Card -> Bool +matchType (t1, _, _) (t2, _, _) = t1 == t2 + +-- Check if two cards match color. +matchValue :: Card -> Card -> Bool +matchValue (_, v1, _) (_, v2, _) = v1 == v2 + +-- Check if two cards have the same color. +matchColor :: Card -> Card -> Bool +matchColor (t1, _, _) (t2, _, _) = t1 == t2 || (fromEnum t1 + fromEnum t2) `elem` [3, 6] From cc20b3a5e6a40be77a10c46cf3270fe85e2b3e38 Mon Sep 17 00:00:00 2001 From: Tibo De Peuter Date: Tue, 15 Nov 2022 22:53:33 +0100 Subject: [PATCH 16/20] #3 Polished CardRenderer --- lib/CardRenderer.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lib/CardRenderer.hs b/lib/CardRenderer.hs index 10bced8..7a3a185 100644 --- a/lib/CardRenderer.hs +++ b/lib/CardRenderer.hs @@ -71,6 +71,7 @@ renderStacks stackDist cardDist = compose . spreadOutStacks where renderedStacks = map (renderStack cardDist) spreadOutStacks = spread (stackDist + cardWidth) 0 . renderedStacks +-- Convert a CardType to a string. cardTypeToString :: CardType -> [Char] cardTypeToString Clubs = "club" cardTypeToString Diamonds = "diamond" @@ -78,6 +79,7 @@ cardTypeToString Hearts = "heart" cardTypeToString Spades = "spade" cardTypeToString _ = "" +-- Convert a CardType to a character. cardTypeToChar :: CardValue -> [Char] cardTypeToChar Ace = "A" cardTypeToChar Jack = "J" From 6ca75115144daea6cfa85a6a29dffbfe59ba8236 Mon Sep 17 00:00:00 2001 From: Tibo De Peuter Date: Tue, 15 Nov 2022 22:55:33 +0100 Subject: [PATCH 17/20] #7 Polish selector --- lib/Selector.hs | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/lib/Selector.hs b/lib/Selector.hs index 97218e8..e2693c5 100644 --- a/lib/Selector.hs +++ b/lib/Selector.hs @@ -1,5 +1,6 @@ module Selector ( Selector (..) +, Coordinate , Direction (..) , initSelector @@ -8,6 +9,7 @@ module Selector , select , deselect , toggleSelection +, getSelected , moveUp , moveDown @@ -38,7 +40,7 @@ data Selector = Selector { position :: Coordinate, -- The card(s) that the selector currently holds. selected :: Maybe Coordinate -} deriving (Show) +} deriving (Show, Eq) ---------------------------------------------------------------------- @@ -64,16 +66,25 @@ move D = moveBy (diff !! 1) move L = moveBy (diff !! 2) move R = moveBy (diff !! 3) +-- Select the current position. select :: Selector -> Selector select s@Selector{ position = pos } = s{ selected = Just pos } +-- Deselect the current selection. deselect :: Selector -> Selector deselect s = s{ selected = Nothing } +-- Toggle the selection of the selector. Deselect if any position is +-- selected, otherwise select the current position. toggleSelection :: Selector -> Selector toggleSelection s@Selector{ selected = Nothing } = select s toggleSelection s = deselect s +-- Get the selected coordinate, otherwise get (0,0) by default. +getSelected :: Selector -> Coordinate +getSelected s@Selector{ selected = Just c } = c +getSelected s@Selector{ selected = Nothing } = (0,0) + ---------------------------------------------------------------------- -- Move the selector up one position. From 7dc72ee211b43670da74df4713ca6139a25628d8 Mon Sep 17 00:00:00 2001 From: Tibo De Peuter Date: Tue, 15 Nov 2022 22:58:24 +0100 Subject: [PATCH 18/20] Polish inputhandler --- lib/InputHandler.hs | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/lib/InputHandler.hs b/lib/InputHandler.hs index 9c04223..6555836 100644 --- a/lib/InputHandler.hs +++ b/lib/InputHandler.hs @@ -15,6 +15,11 @@ module InputHandler import Graphics.Gloss import qualified Graphics.Gloss.Interface.IO.Game as Game +---------------------------------------------------------------------- +-- Handle one or more InputEvents to do something. Compose them to -- +-- create an InputHandler that handles multiple inputs. -- +---------------------------------------------------------------------- + ----------------------------- Constants ------------------------------ -- Something that happens, most often a keypress From 425bb6eee2f4375a30e65c0ee6bbedf9792351e3 Mon Sep 17 00:00:00 2001 From: Tibo De Peuter Date: Tue, 15 Nov 2022 23:29:58 +0100 Subject: [PATCH 19/20] #5 #6 --- lib/Patience.hs | 17 +++++++++++++++-- lib/PatienceBoard.hs | 35 ++++++++++++----------------------- lib/PatienceRenderer.hs | 36 +++++++++++++++++------------------- 3 files changed, 44 insertions(+), 44 deletions(-) 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 From d0b41049bec10aeb4ae29e3452b1efea67e10cbb Mon Sep 17 00:00:00 2001 From: Tibo De Peuter Date: Tue, 15 Nov 2022 23:33:12 +0100 Subject: [PATCH 20/20] Cleanup --- lib/PNGRenderer.hs | 2 ++ src/Main.hs | 14 +++++++++++--- 2 files changed, 13 insertions(+), 3 deletions(-) diff --git a/lib/PNGRenderer.hs b/lib/PNGRenderer.hs index 8c342dd..04955bc 100644 --- a/lib/PNGRenderer.hs +++ b/lib/PNGRenderer.hs @@ -31,8 +31,10 @@ renderPNG = fromJust . unsafePerformIO . loadJuicyPNG blank :: Picture blank = Gloss.Blank +-- Translate a picture by moving it along two axis. translate :: Float -> Float -> Picture -> Picture translate = Gloss.translate +-- Compose multiple pictures into a single picture. compose :: [Picture] -> Picture compose = Gloss.Pictures diff --git a/src/Main.hs b/src/Main.hs index 55d35ac..927c356 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,4 +1,12 @@ -import VoorbeeldModule (hoi) +import Patience -main :: IO () -main = putStrLn hoi +----------------------------- Constants ------------------------------ + +-- Framerate of the game +fps :: Int +fps = 60 + +---------------------------------------------------------------------- + +main :: IO() +main = playPatience fps