{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving #-}

module GameBoard where

import Data.Ix
import Data.Array.IArray
import Data.Monoid

import Types
import Test.QuickCheck

data Piece = Troll | Dwarf
    deriving (Show, Read, Eq)
data Square = Occupied Piece | ThudStone | Empty | Offside
    deriving (Show, Read, Eq)

data Landscape a = L (Array Coord a) deriving (Eq, Show)
instance Functor Landscape where
    fmap f (L a) = L (fmap f a)

data Action = Move Piece Location Location
            | Toss Piece Location Location Location
            deriving (Show, Eq)
extract p (L a) = filter p $ assocs a
update diffs (L a) = L $ a // diffs
get (L a) i = a!i

landscape2board l = Board ts ds
    where ts = map (Loc . fst) $ extract ((==Occupied Troll) . snd) l
          ds = map (Loc . fst) $ extract ((==Occupied Dwarf) . snd) l
board2landscape b = update (newdwarves ++ newtrolls) emptyLandscape
    where newtrolls = map (\(Loc c) -> (c,Occupied Troll)) $ trolls b
          newdwarves = map (\(Loc c) -> (c,Occupied Dwarf)) $ dwarves b

ppSquare (Occupied Dwarf) = 'D'
ppSquare (Occupied Troll) = 'T'
ppSquare (ThudStone     ) = '@'
ppSquare (Empty         ) = ' '
ppSquare (Offside       ) = '#'

ppLandscape brd = unlines $ map (\y -> map (\x -> b`get`(x,y)) [1..15]) [1..15]
    where b = fmap ppSquare brd

printLandscape = putStr . ppLandscape


parseSquare 'D' = Occupied Dwarf
parseSquare 'T' = Occupied Troll
parseSquare '@' = ThudStone
parseSquare '#' = Offside
parseSquare  _  = Empty -- default is blank

mkLandscape sqss = L $ array ((1,1),(15,15)) $ zip locations pieces
    where pieces = map parseSquare (concat sqss)
          locations = [(x,y)| y <- [1..15], x <- [1..15]]

emptyLandscape = mkLandscape $
                ["#####     #####"
                ,"####       ####"
                ,"###         ###"
                ,"##           ##"
                ,"#             #"
                ,"               "
                ,"               "
                ,"       @       "
                ,"               "
                ,"               "
                ,"#             #"
                ,"##           ##"
                ,"###         ###"
                ,"####       ####"
                ,"#####     #####"]
newLandscape = mkLandscape $
                ["#####DD DD#####"
                ,"####D     D####"
                ,"###D       D###"
                ,"##D         D##"
                ,"#D           D#"
                ,"D             D"
                ,"D     TTT     D"
                ,"      T@T      "
                ,"D     TTT     D"
                ,"D             D"
                ,"#D           D#"
                ,"##D         D##"
                ,"###D       D###"
                ,"####D     D####"
                ,"#####DD DD#####"]
dwarfLandscape = mkLandscape $
                ["#####DD DD#####"
                ,"####D     D####"
                ,"###D       D###"
                ,"##D         D##"
                ,"#             #"
                ,"               "
                ,"      TTT      "
                ,"      T@T      "
                ,"      TTT      "
                ,"D             D"
                ,"#D           D#"
                ,"##D         D##"
                ,"###D D  DD D###"
                ,"####DDDDDDD####"
                ,"#####DD DD#####"]

nearby (Loc (x,y)) = [Loc (x', y')
                   | y' <- [y-1..y+1]
                   , x' <- [x-1..x+1]
                   , (x',y')/=(x,y)
                   , inRange (1,15) x' && inRange (1,15) y']

occupied c b = c `elem` (thudstone : trolls b ++ dwarves b)
vacant c = not . occupied c
onside (Loc (x,y)) | y `elem` [6..10]  = x `elem` [1..15]
                   | y `elem` [1..5]   = x `elem` [7-y..y+9]
                   | y `elem` [11..15] = x `elem` [(succ y)-10..25-y]
                   | otherwise         = False
offside = not . onside
thudstone :: Location
thudstone = Loc (8,8)

fullboard :: [Location]
fullboard = concatMap (\y -> map (\x -> Loc (x,y)) [1..15]) [1..15]