{-# 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))