module Interior where

import Affection as A

import Data.Matrix as M
import qualified Data.Map.Strict as Map
import Data.List as L
import Data.Maybe (isNothing, isJust)

import System.Random

-- internal imports

import Types.Interior
import Types.Map
import Types.UserData

placeInteriorIO :: Matrix TileState -> [Graph] -> IO (Matrix (Maybe ImgId))
placeInteriorIO imat graph =
  do
    rnd <- newStdGen
    let (_, mat) =
          foldl
            traverseGraph
            (rnd, M.fromList (nrows imat) (ncols imat) (repeat Nothing))
            graph
    return mat
  where
    traverseGraph
      :: (StdGen, Matrix (Maybe ImgId))
      -> Graph
      -> (StdGen, Matrix (Maybe ImgId))
    traverseGraph acc (GHall sub) =
      foldl traverseGraph acc sub
    traverseGraph put@(rng, mat) (GRoom _ bnds) =
      let applicable =
            reverse (L.sortBy (\a b -> size a `compare` size b) (
              L.filter
                (\a -> clusterRoom a == roomType && size a < size bnds)
                [minBound .. maxBound] :: [Cluster])
              )
          roomType = fst (head $ reverse $ L.sortBy
            (\a b -> snd a `compare` snd b) $ Map.toList $ foldl
              (\acc a -> if a `Map.member` acc
                then Map.insert a (acc Map.! a + 1) acc
                else Map.insert a 1 acc
                )
              Map.empty
              (M.submatrix
                (fst $ matmin bnds) (fst $ matmax bnds)
                (snd $ matmin bnds) (snd $ matmax bnds)
                imat
                )
            )
      in
        foldl (\(orng, omat) -> placeCluster orng bnds 1 omat) put applicable
    placeCluster rng bnds try mat appl =
      let (pr, g1) = randomR (fst (matmin bnds), fst (matmax bnds)) rng
          (pc, g2) = randomR (snd (matmin bnds), snd (matmax bnds)) g1
          freeRoom = foldl
            (\acc a -> if a == Nothing then acc + 1 else acc)
            0
            (M.toList $ M.submatrix
              (fst $ matmin bnds) (fst $ matmax bnds)
              (snd $ matmin bnds) (snd $ matmax bnds)
              mat
              )
          cmat = clusterMat appl
      in
        if try > 100 || fromIntegral freeRoom < size appl
        then (g2, mat)
        else
          if pr - 1 + nrows cmat > fst (matmax bnds) ||
             pc - 1 + ncols cmat > snd (matmax bnds) ||
             any (/= clusterRoom appl)
               (M.toList (M.submatrix
                 (pr - 1) (pr + nrows cmat - 1)
                 (pc - 1) (pc + ncols cmat - 1)
                 imat
                 )) ||
             any isJust
               (M.toList (M.submatrix
                 (pr - 1) (pr + nrows cmat - 1)
                 (pc - 1) (pc + ncols cmat - 1)
                 mat
                 ))
          then placeCluster g2 bnds (try + 1) mat appl
          else A.log A.Debug ("Placing stuff at: " ++ show (pr - 1, pc - 1)) (placeCluster
            g2 bnds (try + 1) (insertMat cmat mat (pr - 1, pc - 1)) appl)

insertMat
  :: Matrix (Maybe a)
  -> Matrix (Maybe a)
  -> (Int, Int)
  -> Matrix (Maybe a)
insertMat i into (roffs, coffs) =
  if roffs + nrows i > nrows into || coffs + ncols i > ncols into
  then error "insertMat: matrix to be inserted does not fit!"
  else foldl
    (\mat (ir, ic) ->
      if isNothing (mat M.! (ir + roffs, ic + coffs))
      then M.setElem (i M.! (ir, ic)) (ir + roffs, ic + coffs) mat
      else mat
      )
    into
    ((,) <$> [1 .. nrows i] <*> [1 .. ncols i])