clean messy tables and create dynamic clusters

This commit is contained in:
nek0 2018-11-13 04:16:02 +01:00
parent 9e077cec16
commit 40c966048b
14 changed files with 128 additions and 171 deletions

View file

Before

Width:  |  Height:  |  Size: 516 B

After

Width:  |  Height:  |  Size: 516 B

View file

Before

Width:  |  Height:  |  Size: 537 B

After

Width:  |  Height:  |  Size: 537 B

View file

Before

Width:  |  Height:  |  Size: 510 B

After

Width:  |  Height:  |  Size: 510 B

View file

Before

Width:  |  Height:  |  Size: 515 B

After

Width:  |  Height:  |  Size: 515 B

View file

@ -41,11 +41,11 @@ traverseGraph
-> (StdGen, (Matrix (Maybe ImgId), [ReachPoint])) -> (StdGen, (Matrix (Maybe ImgId), [ReachPoint]))
traverseGraph imat acc (GHall sub) = traverseGraph imat acc (GHall sub) =
foldl (traverseGraph imat) acc sub foldl (traverseGraph imat) acc sub
traverseGraph imat putt (GRoom _ bnds) = traverseGraph imat (rng, putt) (GRoom _ bnds) =
let applicable = let applicable =
L.sortBy (\b a -> size a `compare` size b) ( L.sortBy (\b a -> size (a, (ph, pw)) `compare` size (b, (ph, pw))) (
L.filter L.filter
(\a -> roomType `elem` clusterRoom a && size a <= size bnds) (\a -> roomType `elem` clusterRoom a && size (a, (ph, pw)) <= size bnds)
[minBound .. maxBound] :: [Cluster]) [minBound .. maxBound] :: [Cluster])
roomType = fst (L.minimumBy roomType = fst (L.minimumBy
(\b a -> (snd a :: Int) `compare` (snd b :: Int)) $ Map.toList $ foldl (\b a -> (snd a :: Int) `compare` (snd b :: Int)) $ Map.toList $ foldl
@ -60,22 +60,25 @@ traverseGraph imat putt (GRoom _ bnds) =
imat 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 in
foldl foldl
(\(orng, (omat, orp)) -> placeCluster imat orng bnds 1 omat orp) (\(orng, (omat, orp)) -> placeCluster imat orng bnds (ph, pw) 1 omat orp)
putt (g2, putt)
applicable applicable
placeCluster placeCluster
:: Matrix TileState :: Matrix TileState
-> StdGen -> StdGen
-> Boundaries Int -> Boundaries Int
-> (Int, Int)
-> Int -> Int
-> Matrix (Maybe ImgId) -> Matrix (Maybe ImgId)
-> [ReachPoint] -> [ReachPoint]
-> Cluster -> Cluster
-> (StdGen, (Matrix (Maybe ImgId), [ReachPoint])) -> (StdGen, (Matrix (Maybe ImgId), [ReachPoint]))
placeCluster imat rng bnds try mat rp appl = placeCluster imat rng bnds dim try mat rp appl =
let (pr, g1) = randomR (fst (matmin bnds) - 1, fst (matmax bnds) - 1) rng 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 (pc, g2) = randomR (snd (matmin bnds) - 1, snd (matmax bnds) - 1) g1
freeRoom = foldl freeRoom = foldl
@ -86,15 +89,15 @@ placeCluster imat rng bnds try mat rp appl =
(snd $ matmin bnds) (snd $ matmax bnds) (snd $ matmin bnds) (snd $ matmax bnds)
mat mat
) :: Int ) :: Int
cmat = clusterMat appl cmat = clusterMat appl dim
newmat = insertMat cmat mat (pr, pc) newmat = insertMat cmat mat (pr, pc)
exits = filter exits = filter
(\p -> pointType p == RoomExit && inBounds (pointCoord p) bnds) (\p -> pointType p == RoomExit && inBounds (pointCoord p) bnds)
rp rp
reaches = map (+ V2 (pr - 1) (pc - 1)) reaches = map (+ V2 (pr - 1) (pc - 1))
(map pointCoord (clusterPoints appl)) (map pointCoord (clusterPoints appl dim))
reachdirs = map pointDir (clusterPoints appl) reachdirs = map pointDir (clusterPoints appl dim)
reachtypes = map pointType (clusterPoints appl) reachtypes = map pointType (clusterPoints appl dim)
oldreaches = foldl (\acc p -> oldreaches = foldl (\acc p ->
if pointType p /= RoomExit && inBounds (pointCoord p) bnds if pointType p /= RoomExit && inBounds (pointCoord p) bnds
then pointCoord p : acc then pointCoord p : acc
@ -105,13 +108,13 @@ placeCluster imat rng bnds try mat rp appl =
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, dim)
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") $ then A.log A.Debug ("no cluster placed") $
placeCluster imat g2 bnds (try + 1) mat rp appl placeCluster imat g2 bnds dim (try + 1) mat rp appl
else if else if
any (`notElem` clusterRoom appl) any (`notElem` clusterRoom appl)
(M.toList (M.submatrix (M.toList (M.submatrix
@ -126,20 +129,20 @@ placeCluster imat rng bnds try mat rp appl =
mat mat
)) ))
then A.log A.Debug ("no cluster placed") $ then A.log A.Debug ("no cluster placed") $
placeCluster imat g2 bnds (try + 1) mat rp appl placeCluster imat g2 bnds dim (try + 1) mat rp appl
else if else if
any (`elem` (oldreaches)) any (`elem` (oldreaches))
(V2 (V2
<$> [pr .. pr + nrows cmat - 1] <$> [pr .. pr + nrows cmat - 1]
<*> [pc .. pc + ncols cmat - 1]) <*> [pc .. pc + ncols cmat - 1])
then A.log A.Debug ("no cluster placed") $ then A.log A.Debug ("no cluster placed") $
placeCluster imat g2 bnds (try + 1) mat rp appl placeCluster imat g2 bnds dim (try + 1) mat rp appl
else if else if
isReachable newmat [(V2 10 10, Boundaries (0, 1) (0, 1))] (oldreaches ++ reaches) exits isReachable newmat [(V2 10 10, Boundaries (0, 1) (0, 1))] (oldreaches ++ reaches) exits
then A.log A.Debug ("placed cluster" ++ show appl) $ then A.log A.Debug ("placed cluster" ++ show appl) $
placeCluster imat g2 bnds (try + 1) newmat newrp appl placeCluster imat g2 bnds dim (try + 1) newmat newrp appl
else A.log A.Debug ("no cluster placed") $ else A.log A.Debug ("no cluster placed") $
placeCluster imat g2 bnds (try + 1) mat rp appl placeCluster imat g2 bnds dim (try + 1) mat rp appl
insertMat insertMat
:: Matrix (Maybe a) :: Matrix (Maybe a)

View file

@ -143,24 +143,24 @@ loadFork ws win glc nvg future progress = do
mmiscbox1 <- createImage nvg (FileName "assets/misc/box1.png") 0 mmiscbox1 <- createImage nvg (FileName "assets/misc/box1.png") 0
modifyMVar_ progress (return . (\(p, _) -> modifyMVar_ progress (return . (\(p, _) ->
( p + increment ( p + increment
, "Loading asset \"table1\"" , "Loading asset \"tableSW\""
))) )))
mtable1 <- createImage nvg (FileName "assets/table/table1.png") 0 mtableSW <- createImage nvg (FileName "assets/table/tableSW.png") 0
modifyMVar_ progress (return . (\(p, _) -> modifyMVar_ progress (return . (\(p, _) ->
( p + increment ( p + increment
, "Loading asset \"table2\"" , "Loading asset \"tableSE\""
))) )))
mtable2 <- createImage nvg (FileName "assets/table/table2.png") 0 mtableSE <- createImage nvg (FileName "assets/table/tableSE.png") 0
modifyMVar_ progress (return . (\(p, _) -> modifyMVar_ progress (return . (\(p, _) ->
( p + increment ( p + increment
, "Loading asset \"table3\"" , "Loading asset \"tableNE\""
))) )))
mtable3 <- createImage nvg (FileName "assets/table/table3.png") 0 mtableNE <- createImage nvg (FileName "assets/table/tableNE.png") 0
modifyMVar_ progress (return . (\(p, _) -> modifyMVar_ progress (return . (\(p, _) ->
( p + increment ( p + increment
, "Loading asset \"table4\"" , "Loading asset \"tableNW\""
))) )))
mtable4 <- createImage nvg (FileName "assets/table/table4.png") 0 mtableNW <- createImage nvg (FileName "assets/table/tableNW.png") 0
modifyMVar_ progress (return . (\(p, _) -> modifyMVar_ progress (return . (\(p, _) ->
( p + increment ( p + increment
, "Loading asset \"tableC1\"" , "Loading asset \"tableC1\""
@ -217,7 +217,7 @@ loadFork ws win glc nvg future progress = do
, mwallcornern, mwallcornere, mwallcorners, mwallcornerw , mwallcornern, mwallcornere, mwallcorners, mwallcornerw
, mwalltne, mwalltse, mwalltsw, mwalltnw, mwallcross , mwalltne, mwalltse, mwalltsw, mwalltnw, mwallcross
, mmiscbox1 , mmiscbox1
, mtable1, mtable2, mtable3, mtable4, mtableC , mtableSW, mtableNW, mtableNE, mtableSE, mtableC
, mtablec1, mtablec2, mtablec3, mtablec4 , mtablec1, mtablec2, mtablec3, mtablec4
, mmiscFlipchart , mmiscFlipchart
, mmiscPlant1, mmiscPlant2 , mmiscPlant1, mmiscPlant2

View file

@ -106,7 +106,7 @@ loadMapFork ud ad future progress = do
fc = FloorConfig fc = FloorConfig
(V2 10 10) (V2 10 10)
[(V2 5 5), (V2 5 20)] [(V2 5 5), (V2 5 20)]
(40, 40) (50, 50)
modifyMVar_ progress (return . (\(p, _) -> modifyMVar_ progress (return . (\(p, _) ->
( p + increment ( p + increment
, "Building floor" , "Building floor"

View file

@ -56,16 +56,16 @@ instance Collidible ImgId where
[ Boundaries (0.34, 0) (0.66, 1) [ Boundaries (0.34, 0) (0.66, 1)
, Boundaries (0, 0.34) (1, 0.66) , Boundaries (0, 0.34) (1, 0.66)
] ]
collisionObstacle ImgTable1 = collisionObstacle ImgTableSW =
[ Boundaries (0, 0.34) (1, 1) [ Boundaries (0, 0.34) (1, 1)
] ]
collisionObstacle ImgTable2 = collisionObstacle ImgTableNW =
[ Boundaries (0, 0) (0.63, 1) [ Boundaries (0, 0) (0.63, 1)
] ]
collisionObstacle ImgTable3 = collisionObstacle ImgTableNE =
[ Boundaries (0, 0) (1, 0.63) [ Boundaries (0, 0) (1, 0.63)
] ]
collisionObstacle ImgTable4 = collisionObstacle ImgTableSE =
[ Boundaries (0.34, 0) (1, 1) [ Boundaries (0.34, 0) (1, 1)
] ]
collisionObstacle ImgTableCorner = collisionObstacle ImgTableCorner =

View file

@ -21,10 +21,10 @@ data ImgId
| ImgWallTNW | ImgWallTNW
| ImgWallCross | ImgWallCross
| ImgMiscBox1 | ImgMiscBox1
| ImgTable1 | ImgTableSW
| ImgTable2 | ImgTableNW
| ImgTable3 | ImgTableNE
| ImgTable4 | ImgTableSE
| ImgTableCorner | ImgTableCorner
| ImgTableC1 | ImgTableC1
| ImgTableC2 | ImgTableC2

View file

@ -1,3 +1,4 @@
{-# LANGUAGE FlexibleInstances #-}
module Types.Interior where module Types.Interior where
import Data.Matrix as M import Data.Matrix as M
@ -13,127 +14,98 @@ import Types.Direction
data Cluster data Cluster
= ClusterBox1 = ClusterBox1
| ClusterTable1 | ClusterTableSW
| ClusterTable2 | ClusterTableNW
| ClusterTable3 | ClusterTableNE
| ClusterTable4 | ClusterTableSE
| ClusterCornerTable | ClusterCornerTable
| ClusterTableGroup | ClusterTableGroup
| ClusterCopier | ClusterCopier
| ClusterFlipchart | ClusterFlipchart
| ClusterConferenceTable1 | ClusterConferenceTable
| ClusterConferenceTable2
| ClusterPlant1 | ClusterPlant1
| ClusterPlant2 | ClusterPlant2
| ClusterToilet | ClusterToilet
| ClusterWatercooler | ClusterWatercooler
deriving (Enum, Bounded, Show) deriving (Enum, Bounded, Show)
clusterMat :: Cluster -> Matrix (Maybe ImgId) -- row -> NS; col -> WE
clusterMat ClusterBox1 = clusterMat :: Cluster -> (Int, Int) -> Matrix (Maybe ImgId)
clusterMat ClusterBox1 _ =
M.fromLists M.fromLists
-- [ [ Nothing]
[ [Just ImgMiscBox1] [ [Just ImgMiscBox1]
-- , [Nothing, Nothing, Nothing]
] ]
clusterMat ClusterTable1 = clusterMat ClusterTableSW (h, _) =
M.fromLists M.fromLists $ replicate h
[[Just ImgEmpty, Just ImgTable1]] [Just ImgEmpty, Just ImgTableSW]
clusterMat ClusterTable2 = clusterMat ClusterTableSE (_, w) =
M.fromLists M.fromLists $
[ [Just ImgTable2] [ replicate w (Just ImgTableSE)
, [Just ImgEmpty] , replicate w (Just ImgEmpty)
] ]
clusterMat ClusterTable3 = clusterMat ClusterTableNE (h, _) =
M.fromLists M.fromLists $ replicate h
[[Just ImgTable3, Just ImgEmpty]] [Just ImgTableNE, Just ImgEmpty]
clusterMat ClusterTable4 = clusterMat ClusterTableNW (_, w) =
M.fromLists M.fromLists $
[ [Just ImgEmpty] [ replicate w (Just ImgEmpty)
, [Just ImgTable4] , replicate w (Just ImgTableNW)
] ]
clusterMat ClusterCornerTable = clusterMat ClusterCornerTable _ =
M.fromLists M.fromLists
[ [Just ImgTable2, Just ImgTableCorner] [ [Just ImgTableSE, Just ImgTableCorner]
, [Just ImgEmpty, Just ImgTable1] , [Just ImgEmpty, Just ImgTableSW]
] ]
clusterMat ClusterTableGroup = clusterMat ClusterTableGroup _ =
M.fromLists M.fromLists
[ [ Just ImgEmpty, Just ImgTable2, Just ImgTableCorner [ [ Just ImgEmpty, Just ImgTableSE, Just ImgTableCorner
, Just ImgEmpty, Just ImgTable2, Just ImgTableCorner , Just ImgEmpty, Just ImgTableSE, Just ImgTableCorner
] ]
, [ Just ImgEmpty, Just ImgEmpty, Just ImgTable1 , [ Just ImgEmpty, Just ImgEmpty, Just ImgTableSW
, Just ImgEmpty, Just ImgEmpty, Just ImgTable1 , Just ImgEmpty, Just ImgEmpty, Just ImgTableSW
] ]
, [ Just ImgEmpty, Just ImgEmpty, Just ImgEmpty , [ Just ImgEmpty, Just ImgEmpty, Just ImgEmpty
, Just ImgEmpty, Just ImgEmpty, Just ImgEmpty , Just ImgEmpty, Just ImgEmpty, Just ImgEmpty
] ]
, [ Nothing, Nothing, Nothing , [ Nothing, Nothing, Nothing
, Just ImgEmpty, Just ImgTable2, Just ImgTableCorner , Just ImgEmpty, Just ImgTableSE, Just ImgTableCorner
] ]
, [ Nothing, Nothing, Nothing , [ Nothing, Nothing, Nothing
, Just ImgEmpty, Just ImgEmpty, Just ImgTable1 , Just ImgEmpty, Just ImgEmpty, Just ImgTableSW
] ]
] ]
clusterMat ClusterCopier = clusterMat ClusterCopier _ =
M.fromLists M.fromLists
[ [ Just ImgEmptyNoWalk] [ [ Just ImgEmptyNoWalk]
, [ Just ImgEmpty] , [ Just ImgEmpty]
] ]
clusterMat ClusterFlipchart = clusterMat ClusterFlipchart _ =
M.fromLists M.fromLists
[ [ Just ImgMiscFlipchart] [ [ Just ImgMiscFlipchart]
, [ Just ImgEmpty] , [ Just ImgEmpty]
] ]
clusterMat ClusterConferenceTable1 = clusterMat ClusterConferenceTable (h, w) =
M.fromLists M.fromLists $
[ [ Just ImgEmpty, Just ImgEmpty, Just ImgEmpty, Just ImgEmpty [ replicate w (Just ImgEmpty)
, Just ImgEmpty, Just ImgEmpty, Just ImgEmpty, Just ImgEmpty , [ Just ImgEmpty, Just ImgTableC4] ++ replicate (w-4) (Just ImgTableNW) ++
] [ Just ImgTableC3, Just ImgEmpty ]
, [ Just ImgEmpty, Just ImgTableC4, Just ImgTable4, Just ImgTable4 ] ++
, Just ImgTable4, Just ImgTable4, Just ImgTableC3, Just ImgEmpty replicate (h-4) ([ Just ImgEmpty, Just ImgTableSW] ++ replicate (w-4) (Just ImgEmpty) ++
] [ Just ImgTableNE, Just ImgEmpty ]) ++
, [ Just ImgEmpty, Just ImgTable1, Just ImgEmpty, Just ImgEmpty [ [ Just ImgEmpty, Just ImgTableC1] ++ replicate (w-4) (Just ImgTableSE) ++
, Just ImgEmpty, Just ImgEmpty, Just ImgTable3, Just ImgEmpty [ Just ImgTableC2, Just ImgEmpty ]
] , replicate w (Just ImgEmpty)
, [ Just ImgEmpty, Just ImgTable1, Just ImgEmpty, Just ImgEmpty
, Just ImgEmpty, Just ImgEmpty, Just ImgTable3, Just ImgEmpty
]
, [ Just ImgEmpty, Just ImgTableC1, Just ImgTable2, Just ImgTable2
, Just ImgTable2, Just ImgTable2, Just ImgTableC2, Just ImgEmpty
]
, [ Just ImgEmpty, Just ImgEmpty, Just ImgEmpty, Just ImgEmpty
, Just ImgEmpty, Just ImgEmpty, Just ImgEmpty, Just ImgEmpty
]
] ]
clusterMat ClusterConferenceTable2 = clusterMat ClusterPlant1 _ =
M.fromLists
[ [ Just ImgEmpty, Just ImgEmpty, Just ImgEmpty
, Just ImgEmpty, Just ImgEmpty, Just ImgEmpty
]
, [ Just ImgEmpty, Just ImgTableC4, Just ImgTable4
, Just ImgTable4, Just ImgTableC3, Just ImgEmpty
]
, [ Just ImgEmpty, Just ImgTable1, Just ImgEmpty
, Just ImgEmpty, Just ImgTable3, Just ImgEmpty
]
, [ Just ImgEmpty, Just ImgTableC1, Just ImgTable2
, Just ImgTable2, Just ImgTableC2, Just ImgEmpty
]
, [ Just ImgEmpty, Just ImgEmpty, Just ImgEmpty
, Just ImgEmpty, Just ImgEmpty, Just ImgEmpty
]
]
clusterMat ClusterPlant1 =
M.fromLists M.fromLists
[ [ Just ImgMiscPlant1 ] ] [ [ Just ImgMiscPlant1 ] ]
clusterMat ClusterPlant2 = clusterMat ClusterPlant2 _ =
M.fromLists M.fromLists
[ [ Just ImgMiscPlant2 ] ] [ [ Just ImgMiscPlant2 ] ]
clusterMat ClusterToilet = clusterMat ClusterToilet _ =
M.fromLists M.fromLists
[ [ Just ImgEmpty, Just ImgEmptyNoWalk] ] [ [ Just ImgEmpty, Just ImgEmptyNoWalk] ]
clusterMat ClusterWatercooler = clusterMat ClusterWatercooler _ =
M.fromLists M.fromLists
[ [ Just ImgMiscWatercooler ] [ [ Just ImgMiscWatercooler ]
, [ Just ImgEmpty ] , [ Just ImgEmpty ]
@ -141,76 +113,58 @@ clusterMat ClusterWatercooler =
clusterRoom :: Cluster -> [TileState] clusterRoom :: Cluster -> [TileState]
clusterRoom ClusterBox1 = [Offi] clusterRoom ClusterBox1 = [Offi]
clusterRoom ClusterTable1 = [Offi] clusterRoom ClusterTableSW = [Offi]
clusterRoom ClusterTable2 = [Offi] clusterRoom ClusterTableNW = [Offi]
clusterRoom ClusterTable3 = [Offi] clusterRoom ClusterTableNE = [Offi]
clusterRoom ClusterTable4 = [Offi] clusterRoom ClusterTableSE = [Offi]
clusterRoom ClusterCornerTable = [Offi] clusterRoom ClusterCornerTable = [Offi]
clusterRoom ClusterTableGroup = [Offi] clusterRoom ClusterTableGroup = [Offi]
clusterRoom ClusterCopier = [Offi] clusterRoom ClusterCopier = [Offi]
clusterRoom ClusterFlipchart = [Offi] clusterRoom ClusterFlipchart = [Offi]
clusterRoom ClusterConferenceTable1 = [Offi] clusterRoom ClusterConferenceTable = [Offi]
clusterRoom ClusterConferenceTable2 = [Offi]
clusterRoom ClusterPlant1 = [Offi] clusterRoom ClusterPlant1 = [Offi]
clusterRoom ClusterPlant2 = [Offi] clusterRoom ClusterPlant2 = [Offi]
clusterRoom ClusterToilet = [Toil] clusterRoom ClusterToilet = [Toil]
clusterRoom ClusterWatercooler = [Kitc, Offi] clusterRoom ClusterWatercooler = [Kitc, Offi]
clusterPoints :: Cluster -> [ReachPoint] clusterPoints :: Cluster -> (Int, Int) -> [ReachPoint]
clusterPoints ClusterBox1 = [] clusterPoints ClusterBox1 _ = []
clusterPoints ClusterTable1 = clusterPoints ClusterTableNE (h, _) =
[ ReachPoint Table (V2 1 1) NE] [ ReachPoint Table (V2 r 2) SW | r <- [1..h] ]
clusterPoints ClusterTable2 = clusterPoints ClusterTableNW (_, w) =
[ ReachPoint Table (V2 2 1) NW] [ ReachPoint Table (V2 1 c) SE | c <- [1..w] ]
clusterPoints ClusterTable3 = clusterPoints ClusterTableSW (h, _) =
[ ReachPoint Table (V2 1 2) SW] [ ReachPoint Table (V2 r 1) NE | r <- [1..h] ]
clusterPoints ClusterTable4 = clusterPoints ClusterTableSE (_, w) =
[ ReachPoint Table (V2 1 1) SE] [ ReachPoint Table (V2 2 c) NW | c <- [1..w] ]
clusterPoints ClusterCornerTable = clusterPoints ClusterCornerTable _ =
[ ReachPoint Computer (V2 2 1) N [ ReachPoint Computer (V2 2 1) N
] ]
clusterPoints ClusterTableGroup = clusterPoints ClusterTableGroup _ =
[ ReachPoint Computer (V2 2 2) N [ ReachPoint Computer (V2 2 2) N
, ReachPoint Computer (V2 2 5) N , ReachPoint Computer (V2 2 5) N
, ReachPoint Computer (V2 5 5) N , ReachPoint Computer (V2 5 5) N
] ]
clusterPoints ClusterCopier = clusterPoints ClusterCopier _ =
[ ReachPoint Copier (V2 2 1) NW [ ReachPoint Copier (V2 2 1) NW
] ]
clusterPoints ClusterFlipchart = clusterPoints ClusterFlipchart _ =
[ ReachPoint Table (V2 2 1) NW [ ReachPoint Table (V2 2 1) NW
] ]
clusterPoints ClusterConferenceTable1 = clusterPoints ClusterConferenceTable (h, w) =
[ ReachPoint Table (V2 1 3) SE [ ReachPoint Table (V2 1 c) SE | c <- [2..w-2] ] ++
, ReachPoint Table (V2 1 4) SE [ ReachPoint Table (V2 r 1) NE | r <- [2..h-2] ] ++
, ReachPoint Table (V2 1 5) SE [ ReachPoint Table (V2 r w) SW | r <- [2..h-2] ] ++
, ReachPoint Table (V2 1 6) SE [ ReachPoint Table (V2 h c) NW | c <- [2..w-2] ]
, ReachPoint Table (V2 3 1) NE clusterPoints ClusterToilet _ =
, ReachPoint Table (V2 3 8) SW
, ReachPoint Table (V2 4 1) NE
, ReachPoint Table (V2 4 8) SW
, ReachPoint Table (V2 6 3) NW
, ReachPoint Table (V2 6 4) NW
, ReachPoint Table (V2 6 5) NW
, ReachPoint Table (V2 6 6) NW
]
clusterPoints ClusterConferenceTable2 =
[ ReachPoint Table (V2 1 3) SE
, ReachPoint Table (V2 1 4) SE
, ReachPoint Table (V2 3 1) NE
, ReachPoint Table (V2 3 6) SW
, ReachPoint Table (V2 5 3) NW
, ReachPoint Table (V2 5 4) NW
]
clusterPoints ClusterToilet =
[ ReachPoint Toilet (V2 1 1) NE [ ReachPoint Toilet (V2 1 1) NE
] ]
clusterPoints ClusterWatercooler = clusterPoints ClusterWatercooler _ =
[ ReachPoint Drink (V2 2 1) NW [ ReachPoint Drink (V2 2 1) NW
] ]
clusterPoints _ = [] clusterPoints _ _ = []
instance Size Cluster where instance Size (Cluster, (Int, Int)) where
size c = size (c, dim) =
let mat = clusterMat c let mat = clusterMat c dim
in fromIntegral ((nrows mat) * (ncols mat)) in fromIntegral ((nrows mat) * (ncols mat))