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.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
|
||||||
|
|
|
@ -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]
|
||||||
|
|
Loading…
Reference in a new issue