packages feed

wordify-0.1.1.0: src/Wordify/Rules/Pos.hs

module Wordify.Rules.Pos
  ( Pos,
    Direction (Horizontal, Vertical),
    posAt,
    above,
    below,
    left,
    right,
    abovePositions,
    belowPositions,
    leftPositions,
    rightPositions,
    xPos,
    yPos,
    gridValue,
    direction,
    starPos,
    posMin,
    posMax,
  )
where

import qualified Data.Map as Map
import Data.Maybe
import Wordify.Rules.Pos.Internal

data Direction = Horizontal | Vertical deriving (Eq)

posMin :: Int
posMin = 1

posMax :: Int
posMax = 15

posAt :: (Int, Int) -> Maybe Pos
posAt = flip Map.lookup posMap

-- | The position above the given position, if it exists.
above :: Pos -> Maybe Pos
above (Pos x y _) = posAt (x, y + 1)

-- | The position below the given position, if it exists.
below :: Pos -> Maybe Pos
below (Pos x y _) = posAt (x, y - 1)

-- | The position to the left of the given position, if it exists.
left :: Pos -> Maybe Pos
left (Pos x y _) = posAt (x - 1, y)

-- | The position to the right of the given position, if it exists.
right :: Pos -> Maybe Pos
right (Pos x y _) = posAt (x + 1, y)

-- | The positions above the position (inclusive)
abovePositions :: Pos -> Int -> [Pos]
abovePositions pos = walkTimes pos above

-- | The positions below the position (inclusive)
belowPositions :: Pos -> Int -> [Pos]
belowPositions pos = walkTimes pos below

-- | The positions to the right of the position (inclusive)
rightPositions :: Pos -> Int -> [Pos]
rightPositions pos = walkTimes pos right

-- | The positions to the left of the position (inclusive)
leftPositions :: Pos -> Int -> [Pos]
leftPositions pos = walkTimes pos left

walkTimes :: Pos -> (Pos -> Maybe Pos) -> Int -> [Pos]
walkTimes startPosition travelFunction = flip take (walkDirection startPosition travelFunction)

walkDirection :: Pos -> (Pos -> Maybe Pos) -> [Pos]
walkDirection startPosition travelFunction =
  case travelFunction startPosition of
    Nothing -> [startPosition]
    Just nextPosition -> startPosition : walkDirection nextPosition travelFunction

-- | The position of the star square
starPos :: Pos
starPos = Pos 8 8 "H8"

direction :: Pos -> Pos -> Maybe Direction
direction startPos endPos
  | xPos startPos == xPos endPos = Just Vertical
  | yPos startPos == yPos endPos = Just Horizontal
  | otherwise = Nothing

{- A map keyed by tuples representing (x,y) co-ordinates, and valued by their
corresponding Pos types -}
posMap :: Map.Map (Int, Int) Pos
posMap = Map.fromList $ catMaybes coordTuples
  where
    coordTuples = zipWith makeTuple (sequence [[posMin .. posMax], [posMin .. posMax]]) $ cycle ['A' .. 'O']
    makeTuple (x : y : _) gridLetter = Just $ ((y, x), Pos y x (gridLetter : show x))
    makeTuple _ _ = Nothing

xPos :: Pos -> Int
xPos (Pos x _ _) = x

yPos :: Pos -> Int
yPos (Pos _ y _) = y

gridValue :: Pos -> String
gridValue (Pos _ _ grid) = grid