diff --git a/ideas/general.md b/ideas/general.md index 54d6988..2a6a04a 100644 --- a/ideas/general.md +++ b/ideas/general.md @@ -26,7 +26,7 @@ of account data. ## View -Cabinet perspective +Isometric perspective ## Mechanics diff --git a/src/Floorplan.hs b/src/Floorplan.hs new file mode 100644 index 0000000..f2d974c --- /dev/null +++ b/src/Floorplan.hs @@ -0,0 +1,250 @@ +module Floorplan where + +import Data.Matrix (Matrix(..)) +import qualified Data.Matrix as M +import Data.Foldable (find) +import Data.Maybe (fromMaybe) + +import System.Random + +import Debug.Trace + +data TileState + = Wall + | Wind + | Door + | Hall + | Offi + | Toil + | Kitc + | Elev + | Unde + deriving (Eq) + +instance Show TileState where + show Wall = "#" + show Wind = "~" + show Door = "+" + show Hall = "_" + show Offi = "." + show Toil = "o" + show Kitc = "k" + show Elev = "x" + show Unde = " " + +data FloorConfig = FloorConfig + { elevator :: (Int, Int) + , facilities :: [(Int, Int)] + , size :: (Int, Int) + } deriving (Show) + +data Boundaries = Boundaries + { matmin :: (Int, Int) + , matmax :: (Int, Int) + } deriving (Show) + +buildHallFloorIO :: FloorConfig -> IO (Matrix TileState) +buildHallFloorIO fc = do + rand <- newStdGen + return $ buildHallFloor fc rand + +buildHallFloor :: FloorConfig -> StdGen -> Matrix TileState +buildHallFloor fc gen = + let empty = emptyFloor fc + (g1, withElv) = buildElevator fc (placeHalls gen fc empty) + (g2, withIW) = buildInnerWalls g1 withElv + withOW = buildOuterWalls withIW + closed = closeOffices withOW + in closed + +emptyFloor :: FloorConfig -> Matrix TileState +emptyFloor fc = + let (rows, cols) = size fc + in M.matrix rows cols (const Unde) + +buildElevator + :: FloorConfig + -> (StdGen, Matrix TileState) + -> (StdGen, Matrix TileState) +buildElevator fc (gen, emptyFloor) = + let (row, col) = elevator fc + boxCoord x = (,) <$> [row - x .. row + x] <*> [col - x .. col + x] + buildShaft = foldl + (\acc coord -> M.setElem (replaceTile (acc M.! coord) Hall) coord acc) + (foldl (\acc coord -> M.setElem Wall coord acc) emptyFloor (boxCoord 2)) + (boxCoord 5) + elvDoor = M.setElem Door (row + 2, col) buildShaft + in (gen, foldl (\acc coord -> M.setElem Elev coord acc) elvDoor (boxCoord 1)) + +placeHalls + :: StdGen + -> FloorConfig + -> Matrix TileState + -> (StdGen, Matrix TileState) +placeHalls rng fc input = + doHalls rng + [(Boundaries (1,1) (nrows input, ncols input))] + (elevator fc) 5 input + where + elPos = elevator fc + doHalls rand bounds cross wmax mat = + let (rnd, gen) = next rand + in foldl (\(agen, amat) b -> + let (row, g1) = randomR (fst (matmin b), fst (matmax b)) agen + (col, g2) = randomR (snd (matmin b), snd (matmax b)) g1 + (nw, g3) = randomR (2, wmax) g2 + (nbs, nmat) = buildHall cross nw b amat + in + if hallRatio nmat < 0.5 && wmax - 1 > 2 + then doHalls g3 nbs (row, col) (wmax -1) nmat + else (g3, nmat) + ) (rand, mat) bounds + +boundSize :: Boundaries -> Int +boundSize (Boundaries min max) = + (fst max - fst min) * (snd max - snd min) + +buildHall + :: (Int, Int) + -> Int + -> Boundaries + -> Matrix TileState + -> ([Boundaries], Matrix TileState) +buildHall coord@(row, col) width bounds mat = + let vertHalls = foldl (\acc c -> M.mapCol + (\r cur -> if r >= fst (matmin bounds) && r <= fst (matmax bounds) + then replaceTile cur Hall + else cur + ) c acc) + mat + [col - (width `div` 2) .. col + (width `div` 2)] + horzHalls = foldl (\acc r -> M.mapRow + (\c cur -> if c >= snd (matmin bounds) && c <= snd (matmax bounds) + then replaceTile cur Hall + else cur + ) r acc) + vertHalls + [row - (width `div` 2) .. row + (width `div` 2)] + in ( [ Boundaries (matmin bounds) coord + , Boundaries (fst (matmin bounds), col) (row, snd (matmax bounds)) + , Boundaries (row, snd (matmin bounds)) (fst (matmax bounds), col) + , Boundaries coord (matmax bounds) + ] + , horzHalls + ) + +replaceTile :: TileState -> TileState -> TileState +replaceTile cur new + | cur == Unde = new + | otherwise = cur + +hallRatio :: Matrix TileState -> Double +hallRatio mat = + let hs = foldl (\acc a -> if a == Hall then acc + 1 else acc) 0 mat + in fromIntegral hs / fromIntegral (nrows mat * ncols mat) + +buildInnerWalls :: StdGen -> Matrix TileState -> (StdGen, Matrix TileState) +buildInnerWalls rng input = + let floodSearchReplace + :: StdGen + -> (Int, Int) + -> Matrix TileState + -> (StdGen, Matrix TileState) + floodSearchReplace gn coord@(row, col) mat + | mat M.! coord == Unde = + let maxRow = doRow row + doRow r + | M.safeGet (r + 1) col mat == Just Unde = doRow (r + 1) + | otherwise = r + maxCol = doCol col + doCol c + | M.safeGet row (c + 1) mat == Just Unde = doCol (c + 1) + | otherwise = c + (cr, g1) = randomR (row, maxRow) gn + (cc, g2) = randomR (col, maxCol) g1 + (nngen, nnmat) = doCross + g2 + (cr, cc) + (Boundaries coord (maxRow, maxCol)) + mat + doCross + :: StdGen + -> (Int, Int) + -> Boundaries + -> Matrix TileState + -> (StdGen, Matrix TileState) + doCross gen coord@(xr, xc) b imat = + let nbs = map (\(min, max) -> Boundaries min max) bounds + bounds = + [ (matmin b, coord) + , ((fst (matmin b), col), (row, snd (matmax b))) + , ((row, snd (matmin b)), (fst (matmax b), col)) + , (coord, matmax b) + ] + (ngen, crosses) = foldl + (\(agen, acc) (minb, maxb) -> + let (fc, g1) = randomR (fst minb, fst maxb) agen + (fr, g2) = randomR (snd minb, snd maxb) g1 + in (g2, acc ++ [(fc, fr)]) + ) (gen, []) bounds + horz = M.mapRow (\icol cur -> + if icol >= snd (matmin b) && icol <= snd (matmax b) + then replaceTile cur Wall + else cur + ) xr imat + vert = M.mapCol (\irow cur -> + if irow >= fst (matmin b) && irow <= fst (matmax b) + then replaceTile cur Wall + else cur + ) xc horz + omat = foldl + (\acc coords -> + M.setElem (replaceTile (acc M.! coords) Offi) coords acc + ) vert btups + btups = (,) + <$> [fst (matmin b) .. fst (matmax b)] + <*> [snd (matmin b) .. snd (matmax b)] + in if trace ("bs: " ++ show (boundSize b)) (boundSize b) >= 16 + then foldl + (\(agen, amat) (cr, nb) -> doCross agen cr nb amat) + (ngen, omat) + (zip crosses nbs) + else trace + ("built cross at " ++ show coord ++ " within " ++ show b) + (gen, omat) + in (nngen, nnmat) + | otherwise = (gn, mat) + tups mat = (,) <$> [1 .. nrows mat] <*> [1 .. ncols mat] + in foldl (\(agen, amat) cds -> floodSearchReplace agen cds amat) + (rng, input) (tups input) + +closeOffices :: Matrix TileState -> Matrix TileState +closeOffices input = + let tups mat = (,) <$> [2 .. nrows mat - 1] <*> [2 .. ncols mat - 1] + isNeighbor (row, col) = + let subm = M.submatrix (row -1) (row + 1) (col - 1) (col + 1) input + in any (== Hall) (M.toList subm) + in foldl (\acc coord -> + if input M.! coord == Offi && isNeighbor coord + then M.setElem Wall coord acc + else acc + ) input (tups input) + +buildOuterWalls :: Matrix TileState -> Matrix TileState +buildOuterWalls input = + let horz :: Matrix TileState + horz = + foldl + (\amat r -> M.mapRow (\_ _ -> Wall) r amat) + input + [ 1 + , nrows input + ] + vert = + foldl + (\amat c -> M.mapCol (\_ _ -> Wall) c amat) + horz + [ 1 + , ncols horz + ] + in vert diff --git a/src/Types/UserData.hs b/src/Types/UserData.hs index f92deac..ebdbcd2 100644 --- a/src/Types/UserData.hs +++ b/src/Types/UserData.hs @@ -44,9 +44,10 @@ data Direction | SE data Entity f = Entity - { pos :: Component f 'Field (V2 Float) - , vel :: Component f 'Field (V2 Float) - , rot :: Component f 'Field Direction + { pos :: Component f 'Field (V2 Float) + , vel :: Component f 'Field (V2 Float) + , rot :: Component f 'Field Direction + , player :: Component f 'Unique Bool } deriving (Generic) diff --git a/tracer-game.cabal b/tracer-game.cabal index 55a1bcf..10dd6e6 100644 --- a/tracer-game.cabal +++ b/tracer-game.cabal @@ -20,6 +20,7 @@ executable tracer-game other-modules: Types , Types.UserData , StateMachine + , Floorplan , Init default-extensions: OverloadedStrings , DeriveGeneric @@ -35,5 +36,7 @@ executable tracer-game , containers , ecstasy , linear + , matrix + , random hs-source-dirs: src default-language: Haskell2010