minesweeper-0.8.8: Core/Square.hs

{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns #-}

-- | Squares.
module Core.Square 
    (
    -- * Types
      Board
    , board
    , xSize
    , ySize

    , Square
    , coords
    , square
    , restrictSquare
    , squares
    , neighbours
    ) where

import Control.Monad
import Data.Binary
import Data.DeriveTH
import Data.Derive.Binary
import Data.Bits
import Data.Maybe

-----------

-- | Board of a board.
newtype Board 
    = S { unS :: Int }
        deriving (Eq, Ord)

instance Show Board where
    show = show . unS

xSize, ySize :: Board -> Int
xSize = fst . unpack . unS
ySize = snd . unpack . unS

board :: Int -> Int -> Board
board i j | i `between` (1, 255) && j `between` (1, 255) = S $ pack i j

--------------------------

-- | Square on a board.
newtype Square 
    = P Int 
        deriving (Eq, Ord)

instance Show Square where
    show = show . coords 

coords :: Square -> (Int, Int)
coords (P i) = unpack i

square :: Board -> Int -> Int -> Maybe Square
square s i j 
    | i `between` (1, xSize s) && j `between` (1, ySize s) = Just $ P $ pack i j
    | otherwise = Nothing

restrictSquare :: Board -> Square -> Square
restrictSquare s (coords -> (i, j)) 
    = P $ pack (max 1 $ min (xSize s) i) (max 1 $ min (ySize s) j) 

-----------------------------------

-- | Squares of a board.
squares :: Board -> [Square]
squares s = [P p | x <- [1..xSize s], p <- take (ySize s) [pack x 1 ..]]

-- | Neighbours of a square on a board.
neighbours :: Board -> Square -> [Square]
neighbours s (coords -> (i, j))
    = catMaybes 
        [square s (i+a) (j+b) | (a, b) <- [(-1,0),(-1,-1),(0,-1),(1,-1),(1,0),(1,1),(0,1),(-1,1)]]

----------------------- auxiliary functions

infix 4 `between`
a `between` (b, c) = b <= a && a <= c

unpack :: Int -> (Int, Int)
unpack i = (shiftR i 8, i .&. 255)

pack :: Int -> Int -> Int
pack i j = shiftL i 8 .|. j


---------------------------------

$( derive makeBinary ''Square )
$( derive makeBinary ''Board )