From 169ed7d05dcbacab4903e761eecc5b2fb09a2d9e Mon Sep 17 00:00:00 2001 From: justin Date: Sat, 13 Nov 2021 11:13:34 +0000 Subject: [PATCH] Working inter-room placements --- src/Dodge/Floor.hs | 7 +++++++ src/Dodge/Layout.hs | 20 ++++++++++++-------- src/Dodge/LevelGen/Data.hs | 3 +++ src/Dodge/Placements/Button.hs | 9 +++++++++ src/Dodge/Room/Data.hs | 2 +- src/Dodge/Room/Door.hs | 17 ++++++++++++----- 6 files changed, 44 insertions(+), 14 deletions(-) diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs index 2b6a50e23..f3633469e 100644 --- a/src/Dodge/Floor.hs +++ b/src/Dodge/Floor.hs @@ -10,11 +10,13 @@ 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 import Dodge.Layout.Tree.Annotate @@ -24,6 +26,7 @@ import Dodge.LevelGen.Data import Dodge.Item.Weapon.Launcher import MonadHelp import Data.Tree +import Color import Control.Lens import Control.Monad.State @@ -35,6 +38,10 @@ import Data.Maybe initialAnoTree :: RandomGen g => Tree [Annotation g] initialAnoTree = padSucWithCorridors $ treeFromTrunk [[StartRoom] + ,[SetLabel 0 $ return $ roomRectAutoLinks 100 100 + & rmExtendedPmnt .~ Just (externalButton red (PS (V2 50 50) 0)) + ] + ,[UseLabel 0 $ return switchDoorRoom] ,[SpecificRoom $ return $ connectRoom lasTunnel ] ,[SpecificRoom $ fmap connectRoom slowDoorRoom ] ,[Corridor] diff --git a/src/Dodge/Layout.hs b/src/Dodge/Layout.hs index d384c34c8..e4417855e 100644 --- a/src/Dodge/Layout.hs +++ b/src/Dodge/Layout.hs @@ -1,11 +1,12 @@ --{-# LANGUAGE TupleSections #-} module Dodge.Layout ( generateLevelFromRoomList - , doPartialPlacements - , doExtendedPlacements +-- , doPartialPlacements +-- , doExtendedPlacements ) where import Dodge.Data import Dodge.LevelGen +import Dodge.LevelGen.Data import Dodge.LevelGen.StaticWalls import Dodge.LevelGen.Pathing import Dodge.Wall.Zone @@ -34,6 +35,8 @@ generateLevelFromRoomList :: [Room] -> World -> World generateLevelFromRoomList gr w = initWallZoning . setupWorldBounds + . doPartialPlacements rs + . doExtendedPlacements rs . flip (foldl' doRoomPlacements) rs $ w { _walls = wallsFromRooms rs , _floorTiles = floorsFromRooms rs @@ -47,25 +50,26 @@ generateLevelFromRoomList gr w rs = zipWith addTile zs gr zs = map fromIntegral $ randomRs (0,63::Int) $ _randGen w -doPartialPlacements :: [Room] -> (IM.IntMap Int,World) -> World +doPartialPlacements :: [Room] -> (IM.IntMap [Placement],World) -> World doPartialPlacements rms (im,w) = foldr (doPartialPlacement im) w rms -doPartialPlacement :: IM.IntMap Int -> Room -> World -> World +doPartialPlacement :: IM.IntMap [Placement] -> Room -> World -> World doPartialPlacement im rm w = case _rmPartialPmnt rm of Nothing -> w Just fi -> case _rmTakeFrom rm of Nothing -> w Just i -> fst $ fst $ placeSpot (w,rm) (fi (im IM.! i)) -doExtendedPlacements :: [Room] -> World -> (IM.IntMap Int, World) +doExtendedPlacements :: [Room] -> World -> (IM.IntMap [Placement], World) doExtendedPlacements rms w = foldr doExtendedPlacement (IM.empty,w) rms -doExtendedPlacement :: Room -> (IM.IntMap Int, World) -> (IM.IntMap Int, World) +doExtendedPlacement :: Room -> (IM.IntMap [Placement], World) -> (IM.IntMap [Placement], World) doExtendedPlacement rm (im,w) = case _rmExtendedPmnt rm of Nothing -> (im,w) - Just _ -> case _rmLabel rm of + Just plmnt -> case _rmLabel rm of Nothing -> (im,w) - Just i -> undefined + Just i -> let ((neww,_),plmnts) = placeSpot (w,rm) plmnt + in (IM.insert i plmnts im, neww) doRoomPlacements :: World -> Room -> World doRoomPlacements w rm = fst $ foldl' (\wr -> fst . placeSpot wr) (w,rm) $ _rmPmnts rm diff --git a/src/Dodge/LevelGen/Data.hs b/src/Dodge/LevelGen/Data.hs index da8f91937..5eaa67e41 100644 --- a/src/Dodge/LevelGen/Data.hs +++ b/src/Dodge/LevelGen/Data.hs @@ -52,6 +52,9 @@ spNoID ps pst = Placement ps pst Nothing (const Nothing) pContID :: PlacementSpot -> PSType -> (Int -> Maybe Placement) -> Placement pContID ps pt = Placement ps pt Nothing . intPlPlPl +plCont :: PlacementSpot -> PSType -> (Placement -> Maybe Placement) -> Placement +plCont ps pt = Placement ps pt Nothing + sPS :: Point2 -> Float -> PSType -> Placement sPS p a pt = Placement (PS p a) pt Nothing (const Nothing) diff --git a/src/Dodge/Placements/Button.hs b/src/Dodge/Placements/Button.hs index 6b0aa386c..236d00fc2 100644 --- a/src/Dodge/Placements/Button.hs +++ b/src/Dodge/Placements/Button.hs @@ -12,6 +12,14 @@ import Dodge.Placements.Spot import Control.Lens +externalButton :: Color -> PlacementSpot -> Placement +externalButton col ps = pContID ps (PutTrigger (const False)) + $ \trigid -> Just $ pContID ps (PutButton (makeSwitch col col (oneff trigid) (offeff trigid))) + (const Nothing) + where + oneff tid = triggers . ix tid .~ const True + offeff tid = triggers . ix tid .~ const False + putLitButtonID :: Color -> Point2 -> Float -> (Int -> Maybe Placement) -> Placement putLitButtonID col p a subpl = mountLightAID (Just col) ls p'' (addZ 40 p') $ \lsid -> jps0 (PutButton (makeButton col (changeLight lsid)) {_btPos = p, _btRot = a}) @@ -31,3 +39,4 @@ putLitButtonID' col f subpl 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 + diff --git a/src/Dodge/Room/Data.hs b/src/Dodge/Room/Data.hs index 96faae584..9b23c0de1 100644 --- a/src/Dodge/Room/Data.hs +++ b/src/Dodge/Room/Data.hs @@ -25,7 +25,7 @@ data Room = Room , _rmPos :: [RoomPos] , _rmPath :: [(Point2, Point2)] , _rmPmnts :: [Placement] - , _rmPartialPmnt :: Maybe (Int -> Placement) + , _rmPartialPmnt :: Maybe ([Placement] -> Placement) , _rmExtendedPmnt :: Maybe Placement , _rmBound :: [ [Point2] ] , _rmFloor :: [Tile] diff --git a/src/Dodge/Room/Door.hs b/src/Dodge/Room/Door.hs index 4629d0efa..89d0bd922 100644 --- a/src/Dodge/Room/Door.hs +++ b/src/Dodge/Room/Door.hs @@ -2,12 +2,16 @@ module Dodge.Room.Door where import Geometry +import Dodge.Data import Dodge.Room.Data import Dodge.Default.Room import Dodge.Placements ---import Color +import Color ---import qualified Data.IntMap.Strict as IM +import Data.Maybe +import qualified Data.IntMap.Strict as IM +import Dodge.LevelGen.Data +import Control.Lens door :: Room door = defaultRoom @@ -23,12 +27,12 @@ door = defaultRoom ,(V2 20 5,pi) ] - -switchDoor :: Room -switchDoor = defaultRoom +switchDoorRoom :: Room +switchDoorRoom = defaultRoom { _rmPolys = [rectNSWE 40 0 0 40] , _rmLinks = lnks , _rmPath = [(V2 20 35,V2 20 5)] + , _rmPartialPmnt = Just f -- door extends into side walls (for shadows as rendered 12/03) -- note no bounds } @@ -36,4 +40,7 @@ switchDoor = defaultRoom lnks = [(V2 20 35,0) ,(V2 20 5,pi) ] + f (pmnt:_) = putDoubleDoor False red (cond pmnt) (V2 0 20) (V2 40 20) 2 + f _ = error "tried to put a door using an empty placement list" + cond pmnt w = w & _triggers w IM.! fromJust (_plMID pmnt)