tracer/src/Types/Interior.hs

295 lines
8.6 KiB
Haskell

{-# LANGUAGE FlexibleInstances #-}
module Types.Interior where
import qualified Affection as A
import Data.Matrix as M
import Linear.V2
import System.Random (StdGen, randomR)
-- internal imports
import Types.Map
import Types.ReachPoint
import Types.ImgId
import Types.Direction
data Cluster
= ClusterBox1
| ClusterTableSW
-- | ClusterTableNW
-- | ClusterTableNE
| ClusterTableSE
| ClusterCornerTable
| ClusterTableGroup
| ClusterCopier
| ClusterFlipchart
| ClusterConferenceTable
| ClusterPlant1
| ClusterPlant2
| ClusterToilets
| ClusterWatercooler
| ClusterVending
| ClusterCabinets
| ClusterBreakroomTable
deriving (Enum, Bounded, Show)
-- row -> NS; col -> WE
clusterMatWithRPs :: Cluster -> (Int, Int) -> StdGen -> (Matrix (Maybe ImgId), [ReachPoint])
clusterMatWithRPs ClusterBox1 dim _ =
( M.fromLists
[ [Just ImgMiscBox1]
]
, clusterPoints ClusterBox1 dim
)
clusterMatWithRPs ClusterTableSW dim@(mh, _) g =
let h = min 3 mh
ps = [ ReachPoint (if p /= 1 then Table else Computer) (V2 r 1) NE 0 |
(r, p) <- zip [1..] $ map fst (tail $ foldl
(\acc@((_, fg):_) _ -> randomR (1 :: Int, 3) fg : acc)
[(0, g)]
[1..h])
]
in
( M.fromLists $ replicate h
[Just ImgEmpty, Just ImgTableSW]
, ps
)
clusterMatWithRPs ClusterTableSE dim@(_, mw) g =
let w = min 3 mw
ps = [ ReachPoint (if p /= 1 then Table else Computer) (V2 2 c) NW 0 |
(c, p) <- zip [1..] $ map fst (tail $ foldl
(\acc@((_, fg):_) _ -> randomR (1 :: Int, 3) fg : acc)
[(0, g)]
[1..w])
]
in
( M.fromLists $
[ replicate w (Just ImgTableSE)
, replicate w (Just ImgEmpty)
]
, ps
)
clusterMatWithRPs ClusterCornerTable dim _ =
( M.fromLists
[ [Just ImgTableSE, Just ImgTableCorner]
, [Just ImgEmpty, Just ImgTableSW]
]
, clusterPoints ClusterCornerTable dim
)
clusterMatWithRPs ClusterTableGroup dim _ =
( M.fromLists
[ [ Just ImgEmpty, Just ImgTableSE, Just ImgTableCorner
, Just ImgEmpty, Just ImgTableSE, Just ImgTableCorner
]
, [ 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 ImgTableSE, Just ImgTableCorner
]
, [ Nothing, Nothing, Nothing
, Just ImgEmpty, Just ImgEmpty, Just ImgTableSW
]
]
, clusterPoints ClusterTableGroup dim
)
clusterMatWithRPs ClusterCopier dim _ =
( M.fromLists
[ [ Just ImgEmptyNoWalk]
, [ Just ImgEmpty]
]
, clusterPoints ClusterCopier dim
)
clusterMatWithRPs ClusterFlipchart dim _ =
( M.fromLists
[ [ Just ImgMiscFlipchart]
, [ Just ImgEmpty]
]
, clusterPoints ClusterFlipchart dim
)
clusterMatWithRPs ClusterConferenceTable dim@(h, w) _ =
let mmw = max 4 w
mmh = max 4 h
mw = min 7 mmw
mh = min 7 mmh
in
( M.fromLists $
[ replicate mw (Just ImgEmpty)
, [ Just ImgEmpty, Just ImgTableC4] ++ replicate (mw-4) (Just ImgTableNW) ++
[ Just ImgTableC3, Just ImgEmpty ]
] ++
replicate (mh-4) ([ Just ImgEmpty, Just ImgTableSW] ++ replicate (mw-4) (Just ImgEmpty) ++
[ Just ImgTableNE, Just ImgEmpty ]) ++
[ [ Just ImgEmpty, Just ImgTableC1] ++ replicate (mw-4) (Just ImgTableSE) ++
[ Just ImgTableC2, Just ImgEmpty ]
, replicate mw (Just ImgEmpty)
]
, clusterPoints ClusterConferenceTable dim
)
clusterMatWithRPs ClusterPlant1 dim _ =
( M.fromLists
[ [ Just ImgMiscPlant1 ] ]
, clusterPoints ClusterPlant1 dim
)
clusterMatWithRPs ClusterPlant2 dim _ =
( M.fromLists
[ [ Just ImgMiscPlant2 ] ]
, clusterPoints ClusterPlant2 dim
)
clusterMatWithRPs ClusterToilets dim@(_, h) _ =
let mh = min 3 h
in
( M.fromLists (replicate mh
([ Just ImgEmpty, Just ImgEmptyNoWalk]))
, clusterPoints ClusterToilets dim
)
clusterMatWithRPs ClusterWatercooler dim _ =
( M.fromLists
[ [ Just ImgMiscWatercooler ]
, [ Just ImgEmpty ]
]
, clusterPoints ClusterWatercooler dim
)
clusterMatWithRPs ClusterVending dim _ =
( M.fromLists
[ [ Just ImgMiscVending ]
, [ Just ImgEmpty ]
]
, clusterPoints ClusterVending dim
)
clusterMatWithRPs ClusterCabinets (h, w) g =
let iw = max 2 w
ih = max 2 h
rw = min 5 iw
rh = min 5 ih
selses =
[ ImgCabinetCoffeeSE
, ImgCabinetSinkSE
, ImgCabinetStoveSE
]
selsws =
[ ImgCabinetCoffeeSW
, ImgCabinetSinkSW
, ImgCabinetStoveSW
]
(g1, ses, seps) = foldl
(\(gen, lsi, lsr) a ->
let (switch, gf1) = randomR (1, 3) gen :: (Int, StdGen)
in if switch == 1
then
let (typ, gf2) = randomR (0, length selses - 1) gf1
img = selses !! typ
rp i
| i == ImgCabinetCoffeeSE = ReachPoint Drink (V2 2 a) NW 0
| i == ImgCabinetSinkSE = ReachPoint Drink (V2 2 a) NW 0
| i == ImgCabinetStoveSE = ReachPoint Eat (V2 2 a) NW 0
in (gf2, Just img : lsi, rp img : lsr)
else
(gf1, Just ImgCabinetSE : lsi, lsr)
)
(g, [], [])
(reverse [1 .. rw - 1])
(g2, sws, swps) = foldl
(\(gen, lsi, lsr) a ->
let (switch, gf1) = randomR (1, 3) gen :: (Int, StdGen)
in if switch == 1
then
let (typ, gf2) = randomR (0, length selsws - 1) gf1
img = selsws !! typ
rp i
| i == ImgCabinetCoffeeSW = ReachPoint Drink (V2 a (rw - 1)) NE 0
| i == ImgCabinetSinkSW = ReachPoint Drink (V2 a (rw - 1)) NE 0
| i == ImgCabinetStoveSW = ReachPoint Eat (V2 a (rw - 1)) NE 0
in (gf2, Just img : lsi, rp img : lsr)
else
(gf1, Just ImgCabinetSW : lsi, lsr)
)
(g1, [], [])
(reverse [2 .. rh])
outmat =
(M.fromLists [ses] M.<|> M.fromLists [[ Just ImgCabinetCorner ]])
M.<->
(M.fromList (rh - 1) (rw - 1) (repeat $ Just ImgEmpty)
M.<|>
M.fromLists (map (\a -> [a]) sws)
)
in (outmat, (seps ++ swps))
clusterMatWithRPs ClusterBreakroomTable dim g =
( fst (clusterMatWithRPs ClusterConferenceTable (4, 4) g)
, clusterPoints ClusterBreakroomTable dim
)
clusterRoom :: Cluster -> [TileState]
clusterRoom ClusterBox1 = [Offi]
clusterRoom ClusterTableSW = [Offi]
clusterRoom ClusterTableSE = [Offi]
clusterRoom ClusterCornerTable = [Offi]
clusterRoom ClusterTableGroup = [Offi]
clusterRoom ClusterCopier = [Offi]
clusterRoom ClusterFlipchart = [Offi]
clusterRoom ClusterConferenceTable = [Offi]
clusterRoom ClusterPlant1 = [Offi]
clusterRoom ClusterPlant2 = [Offi]
clusterRoom ClusterToilets = [Toil]
clusterRoom ClusterWatercooler = [Kitc, Offi]
clusterRoom ClusterVending = [Kitc]
clusterRoom ClusterCabinets = [Kitc]
clusterRoom ClusterBreakroomTable = [Kitc]
clusterPoints :: Cluster -> (Int, Int) -> [ReachPoint]
clusterPoints ClusterBox1 _ = []
clusterPoints ClusterCornerTable _ =
[ ReachPoint Computer (V2 2 1) N 0
]
clusterPoints ClusterTableGroup _ =
[ ReachPoint Computer (V2 2 2) N 0
, ReachPoint Computer (V2 2 5) N 0
, ReachPoint Computer (V2 5 5) N 0
]
clusterPoints ClusterCopier _ =
[ ReachPoint Copier (V2 2 1) NW 0
]
clusterPoints ClusterFlipchart _ =
[ ReachPoint Table (V2 2 1) NW 0
]
clusterPoints ClusterConferenceTable (h, w) =
let iw = max 4 w
ih = max 4 h
mw = min 7 iw
mh = min 7 ih
in
[ ReachPoint Table (V2 1 c) SE 0 | c <- [2..mw-1] ] ++
[ ReachPoint Table (V2 r 1) NE 0 | r <- [2..mh-1] ] ++
[ ReachPoint Table (V2 r mw) SW 0 | r <- [2..mh-1] ] ++
[ ReachPoint Table (V2 mh c) NW 0 | c <- [2..mw-1] ]
clusterPoints ClusterToilets (_, h) =
let mh = min 3 h
in
map (\r -> ReachPoint Toilet (V2 r 1) NE 0)
[1 .. mh]
clusterPoints ClusterWatercooler _ =
[ ReachPoint Drink (V2 2 1) NW 0
]
clusterPoints ClusterVending _ =
[ ReachPoint Eat (V2 2 1) NW 0
]
clusterPoints ClusterBreakroomTable _ =
map
(\p -> p
{ pointType = Eat }
)
(clusterPoints ClusterConferenceTable (4, 4))
clusterPoints _ _ = []
instance Size (Cluster, (Int, Int), StdGen) where
size (c, dim, gen) =
let mat = fst $ clusterMatWithRPs c dim gen
in fromIntegral ((nrows mat) * (ncols mat))