From 027b4b7d8b50af116cb4332577bd10cc69278299 Mon Sep 17 00:00:00 2001 From: justin Date: Wed, 9 Mar 2022 22:14:34 +0000 Subject: [PATCH] Add explicit door position field --- src/Dodge/Data.hs | 5 +++- src/Dodge/Default/Room.hs | 2 +- src/Dodge/LevelGen/Data.hs | 2 +- src/Dodge/LockAndKey.hs | 10 ++++---- src/Dodge/Placement/Instance/Door.hs | 9 ++++--- src/Dodge/Placement/PlaceSpot/TriggerDoor.hs | 15 +++++++++-- src/Dodge/Room/GlassLesson.hs | 26 +++++++++----------- src/Dodge/Room/LasTurret.hs | 2 +- src/Dodge/Room/LongDoor.hs | 2 +- src/Dodge/Room/LongRoom.hs | 2 +- src/Dodge/Room/RezBox.hs | 8 +++--- src/Dodge/Room/RunPast.hs | 2 +- src/Dodge/Tree/Shift.hs | 4 +-- src/Dodge/Wall/Move.hs | 1 + 14 files changed, 53 insertions(+), 37 deletions(-) diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index d6a8577ac..7689bdfe0 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -123,7 +123,7 @@ data World = World , _inventoryMode :: InventoryMode , _distortions :: [Distortion] , _worldBounds :: Bounds - , _gameRooms :: [GameRoom] -- consider using and IntMap + , _gameRooms :: [GameRoom] -- consider using an IntMap , _maybeWorld :: Maybe' World , _rewindWorlds :: [World] , _timeFlow :: TimeFlowStatus @@ -739,6 +739,9 @@ data Door = Door , _drStatus :: DoorStatus , _drTrigger :: World -> Bool , _drMech :: Door -> World -> World + , _drPos :: Point2 + , _drOpenPos :: Point2 + , _drClosePos :: Point2 } data DoorStatus = DoorOpen | DoorClosed | DoorHalfway | DoorInt Int deriving (Eq, Ord, Show) diff --git a/src/Dodge/Default/Room.hs b/src/Dodge/Default/Room.hs index 4ea9b5b01..de56cb16e 100644 --- a/src/Dodge/Default/Room.hs +++ b/src/Dodge/Default/Room.hs @@ -25,7 +25,7 @@ defaultRoom = Room , _rmTakeFrom = Nothing , _rmStartWires = IM.empty , _rmEndWires = IM.empty - , _rmConnectsTo = S.singleton OutLink + , _rmConnectsTo = S.member OutLink , _rmMID = Nothing , _rmMParent = Nothing , _rmChildren = [] diff --git a/src/Dodge/LevelGen/Data.hs b/src/Dodge/LevelGen/Data.hs index 83e70cafe..fee8a273c 100644 --- a/src/Dodge/LevelGen/Data.hs +++ b/src/Dodge/LevelGen/Data.hs @@ -89,7 +89,7 @@ data Room = Room , _rmTakeFrom :: Maybe Int , _rmStartWires :: IM.IntMap RoomWire , _rmEndWires :: IM.IntMap RoomWire - , _rmConnectsTo :: S.Set RoomLinkType + , _rmConnectsTo :: (S.Set RoomLinkType -> Bool) , _rmMID :: Maybe Int , _rmMParent :: Maybe Int , _rmChildren :: [Int] diff --git a/src/Dodge/LockAndKey.hs b/src/Dodge/LockAndKey.hs index 4728a9124..e53eb9ddd 100644 --- a/src/Dodge/LockAndKey.hs +++ b/src/Dodge/LockAndKey.hs @@ -14,11 +14,11 @@ import Control.Monad.State lockRoomKeyItems :: RandomGen g => [ (Int -> State g (SubCompTree Room) , State g CombineType ) ] lockRoomKeyItems = - [(lasCenSensEdge, takeOne [LAUNCHER,LASGUN,SPARKGUN,FLATSHIELD] ) - ,(const slowDoorRoomRunPast, return MINIGUN) - ,(const longRoomRunPast, takeOne [SNIPERRIFLE,FLATSHIELD]) - ,(const glassLessonRunPast, takeOne [LASGUN]) - ,(const $ lasTunnelRunPast 400, return FLATSHIELD) +-- [(lasCenSensEdge, takeOne [LAUNCHER,LASGUN,SPARKGUN,FLATSHIELD] ) + [(const slowDoorRoomRunPast, return MINIGUN) +-- ,(const longRoomRunPast, takeOne [SNIPERRIFLE,FLATSHIELD]) +-- ,(const glassLessonRunPast, takeOne [LASGUN]) +-- ,(const $ lasTunnelRunPast 400, return FLATSHIELD) ] itemRooms :: RandomGen g => [(CombineType, State g (SubCompTree Room))] diff --git a/src/Dodge/Placement/Instance/Door.hs b/src/Dodge/Placement/Instance/Door.hs index 18f42d69f..ce5ce43a9 100644 --- a/src/Dodge/Placement/Instance/Door.hs +++ b/src/Dodge/Placement/Instance/Door.hs @@ -1,4 +1,9 @@ -module Dodge.Placement.Instance.Door where +module Dodge.Placement.Instance.Door + ( putDoubleDoor + , putAutoDoor + , putDoubleDoorThen + , switchDoor -- not used 9/3/22 + ) where import Dodge.Data import Dodge.Base import Color @@ -19,8 +24,6 @@ putDoubleDoorThen pathing col cond a b speed mayp = ps0j (PutSlideDr pathing col where half = 0.5 *.* (a +.+ b) - - putAutoDoor :: Point2 -> Point2 -> Placement putAutoDoor a b = PlacementUsingPos (addZ 0 a) $ \az -> PlacementUsingPos (addZ 0 b) diff --git a/src/Dodge/Placement/PlaceSpot/TriggerDoor.hs b/src/Dodge/Placement/PlaceSpot/TriggerDoor.hs index 903f3a567..cee00f94c 100644 --- a/src/Dodge/Placement/PlaceSpot/TriggerDoor.hs +++ b/src/Dodge/Placement/PlaceSpot/TriggerDoor.hs @@ -33,7 +33,12 @@ plDoor col cond pss gw = (drid, gw & gWorld .~ (addWalls w & doors %~ addDoor)) , _drStatus = DoorInt 0 , _drTrigger = cond , _drMech = doorMechanismStepwise nsteps drid wlids pss + , _drPos = openp + , _drOpenPos = openp + , _drClosePos = closep } + openp = 0.5 *.* uncurry (+.+) (head pss) + closep = 0.5 *.* uncurry (+.+) (last pss) nsteps = length pss - 1 wlids = take 4 [IM.newKey $ _walls w ..] wlps' = uncurry (rectanglePairs 9) $ head pss @@ -49,6 +54,7 @@ addDoorWall col pathableStatus w (wlid,wlps) = w & walls %~ IM.insert wlid defau , _wlPathable = pathableStatus } -- TODO use vector instead of list, perhaps also memoisation of rectanglePairs +-- TODO update _drPos -- perhaps also remove use of DoorInt in favour of DoorOpen/DoorClosed doorMechanismStepwise :: Int -> Int -> [Int] -> [(Point2,Point2)] -> Door -> World -> World doorMechanismStepwise nsteps drid wlids pss dr w @@ -72,14 +78,16 @@ doorMechanismStepwise nsteps drid wlids pss dr w doorMechanism :: Int -> Float -> [(Int,(Point2,Point2),(Point2,Point2))] -> Door -> World -> World doorMechanism drid speed wlidOpCps dr w | toOpen && dstatus /= DoorOpen = moveUpdate $ foldl' doOpen w wlidOpCps + & doors . ix drid . drPos %~ mvP speed (_drOpenPos dr) | not toOpen && dstatus /= DoorClosed = moveUpdate $ foldl' doClose w wlidOpCps + & doors . ix drid . drPos %~ mvP speed (_drClosePos dr) | otherwise = w where moveUpdate = playSound . setStatus playSound = soundContinue (WallSound drid) (fst cpos) slideDoorS (Just 1) setStatus - | dist (fst wlpos) (fst opos) < 1 = doors . ix drid . drStatus .~ DoorOpen - | dist (fst wlpos) (fst cpos) < 1 = doors . ix drid . drStatus .~ DoorClosed + | dist (_drPos dr) (_drOpenPos dr) < 1 = doors . ix drid . drStatus .~ DoorOpen + | dist (_drPos dr) (_drClosePos dr) < 1 = doors . ix drid . drStatus .~ DoorClosed | otherwise = doors . ix drid . drStatus .~ DoorHalfway (wlid',opos,cpos) = head wlidOpCps wlpos = _wlLine $ _walls w IM.! wlid' @@ -101,6 +109,9 @@ plSlideDoor isPathable col cond a b speed gw = (drid, gw & gWorld .~ (addWalls w , _drStatus = DoorClosed , _drTrigger = cond , _drMech = doorMechanism drid speed (zip3 wlids shiftedPairs pairs) + , _drPos = b + , _drOpenPos = shiftLeft b + , _drClosePos = b } addWalls w' = foldl' (addDoorWall col isPathable) w' $ zip wlids pairs pairs = rectanglePairs 9 a b diff --git a/src/Dodge/Room/GlassLesson.hs b/src/Dodge/Room/GlassLesson.hs index 1478ca23f..9aaa94b24 100644 --- a/src/Dodge/Room/GlassLesson.hs +++ b/src/Dodge/Room/GlassLesson.hs @@ -24,22 +24,20 @@ glassLesson = do i <- takeOne [1,2,3] corridors <- replicateM i $ PassDown <$> shuffleLinks corridor return $ Node (PassDown botRoom) - [ singleUseNone $ door & rmConnectsTo .~ S.singleton (LabLink 0) + [ singleUseNone $ door & rmConnectsTo .~ fromWest North 1 , uppers - , treeFromPost (PassDown (door & rmConnectsTo .~ S.singleton (OnEdge East)) + , treeFromPost (PassDown (door & rmConnectsTo .~ S.member (OnEdge East)) : corridors) $ UseAll door] where - uppers = Node (PassDown $ door & rmConnectsTo .~ S.singleton (LabLink 1)) - [singleUseNone $ setInLinksPD (onBottomEdgeLeft . fst) topRoom] - botRoom = set rmPmnts botplmnts $ roomRect 200 200 1 1 - & rmLinks %~ (setInLinksByType (OnEdge West) - . addLabelLink 0 (onTopEdgeRight . _rlPos) - . addLabelLink 1 (onTopEdgeLeft . _rlPos) - ) - onTopEdgeRight (V2 x y) = x > 50 && y > 95 - onTopEdgeLeft (V2 x y) = x < 50 && y > 95 - onBottomEdgeLeft (V2 x y) = x < 50 && y < 5 - topRoom = set rmPmnts topplmnts $ roomRect 200 200 1 1 + fromWest edge i s = S.member (OnEdge edge) s && S.member (FromWest i) s + uppers = Node (PassDown $ door & rmConnectsTo .~ fromWest North 0) + [singleUseNone topRoom] + botRoom = roomRect 200 200 1 1 + & rmPmnts .~ botplmnts + & rmLinks %~ setInLinksByType (OnEdge West) + topRoom = roomRect 200 200 1 1 + & rmPmnts .~ topplmnts + & rmLinks %~ setInLinks (fromWest South 0 . _rlType) botplmnts = [sPS (V2 0 0) 0 $ PutWall (rectNSWE 200 0 90 110) defaultCrystalWall ,sPS (V2 50 100) 0 $ PutCrit miniGunCrit @@ -59,4 +57,4 @@ glassLesson = do glassLessonRunPast :: RandomGen g => State g (SubCompTree Room) glassLessonRunPast = f <$> glassLesson where - f (Node r rs) = Node r $ return (UseLabel 0 $ door & rmConnectsTo .~ S.singleton (OnEdge West)) : rs + f (Node r rs) = Node r $ return (UseLabel 0 $ door & rmConnectsTo .~ S.member (OnEdge West)) : rs diff --git a/src/Dodge/Room/LasTurret.hs b/src/Dodge/Room/LasTurret.hs index 61b13ca32..fae928f03 100644 --- a/src/Dodge/Room/LasTurret.hs +++ b/src/Dodge/Room/LasTurret.hs @@ -123,5 +123,5 @@ lasTunnelRunPast y = do r2 <- takeOne [door,corridor] return $ Node (PassDown r) [ singleUseAll r1 - , return (UseLabel 0 $ r2 & rmConnectsTo .~ S.singleton InLink) + , return (UseLabel 0 $ r2 & rmConnectsTo .~ S.member InLink) ] diff --git a/src/Dodge/Room/LongDoor.hs b/src/Dodge/Room/LongDoor.hs index f57ee19a3..39b42672c 100644 --- a/src/Dodge/Room/LongDoor.hs +++ b/src/Dodge/Room/LongDoor.hs @@ -148,5 +148,5 @@ slowDoorRoomRunPast = do r <- slowDoorRoom return $ treeFromTrunk [PassDown door] $ Node (PassDown r) [ singleUseAll door - , return (UseLabel 0 $ door & rmConnectsTo .~ S.singleton InLink) + , return (UseLabel 0 $ door & rmConnectsTo .~ S.member InLink) ] diff --git a/src/Dodge/Room/LongRoom.hs b/src/Dodge/Room/LongRoom.hs index 9d8deafbb..b3b5496e5 100644 --- a/src/Dodge/Room/LongRoom.hs +++ b/src/Dodge/Room/LongRoom.hs @@ -54,7 +54,7 @@ longRoomRunPast = do (Node (PassDown r) [ singleUseAll door --, return (UseLabel 0 $ door & rmConnectsTo .~ S.singleton InLink) - , treeFromPost [PassDown $ corridor & rmConnectsTo .~ S.singleton InLink, PassDown corridor] + , treeFromPost [PassDown $ corridor & rmConnectsTo .~ S.member InLink, PassDown corridor] (UseLabel 0 door) ] ) diff --git a/src/Dodge/Room/RezBox.hs b/src/Dodge/Room/RezBox.hs index 6f95ceedd..aaca00daa 100644 --- a/src/Dodge/Room/RezBox.hs +++ b/src/Dodge/Room/RezBox.hs @@ -62,7 +62,7 @@ rezBoxesWp = do (Node (PassDown centralRoom) (rezrooms ++ [onwardpassage])) where adddoor rm = treeFromPost [PassDown $ connectsToNorth door ] (PassDown rm) - connectsToNorth = rmConnectsTo .~ S.singleton (OnEdge North) + connectsToNorth = rmConnectsTo .~ S.member (OnEdge North) maybeBlockedPassage :: RandomGen g => State g (SubCompTree Room) maybeBlockedPassage = fmap singleUseAll $ join $ takeOne [return corridor, blockedCorridorCloseBlocks] rezBoxesWpCrit :: RandomGen g => State g (SubCompTree Room) @@ -75,7 +75,7 @@ rezBoxesWpCrit = do aroom = rezInvBox thecol let centralRoom = (roomRectAutoLinks w h) {_rmPmnts = []} onwardpassage <- - applyToCompRoot (rmConnectsTo .~ S.singleton (OnEdge West)) <$> maybeBlockedPassage + applyToCompRoot (rmConnectsTo .~ S.member (OnEdge West)) <$> maybeBlockedPassage let n = length $ filter bottomEdgeTest $ map lnkPosDir $ _rmLinks centralRoom i <- state $ randomR (0,n-3) j <- state $ randomR (i,n-2) @@ -88,7 +88,7 @@ rezBoxesWpCrit = do ] (Node (PassDown centralRoom) (rezrooms ++ [onwardpassage])) where - adddoor rm = treeFromPost [PassDown $ door & rmConnectsTo .~ S.singleton (OnEdge North)] (PassDown rm) + adddoor rm = treeFromPost [PassDown $ door & rmConnectsTo .~ S.member (OnEdge North)] (PassDown rm) crAdd :: Room -> Room crAdd = rmPmnts .:~ sPS (V2 20 10) (0.5*pi) randC1 @@ -99,7 +99,7 @@ rezBoxes = do h <- state $ randomR (40,40) thecol <- rezColor let bottomEdgeTest = S.member (OnEdge South) . _rlType - dbox = treeFromPost [PassDown $ door & rmConnectsTo .~ S.singleton (OnEdge South)] + dbox = treeFromPost [PassDown $ door & rmConnectsTo .~ S.member (OnEdge South)] (PassDown $ rezInvBox thecol) centralRoom <- shuffleLinks $ (roomRectAutoLinks w h) {_rmPmnts = []} & rmLinks %~ setInLinks bottomEdgeTest diff --git a/src/Dodge/Room/RunPast.hs b/src/Dodge/Room/RunPast.hs index ebd52d413..950cf243b 100644 --- a/src/Dodge/Room/RunPast.hs +++ b/src/Dodge/Room/RunPast.hs @@ -68,5 +68,5 @@ runPastRoom i = do critrooms = treeFromPost [PassDown switchdoor] (PassDown critroom) : replicate (n-2) (treeFromPost [PassDown switchdoor] (PassDown linkcor)) return $ Node (PassDown cenroom) $ - map (applyToCompRoot $ rmConnectsTo .~ S.singleton (OnEdge theedge)) (controom : critrooms) + map (applyToCompRoot $ rmConnectsTo .~ S.member (OnEdge theedge)) (controom : critrooms) ++ [return $ PassDown aswitchroom] diff --git a/src/Dodge/Tree/Shift.hs b/src/Dodge/Tree/Shift.hs index f5e49bd7c..b67af804e 100644 --- a/src/Dodge/Tree/Shift.hs +++ b/src/Dodge/Tree/Shift.hs @@ -14,7 +14,7 @@ import Padding import LensHelp hiding (Empty, (<|) , (|>)) --import Control.Lens hiding (Empty, (<|) , (|>)) -import qualified Data.Set as S +--import qualified Data.Set as S import Data.Tree import Data.Sequence hiding (zipWith) import Data.List (delete) @@ -43,7 +43,7 @@ posRms bounds parenti@(parent,_) ( (numChild,t@(Node childi _) ):its) tseq = do where child = fst childi outlinks = zipCount - . Prelude.filter (not . S.null . S.intersection (_rmConnectsTo child) . _rlType) + . Prelude.filter (_rmConnectsTo child . _rlType) $ _rmLinks parent tryParentLinks [] = putStrLn "no viable link pairs, backtrack" >> return Nothing tryParentLinks ((j,outlnk):ls) = tryChildLinks . zipCount . rmInLinks $ fst childi diff --git a/src/Dodge/Wall/Move.hs b/src/Dodge/Wall/Move.hs index 28ce486fa..fd2d12ed0 100644 --- a/src/Dodge/Wall/Move.hs +++ b/src/Dodge/Wall/Move.hs @@ -3,6 +3,7 @@ module Dodge.Wall.Move ( moveWallID , moveWall , moveWallIDToward + , mvP ) where import Dodge.Data import Dodge.Base