101 lines
2.9 KiB
Haskell
101 lines
2.9 KiB
Haskell
module Selector
|
|
( Selector (..)
|
|
, Coordinate
|
|
, Direction (..)
|
|
|
|
, initSelector
|
|
, move
|
|
, moveBy
|
|
, select
|
|
, deselect
|
|
, toggleSelection
|
|
, getSelected
|
|
|
|
, 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, Eq)
|
|
|
|
----------------------------------------------------------------------
|
|
|
|
-- 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 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.
|
|
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
|