Merge branch 'master' into polishing
This commit is contained in:
commit
d146a24722
4 changed files with 534 additions and 17 deletions
26
lib/Patience.hs
Normal file
26
lib/Patience.hs
Normal file
|
|
@ -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
|
||||
|
|
@ -1,10 +1,34 @@
|
|||
module PatienceBoard
|
||||
( Board
|
||||
( Game (..)
|
||||
, Board (..)
|
||||
, amountOfGameStacks
|
||||
, amountOfEndingStacks
|
||||
, gameStacksCoord
|
||||
, endingStacksCoord
|
||||
, pileCoord
|
||||
|
||||
,initBoard
|
||||
, handleInputs
|
||||
, initGame
|
||||
|
||||
, isInGame
|
||||
, isInEnding
|
||||
, isInPile
|
||||
) 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 +40,287 @@ data Board = Board {
|
|||
pile :: Stack
|
||||
} deriving (Show)
|
||||
|
||||
-- Show the first of a stack of cards.
|
||||
showFirst :: Stack -> Stack
|
||||
showFirst (c:cs) = (showCard c):cs
|
||||
-- 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
|
||||
|
||||
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
|
||||
|
||||
------------------------------- 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
|
||||
}
|
||||
|
||||
------------------- 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
|
||||
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
|
||||
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)
|
||||
| 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.
|
||||
showFirst :: Stack -> Stack
|
||||
showFirst [] = []
|
||||
showFirst (c:cs) = showCard c : cs
|
||||
|
||||
-- Rotate the pile n times.
|
||||
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 :: 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
|
||||
visibility = vis == Visible
|
||||
|
||||
-- Check if a card can be played ontop of an EndingStack.
|
||||
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
|
||||
visibility = vis == Visible
|
||||
|
||||
-- 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 from 0 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 oldPile 0 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 oldPile 0 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 from 0 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'
|
||||
|
||||
-- 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 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.
|
||||
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 }
|
||||
| isLegalMove dir g = g{ selector = move dir s }
|
||||
| otherwise = g
|
||||
|
||||
-- Toggle selector. If a card was already selected, try to move it.
|
||||
toggleSelector :: Game -> Game
|
||||
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
|
||||
handleInputs = composeInputHandler [
|
||||
handleUp (moveSelector U),
|
||||
handleDown (moveSelector D),
|
||||
handleLeft (moveSelector L),
|
||||
handleRight (moveSelector R),
|
||||
|
||||
handleSpace toggleSelector,
|
||||
handleEnter rotatePile
|
||||
]
|
||||
|
|
|
|||
117
lib/PatienceRenderer.hs
Normal file
117
lib/PatienceRenderer.hs
Normal file
|
|
@ -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)
|
||||
90
lib/Selector.hs
Normal file
90
lib/Selector.hs
Normal file
|
|
@ -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
|
||||
Reference in a new issue