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 -> Matrix (Maybe ImgId) -> [Graph] -> IO (Matrix (Maybe ImgId)) placeInteriorIO imat imgmat graph = do rnd <- newStdGen let (_, mat) = foldl traverseGraph (rnd, imgmat) 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) - 1, fst (matmax bnds) - 1) rng (pc, g2) = randomR (snd (matmin bnds) - 1, snd (matmax bnds) - 1) 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 > 10 || fromIntegral freeRoom < size appl then (g2, mat) else if pr + nrows cmat - 1 > fst (matmax bnds) || pc + ncols cmat - 1 > snd (matmax bnds) || any (/= clusterRoom appl) (M.toList (M.submatrix pr (pr + nrows cmat - 1) pc (pc + ncols cmat - 1) imat )) || any isJust (M.toList (M.submatrix pr (pr + nrows cmat - 1) pc (pc + ncols cmat - 1) mat )) then placeCluster g2 bnds (try + 1) mat appl else placeCluster g2 bnds (try + 1) (insertMat cmat mat (pr, pc)) 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 - 1, ic + coffs - 1)) then M.setElem (i M.! (ir, ic)) (ir + roffs - 1, ic + coffs - 1) mat else mat ) into ((,) <$> [1 .. nrows i] <*> [1 .. ncols i])