proper placement now

This commit is contained in:
nek0 2018-03-03 17:42:24 +01:00
parent c3f561bfcd
commit 6518695a9e
2 changed files with 25 additions and 18 deletions

View file

@ -15,14 +15,18 @@ import Types.Interior
import Types.Map import Types.Map
import Types.UserData import Types.UserData
placeInteriorIO :: Matrix TileState -> [Graph] -> IO (Matrix (Maybe ImgId)) placeInteriorIO
placeInteriorIO imat graph = :: Matrix TileState
-> Matrix (Maybe ImgId)
-> [Graph]
-> IO (Matrix (Maybe ImgId))
placeInteriorIO imat imgmat graph =
do do
rnd <- newStdGen rnd <- newStdGen
let (_, mat) = let (_, mat) =
foldl foldl
traverseGraph traverseGraph
(rnd, M.fromList (nrows imat) (ncols imat) (repeat Nothing)) (rnd, imgmat)
graph graph
return mat return mat
where where
@ -55,8 +59,8 @@ placeInteriorIO imat graph =
in in
foldl (\(orng, omat) -> placeCluster orng bnds 1 omat) put applicable foldl (\(orng, omat) -> placeCluster orng bnds 1 omat) put applicable
placeCluster rng bnds try mat appl = placeCluster rng bnds try mat appl =
let (pr, g1) = randomR (fst (matmin bnds), fst (matmax bnds)) rng let (pr, g1) = randomR (fst (matmin bnds) - 1, fst (matmax bnds) - 1) rng
(pc, g2) = randomR (snd (matmin bnds), snd (matmax bnds)) g1 (pc, g2) = randomR (snd (matmin bnds) - 1, snd (matmax bnds) - 1) g1
freeRoom = foldl freeRoom = foldl
(\acc a -> if a == Nothing then acc + 1 else acc) (\acc a -> if a == Nothing then acc + 1 else acc)
0 0
@ -70,23 +74,23 @@ placeInteriorIO imat graph =
if try > 100 || fromIntegral freeRoom < size appl if try > 100 || fromIntegral freeRoom < size appl
then (g2, mat) then (g2, mat)
else else
if pr - 1 + nrows cmat > fst (matmax bnds) || if pr + nrows cmat - 1 > fst (matmax bnds) ||
pc - 1 + ncols cmat > snd (matmax bnds) || pc + ncols cmat - 1 > snd (matmax bnds) ||
any (/= clusterRoom appl) any (/= clusterRoom appl)
(M.toList (M.submatrix (M.toList (M.submatrix
(pr - 1) (pr + nrows cmat - 1) pr (pr + nrows cmat - 1)
(pc - 1) (pc + ncols cmat - 1) pc (pc + ncols cmat - 1)
imat imat
)) || )) ||
any isJust any isJust
(M.toList (M.submatrix (M.toList (M.submatrix
(pr - 1) (pr + nrows cmat - 1) pr (pr + nrows cmat - 1)
(pc - 1) (pc + ncols cmat - 1) pc (pc + ncols cmat - 1)
mat mat
)) ))
then placeCluster g2 bnds (try + 1) mat appl then placeCluster g2 bnds (try + 1) mat appl
else A.log A.Debug ("Placing stuff at: " ++ show (pr - 1, pc - 1)) (placeCluster else placeCluster
g2 bnds (try + 1) (insertMat cmat mat (pr - 1, pc - 1)) appl) g2 bnds (try + 1) (insertMat cmat mat (pr, pc)) appl
insertMat insertMat
:: Matrix (Maybe a) :: Matrix (Maybe a)
@ -98,8 +102,8 @@ insertMat i into (roffs, coffs) =
then error "insertMat: matrix to be inserted does not fit!" then error "insertMat: matrix to be inserted does not fit!"
else foldl else foldl
(\mat (ir, ic) -> (\mat (ir, ic) ->
if isNothing (mat M.! (ir + roffs, ic + coffs)) if isNothing (mat M.! (ir + roffs - 1, ic + coffs - 1))
then M.setElem (i M.! (ir, ic)) (ir + roffs, ic + coffs) mat then M.setElem (i M.! (ir, ic)) (ir + roffs - 1, ic + coffs - 1) mat
else mat else mat
) )
into into

View file

@ -36,10 +36,13 @@ import Util
loadMap :: Affection UserData () loadMap :: Affection UserData ()
loadMap = do loadMap = do
ud <- getAffection ud <- getAffection
let fc = FloorConfig (20, 20) [(5,5), (35, 35)] (50,75) let fc = FloorConfig
(20, 20)
[] -- [(5,5), (35, 35)]
(50,75)
(Subsystems _ m) = subsystems ud (Subsystems _ m) = subsystems ud
(matrix, gr) <- liftIO $ buildHallFloorIO fc (matrix, gr) <- liftIO $ buildHallFloorIO fc
inter <- liftIO $ placeInteriorIO matrix gr inter <- liftIO $ placeInteriorIO matrix (convertTileToImg matrix) gr
(nws, _) <- yieldSystemT (worldState ud) $ do (nws, _) <- yieldSystemT (worldState ud) $ do
void $ newEntity $ defEntity void $ newEntity $ defEntity
{ pos = Just (V2 20.5 20.5) { pos = Just (V2 20.5 20.5)
@ -51,7 +54,7 @@ loadMap = do
{ worldState = nws { worldState = nws
, stateData = MenuData , stateData = MenuData
{ mapMat = matrix { mapMat = matrix
, imgMat = insertMat inter (convertTileToImg matrix) (0, 0) , imgMat = inter
, initCoords = (0, 500) , initCoords = (0, 500)
} }
, uuid = [uu] , uuid = [uu]