module Board(module Board,module Array) where

import Array
import List(nub)
import Maybe(listToMaybe)
import Monad(guard)
import Random
import Utils

data Dir = N | E | S | W deriving (Read,Show,Enum,Eq)

dir N = (0,1)
dir E = (1,0)
dir S = (0,-1)
dir W = (-1,0)


instance Random Dir where
  random g = let (p,g') = randomR (0,3) g
             in (toEnum p,g')
  randomR (r1,r2) g = let (p,g') = randomR (fromEnum r1, fromEnum r2) g
                      in (toEnum p,g')                        



type Pos  = (Int,Int)
data Tile = Normal | Lethal | Impassable | Base   deriving (Eq)
type T    = Array Pos Tile



homeBases b = map fst . filter ((Base ==) . snd) . assocs $ b


b `tileAt` p = b ! p

instance Show Tile where
  show Normal      = "."
  show Lethal      = "~"
  show Impassable  = "#"
  show Base        = "@"

instance Read Tile where
  readsPrec _ ('.':s) = [(Normal,s)]
  readsPrec _ ('~':s) = [(Lethal,s)]
  readsPrec _ ('#':s) = [(Impassable,s)]
  readsPrec _ ('@':s) = [(Base,s)]
  readsPrec _ _       = []


-- map is upside down, i.e. (1,1) is top left corner
toString :: T -> String
toString b = show x ++ " " ++ show y ++ "\n" ++ board
  where
  (x,y)   = snd $ bounds b
  board   = init $ unlines (map showR [1..y])
  showR r = concatMap show  [ b!(c,r) | c <- [1..x]]


fromStrings :: [String] -> Maybe T
fromStrings [] = Nothing
fromStrings ls = do
  let board_lines = reverse ls
      y = length ls

  x <- case nub (map length ls) of
        [z] -> return z
        _   -> Nothing

  rs <- mapM (parseRow x) board_lines
  return $ array ((1,1),(x,y)) [ ((c,r),t) |   
                      (r,row) <- [1..] `zip` rs, (c,t) <- [1..] `zip` row]
  where  
  parseRow 0 s = return []
  parseRow n s = do
    (t,s1) <- listToMaybe (reads s)
    ts     <- parseRow (n-1) s1
    return (t:ts)
 
fromString :: String -> Maybe T
fromString = fromStrings . lines
  
save :: String -> T -> IO ()
save name b = writeFile name (toString b)

load :: String -> IO (Maybe T)
load name = fromString # readFile name
  

blank n = array ((1,1),(n,n)) [((x,y),Normal) | x <- [1..n], y <- [1..n]]