module Interior where import Data.Matrix as M import qualified Data.Map.Strict as Map import Data.List as L import Data.Maybe (isNothing, isJust) import Linear.V2 import System.Random -- internal imports import Navigation import Util import Types placeInteriorIO :: Matrix TileState -> Matrix (Maybe ImgId) -> [ReachPoint] -> [Graph] -> IO (Matrix (Maybe ImgId), [ReachPoint]) placeInteriorIO imat imgmat irp graph = do rnd <- newStdGen let (_, matps) = foldl (traverseGraph imat) (rnd, (imgmat, irp)) graph return matps traverseGraph :: Matrix TileState -> (StdGen, (Matrix (Maybe ImgId), [ReachPoint])) -> Graph -> (StdGen, (Matrix (Maybe ImgId), [ReachPoint])) traverseGraph imat acc (GHall sub) = foldl (traverseGraph imat) acc sub traverseGraph imat (rng, putt) (GRoom _ bnds clear _) = let applicable = L.sortBy (\b a -> size (a, (ph, pw), rng) `compare` size (b, (ph, pw), rng)) ( L.filter (\a -> roomType `elem` clusterRoom a && size (a, (ph, pw), rng) <= size bnds) [minBound .. maxBound] :: [Cluster]) roomType = fst (L.minimumBy (\b a -> (snd a :: Int) `compare` (snd b :: Int)) $ 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 ) ) (ph, g1) = randomR (1, fst (matmax bnds) - fst (matmin bnds) + 1) rng (pw, g2) = randomR (1, snd (matmax bnds) - snd (matmin bnds) + 1) g1 in foldl (\(orng, (omat, orp)) -> placeCluster imat orng bnds (ph, pw) 1 clear omat orp ) (g2, putt) applicable placeCluster :: Matrix TileState -> StdGen -> Boundaries Int -> (Int, Int) -> Int -> Word -> Matrix (Maybe ImgId) -> [ReachPoint] -> Cluster -> (StdGen, (Matrix (Maybe ImgId), [ReachPoint])) placeCluster imat rng bnds dim try clearance mat rp 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 (g2_1, g2_2) = split g2 freeRoom = foldl (\acc a -> if isNothing a then acc + 1 else acc) 0 (M.toList $ M.submatrix (fst $ matmin bnds) (fst $ matmax bnds) (snd $ matmin bnds) (snd $ matmax bnds) mat ) :: Int (cmat, nrp) = clusterMatWithRPs appl dim g2_2 newmat = insertMat cmat mat (pr, pc) exits = filter (\p -> pointType p == RoomExit && inBounds (pointCoord p) bnds) rp oldreaches = foldl (\acc p -> if pointType p /= RoomExit && inBounds (pointCoord p) bnds then pointCoord p : acc else acc ) [] rp reaches = (map (+ V2 (pr - 1) (pc - 1)) (map pointCoord nrp)) newrp = rp ++ map (\(a, b, c) -> ReachPoint a b c clearance) (zip3 (map pointType nrp) reaches (map pointDir nrp) ) in if try >= 10 || fromIntegral freeRoom <= size (appl, dim, g2) then (g2, (mat, rp)) else if pr + nrows cmat - 1 > fst (matmax bnds) || pc + ncols cmat - 1 > snd (matmax bnds) then placeCluster imat g2 bnds dim (try + 1) clearance mat rp appl else if any (`notElem` 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 imat g2_1 bnds dim (try + 1) clearance mat rp appl else if any (`elem` (oldreaches)) (V2 <$> [pr .. pr + nrows cmat - 1] <*> [pc .. pc + ncols cmat - 1]) then placeCluster imat g2 bnds dim (try + 1) clearance mat rp appl else if isReachable newmat [(V2 10 10, Boundaries (0, 1) (0, 1))] (oldreaches ++ reaches) exits then placeCluster imat g2_1 bnds dim (try + 1) clearance newmat newrp appl else placeCluster imat g2_1 bnds dim (try + 1) clearance mat rp 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])