nek0/tracer
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

eliminating toilet bug

Browse source
This commit is contained in:
nek0 2018-10-14 23:18:41 +02:00
parent 5ec3be4429
commit c4c7541b71
3 changed files with 19 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

23
src/Interior.hs
View file

@ -1,5 +1,7 @@
module Interior where module Interior where
import qualified Affection as A
import Data.Matrix as M import Data.Matrix as M
import qualified Data.Map.Strict as Map import qualified Data.Map.Strict as Map
import Data.List as L import Data.List as L
@ -100,11 +102,14 @@ placeInteriorIO imat imgmat irp graph =
newrp = rp ++ map (\(a, b, c) -> ReachPoint a b c) newrp = rp ++ map (\(a, b, c) -> ReachPoint a b c)
(zip3 reachtypes reaches reachdirs) (zip3 reachtypes reaches reachdirs)
in in
if try > 10 || fromIntegral freeRoom < size appl if try >= 10 || fromIntegral freeRoom <= size appl
then (g2, (mat, rp)) then (g2, (mat, rp))
else else
if (pr + nrows cmat - 1 > fst (matmax bnds) || if pr + nrows cmat - 1 > fst (matmax bnds) ||
pc + ncols cmat - 1 > snd (matmax bnds) || pc + ncols cmat - 1 > snd (matmax bnds)
then A.log A.Debug ("no cluster placed") $
placeCluster g2 bnds (try + 1) mat rp appl
else if
any (`notElem` clusterRoom appl) any (`notElem` clusterRoom appl)
(M.toList (M.submatrix (M.toList (M.submatrix
pr (pr + nrows cmat - 1) pr (pr + nrows cmat - 1)
@ -116,11 +121,15 @@ placeInteriorIO imat imgmat irp graph =
pr (pr + nrows cmat - 1) pr (pr + nrows cmat - 1)
pc (pc + ncols cmat - 1) pc (pc + ncols cmat - 1)
mat mat
))) || ))
then A.log A.Debug ("no cluster placed") $
placeCluster g2 bnds (try + 1) mat rp appl
else if
not (isReachable newmat [] (oldreaches ++ reaches) exits) not (isReachable newmat [] (oldreaches ++ reaches) exits)
then placeCluster g2 bnds (try + 1) mat rp appl then A.log A.Debug ("no cluster placed") $
else placeCluster placeCluster g2 bnds (try + 1) mat rp appl
g2 bnds (try + 1) newmat newrp appl else A.log A.Debug ("placed cluster" ++ show appl) $
placeCluster g2 bnds (try + 1) newmat newrp appl
insertMat insertMat
:: Matrix (Maybe a) :: Matrix (Maybe a)

2
src/Types/Interior.hs
View file

@ -27,7 +27,7 @@ data Cluster
| ClusterPlant2 | ClusterPlant2
| ClusterToilet | ClusterToilet
| ClusterWatercooler | ClusterWatercooler
deriving (Enum, Bounded) deriving (Enum, Bounded, Show)
clusterMat :: Cluster -> Matrix (Maybe ImgId) clusterMat :: Cluster -> Matrix (Maybe ImgId)
clusterMat ClusterBox1 = clusterMat ClusterBox1 =