#1 Toggle selection

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