From 4a089ff0ccabffdc7bf021edbf806f76d315a6af Mon Sep 17 00:00:00 2001 From: justin Date: Sun, 14 Nov 2021 00:39:24 +0000 Subject: [PATCH] Work toward adding wiring --- src/Dodge/Debug/LinkDecoration.hs | 2 +- src/Dodge/Default/Room.hs | 21 ++++---- src/Dodge/Floor.hs | 23 ++------- src/Dodge/Layout.hs | 74 +++++++++++++++++------------ src/Dodge/Layout/Tree/Annotate.hs | 9 ++-- src/Dodge/Layout/Tree/Either.hs | 6 +++ src/Dodge/Layout/Tree/Shift.hs | 2 +- src/Dodge/LevelGen.hs | 9 ++-- src/Dodge/LevelGen/Data.hs | 51 +++++++++++++++++--- src/Dodge/Placements/Button.hs | 2 +- src/Dodge/Placements/LightSource.hs | 11 ++--- src/Dodge/Placements/Wall.hs | 1 - src/Dodge/Room.hs | 4 +- src/Dodge/Room/AddTile.hs | 17 ------- src/Dodge/Room/Airlock.hs | 1 - src/Dodge/Room/Boss.hs | 4 +- src/Dodge/Room/Branch.hs | 2 +- src/Dodge/Room/CheckConsistency.hs | 2 +- src/Dodge/Room/Corridor.hs | 22 +-------- src/Dodge/Room/Data.hs | 45 ------------------ src/Dodge/Room/Door.hs | 3 +- src/Dodge/Room/Foreground.hs | 3 -- src/Dodge/Room/Link.hs | 2 +- src/Dodge/Room/Listed.hs | 7 --- src/Dodge/Room/LockAndKeyList.hs | 2 +- src/Dodge/Room/LongDoor.hs | 4 +- src/Dodge/Room/NoNeedWeapon.hs | 4 +- src/Dodge/Room/Path.hs | 2 +- src/Dodge/Room/Procedural.hs | 1 - src/Dodge/Room/RoadBlock.hs | 5 +- src/Dodge/Room/Room.hs | 2 +- src/Dodge/Room/Start.hs | 20 ++++---- src/Dodge/Room/Teleport.hs | 4 +- src/Dodge/Room/Treasure.hs | 1 - 34 files changed, 154 insertions(+), 214 deletions(-) delete mode 100644 src/Dodge/Room/AddTile.hs delete mode 100644 src/Dodge/Room/Data.hs delete mode 100644 src/Dodge/Room/Listed.hs diff --git a/src/Dodge/Debug/LinkDecoration.hs b/src/Dodge/Debug/LinkDecoration.hs index e531f4cec..d4445f6aa 100644 --- a/src/Dodge/Debug/LinkDecoration.hs +++ b/src/Dodge/Debug/LinkDecoration.hs @@ -4,7 +4,7 @@ module Dodge.Debug.LinkDecoration ) where import Dodge.Data --import Dodge.Base -import Dodge.Room.Data +import Dodge.LevelGen.Data import Dodge.Picture.Layer import Picture import qualified IntMapHelp as IM diff --git a/src/Dodge/Default/Room.hs b/src/Dodge/Default/Room.hs index 52a781a85..d03e8b740 100644 --- a/src/Dodge/Default/Room.hs +++ b/src/Dodge/Default/Room.hs @@ -1,7 +1,7 @@ module Dodge.Default.Room where import Geometry.Data -import Dodge.Room.Data +import Dodge.LevelGen.Data defaultRoom :: Room defaultRoom = Room @@ -10,14 +10,15 @@ defaultRoom = Room , _rmPos = [] , _rmPath = [] , _rmPmnts = [] - , _rmPartialPmnt = Nothing - , _rmExtendedPmnt = Nothing - , _rmBound = [] - , _rmFloor = [] - , _rmName = "defaultRoom" - , _rmShift = (V2 0 0 , 0) + , _rmPartPmnt = Nothing + , _rmExtPmnt = Nothing + , _rmBound = [] + , _rmFloor = [] + , _rmName = "defaultRoom" + , _rmShift = (V2 0 0 , 0) , _rmViewpoints = [] - , _rmRandPSs = [] - , _rmLabel = Nothing - , _rmTakeFrom = Nothing + , _rmRandPSs = [] + , _rmLabel = Nothing + , _rmTakeFrom = Nothing + , _rmWires = [] } diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs index 8e20179ee..1cc549d69 100644 --- a/src/Dodge/Floor.hs +++ b/src/Dodge/Floor.hs @@ -6,16 +6,7 @@ module Dodge.Floor import Geometry.Data import Dodge.Data import Dodge.Creature.State.Data -import Dodge.Room.Procedural -import Dodge.Room.RoadBlock -import Dodge.Room.Data import Dodge.Room -import Dodge.Room.Door -import Dodge.Room.Branch -import Dodge.Room.Boss -import Dodge.Room.LongDoor -import Dodge.Room.NoNeedWeapon -import Dodge.Room.Link import Dodge.Placements.Button import Dodge.Layout.Tree.Polymorphic import Dodge.Layout.Tree.Either @@ -38,10 +29,11 @@ import Data.Maybe initialAnoTree :: RandomGen g => Tree [Annotation g] initialAnoTree = padSucWithCorridors $ treeFromTrunk [[StartRoom] - ,[SetLabel 0 $ return $ roomRectAutoLinks 100 100 - & rmExtendedPmnt ?~ externalButton red (anyLnkInPS 5) + ,[ChainAnos [[SetLabel 0 $ return $ roomRectAutoLinks 100 100 + & rmExtPmnt ?~ externalButton red (anyLnkInPS 5) ] + ,[UseLabel 0 $ return switchDoorRoom] + ] ] - ,[UseLabel 0 $ return switchDoorRoom] ,[SpecificRoom $ return $ connectRoom lasTunnel ] ,[SpecificRoom $ fmap connectRoom slowDoorRoom ] ,[Corridor] @@ -113,12 +105,6 @@ layoutLevelFromSeed i seed = do putStr $ "Level generation with seed " ++ show seed ++ " failed: " let (seed',_) = random g layoutLevelFromSeed i' seed' - -- where - -- setLastLinkToUsed rm = case _rmLinks rm of - -- (_:_) -> rm - -- & rmLinks %~ init - -- & rmUsedLinks %~ (last (_rmLinks rm) :) - -- _ -> rm compactDrawTree :: Tree String -> String compactDrawTree = unlines . compactDraw @@ -132,5 +118,4 @@ compactDraw (Node x ts0) = lines x ++ drawSubTrees ts0 "|" : compactDraw t drawSubTrees (t:ts) = "|" : shift "+- " "| " (compactDraw t) ++ drawSubTrees ts - shift first other = zipWith (++) (first : repeat other) diff --git a/src/Dodge/Layout.hs b/src/Dodge/Layout.hs index f6f6a28b3..2f169a2e8 100644 --- a/src/Dodge/Layout.hs +++ b/src/Dodge/Layout.hs @@ -1,8 +1,6 @@ --{-# LANGUAGE TupleSections #-} module Dodge.Layout ( generateLevelFromRoomList --- , doPartialPlacements --- , doExtendedPlacements ) where import Dodge.Data import Dodge.LevelGen @@ -12,30 +10,30 @@ import Dodge.LevelGen.Pathing import Dodge.Wall.Zone import Dodge.GameRoom import Dodge.Bounds -import Dodge.Room.Data -import Dodge.Room.AddTile +--import Dodge.LevelGen.Data +import Dodge.Room.Foreground import Dodge.Default.Wall import Geometry ---import Geometry.Data import qualified IntMapHelp as IM ---import Dodge.Debug.LinkDecoration import Tile import Data.List (nubBy) ---import Control.Monad.State +import Data.Traversable import Control.Lens import System.Random import Data.Foldable import qualified Control.Foldl as L import Data.Maybe +import Data.Function generateLevelFromRoomList :: [Room] -> World -> World generateLevelFromRoomList gr w = initWallZoning . setupWorldBounds - . doPartialPlacements rs - . doExtendedPlacements rs - . flip (foldl' doRoomPlacements) rs + . placeWires + . doPartialPlacements + . doExtendedPlacements + . flip (mapAccumR doRoomPlacements) rs $ w { _walls = wallsFromRooms rs , _floorTiles = floorsFromRooms rs , _gameRooms = gameRoomsFromRooms rs @@ -48,29 +46,40 @@ generateLevelFromRoomList gr w rs = zipWith addTile zs gr zs = map fromIntegral $ randomRs (0,63::Int) $ _randGen w -doPartialPlacements :: [Room] -> (IM.IntMap [Placement],World) -> World -doPartialPlacements rms (im,w) = foldr (doPartialPlacement im) w rms +placeWires :: (World,[Room])-> World +placeWires (w,rms) = foldr placeRoomWires w rms -doPartialPlacement :: IM.IntMap [Placement] -> Room -> World -> World -doPartialPlacement im rm w = case _rmPartialPmnt rm of - Nothing -> w +placeRoomWires :: Room -> World -> World +placeRoomWires rm w = foldr placeWire w (_rmWires rm) + +placeWire :: RoomWire -> World -> World +placeWire rw w = case rw of + RoomWire (p,_) (q,_) -> w & foregroundShape %~ (thinHighBar 40 p q <>) + +doPartialPlacements :: ( (IM.IntMap [Placement],World) , [Room] ) -> (World,[Room]) +doPartialPlacements ((im,w),rms) = mapAccumR (doPartialPlacement im) w rms + +doPartialPlacement :: IM.IntMap [Placement] -> World -> Room -> (World, Room) +doPartialPlacement im w rm = case _rmPartPmnt rm of + Nothing -> (w, rm) Just fi -> case _rmTakeFrom rm of - Nothing -> w - Just i -> fst $ fst $ placeSpot (w,rm) (fi (im IM.! i)) + Nothing -> (w, rm) + Just i -> fst $ placeSpot (w,rm) (fi (im IM.! i)) -doExtendedPlacements :: [Room] -> World -> (IM.IntMap [Placement], World) -doExtendedPlacements rms w = foldr doExtendedPlacement (IM.empty,w) rms +doExtendedPlacements :: (World,[Room]) -> ( (IM.IntMap [Placement], World) , [Room] ) +doExtendedPlacements (w,rms) = mapAccumR doExtendedPlacement (IM.empty,w) rms -doExtendedPlacement :: Room -> (IM.IntMap [Placement], World) -> (IM.IntMap [Placement], World) -doExtendedPlacement rm (im,w) = case _rmExtendedPmnt rm of - Nothing -> (im,w) +doExtendedPlacement :: (IM.IntMap [Placement], World) -> Room + -> ( (IM.IntMap [Placement], World) , Room ) +doExtendedPlacement (im,w) rm = case _rmExtPmnt rm of + Nothing -> ( (im,w) , rm ) Just plmnt -> case _rmLabel rm of - Nothing -> (im,w) - Just i -> let ((neww,_),plmnts) = placeSpot (w,rm) plmnt - in (IM.insert i plmnts im, neww) + Nothing -> ( (im,w) , rm ) + Just i -> let ((neww,newrm),plmnts) = placeSpot (w,rm) plmnt + in ( (IM.insert i plmnts im, neww) , newrm ) -doRoomPlacements :: World -> Room -> World -doRoomPlacements w rm = fst $ foldl' (\wr -> fst . placeSpot wr) (w,rm) $ _rmPmnts rm +doRoomPlacements :: World -> Room -> (World, Room) +doRoomPlacements w rm = foldl' (\wr -> fst . placeSpot wr) (w,rm) $ _rmPmnts rm setupWorldBounds :: World -> World setupWorldBounds w = w @@ -93,9 +102,6 @@ setupWorldBounds w = w initWallZoning :: World -> World initWallZoning w = foldl' (flip insertWallInZones) (w & wallsZone . znObjects .~ IM.empty) (_walls w) ---initWallZoning w = set (wallsZone . znObjects) (foldl' (flip wallInZone) IM.empty (_walls w)) w --- where --- wallInZone wl = flip (foldl' (flip $ \(a,b) -> insertIMInZone a b (_wlID wl) wl)) (zoneOfWall wl) --makePath :: Tree Room -> [(Point2,Point2)] --makePath = concatMap _rmPath . flatten @@ -168,3 +174,11 @@ floorsFromRooms = concatMap (concatMap tToRender . _rmFloor) -- f r = shiftRoomBy ( V2 0 0 -.- rotateV (pi-a) p , 0) $ shiftRoomBy (V2 0 0,pi-a) r -- where -- (p,a) = last $ _rmLinks r + +addTile :: Float -> Room -> Room +addTile z r + | not (null (_rmFloor r)) || null rp = r + | otherwise = r & rmFloor .~ [makeTileFromPoly poly z] + where + rp = _rmPolys r + poly = orderPolygon . convexHullSafe . nubBy ((==) `on` roundPoint2) $ concat rp diff --git a/src/Dodge/Layout/Tree/Annotate.hs b/src/Dodge/Layout/Tree/Annotate.hs index 9cffbf75e..57622ebbf 100644 --- a/src/Dodge/Layout/Tree/Annotate.hs +++ b/src/Dodge/Layout/Tree/Annotate.hs @@ -15,9 +15,6 @@ data Annotation g = Lock Int | Key Int | Corridor - | CorridorDebug - | SwitchDoorAno - | DoorNumAno Int | AirlockAno | FirstWeapon | StartRoom @@ -28,6 +25,7 @@ data Annotation g | TreasureAno [Creature] [Item] | SetLabel Int (State g Room) | UseLabel Int (State g Room) + | ChainAnos [[Annotation g]] addLock :: RandomGen g => Int -> Tree [Annotation g] -> State g (Tree [Annotation g]) addLock i t = do @@ -59,12 +57,13 @@ anoToRoomTree anos = case anos of [UseLabel i randrm] -> do rm <- randrm return $ connectRoom $ rm & rmTakeFrom ?~ i + [ChainAnos ass] -> do + rms <- mapM anoToRoomTree ass + return $ linkEitherTrees rms [OrAno as] -> do a <- takeOne as anoToRoomTree a [Corridor] -> pure . Right <$> randomiseOutLinks corridor - [CorridorDebug] -> pure . Right <$> randomiseOutLinks corridorDebug --- [DoorAno] -> roomThenCorridor door [AirlockAno] -> airlock >>= roomThenCorridor [FirstWeapon] -> do branchWP <- branchRectWith weaponRoom diff --git a/src/Dodge/Layout/Tree/Either.hs b/src/Dodge/Layout/Tree/Either.hs index 0611c0e91..b73c1fa50 100644 --- a/src/Dodge/Layout/Tree/Either.hs +++ b/src/Dodge/Layout/Tree/Either.hs @@ -7,6 +7,7 @@ module Dodge.Layout.Tree.Either , connectRoom , connectTrunk , deadRoom + , linkEitherTrees ) where import Data.Tree @@ -32,6 +33,11 @@ appendEitherTree appendEitherTree (Node (Left x) ts) ts' = Node (Left x) $ map (`appendEitherTree` ts') ts appendEitherTree (Node (Right x) _) ts' = Node (Left x) ts' +linkEitherTrees :: [Tree (Either a a)] -> Tree (Either a a) +linkEitherTrees (t:s:ts) = linkEitherTrees (appendEitherTree t [s]:ts) +linkEitherTrees [t] = t +linkEitherTrees [] = error "tried to concatenate an empty list of either trees" + removeEither :: Either p p -> p removeEither (Left y) = y removeEither (Right y) = y diff --git a/src/Dodge/Layout/Tree/Shift.hs b/src/Dodge/Layout/Tree/Shift.hs index 2bcb154ac..8105eb7fe 100644 --- a/src/Dodge/Layout/Tree/Shift.hs +++ b/src/Dodge/Layout/Tree/Shift.hs @@ -4,7 +4,7 @@ Creates a list of rooms; after this step the structure is determined by the actu module Dodge.Layout.Tree.Shift ( positionRooms ) where -import Dodge.Room.Data +import Dodge.LevelGen.Data import Dodge.Room.Link import Dodge.Layout.Tree.Polymorphic import Geometry.ConvexPoly diff --git a/src/Dodge/LevelGen.hs b/src/Dodge/LevelGen.hs index adfd559ae..3f294a3f5 100644 --- a/src/Dodge/LevelGen.hs +++ b/src/Dodge/LevelGen.hs @@ -15,7 +15,6 @@ import Dodge.LevelGen.TriggerDoor import Dodge.LevelGen.Data import Dodge.Default.Wall import Dodge.RandomHelp -import Dodge.Room.Data import Dodge.Placements.Spot import Geometry import Geometry.Vector3D @@ -30,7 +29,7 @@ import qualified Data.IntSet as IS -- when placing a placement, we update the world and the room and assign an id -- to the placement -placeSpot :: (World,Room) -> Placement -> ( (World,Room), [Placement]) +placeSpot :: (World,Room) -> Placement -> ( (World,Room), [Placement] ) placeSpot (w,rm) plmnt = case plmnt of Placement{_plSpot = PSRoomRand i} -> placeSpotRoomRand rm i plmnt w Placement{_plSpot = PSLnk{}} -> placeSpotUsingLink w rm plmnt @@ -58,11 +57,11 @@ placeSpotUsingLink w rm plmnt = case lnks of where uselnk lnki = rm & rmLinks %~ deletei lnki rps = _plSpot plmnt - fallback = _psFallback rps - test = _psLinkTest rps + fallback = _psLnkFallback rps + test = _psLnkTest rps (lnks,g) = runState (shuffle $ filter (test . snd) $ zip [0..] $ map (invShiftLinkBy $ _rmShift rm) $ _rmLinks rm) $ _randGen w - f x (PSLnk t s _) + f x (PSLnk t s _ _) | t x = uncurry PS $ s x f _ ps = ps invShiftLinkBy :: (Point2,Float) -> (Point2,Float) -> (Point2,Float) diff --git a/src/Dodge/LevelGen/Data.hs b/src/Dodge/LevelGen/Data.hs index c24e40b7b..8d39d5b86 100644 --- a/src/Dodge/LevelGen/Data.hs +++ b/src/Dodge/LevelGen/Data.hs @@ -5,6 +5,7 @@ import Dodge.Data import Picture import Geometry import Shape.Data +import Data.Tile import Control.Lens import Control.Monad.State @@ -33,10 +34,12 @@ data PSType = PutCrit {_unPutCrit :: Creature} -- maybe there is a monadic implementation of this? data PlacementSpot = PS { _psPos :: Point2 , _psRot :: Float } - | PSLnk { _psLinkTest :: (Point2,Float) -> Bool - , _psLinkShift :: (Point2,Float) -> (Point2,Float) - , _psFallback :: Maybe Placement - } + | PSLnk + { _psLnkTest :: (Point2,Float) -> Bool + , _psLnkShift :: (Point2,Float) -> (Point2,Float) + , _psLnkRoomEff :: (Point2,Float) -> Room -> Room + , _psLnkFallback :: Maybe Placement + } | PSRoomRand { _psRoomRandPointNum :: Int } data Placement = Placement { _plSpot :: PlacementSpot @@ -48,11 +51,11 @@ data Placement = Placement | RandomPlacement {_unRandomPlacement :: State StdGen Placement} anyLnkOutPS :: PlacementSpot -anyLnkOutPS = PSLnk (const True) id Nothing +anyLnkOutPS = PSLnk (const True) id (const id) Nothing anyLnkInPS :: Float -- ^ amount to shift inward -> PlacementSpot -anyLnkInPS x = PSLnk (const True) f Nothing +anyLnkInPS x = PSLnk (const True) f (const id) Nothing where f (v,a) = (v -.- x *.* unitVectorAtAngle (a + 0.5 * pi), a+ pi) @@ -104,6 +107,42 @@ addPlmnt pl pl2 = case pl2 of g Nothing = Just pl g (Just pl') = Just $ addPlmnt pl pl' +{- +The '_rmPolys' list states which polygons should be cut out to form the indestructible walls of the room. +Link pairs contain a position and rotation to attach to another room; +0 is for links going to another room to the north, pi/2 for links going to a room to the west, etc. +TODO : Explain path, does it need both directions? +Placement spots allow things to be put in the room during level generation. +Room bounds between a new room and previously placed rooms are checked during level generation, +assigning no bounds will allow rooms to overlap. + -} +data Room = Room + { _rmPolys :: [ [Point2] ] + , _rmLinks :: [(Point2,Float)] + , _rmPos :: [RoomPos] + , _rmPath :: [(Point2, Point2)] + , _rmPmnts :: [Placement] + , _rmPartPmnt :: Maybe ([Placement] -> Placement) + , _rmExtPmnt :: Maybe Placement + , _rmBound :: [ [Point2] ] + , _rmFloor :: [Tile] + , _rmName :: String + , _rmShift :: (Point2, Float) + , _rmViewpoints :: [Point2] + , _rmRandPSs :: [State StdGen (Point2,Float)] + , _rmLabel :: Maybe Int + , _rmTakeFrom :: Maybe Int + , _rmWires :: [RoomWire] + } +data RoomWire + = RoomWire (Point2,Float) (Point2,Float) +data RoomPos + = OutLink Int Point2 Float + | InLink Point2 Float + | PosPl Point2 Float + | LabPos Int RoomPos + deriving (Eq,Ord,Show) +makeLenses ''Room makeLenses ''PSType makeLenses ''PlacementSpot makeLenses ''Placement diff --git a/src/Dodge/Placements/Button.hs b/src/Dodge/Placements/Button.hs index 930d8be60..1674403e6 100644 --- a/src/Dodge/Placements/Button.hs +++ b/src/Dodge/Placements/Button.hs @@ -38,5 +38,5 @@ putLitButtonID' col f subpl where changeLight lsid = lightSources . ix lsid . lsIntensity .~ V3 0 0.5 0 ls = defaultLS { _lsRad = 75 , _lsIntensity = V3 0.5 0 0 } - thePS = PSLnk f id Nothing + thePS = PSLnk f id (const id) Nothing diff --git a/src/Dodge/Placements/LightSource.hs b/src/Dodge/Placements/LightSource.hs index 3d926e072..afcc125a5 100644 --- a/src/Dodge/Placements/LightSource.hs +++ b/src/Dodge/Placements/LightSource.hs @@ -27,9 +27,6 @@ mntLSOn shapeF mcol ls wallp lsp@(V3 lx ly _) V2 x y = rotateV 1 . (0.1 *.*) . normalizeV $ wallp -.- V2 lx ly setCol = maybe id colorSH mcol -redMID :: (Maybe Color -> LightSource -> Point2 -> Point3 -> (Int -> Maybe Placement) -> Placement) - -> Point2 -> Point3 -> Placement -redMID f wallp lampp = f Nothing defaultLS wallp lampp (const Nothing) iShape :: Point2 -> Point3 -> Shape iShape wp (V3 x y z) = thinHighBar z wp (V2 x y) @@ -80,17 +77,17 @@ vShape wallpos (V3 x y z) = wallposDown = wallpos -.- n mntLS :: (Point2 -> Point3 -> Shape) -> Point2 -> Point3 -> Placement -mntLS shp = redMID $ mntLSOn shp +mntLS shp wallp lampp = mntLSOn shp Nothing defaultLS wallp lampp (const Nothing) mntLSCond :: (Point2 -> Point3 -> Shape) -> ((Point2,Float) -> Bool) -> Placement -mntLSCond shp cond = updatePSToLevel 2 (const $ PSLnk cond id Nothing) - $ redMID (mntLSOn shp) 0 (V3 0 (-40) 40) +mntLSCond shp cond = updatePSToLevel 2 (const $ PSLnk cond id (const id) Nothing) + $ mntLS shp 0 (V3 0 (-40) 40) -- note that this perhaps pushes the vshape light out too far mntLight :: Point2 -> Point2 -> Placement mntLight a b = RandomPlacement $ do shp <- takeOne [vShape,iShape,lShape,jShape,liShape] - return $ redMID (mntLSOn shp) a (addZ 50 b) + return $ mntLS shp a (addZ 50 b) mntLightLnkCond :: ((Point2,Float) -> Bool) -> Placement mntLightLnkCond f = RandomPlacement $ do diff --git a/src/Dodge/Placements/Wall.hs b/src/Dodge/Placements/Wall.hs index dc76d267f..e8aa529db 100644 --- a/src/Dodge/Placements/Wall.hs +++ b/src/Dodge/Placements/Wall.hs @@ -5,7 +5,6 @@ import Color import Geometry import Dodge.LevelGen.Data import Dodge.Default.Wall -import Dodge.Room.Data import Data.List import Control.Lens diff --git a/src/Dodge/Room.hs b/src/Dodge/Room.hs index 9d6bef056..a028afe83 100644 --- a/src/Dodge/Room.hs +++ b/src/Dodge/Room.hs @@ -4,7 +4,7 @@ Specification of individual rooms. module Dodge.Room ( module Dodge.Room.Room , module Dodge.Room.Foreground - , module Dodge.Room.Data + , module Dodge.LevelGen.Data , module Dodge.Room.Procedural , module Dodge.Room.Corridor , module Dodge.Room.Link @@ -26,7 +26,7 @@ import Dodge.Room.RoadBlock import Dodge.Room.Teleport import Dodge.Room.Branch import Dodge.Room.Foreground -import Dodge.Room.Data +import Dodge.LevelGen.Data import Dodge.Room.Procedural import Dodge.Room.Corridor import Dodge.Room.Link diff --git a/src/Dodge/Room/AddTile.hs b/src/Dodge/Room/AddTile.hs deleted file mode 100644 index a310f0a12..000000000 --- a/src/Dodge/Room/AddTile.hs +++ /dev/null @@ -1,17 +0,0 @@ -module Dodge.Room.AddTile - where -import Dodge.Room.Data -import Tile -import Geometry - -import Control.Lens -import Data.List -import Data.Function - -addTile :: Float -> Room -> Room -addTile z r - | not (null (_rmFloor r)) || null rp = r - | otherwise = r & rmFloor .~ [makeTileFromPoly poly z] - where - rp = _rmPolys r - poly = orderPolygon . convexHullSafe . nubBy ((==) `on` roundPoint2) $ concat rp diff --git a/src/Dodge/Room/Airlock.hs b/src/Dodge/Room/Airlock.hs index 4701cde5c..11eb9bb78 100644 --- a/src/Dodge/Room/Airlock.hs +++ b/src/Dodge/Room/Airlock.hs @@ -1,7 +1,6 @@ {-# LANGUAGE TupleSections #-} {- Rooms that contain two doors and a switch alternating both. -} module Dodge.Room.Airlock where -import Dodge.Room.Data import Dodge.Placements import Dodge.Room.Foreground import Dodge.Default.Room diff --git a/src/Dodge/Room/Boss.hs b/src/Dodge/Room/Boss.hs index 473f25bf6..1ec9f9796 100644 --- a/src/Dodge/Room/Boss.hs +++ b/src/Dodge/Room/Boss.hs @@ -4,12 +4,12 @@ module Dodge.Room.Boss import Dodge.Data import Dodge.Default.Room import Dodge.Placements -import Dodge.Room.Data +import Dodge.LevelGen.Data import Dodge.Room.Procedural import Dodge.Room.Link import Dodge.Room.Corridor import Dodge.Room.Path -import Dodge.LevelGen.Data +--import Dodge.LevelGen.Data import Dodge.Creature import Dodge.Creature.State.Data import Dodge.RandomHelp diff --git a/src/Dodge/Room/Branch.hs b/src/Dodge/Room/Branch.hs index 2324a6c44..249008b26 100644 --- a/src/Dodge/Room/Branch.hs +++ b/src/Dodge/Room/Branch.hs @@ -4,7 +4,7 @@ Collections of rooms that branch into multiple paths. module Dodge.Room.Branch where --import Geometry -import Dodge.Room.Data +import Dodge.LevelGen.Data import Dodge.Room.Door import Dodge.Room.Link import Dodge.Room.Procedural diff --git a/src/Dodge/Room/CheckConsistency.hs b/src/Dodge/Room/CheckConsistency.hs index 1d1127fcd..d76fa9224 100644 --- a/src/Dodge/Room/CheckConsistency.hs +++ b/src/Dodge/Room/CheckConsistency.hs @@ -1,6 +1,6 @@ module Dodge.Room.CheckConsistency where -import Dodge.Room.Data +import Dodge.LevelGen.Data import Dodge.Graph linksOnPath :: Room -> Bool diff --git a/src/Dodge/Room/Corridor.hs b/src/Dodge/Room/Corridor.hs index 22bd3339f..9886fad2a 100644 --- a/src/Dodge/Room/Corridor.hs +++ b/src/Dodge/Room/Corridor.hs @@ -1,6 +1,6 @@ module Dodge.Room.Corridor where -import Dodge.Room.Data +import Dodge.LevelGen.Data --import Dodge.Room.Foreground import Dodge.Default.Room --import Dodge.LevelGen.Data @@ -29,26 +29,6 @@ corridor = defaultRoom ,((20,70), negate $ pi/6) ,((20,10) ,pi) ] -{- | Debug drop-in copy of corridor -} -corridorDebug :: Room -corridorDebug = defaultRoom - { _rmPolys = - [ rectNSWE 80 0 0 40 - --, [ (0,0), (0,200) , (200,100)] - --, [ (0,0), (0,20) , (20,10)] - ] - , _rmLinks = lnks - , _rmPath = concatMap (doublePair . (,) (V2 20 60) . fst) lnks - , _rmPmnts = [] - , _rmBound = [ rectNSWE 50 30 0 40 ] - } - where - lnks = map (first toV2) - [((20,70) ,0) - ,((20,70), pi/6) - ,((20,70), negate $ pi/6) - ,((20,10) ,pi) - ] corridorN :: Room corridorN = defaultRoom { _rmPolys = [rectNSWE 80 0 0 40 diff --git a/src/Dodge/Room/Data.hs b/src/Dodge/Room/Data.hs deleted file mode 100644 index 9b23c0de1..000000000 --- a/src/Dodge/Room/Data.hs +++ /dev/null @@ -1,45 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE StrictData #-} -module Dodge.Room.Data - where -import Dodge.LevelGen.Data -import Geometry.Data -import Data.Tile - -import Control.Monad.State -import System.Random -import Control.Lens ---import qualified Data.IntMap.Strict as IM -{- -The '_rmPolys' list states which polygons should be cut out to form the indestructible walls of the room. -Link pairs contain a position and rotation to attach to another room; -0 is for links going to another room to the north, pi/2 for links going to a room to the west, etc. -TODO : Explain path, does it need both directions? -Placement spots allow things to be put in the room during level generation. -Room bounds between a new room and previously placed rooms are checked during level generation, -assigning no bounds will allow rooms to overlap. - -} -data Room = Room - { _rmPolys :: [ [Point2] ] - , _rmLinks :: [(Point2,Float)] - , _rmPos :: [RoomPos] - , _rmPath :: [(Point2, Point2)] - , _rmPmnts :: [Placement] - , _rmPartialPmnt :: Maybe ([Placement] -> Placement) - , _rmExtendedPmnt :: Maybe Placement - , _rmBound :: [ [Point2] ] - , _rmFloor :: [Tile] - , _rmName :: String - , _rmShift :: (Point2, Float) - , _rmViewpoints :: [Point2] - , _rmRandPSs :: [State StdGen (Point2,Float)] - , _rmLabel :: Maybe Int - , _rmTakeFrom :: Maybe Int - } -data RoomPos - = OutLink Int Point2 Float - | InLink Point2 Float - | PosInt Int Point2 Float - | PosPl Point2 Float - deriving (Eq,Ord,Show) -makeLenses ''Room diff --git a/src/Dodge/Room/Door.hs b/src/Dodge/Room/Door.hs index 89d0bd922..d18824d1f 100644 --- a/src/Dodge/Room/Door.hs +++ b/src/Dodge/Room/Door.hs @@ -3,7 +3,6 @@ module Dodge.Room.Door where import Geometry import Dodge.Data -import Dodge.Room.Data import Dodge.Default.Room import Dodge.Placements import Color @@ -32,7 +31,7 @@ switchDoorRoom = defaultRoom { _rmPolys = [rectNSWE 40 0 0 40] , _rmLinks = lnks , _rmPath = [(V2 20 35,V2 20 5)] - , _rmPartialPmnt = Just f + , _rmPartPmnt = Just f -- door extends into side walls (for shadows as rendered 12/03) -- note no bounds } diff --git a/src/Dodge/Room/Foreground.hs b/src/Dodge/Room/Foreground.hs index 56cf80ce0..7b714d18e 100644 --- a/src/Dodge/Room/Foreground.hs +++ b/src/Dodge/Room/Foreground.hs @@ -1,11 +1,8 @@ --{-# LANGUAGE TupleSections #-} module Dodge.Room.Foreground where ---import Dodge.Picture ---import Dodge.Base import Picture import Geometry ---import Geometry.Data import Geometry.Vector3D import Shape import Quaternion diff --git a/src/Dodge/Room/Link.hs b/src/Dodge/Room/Link.hs index 409ad7463..177c292d1 100644 --- a/src/Dodge/Room/Link.hs +++ b/src/Dodge/Room/Link.hs @@ -16,7 +16,7 @@ module Dodge.Room.Link , setLastLinkToUsed ) where import Dodge.LevelGen -import Dodge.Room.Data +import Dodge.LevelGen.Data import Dodge.RandomHelp import Geometry import Data.Tile diff --git a/src/Dodge/Room/Listed.hs b/src/Dodge/Room/Listed.hs deleted file mode 100644 index 81baa7a93..000000000 --- a/src/Dodge/Room/Listed.hs +++ /dev/null @@ -1,7 +0,0 @@ -module Dodge.Room.Listed - ( roomList - ) where -import Dodge.Room.Data - -roomList :: [Room] -roomList = [] diff --git a/src/Dodge/Room/LockAndKeyList.hs b/src/Dodge/Room/LockAndKeyList.hs index 8c06426fe..33cef4b8b 100644 --- a/src/Dodge/Room/LockAndKeyList.hs +++ b/src/Dodge/Room/LockAndKeyList.hs @@ -1,6 +1,6 @@ module Dodge.Room.LockAndKeyList where -import Dodge.Room.Data +import Dodge.LevelGen.Data import Dodge.Room.RoadBlock import Dodge.Room.Boss diff --git a/src/Dodge/Room/LongDoor.hs b/src/Dodge/Room/LongDoor.hs index 3556ffe32..f1ed9bfe2 100644 --- a/src/Dodge/Room/LongDoor.hs +++ b/src/Dodge/Room/LongDoor.hs @@ -5,12 +5,12 @@ module Dodge.Room.LongDoor where import Dodge.Data import Dodge.Default.Room -import Dodge.Room.Data +import Dodge.LevelGen.Data import Dodge.Placements import Dodge.Room.Link import Dodge.Room.Procedural --import Dodge.Layout.Tree.Either -import Dodge.LevelGen.Data +--import Dodge.LevelGen.Data import Dodge.LevelGen.Switch import Dodge.RandomHelp import Dodge.Creature.Inanimate diff --git a/src/Dodge/Room/NoNeedWeapon.hs b/src/Dodge/Room/NoNeedWeapon.hs index 6e4e770e2..00004744c 100644 --- a/src/Dodge/Room/NoNeedWeapon.hs +++ b/src/Dodge/Room/NoNeedWeapon.hs @@ -6,11 +6,11 @@ import Dodge.Data import Dodge.Creature import Dodge.Creature.State.Data --import Dodge.Creature.Inanimate -import Dodge.Room.Data +import Dodge.LevelGen.Data import Dodge.Room.Procedural import Dodge.Room.Link import Dodge.RandomHelp -import Dodge.LevelGen.Data +--import Dodge.LevelGen.Data import Geometry.Data import Control.Lens diff --git a/src/Dodge/Room/Path.hs b/src/Dodge/Room/Path.hs index ddb3f5289..029f575bd 100644 --- a/src/Dodge/Room/Path.hs +++ b/src/Dodge/Room/Path.hs @@ -5,7 +5,7 @@ module Dodge.Room.Path , createPathGrid ) where -import Dodge.Room.Data +import Dodge.LevelGen.Data import Dodge.LevelGen.StaticWalls import Geometry diff --git a/src/Dodge/Room/Procedural.hs b/src/Dodge/Room/Procedural.hs index 91d7b75a4..ae4406958 100644 --- a/src/Dodge/Room/Procedural.hs +++ b/src/Dodge/Room/Procedural.hs @@ -11,7 +11,6 @@ module Dodge.Room.Procedural ) where import Dodge.Data import Dodge.Default.Wall -import Dodge.Room.Data import Dodge.Placements import Dodge.Room.Link import Dodge.Room.Path diff --git a/src/Dodge/Room/RoadBlock.hs b/src/Dodge/Room/RoadBlock.hs index 6d634cff9..0d97ae438 100644 --- a/src/Dodge/Room/RoadBlock.hs +++ b/src/Dodge/Room/RoadBlock.hs @@ -2,14 +2,13 @@ module Dodge.Room.RoadBlock where import Geometry ---import Dodge.Data import Dodge.Default.Room -import Dodge.Room.Data +import Dodge.LevelGen.Data import Dodge.Room.Link import Dodge.Placements import Dodge.Room.Corridor import Dodge.Room.Furniture -import Dodge.LevelGen.Data +--import Dodge.LevelGen.Data --import Dodge.Default.Wall --import Dodge.RandomHelp import Dodge.Creature diff --git a/src/Dodge/Room/Room.hs b/src/Dodge/Room/Room.hs index 9194a2c8b..2d10b4627 100644 --- a/src/Dodge/Room/Room.hs +++ b/src/Dodge/Room/Room.hs @@ -10,7 +10,7 @@ import Dodge.Default.Wall import Dodge.Layout.Tree.Polymorphic import Dodge.Layout.Tree.Either import Dodge.Placements -import Dodge.Room.Data +--import Dodge.LevelGen.Data import Dodge.Room.Procedural import Dodge.Room.Corridor import Dodge.Room.Link diff --git a/src/Dodge/Room/Start.hs b/src/Dodge/Room/Start.hs index 6ee0541b4..02dbd95de 100644 --- a/src/Dodge/Room/Start.hs +++ b/src/Dodge/Room/Start.hs @@ -1,5 +1,5 @@ module Dodge.Room.Start where -import Dodge.Room.Data +import Dodge.LevelGen.Data import Dodge.Room.Door import Dodge.Room.Link import Dodge.Room.Procedural @@ -7,7 +7,7 @@ import Dodge.Room.Foreground import Dodge.Room.Furniture import Dodge.Placements import Dodge.Layout.Tree.Polymorphic -import Dodge.LevelGen.Data +--import Dodge.LevelGen.Data import Geometry.Data import Color import Shape @@ -25,13 +25,8 @@ startRoom :: RandomGen g => State g (Tree (Either Room Room)) startRoom = do w <- state $ randomR (100,400) h <- state $ randomR (200,400) - let fground = sPS (V2 0 0) 0 $ PutForeground $ - girderV 40 20 10 (V2 0 (h/2)) (V2 w (h/2)) - treeFromPost [Left rezBox, Left door] . Right - <$> randomiseOutLinks (shiftRoomBy (V2 (-20) (-20),0) - $ roomRectAutoLinks w h & rmPmnts %~ - ( - [ fground + let plmnts = + [ sPS (V2 0 0) 0 $ PutForeground $ girderV 40 20 10 (V2 0 (h/2)) (V2 w (h/2)) , mntLS jShape (V2 0 (h/3)) (V3 40 (h/3) 70) , tankSquareEmboss4 (dim orange) 50 (h-60) , tankSquare (dim orange) 50 50 @@ -39,6 +34,9 @@ startRoom = do , lightSensor (V2 (0.8*w) (0.25*h)) 0 , putLasTurret & plSpot .~ PS (V2 (0.8*w) (0.8*h)) 0 , sps0 $ PutForeground $ colorSH orange $ pipePP 2 (V3 50 50 25) (V3 50 120 25) - ] ++ - ) + ] + treeFromPost [Left rezBox, Left door] . Right + <$> randomiseOutLinks + (shiftRoomBy (V2 (-20) (-20),0) + $ roomRectAutoLinks w h & rmPmnts %~ (plmnts ++) ) diff --git a/src/Dodge/Room/Teleport.hs b/src/Dodge/Room/Teleport.hs index f72c43b6d..990dd4823 100644 --- a/src/Dodge/Room/Teleport.hs +++ b/src/Dodge/Room/Teleport.hs @@ -3,10 +3,10 @@ module Dodge.Room.Teleport where import Dodge.Data import Dodge.Base -import Dodge.Room.Data +import Dodge.LevelGen.Data import Dodge.Room.Procedural import Dodge.Placements -import Dodge.LevelGen.Data +--import Dodge.LevelGen.Data import Geometry import Picture import Dodge.WorldEvent.Explosion diff --git a/src/Dodge/Room/Treasure.hs b/src/Dodge/Room/Treasure.hs index 010df93e8..56b7225ac 100644 --- a/src/Dodge/Room/Treasure.hs +++ b/src/Dodge/Room/Treasure.hs @@ -5,7 +5,6 @@ Typically dead ends. module Dodge.Room.Treasure where import Dodge.Data -import Dodge.Room.Data import Dodge.Placements import Dodge.Default.Room import Dodge.LevelGen.Data