setgame (empty) → 1.1

raw patch · 9 files changed

+745/−0 lines, 9 filesdep +basedep +randomdep +setgamesetup-changed

Dependencies added: base, random, setgame, vty

Files

• LICENSE +29/−0
• Main.hs +7/−0
• Setup.hs +6/−0
• setgame.cabal +32/−0
• src/Set/Ascii.hs +60/−0
• src/Set/Card.hs +66/−0
• src/Set/Game.hs +96/−0
• src/Set/Utils.hs +97/−0
• src/SetGame.hs +352/−0

@@ -0,0 +1,29 @@+Copyright (c) 2010, Eric Mertens+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++Redistributions of source code must retain the above copyright notice,+this list of conditions and the following disclaimer.++Redistributions in binary form must reproduce the above copyright+notice, this list of conditions and the following disclaimer in the+documentation and/or other materials provided with the distribution.++Neither the name of the author nor the names of its contributors+may be used to endorse or promote products derived from this software+without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS+IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED+TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A+PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED+TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR+PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING+NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,7 @@+module Main where++import Data.Monoid (mempty)+import SetGame (gameMain)++main :: IO ()+main = gameMain mempty

@@ -0,0 +1,6 @@+module Main (main) where++import Distribution.Simple++main :: IO ()+main = defaultMainWithHooks simpleUserHooks

@@ -0,0 +1,32 @@+name:		setgame+version:	1.1+category:	Game+license:	BSD3+license-file:	LICENSE+maintainer:	emertens@gmail.com+synopsis:	A console interface to the game of Set+description:	A console interface to the game of Set+build-type: Simple+cabal-version: >=1.8+tested-with: GHC == 7.10.2, GHC == 7.8.4++source-repository head+  type: git+  location: https://github.com/glguy/set-game++library+  build-depends:        base     >=4.7 && <4.9,+                        random   >=1.1 && <1.2,+                        vty      >=5.4 && <5.5+  hs-source-dirs: src+  ghc-options: -Wall+  exposed-modules: SetGame,+                   Set.Ascii,+                   Set.Card,+                   Set.Game,+                   Set.Utils++executable set-game+  main-is: Main.hs+  build-depends: setgame, base+  ghc-options: -Wall -threaded

@@ -0,0 +1,60 @@+{-# LANGUAGE NamedFieldPuns #-}+module Set.Ascii (cardLines) where++import Set.Card++-------------------------------------------------------------------------------+-- Card drawing functions -----------------------------------------------------+-------------------------------------------------------------------------------++-- | 'selectArt' returns the ASCII art representation of the lines for+--   a given 'Shading' and 'Symbol'.+selectArt :: Shading -> Symbol -> [String]+selectArt Open    Diamond  = ["    "+                             ," ╱╲ "+                             ,"╱  ╲"+                             ,"‾‾‾‾"]+selectArt Striped Diamond  = ["    "+                             ," ╱╲ "+                             ,"╱╱╲╲"+                             ,"‾‾‾‾"]+selectArt Solid   Diamond  = ["    "+                             ," ╱╲ "+                             ,"╱╳╳╲"+                             ,"‾‾‾‾"]+selectArt Open    Squiggle = ["___ "+                             ,"╲  ╲"+                             ,"╱  ╱"+                             ,"‾‾‾ "]+selectArt Striped Squiggle = ["___ "+                             ,"╲╲╲╲"+                             ,"╱╱╱╱"+                             ,"‾‾‾ "]+selectArt Solid   Squiggle = ["___ "+                             ,"╲╳╳╲"+                             ,"╱╳╳╱"+                             ,"‾‾‾ "]+selectArt Open    Oval     = [" __ "+                             ,"╱  ╲"+                             ,"╲  ╱"+                             ," ‾‾ "]+selectArt Striped Oval     = [" __ "+                             ,"╱╱╲╲"+                             ,"╲╲╱╱"+                             ," ‾‾ "]+selectArt Solid   Oval     = [" __ "+                             ,"╱╳╳╲"+                             ,"╲╳╳╱"+                             ," ‾‾ "]++-- | Compute the ASCII lines and color of a given card+cardLines :: Card -> (Color, [String])+cardLines Card {color, count, shading, symbol}+  = (color, map (duplicate count) (selectArt shading symbol))++-- | 'duplicate' pads a 'String' to fit neatly, centered in a 14-character+--   region.+duplicate :: Count -> String -> String+duplicate One   x = "      " ++        x        ++ "      "+duplicate Two   x = "   "    ++ x ++ "  " ++ x  ++    "   "+duplicate Three x = " " ++ x ++ " " ++ x ++ " " ++ x ++ " "

@@ -0,0 +1,66 @@+module Set.Card+  (-- * Types+   Card(..),+   Color(..),+   Count(..),+   Shading(..),+   Symbol(..),++   -- * 'Card' interface functions+   allCards,+   validSet,+   solve+  ) where++import Data.List                        (tails)++import Set.Utils+  +data Color = Red | Purple | Green+ deriving (Show, Eq, Ord)++data Count = One | Two | Three+ deriving (Show, Eq, Ord)+ +data Shading = Open | Striped | Solid+ deriving (Show, Eq, Ord)+ +data Symbol = Diamond | Squiggle | Oval+ deriving (Show, Eq, Ord)++data Card = Card { color :: Color+                 , count :: Count+                 , shading :: Shading+                 , symbol :: Symbol+                 }+ deriving (Show, Eq)++checkAttribute :: Eq a => [a] -> Bool+checkAttribute xs = all (uncurry (==)) combos+                 || all (uncurry (/=)) combos+ where+ combos = chooseTwo xs++validSet :: Card -> Card -> Card -> Bool+validSet card1 card2 card3+  = checkAttribute (map color   cards)+ && checkAttribute (map count   cards)+ && checkAttribute (map shading cards)+ && checkAttribute (map symbol  cards)+  where+  cards = [card1, card2, card3] ++allCards :: [Card]+allCards = [Card a b c d | a <- [Red,     Purple,   Green]+                         , b <- [One,     Two,      Three]+                         , c <- [Open,    Striped,  Solid]+                         , d <- [Diamond, Squiggle, Oval]]+++-- | 'solveBoard' returns the list of all valid sets contained in the given+--   list.+solve :: [Card] -> [(Card,Card,Card)]+solve xs = [(a,b,c) | (a:as) <- tails xs+                    , (b:bs) <- tails as+                    , c      <- bs+                    , validSet a b c]

@@ -0,0 +1,96 @@+{-# LANGUAGE NamedFieldPuns #-}+module Set.Game (+        -- * Types+          Game++        -- * 'Game' creation functions+        , newGame++        -- * 'Game' update functions+        , considerSet+        , extraCards+        , sortTableau++        -- * Game query functions+        , tableau+        , deckNull+        , deckSize+        , emptyGame+        , hint+  ) where++import Control.Monad (guard)+import System.Random (RandomGen)++import Set.Card+import Set.Utils+import Data.List (sortBy)++-- | 'tableauSize' is the minimum number of cards that should be on the tableau.+tableauSize :: Int+tableauSize = 12++-- | 'Game' represents the current state of a Set game including the remaining+-- shuffled deck and the current tableau.+data Game = Game [Card] [Card]++tableau :: Game -> [Card]+tableau (Game t _) = t++-- | 'newGame' creates a new 'Game' with a full tableau and shuffled deck.+newGame :: IO Game+newGame = (deal . Game []) `fmap` shuffleIO allCards++-- | 'deal' adds additional cards as needed to reach 'tableauSize' cards.+deal :: Game -> Game+deal game = addCards (tableauSize - length (tableau game)) game++-- | 'considerSet' verifies that a given set exists in the tableau+-- and then removes the set from the tableau.+considerSet :: Card -> Card -> Card -> Game -> Maybe Game+considerSet card0 card1 card2 (Game t d) = do+  guard (validSet card0 card1 card2)+  t' <- delete1 card0 =<< delete1 card1 =<< delete1 card2 t+  return (deal (Game t' d))++-- | 'addCards' adds the top @n cards from the deck to the end of the tableau.+addCards :: Int -> Game -> Game+addCards n (Game t d) = Game (t ++ dealt) d'+  where+  (dealt, d')    = splitAt n d++-- | 'deckSize' returns the number of cards remaining in the deck.+deckSize :: Game -> Int+deckSize (Game _ d) = length d++-- | 'deckNull' returns 'True' iff the deck is empty.+deckNull :: Game -> Bool+deckNull (Game _ d) = null d++-- | 'extraCards' returns either a new game with 3 additional cards dealt+-- or the number of sets remaining in the tableau.+extraCards :: Game -> Either Int Game+extraCards game+  | sets == 0 && not (deckNull game) = Right (addCards 3 game)+  | otherwise                        = Left sets+  where+   sets = length (solve (tableau game))++-- | 'hint' returns a randomly selected card contained in a set found on+-- the tableau.+hint :: RandomGen g => g -> Game -> (Maybe Card, g)+hint g game =+  let (tableau', g') = shuffle (tableau game) g+  in case solve tableau' of+      ((a,_,_):_) -> (Just a, g')+      _ -> (Nothing, g')++-- | 'sortTableau' sorts the tableau with a given order.+sortTableau :: (Card -> Card -> Ordering) -> Game -> Game+sortTableau f (Game t d) = Game (sortBy f t) d++-- | 'emptyGame' tests for a game with no cards remaining+--   in either the tableau or the deck.+emptyGame :: Game -> Bool+emptyGame game = null (tableau game) && deckNull game+

@@ -0,0 +1,97 @@+module Set.Utils where++import Data.List     (tails)+import System.Random (newStdGen, RandomGen, randomR)++-------------------------------------------------------------------------------+-- List utilities--------------------------------------------------------------+-------------------------------------------------------------------------------++-- | 'groups' breaks a list into sublists of the given size. The final resulting+--   group may contain fewer elements than the given size.+--   Property: For all positive n. concat (groups n xs) == xs+groups :: Int -> [a] -> [[a]]+groups _ [] = []+groups n xs = as : groups n bs+  where+  (as,bs) = splitAt n xs++-- | 'delete1' returns a list with the first occurrence of @x removed. If there+-- is no occurrence 'Nothing' is returned.+delete1 :: Eq a => a -> [a] -> Maybe [a]+delete1 x (y:ys)+  | x == y = Just ys+  | otherwise = fmap (y:) (delete1 x ys)+delete1 _ [] = Nothing++-- | 'index' returns the element at the given 0-based index and returns+-- 'Nothing' on failure.+index :: Int -> [a] -> Maybe a+index 0 (x:_)           = Just x+index n (_:xs) | n > 0  = index (n-1) xs+index _ _               = Nothing++-- | Extract an element from a list by index returning that element+-- and the remaining list.+select :: Int -> [a] -> (a,[a])+select _ [] = error "select: index too large"+select 0 (x:xs) = (x,xs)+select n (x:xs) = (y,x:ys)+  where+  (y,ys) = select (n-1) xs++-- | Drop last element of list if there is an element to drop.+init' :: [a] -> [a]+init' [] = []+init' xs = init xs++-------------------------------------------------------------------------------+-- Other utilities ------------------------------------------------------------+-------------------------------------------------------------------------------++-- | 'chooseTwo' returns all combinations of two elements.+chooseTwo :: [a] -> [(a,a)]+chooseTwo xs = [ (a,b) | (a:as) <- tails xs+                       , b      <- as+                       ]++-- | 'seconds' converts seconds to microseconds for use in 'threadDelay'.+seconds :: Int -> Int+seconds x = 1000000 * x++-------------------------------------------------------------------------------+-- List shuffling utilities ---------------------------------------------------+-------------------------------------------------------------------------------++-- | 'shuffleIO' calls shuffle using a generator from 'newStdGen'.+shuffleIO :: [a] -> IO [a]+shuffleIO xs = fmap (fst . shuffle xs) newStdGen++-- | 'shuffle' shuffles the elements of a list using the given random generator.+shuffle :: RandomGen g => [a] -> g -> ([a], g)+shuffle xs = shuffle' (length xs) xs++shuffle' :: RandomGen g =>  Int -> [a] -> g -> ([a], g)+shuffle' _ [] g = ([], g)+shuffle' n xs g = (x:xs'', g'')+  where+  n'            = n - 1+  (i, g')       = randomR (0,n') g+  (x, xs')      = select i xs+  (xs'', g'')   = shuffle' n' xs' g'++-------------------------------------------------------------------------------+-- Text manipulation utilities ------------------------------------------------+-------------------------------------------------------------------------------++-- | 'centerText' centers the given string in a field of @width characters.+centerText :: Int -> String -> String+centerText width xs = replicate ((width - length xs) `div` 2 ) ' ' ++ xs+                   ++ replicate ((width - length xs + 1) `div` 2 ) ' '+-- | 'centerText' right-aligns the given string in a field of @width characters.+leftPadText :: Int -> String -> String+leftPadText width xs = replicate (width - length xs) ' ' ++ xs++-- | 'centerText' left-aligns the given string in a field of @width characters.+rightPadText :: Int -> String -> String+rightPadText width xs = xs ++ replicate (width - length xs) ' '

@@ -0,0 +1,352 @@+module SetGame (gameMain) where++import Control.Concurrent               (threadDelay)+import Data.List                        (delete)+import Data.Foldable                    (traverse_)+import Graphics.Vty as Vty+import System.Random                    (newStdGen, StdGen)++import Set.Ascii                        (cardLines)+import Set.Card                         (Card, Color(Red,Purple,Green))+import Set.Game+import Set.Utils hiding (select)++gameMain :: Vty.Config -> IO ()+gameMain config = do+  vty <- mkVty config+  game <- newGame+  g <- newStdGen+  run vty game+        $ setGame game+        $ newInterface g+  shutdown vty++-- | 'run' is the main event-loop for the game. It alternates+--   reading user input and drawing the interface.+run :: Vty -> Game -> Interface -> IO ()+run vty game s+ | emptyGame game = return ()+ | otherwise = do+  s' <- printGame vty s++  cmd <- handleInput vty+  let simple f = run vty game (f s')+  case cmd of+    Deal        -> traverse_ (\(g,i) -> run vty g i) (checkNoSets game s')+    Delete      -> simple $ clearSelection . clearMessage+    Hint        -> simple $ giveHint game+    Move dir    -> simple $ moveFocus dir+    Quit        -> return ()+    Redraw      -> refresh vty >> run vty game s+    Select      -> traverse_ (\(g,i) -> run vty g i) (select game s')++-- | 'select' performs an event on the interface based on the currently+--   focused control.+select :: Game -> Interface -> Maybe (Game, Interface)+select game s = case iControl s of+ CardButton i -> case index i (iTableau s) of+   Just t | isSelected t s      -> Just (game, updateSelection (delete t)+                                             . clearMessage+                                             $ s)+          | otherwise           -> addCard t game s+   Nothing                      -> Just (game, setControl (CardButton 0)+                                             $ s)++-- | 'addCard' attempts to add a new card to the selection and handles+--   checking for a valid set when the selection becomes full.+addCard :: Card -> Game -> Interface -> Maybe (Game, Interface)+addCard card0 game s = case iSelection s of+  (_:_:_:_)      -> Just (game, setMessage "Selection full" s)+  [card1, card2] -> checkSet card0 card1 card2 game . appendSelection card0+                                                    . clearMessage+                                                    $ s+  _              -> Just (game, appendSelection card0+                              . clearMessage+                              $ s)++-- | 'setGame' updates the 'Interface' based on the current 'Game' state.+setGame :: Game -> Interface -> Interface+setGame game = setTableau (tableau game)+             . setRemaining (deckSize game)++moveFocus :: Direction -> Interface -> Interface+moveFocus dir s = setControl control s+ where+  control = case iControl s of+    CardButton i -> moveFocusCardButton dir i (length (iTableau s))++moveFocusCardButton :: Direction -> Int -> Int -> CurrentControl+moveFocusCardButton dir i n = CardButton i1+   where+    (row,col) = i `divMod` cols++    (row1, col1) = case dir of+      GoUp        -> (row - 1, col)+      GoDown      -> (row + 1, col)+      GoLeft      -> (row, col - 1)+      GoRight     -> (row, col + 1)++    i1 = case dir of+      _ | toI (row1, col1) < n+                  -> toI (row1, col1)+      GoUp        -> toI (-2, col1)+      GoDown      -> toI (0, col1)+      GoLeft      -> toI (row1, n-1)+      GoRight     -> toI (row1, 0)++    toI (r,c) = r `mod` rows * cols + c `mod` cols++    rows = (n + cols - 1) `div` cols+    cols = tableauWidth++printGame :: Vty -> Interface -> IO Interface+printGame vty s = do+   update vty $ makePicture+              $ interfaceImage s+   case iTimer s of+     Nothing -> return s+     Just (delay, s') -> do+       threadDelay delay+       printGame vty s'++-- | 'giveHint' checks for a hint in the current game and alters the+--   selection if a hint is found.+giveHint :: Game -> Interface -> Interface+giveHint game s = incHintCounter . setGen g . f $ s+  where+  f = case mbHint of+        Just a -> setMessage hintmsg . setSelection [a]+        Nothing -> setMessage dealmsg++  (mbHint, g) = hint (iStdGen s) game++  hintmsg = "There is a set using this card."+  dealmsg = "No sets in this tableau, deal more cards."++-- | 'checkSet' will extract the chosen set from the tableau and check it+--   for validity. If a valid set is removed from the tableau the tableau+--   will be refilled up to 12 cards.+checkSet :: Card -> Card -> Card -> Game -> Interface+         -> Maybe (Game, Interface)+checkSet a b c game s = Just $ case considerSet a b c game of+  Nothing       -> (game, setMessage "Not a set!"+                        . delayedUpdate (seconds 1 `div` 4)+                        ( setMessage "Not a set.")+                        $ s)++  Just game'    -> (game', delayedUpdate (seconds 1)+                        ( setGame game'+                        . clearSelection+                        . setMessage "Good job.")+                        . setMessage "Good job!"+                        $ s)++-- | 'checkNoSets' verifies that there are no sets in the current tableau+-- and deals additional cards to the tableau in that case.+checkNoSets :: Game -> Interface -> Maybe (Game, Interface)+checkNoSets game s = case extraCards game of+  Right game'   -> Just (game', setGame game'+                              . incDealCounter+                              . setMessage "Dealing more cards."+                              $ s)+  Left 0        -> Just (game , setMessage "Game over, all sets found." s)+  Left sets     -> Just (game , incBadDealCounter+                              . setMessage msg+                              $ s)+    where+       msg = "Oops, " ++ show sets ++ " sets in tableau. Keep looking."++-------------------------------------------------------------------------------+-- Interface manipulation functions -------------------------------------------+-------------------------------------------------------------------------------++data Interface = IS+  { iControl :: CurrentControl+  , iSelection :: [Card]+  , iMessage :: String+  , iDealCounter :: Integer+  , iBadDealCounter :: Integer+  , iHintCounter :: Integer+  , iStdGen :: StdGen+  , iTimer :: Maybe (Int, Interface)+  , iTableau :: [Card]+  , iRemaining :: Int+  }++newInterface :: StdGen -> Interface+newInterface g = IS+  { iControl = CardButton 0+  , iSelection = []+  , iMessage = ""+  , iDealCounter = 0+  , iBadDealCounter = 0+  , iHintCounter = 0+  , iStdGen = g+  , iTimer = Nothing+  , iTableau = []+  , iRemaining = 0+  }++data CurrentControl = CardButton Int+ deriving (Eq)++setRemaining :: Int -> Interface -> Interface+setRemaining n s = s { iRemaining = n }++setTableau :: [Card] -> Interface -> Interface+setTableau xs s = s { iTableau = xs }++setTimer :: Int -> Interface -> Interface -> Interface+setTimer delay s' s = s { iTimer = Just (delay, s') }++delayedUpdate :: Int -> (Interface -> Interface)+              -> Interface -> Interface+delayedUpdate delay f s = setTimer delay (f s) s++incHintCounter :: Interface -> Interface+incHintCounter i = i { iHintCounter = iHintCounter i + 1 }++incDealCounter :: Interface -> Interface+incDealCounter i = i { iDealCounter = iDealCounter i + 1 }++incBadDealCounter :: Interface -> Interface+incBadDealCounter i = i { iBadDealCounter = iBadDealCounter i + 1 }++setControl :: CurrentControl -> Interface -> Interface+setControl x i = i { iControl = x }++clearMessage :: Interface -> Interface+clearMessage = setMessage ""++setMessage :: String -> Interface -> Interface+setMessage msg i = i { iMessage = msg }++setSelection :: [Card] -> Interface -> Interface+setSelection xs i = i { iSelection = xs }++updateSelection :: ([Card] -> [Card]) -> Interface -> Interface+updateSelection f i = setSelection (f (iSelection i)) i++appendSelection :: Card -> Interface -> Interface+appendSelection card = updateSelection (++ [card])++clearSelection :: Interface -> Interface+clearSelection = updateSelection (const [])++isSelected :: Card -> Interface -> Bool+isSelected x i = x `elem` iSelection i++setGen :: StdGen -> Interface -> Interface+setGen g i = i { iStdGen = g }++-------------------------------------------------------------------------------+-- Input to event mapping -----------------------------------------------------+-------------------------------------------------------------------------------++data Command = Move Direction | Select | Quit | Deal | Delete | Hint | Redraw+data Direction = GoUp | GoDown | GoLeft | GoRight++handleInput :: Vty -> IO Command+handleInput vty = do+ ev <- nextEvent vty+ case ev of+   EvKey KBS         [] -> return Delete+   EvKey KUp         [] -> return (Move GoUp)+   EvKey KDown       [] -> return (Move GoDown)+   EvKey KLeft       [] -> return (Move GoLeft)+   EvKey KRight      [] -> return (Move GoRight)+   EvKey KEnter      [] -> return Select+   EvKey (KChar 'd') [] -> return Deal+   EvKey (KChar 'h') [] -> return Hint+   EvKey (KChar 'q') [] -> return Quit+   EvKey (KChar 'l') [MCtrl] -> return Redraw+   _ -> handleInput vty++-------------------------------------------------------------------------------+-- Interface rendering functions ----------------------------------------------+-------------------------------------------------------------------------------++titleString :: String+titleString = "The game of Set"++helpString :: String+helpString = "(D)eal, (H)int, (Q)uit, Arrows move, Return selects,\+             \ Backspace clears"++interfaceImage :: Interface -> Image+interfaceImage s =+  boldString (centerText 72 titleString)+  <->+  plainString helpString+  <->+  tableauImage s+  <->+  plainString "Cards remaining in deck: "+    <|> boldString  (leftPadText 2 (show (iRemaining s)))+    <|> plainString "    ["+    <|> boldString  (rightPadText 38 (iMessage s))+    <|> plainString "]"+  <->+  plainString "Deal count: "+    <|> boldString  (show (iDealCounter s))+    <|> plainString "/"+    <|> boldString  (show (iDealCounter s + iBadDealCounter s))+    <|> plainString "   Hints used: "+    <|> boldString  (show (iHintCounter s))++tableauImage :: Interface -> Image+tableauImage s+  | null (iTableau s)   = boldString "No more cards!"+                      <-> plainString " "++  | otherwise           = vertCat+                        $ map cardRowImage+                        $ groups tableauWidth+                        $ zipWith testFocus [0..] +                        $ iTableau s+  where+  testFocus i c = (iControl s == CardButton i, isSelected c s, c)++cardRowImage :: [(Bool, Bool, Card)] -> Image+cardRowImage = horizCat . map cardImage++-- | 'cardImage' renders a 'Card' based on its current selection and focus+--   state.+cardImage :: (Bool, Bool, Card) -> Image+cardImage (focused,selected,c) = leftSide <|> body <|> rightSide <-> bottom+ where+  body          = vertCat (map (Vty.string cardAttr) xs)+  leftSide     = charFill fillAttr leftFiller 1 (4 :: Int)+  rightSide    = charFill fillAttr rightFiller 1 (4 :: Int)+  bottom        = charFill defAttr ' ' 18 (1 :: Int)++  (cardColor, xs) = cardLines c++  vtyColor = case cardColor of+    Red         -> red+    Purple      -> cyan+    Green       -> green++  (fillAttr, leftFiller, rightFiller)+    | focused   = (defAttr`withForeColor`white`withBackColor`yellow,+                     '▶', '◀')+    | otherwise = (defAttr, ' ', ' ')++  cardAttr+    | selected  = baseCardAttr `withStyle` reverseVideo+    | otherwise = baseCardAttr++  baseCardAttr = defAttr `withForeColor` vtyColor `withBackColor` black++makePicture :: Image -> Picture+makePicture img = (picForImage img)+ { picBackground = Background ' ' defAttr }++plainString :: String -> Image+plainString = string defAttr++boldString :: String -> Image+boldString = string (defAttr `withStyle` bold)++tableauWidth :: Int+tableauWidth = 4