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

clean messy tables and create dynamic clusters

Browse source
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
Show stats Download patch file Download diff file Expand all files Collapse all files

0
assets/table/table3.kra → assets/table/tableNE.kra
View file

0
assets/table/table3.png → assets/table/tableNE.png
View file

Side by side Swipe Overlay

Before

Width:  |  Height:  |  Size: 516 B

After

Width:  |  Height:  |  Size: 516 B

0
assets/table/table4.kra → assets/table/tableNW.kra
View file

0
assets/table/table4.png → assets/table/tableNW.png
View file

Side by side Swipe Overlay

Before

Width:  |  Height:  |  Size: 537 B

After

Width:  |  Height:  |  Size: 537 B

0
assets/table/table2.kra → assets/table/tableSE.kra
View file

0
assets/table/table2.png → assets/table/tableSE.png
View file

Side by side Swipe Overlay

Before

Width:  |  Height:  |  Size: 510 B

After

Width:  |  Height:  |  Size: 510 B

0
assets/table/table1.kra → assets/table/tableSW.kra
View file

0
assets/table/table1.png → assets/table/tableSW.png
View file

Side by side Swipe Overlay

Before

Width:  |  Height:  |  Size: 515 B

After

Width:  |  Height:  |  Size: 515 B

35
src/Interior.hs
View file

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

18
src/Load.hs
View file

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

2
src/MainGame/WorldMap.hs
View file

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

8
src/Types/Collidible.hs
View file

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

8
src/Types/ImgId.hs
View file

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

206
src/Types/Interior.hs
View file

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