diff --git a/assets/table/table3.kra b/assets/table/tableNE.kra similarity index 100% rename from assets/table/table3.kra rename to assets/table/tableNE.kra diff --git a/assets/table/table3.png b/assets/table/tableNE.png similarity index 100% rename from assets/table/table3.png rename to assets/table/tableNE.png diff --git a/assets/table/table4.kra b/assets/table/tableNW.kra similarity index 100% rename from assets/table/table4.kra rename to assets/table/tableNW.kra diff --git a/assets/table/table4.png b/assets/table/tableNW.png similarity index 100% rename from assets/table/table4.png rename to assets/table/tableNW.png diff --git a/assets/table/table2.kra b/assets/table/tableSE.kra similarity index 100% rename from assets/table/table2.kra rename to assets/table/tableSE.kra diff --git a/assets/table/table2.png b/assets/table/tableSE.png similarity index 100% rename from assets/table/table2.png rename to assets/table/tableSE.png diff --git a/assets/table/table1.kra b/assets/table/tableSW.kra similarity index 100% rename from assets/table/table1.kra rename to assets/table/tableSW.kra diff --git a/assets/table/table1.png b/assets/table/tableSW.png similarity index 100% rename from assets/table/table1.png rename to assets/table/tableSW.png diff --git a/src/Interior.hs b/src/Interior.hs index dce9e8a..21d674f 100644 --- a/src/Interior.hs +++ b/src/Interior.hs @@ -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) diff --git a/src/Load.hs b/src/Load.hs index e85eacd..34ef62c 100644 --- a/src/Load.hs +++ b/src/Load.hs @@ -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 diff --git a/src/MainGame/WorldMap.hs b/src/MainGame/WorldMap.hs index fcc549b..0435099 100644 --- a/src/MainGame/WorldMap.hs +++ b/src/MainGame/WorldMap.hs @@ -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" diff --git a/src/Types/Collidible.hs b/src/Types/Collidible.hs index d22e35f..13f14e3 100644 --- a/src/Types/Collidible.hs +++ b/src/Types/Collidible.hs @@ -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 = diff --git a/src/Types/ImgId.hs b/src/Types/ImgId.hs index 9c45ebf..45bcb4d 100644 --- a/src/Types/ImgId.hs +++ b/src/Types/ImgId.hs @@ -21,10 +21,10 @@ data ImgId | ImgWallTNW | ImgWallCross | ImgMiscBox1 - | ImgTable1 - | ImgTable2 - | ImgTable3 - | ImgTable4 + | ImgTableSW + | ImgTableNW + | ImgTableNE + | ImgTableSE | ImgTableCorner | ImgTableC1 | ImgTableC2 diff --git a/src/Types/Interior.hs b/src/Types/Interior.hs index c81c5bc..a008c95 100644 --- a/src/Types/Interior.hs +++ b/src/Types/Interior.hs @@ -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 = - M.fromLists - [ [ Just ImgEmpty, Just ImgTable2, Just ImgTableCorner - , Just ImgEmpty, Just ImgTable2, Just ImgTableCorner - ] - , [ Just ImgEmpty, Just ImgEmpty, Just ImgTable1 - , Just ImgEmpty, Just ImgEmpty, Just ImgTable1 - ] - , [ Just ImgEmpty, Just ImgEmpty, Just ImgEmpty - , Just ImgEmpty, Just ImgEmpty, Just ImgEmpty - ] - , [ Nothing, Nothing, Nothing - , Just ImgEmpty, Just ImgTable2, Just ImgTableCorner - ] - , [ Nothing, Nothing, Nothing - , Just ImgEmpty, Just ImgEmpty, Just ImgTable1 - ] - ] -clusterMat ClusterCopier = +clusterMat ClusterTableGroup _ = + 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 + ] + ] +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 - ] - , [ 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 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) ] -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))