proper placement now
This commit is contained in:
parent
c3f561bfcd
commit
6518695a9e
2 changed files with 25 additions and 18 deletions
|
@ -15,14 +15,18 @@ import Types.Interior
|
|||
import Types.Map
|
||||
import Types.UserData
|
||||
|
||||
placeInteriorIO :: Matrix TileState -> [Graph] -> IO (Matrix (Maybe ImgId))
|
||||
placeInteriorIO imat graph =
|
||||
placeInteriorIO
|
||||
:: Matrix TileState
|
||||
-> Matrix (Maybe ImgId)
|
||||
-> [Graph]
|
||||
-> IO (Matrix (Maybe ImgId))
|
||||
placeInteriorIO imat imgmat graph =
|
||||
do
|
||||
rnd <- newStdGen
|
||||
let (_, mat) =
|
||||
foldl
|
||||
traverseGraph
|
||||
(rnd, M.fromList (nrows imat) (ncols imat) (repeat Nothing))
|
||||
(rnd, imgmat)
|
||||
graph
|
||||
return mat
|
||||
where
|
||||
|
@ -55,8 +59,8 @@ placeInteriorIO imat graph =
|
|||
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
|
||||
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
|
||||
|
@ -70,23 +74,23 @@ placeInteriorIO imat graph =
|
|||
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) ||
|
||||
if pr + nrows cmat - 1 > fst (matmax bnds) ||
|
||||
pc + ncols cmat - 1 > snd (matmax bnds) ||
|
||||
any (/= clusterRoom appl)
|
||||
(M.toList (M.submatrix
|
||||
(pr - 1) (pr + nrows cmat - 1)
|
||||
(pc - 1) (pc + ncols cmat - 1)
|
||||
pr (pr + nrows cmat - 1)
|
||||
pc (pc + ncols cmat - 1)
|
||||
imat
|
||||
)) ||
|
||||
any isJust
|
||||
(M.toList (M.submatrix
|
||||
(pr - 1) (pr + nrows cmat - 1)
|
||||
(pc - 1) (pc + ncols cmat - 1)
|
||||
pr (pr + nrows cmat - 1)
|
||||
pc (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)
|
||||
else placeCluster
|
||||
g2 bnds (try + 1) (insertMat cmat mat (pr, pc)) appl
|
||||
|
||||
insertMat
|
||||
:: Matrix (Maybe a)
|
||||
|
@ -98,8 +102,8 @@ insertMat i into (roffs, coffs) =
|
|||
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
|
||||
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
|
||||
|
|
|
@ -36,10 +36,13 @@ import Util
|
|||
loadMap :: Affection UserData ()
|
||||
loadMap = do
|
||||
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
|
||||
(matrix, gr) <- liftIO $ buildHallFloorIO fc
|
||||
inter <- liftIO $ placeInteriorIO matrix gr
|
||||
inter <- liftIO $ placeInteriorIO matrix (convertTileToImg matrix) gr
|
||||
(nws, _) <- yieldSystemT (worldState ud) $ do
|
||||
void $ newEntity $ defEntity
|
||||
{ pos = Just (V2 20.5 20.5)
|
||||
|
@ -51,7 +54,7 @@ loadMap = do
|
|||
{ worldState = nws
|
||||
, stateData = MenuData
|
||||
{ mapMat = matrix
|
||||
, imgMat = insertMat inter (convertTileToImg matrix) (0, 0)
|
||||
, imgMat = inter
|
||||
, initCoords = (0, 500)
|
||||
}
|
||||
, uuid = [uu]
|
||||
|
|
Loading…
Reference in a new issue