diff --git a/src/Dodge/Layout.hs b/src/Dodge/Layout.hs index e3e5b8924..65c55133b 100644 --- a/src/Dodge/Layout.hs +++ b/src/Dodge/Layout.hs @@ -142,7 +142,8 @@ doExtendedPlacements :: GenWorld -> ( IM.IntMap [Placement], GenWorld) doExtendedPlacements w = let ((pmnts,gw),rms) = mapAccumR doExtendedPlacement (IM.empty,w) (_gRooms w) in (pmnts,gw{_gRooms = rms}) -doExtendedPlacement :: (IM.IntMap [Placement], GenWorld) -> Room +doExtendedPlacement :: (IM.IntMap [Placement], GenWorld) + -> Room -> ( (IM.IntMap [Placement], GenWorld) , Room ) doExtendedPlacement (im,w) rm = case _rmExtPmnt rm of Nothing -> ( (im,w) , rm ) @@ -227,7 +228,7 @@ gameRoomFromRoom rm = GameRoom UsedInLink{} -> ma _ -> Nothing where - ma = Just $ 0.5*pi + (_rpDir rp) + snd (_rmShift rm) + ma = Just $ 0.5*pi + _rpDir rp + snd (_rmShift rm) closePoints x y = roundPoint2 x == roundPoint2 y getDir (rp:xs) = case _rpLinkStatus rp of UsedInLink {} -> _rpDir rp + snd (_rmShift rm) diff --git a/src/Dodge/LevelGen/Data.hs b/src/Dodge/LevelGen/Data.hs index 2d20c08a6..fb240bf5e 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 -> Bool) + , _rmConnectsTo :: S.Set RoomLinkType -> Bool , _rmMID :: Maybe Int , _rmMParent :: Maybe Int , _rmChildren :: [Int] @@ -105,7 +105,9 @@ data RoomLinkType | LabLink Int | OnEdge CardinalPoint | FromSouth Int + | FromNorth Int | FromWest Int + | FromEast Int deriving (Eq,Ord,Show) data CardinalPoint = North @@ -130,7 +132,14 @@ data RPLinkStatus | UnusedLink { _rplsType :: S.Set RoomLinkType } | NotLink deriving (Eq,Ord,Show) - +data OutPlacement = OutPlacement + { _opPlacement :: Placement + , _opPlacementID :: Int + } +data InPlacement = InPlacement + { _ipPlacement :: [Placement] -> Placement + , _ipPlacementID :: Int + } data RoomPos = RoomPos { _rpPos :: Point2 , _rpDir :: Float diff --git a/src/Dodge/LockAndKey.hs b/src/Dodge/LockAndKey.hs index e53eb9ddd..4728a9124 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/Button.hs b/src/Dodge/Placement/Instance/Button.hs index 3719f453f..61f99cf30 100644 --- a/src/Dodge/Placement/Instance/Button.hs +++ b/src/Dodge/Placement/Instance/Button.hs @@ -90,9 +90,9 @@ extTrigLitPos ps f = psPtCont ps (PutTrigger (const False)) thels = lsColPosRad (V3 0.5 0 0) (V3 0 0 78) 75 putLitButOnPosExtTrig :: Color - -> (RoomPos -> Room -> Maybe (PlacementSpot,RoomPos)) + -> PlacementSpot -> Placement -putLitButOnPosExtTrig col f +putLitButOnPosExtTrig col thePS = psPtCont thePS (PutTrigger (const False)) $ \tp -> Just $ plSpot .~ _plSpot tp $ mntLSOn aShape (Just col) ls 0 (V3 0 (-40) 40) $ \plmnt -> let lsid = fromJust $ _plMID plmnt @@ -104,4 +104,3 @@ putLitButOnPosExtTrig col f oneff tid = triggers . ix tid .~ const True changeLight lsid = lightSources . ix lsid . lsParam . lsCol .~ V3 0 0.5 0 ls = lsRadCol 75 (V3 0.5 0 0) - thePS = PSPos f (const id) Nothing diff --git a/src/Dodge/Placement/Instance/LightSource.hs b/src/Dodge/Placement/Instance/LightSource.hs index 06995ab21..4bfd551dd 100644 --- a/src/Dodge/Placement/Instance/LightSource.hs +++ b/src/Dodge/Placement/Instance/LightSource.hs @@ -22,7 +22,7 @@ propLSThen :: (Prop -> World -> World) -> Prop -> (Placement -> Placement -> Maybe Placement) -- ^ continuation, access to ls and prop placements -> Placement -propLSThen propf lsf ls prop cont = pt0 (PutLS $ ls) +propLSThen propf lsf ls prop cont = pt0 (PutLS ls) $ \lspl -> Just $ pt0 (PutProp $ prop & pjUpdate .~ theupdate (fromJust $ _plMID lspl)) $ cont lspl where diff --git a/src/Dodge/PlacementSpot.hs b/src/Dodge/PlacementSpot.hs index e6317c63a..e621261a6 100644 --- a/src/Dodge/PlacementSpot.hs +++ b/src/Dodge/PlacementSpot.hs @@ -1,5 +1,26 @@ -{-# LANGUAGE LambdaCase #-} -module Dodge.PlacementSpot where +--{-# LANGUAGE LambdaCase #-} +module Dodge.PlacementSpot + ( atFstLnkOut + , useUnusedLnk + , psRandRanges + , useRoomPosCond + , isUsedLnkUnplaced + , anyUnusedSpot + , unusedSpotAwayFromLink + , isUnusedLnk + , unusedLnkToPS + , unusedSpotNearInLink + , randDirPS + , unusedSpotAwayFromInLink + , useLnkRoomPos + , atFstLnkOutShiftInward + , atFstLnkOutShiftBy + , atNthLnkOutShiftInward + , unusedOffPathAwayFromLink + , setFallback + , twoRoomPoss + , isUnusedLinkType + ) where import Dodge.LevelGen.Data import Geometry @@ -22,88 +43,61 @@ randDirPS ps = do a <- state $ randomR (0,pi*2) return $ setDirPS a ps +roomPosBool :: (RoomPos -> Bool) -> PlacementSpot +roomPosBool t = PSPos (useRoomPosCond t) (const id) Nothing + anyUnusedSpot :: PlacementSpot -anyUnusedSpot = PSPos f (const id) Nothing - where - f rp _ - | _rpLinkStatus rp == NotLink && _rpPlacementUse rp == 0 - = Just $ (PS (_rpPos rp) (_rpDir rp), rp & rpPlacementUse +~ 1) - | otherwise = Nothing +anyUnusedSpot = roomPosBool $ \rp -> _rpLinkStatus rp == NotLink && _rpPlacementUse rp == 0 + +roomPosRoomBool :: (RoomPos -> Room -> Bool) -> PlacementSpot +roomPosRoomBool t = PSPos (useRoomPosRoomCond t) (const id) Nothing + unusedSpotAwayFromLink :: Float -> PlacementSpot -unusedSpotAwayFromLink x = PSPos f (const id) Nothing - where - f rp r - | _rpLinkStatus rp == NotLink - && _rpPlacementUse rp == 0 - && all ( (>x) . dist p ) (usedRoomLinkPoss r) - = Just $ (PS p (_rpDir rp), rp & rpPlacementUse +~ 1) - | otherwise = Nothing - where - p = _rpPos rp +unusedSpotAwayFromLink x = roomPosRoomBool $ \rp r -> _rpLinkStatus rp == NotLink + && _rpPlacementUse rp == 0 + && all ( (>x) . dist (_rpPos rp) ) (usedRoomLinkPoss r) setFallback :: Placement -> Placement -> Placement -setFallback fallback plmnt = plmnt - & plSpot . psFallback %~ maybe (Just fallback) Just - & plIDCont %~ fmap (fmap $ setFallback fallback) +setFallback fallback = (plSpot . psFallback %~ maybe (Just fallback) Just) + . (plIDCont %~ fmap (fmap $ setFallback fallback)) unusedOffPathAwayFromLink :: Float -> PlacementSpot -unusedOffPathAwayFromLink x = PSPos f (const id) Nothing - where - f rp r - | _rpLinkStatus rp == NotLink - && _rpPlacementUse rp == 0 - && all ( (>x) . dist p ) (usedRoomLinkPoss r) - && RoomPosOffPath `S.member` _rpType rp - = Just $ (PS p (_rpDir rp), rp & rpPlacementUse +~ 1) - | otherwise = Nothing - where - p = _rpPos rp +unusedOffPathAwayFromLink x = roomPosRoomBool $ \rp r -> _rpLinkStatus rp == NotLink + && _rpPlacementUse rp == 0 + && all ( (>x) . dist (_rpPos rp) ) (usedRoomLinkPoss r) + && RoomPosOffPath `S.member` _rpType rp unusedSpotAwayFromInLink :: Float -> PlacementSpot -unusedSpotAwayFromInLink x = PSPos f (const id) Nothing - where - f rp r - | _rpLinkStatus rp == NotLink - && _rpPlacementUse rp == 0 - && all ( (>x) . dist p ) (usedRoomInLinkPoss r) - = Just $ (PS p (_rpDir rp), rp & rpPlacementUse +~ 1) - | otherwise = Nothing - where - p = _rpPos rp +unusedSpotAwayFromInLink x = roomPosRoomBool $ \rp r -> _rpLinkStatus rp == NotLink + && _rpPlacementUse rp == 0 + && all ( (>x) . dist (_rpPos rp) ) (usedRoomInLinkPoss r) -twoUnusedLinks :: (PlacementSpot -> PlacementSpot -> Placement) - -> Placement -twoUnusedLinks f = Placement useUnusedLink PutNothing Nothing - $ \pl1 -> Just $ Placement useUnusedLink PutNothing Nothing - $ \pl2 -> Just $ f (_plSpot pl1) (_plSpot pl2) +--twoUnusedLinks :: (PlacementSpot -> PlacementSpot -> Placement) -> Placement +--twoUnusedLinks = twoRoomPoss isUnusedLnk isUnusedLnk twoRoomPoss :: (RoomPos -> Bool) -> (RoomPos -> Bool) -> (PlacementSpot -> PlacementSpot -> Placement) -> Placement -twoRoomPoss cond1 cond2 f = Placement (useRoomPos cond1) PutNothing Nothing - $ \pl1 -> Just $ Placement (useRoomPos cond2) PutNothing Nothing +twoRoomPoss cond1 cond2 f = Placement (roomPosBool cond1) PutNothing Nothing + $ \pl1 -> Just $ Placement (roomPosBool cond2) PutNothing Nothing $ \pl2 -> Just $ f (_plSpot pl1) (_plSpot pl2) -useUnusedLink :: PlacementSpot -useUnusedLink = PSPos unusedLnkToPS (const id) Nothing - -useRoomPos :: (RoomPos -> Bool) -> PlacementSpot -useRoomPos cond = PSPos (useRoomPosCond cond) (const id) Nothing - isUnusedLnk :: RoomPos -> Bool isUnusedLnk rp = case _rpLinkStatus rp of UnusedLink {} -> _rpPlacementUse rp == 0 _ -> False +useUnusedLnk :: PlacementSpot +useUnusedLnk = roomPosBool isUnusedLnk + isUsedLnkUnplaced :: RoomPos -> Bool isUsedLnkUnplaced rp = case _rpLinkStatus rp of UsedOutLink {} -> _rpPlacementUse rp == 0 - UsedInLink {} -> _rpPlacementUse rp == 0 + UsedInLink {} -> _rpPlacementUse rp == 0 _ -> False -useRoomPosCond :: (RoomPos -> Bool) - -> RoomPos -> Room -> Maybe (PlacementSpot,RoomPos) +useRoomPosCond :: (RoomPos -> Bool) -> RoomPos -> Room -> Maybe (PlacementSpot,RoomPos) useRoomPosCond t rp _ | t rp = Just (PS p a, rp & rpPlacementUse +~ 1) | otherwise = Nothing @@ -111,33 +105,33 @@ useRoomPosCond t rp _ p = _rpPos rp a = _rpDir rp +useRoomPosRoomCond :: (RoomPos -> Room -> Bool) -> RoomPos -> Room -> Maybe (PlacementSpot,RoomPos) +useRoomPosRoomCond t rp r + | t rp r = Just (PS p a, rp & rpPlacementUse +~ 1) + | otherwise = Nothing + where + p = _rpPos rp + a = _rpDir rp + unusedLnkToPS :: RoomPos -> Room -> Maybe (PlacementSpot,RoomPos) unusedLnkToPS = useRoomPosCond $ \rp -> case _rpLinkStatus rp of UnusedLink {} -> True _ -> False -usedInLnkToPS :: RoomPos -> Room -> Maybe (PlacementSpot,RoomPos) -usedInLnkToPS = useRoomPosCond $ \rp -> case _rpLinkStatus rp of - UsedInLink {} -> True - _ -> False +--usedInLnkToPS :: RoomPos -> Room -> Maybe (PlacementSpot,RoomPos) +--usedInLnkToPS = useRoomPosCond $ \rp -> case _rpLinkStatus rp of +-- UsedInLink {} -> True +-- _ -> False isUnusedLinkType :: RoomLinkType -> RoomPos -> Bool isUnusedLinkType rlt rp = case _rpLinkStatus rp of UnusedLink{_rplsType = rlts} -> rlt `S.member` rlts _ -> False --- TODO unify this with other xSpotNear/FarLink unusedSpotNearInLink :: Float -> PlacementSpot -unusedSpotNearInLink x = PSPos f (const id) Nothing - where - f rp r - | _rpLinkStatus rp == NotLink - && _rpPlacementUse rp == 0 - && any ( ( _rpLinkStatus rp == NotLink + && _rpPlacementUse rp == 0 + && any ( ( [Point2] usedRoomInLinkPoss r = mapMaybe f $ _rmPos r @@ -154,21 +148,8 @@ usedRoomLinkPoss r = mapMaybe f $ _rmPos r UsedOutLink {} -> Just $ _rpPos rp _ -> Nothing --- TODO rename to any unused link facing out --- note this can REUSE unused links -anyLnkOutPS :: PlacementSpot -anyLnkOutPS = PSPos f (const id) Nothing - where - f rp _ = case _rpLinkStatus rp of - UnusedLink {} -> Just (PS (_rpPos rp) (_rpDir rp), rp & rpPlacementUse +~ 1) - _ -> Nothing - atFstLnkOut :: PlacementSpot -atFstLnkOut = PSPos f (const id) Nothing - where - f rp _ = case _rpLinkStatus rp of - UsedOutLink {_rplsChildNum = 0} -> Just (PS (_rpPos rp) (_rpDir rp), rp & rpPlacementUse +~ 1) - _ -> Nothing +atFstLnkOut = roomPosBool $ \rp -> rp ^? rpLinkStatus . rplsChildNum == Just 0 atNthLnkOutShiftBy :: Int -> ((Point2,Float) -> (Point2,Float)) -> PlacementSpot atNthLnkOutShiftBy n theshift = PSPos f (const id) Nothing @@ -186,30 +167,22 @@ atFstLnkOutShiftBy = atNthLnkOutShiftBy 0 atFstLnkOutShiftInward :: Float -> PlacementSpot atFstLnkOutShiftInward = atNthLnkOutShiftInward 0 -atNthLnkOutShiftInward ::Int -> Float -> PlacementSpot +atNthLnkOutShiftInward :: Int -> Float -> PlacementSpot atNthLnkOutShiftInward n x = atNthLnkOutShiftBy n f where f (p,a) = (p +.+ rotateV a (V2 0 (negate x)),a) --- does not change the placement use count -overFstLnkOut :: PlacementSpot -overFstLnkOut = PSPos f (const id) Nothing - where - f rp _ = case _rpLinkStatus rp of - UsedOutLink {_rplsChildNum = 0} -> Just (PS (_rpPos rp) (_rpDir rp), rp) - _ -> Nothing - -anyLnkInPS :: Float -- ^ amount to shift inward - -> PlacementSpot -anyLnkInPS x = PSPos f (const id) Nothing - where - f rp _ = case _rpLinkStatus rp of - UnusedLink {} -> Just (PS v' a', rp & rpPlacementUse +~ 1) - _ -> Nothing - where - a = _rpDir rp - v' = _rpPos rp -.- x *.* unitVectorAtAngle (a + 0.5 * pi) - a' = a + pi +--anyLnkInPS :: Float -- ^ amount to shift inward +-- -> PlacementSpot +--anyLnkInPS x = PSPos f (const id) Nothing +-- where +-- f rp _ = case _rpLinkStatus rp of +-- UnusedLink {} -> Just (PS v' a', rp & rpPlacementUse +~ 1) +-- _ -> Nothing +-- where +-- a = _rpDir rp +-- v' = _rpPos rp -.- x *.* unitVectorAtAngle (a + 0.5 * pi) +-- a' = a + pi -- this should probably check the placement use, but so should others: should -- unify these diff --git a/src/Dodge/Room/Door.hs b/src/Dodge/Room/Door.hs index 2c50f63ac..ffcb48ae7 100644 --- a/src/Dodge/Room/Door.hs +++ b/src/Dodge/Room/Door.hs @@ -34,7 +34,7 @@ switchDoorRoom = defaultRoom , _rmLinks = init lnks++ [last lnks] , _rmPath = [(V2 20 35,V2 20 5)] , _rmPartPmnt = Just f --- door extends into side walls (for shadows as rendered 12/03) +-- door extends into side walls (for shadows as rendered 12/03/21) -- note no bounds } where diff --git a/src/Dodge/Room/LasTurret.hs b/src/Dodge/Room/LasTurret.hs index fae928f03..aa3169b26 100644 --- a/src/Dodge/Room/LasTurret.hs +++ b/src/Dodge/Room/LasTurret.hs @@ -59,11 +59,12 @@ lightSensByDoor rm = rm & rmPmnts .++~ [ psPt atFstLnkOut $ PutShape $ colorSH yellow $ barPP 1.5 (V3 20 (-1) 0) (V3 20 (-1) 80) - , heightWallPS (atNthLnkOutShiftInward 1 100) 30 (rectNSEW 10 (-10) 20 (-20)) - , heightWallPS (atFstLnkOutShiftInward 100) 30 (rectNSEW 10 (-10) 20 (-20)) + , heightWallPS (atNthLnkOutShiftInward 1 100) 30 covershape + , heightWallPS (atFstLnkOutShiftInward 100) 30 covershape ] & rmExtPmnt ?~ lasSensLightAboveDoor 20 (atFstLnkOutShiftBy sensorshift) where + covershape = rectNSEW 10 (-10) 20 (-20) sensorshift (p,a) = (p +.+ rotateV a (V2 60 (-20)), a) lasSensorTurretTest :: RandomGen g => Int -> State g (SubCompTree Room) diff --git a/src/Dodge/Room/LongDoor.hs b/src/Dodge/Room/LongDoor.hs index 16596381b..20b60cd13 100644 --- a/src/Dodge/Room/LongDoor.hs +++ b/src/Dodge/Room/LongDoor.hs @@ -75,9 +75,7 @@ twinSlowDoorRoom w h x = defaultRoom twinSlowDoorChasers :: RandomGen g => State g Room twinSlowDoorChasers = do - let lps = V2 (-65) <$> [20,40 .. 180] - rps = V2 65 <$> [20,40 .. 180] - ps <- takeN 4 $ lps ++ rps + ps <- takeN 4 $ [ V2 x y | x <- [-65,65], y <- [20,40 .. 180] ] let plmnts = map (\p -> sPS p 0 $ PutCrit chaseCrit) ps return $ twinSlowDoorRoom 80 200 40 & rmPmnts %~ (plmnts ++) @@ -116,7 +114,7 @@ addButtonSlowDoor x h rm = do $ amountedlight dr1 (-50) $ amountedlight dr2 50 $ amountedlight dr2 (-50) - $ Nothing + Nothing getdoorpos drid w = let Just (a,b) = w ^? doors . ix drid . drPos in (b, argV (a-.-b)) butPosCond = useRoomPosCond $ \rp -> isUnusedLnk rp && yV2 (_rpPos rp) < 0.5 * h diff --git a/src/Dodge/Room/Procedural.hs b/src/Dodge/Room/Procedural.hs index dd9ebe89d..cf764ded9 100644 --- a/src/Dodge/Room/Procedural.hs +++ b/src/Dodge/Room/Procedural.hs @@ -1,5 +1,4 @@ -{- | - Procedural creation of rooms and subroom parts. -} +{- | Procedural creation of rooms and subroom parts. -} module Dodge.Room.Procedural ( roomRect , roomRectAutoLinks @@ -74,24 +73,35 @@ roomRect x y xn yn = defaultRoom wlnks = somelnks (V2 x 20) (gridPoints 0 1 yd (yn+1)) (-pi/2) nlnks = somelnks (V2 20 y) (gridPoints xd (xn+1) 0 1 ) 0 slnks = somelnks (V2 20 0) (gridPoints xd (xn+1) 0 1 ) pi - lnks = m North FromWest nlnks - ++ m East FromSouth elnks - ++ m West FromSouth wlnks - ++ m South FromWest slnks - m edge edgefrom = zipWith (lnkBothAnd' (OnEdge edge) edgefrom) [0..] + lnks = m North FromWest FromEast nlnks + ++ m East FromSouth FromNorth elnks + ++ m West FromSouth FromNorth wlnks + ++ m South FromWest FromEast slnks + m edge edgefrom1 edgefrom2 = zipWith (lnkBothAnd' (OnEdge edge) edgefrom1 edgefrom2) [0..] + . zipCountDown pth = linksAndPath' lnks $ map (bimap (+.+ V2 20 20) (+.+ V2 20 20)) (makeGrid xd xn yd yn) posps = map (+.+ V2 20 20) $ gridPoints xd (xn+1) yd (yn+1) interposps = map (+.+ V2 (20 + xd/2) (20 + yd/2)) $ gridPoints xd xn yd yn + +zipCountDown :: [a] -> [(Int,a)] +zipCountDown xs = zip [length xs - 1, length xs - 2 ..] xs + +lnkBothAnd' :: RoomLinkType -> (Int -> RoomLinkType) + -> (Int -> RoomLinkType) + -> Int -> (Int,(Point2,Float)) -> RoomLink +lnkBothAnd' rlt ltcon ltcon2 i (j,(p,a)) = RoomLink + {_rlType = S.fromList [OutLink,InLink,rlt,ltcon i,ltcon2 j] + ,_rlPos = p + , _rlDir = a + } {- Creates a rectangular room, automatically creates links and pathfinding graph at a sensible size. -} -- it is not clear to me that this works for very small rooms (but it does seem -- to do so) roomRectAutoLinks :: Float -> Float -> Room -roomRectAutoLinks x y = (roomRect x y xn yn) - {_rmPmnts = plmnts} +roomRectAutoLinks x y = (roomRect x y (f x) (f y)) {_rmPmnts = plmnts} where - xn = max 1 $ (ceiling x - 40) `div` 60 - yn = max 1 $ (ceiling y - 40) `div` 60 - plmnts = replicate 3 (mntLightLnkCond $ useRoomPosCond isUsedLnkUnplaced) + f z = max 1 $ (ceiling z - 40) `div` 60 + plmnts = replicate 3 . mntLightLnkCond $ useRoomPosCond isUsedLnkUnplaced {- Combines two rooms into one room. - will have to work out exactly what to do with combining links Mostly involves concatenation. -} @@ -126,7 +136,7 @@ quarterRoomTri w = do [ [ mntLS vShape (V2 0 w) (V3 0 (w-20) 70) , blockLine (V2 (w/2) (w/2)) (V2 (w/2) w) ] - , [blockLine (V2 (w/2) (w/2)) (V2 (negate $ w/2) (w/2))] + , [ blockLine (V2 (w/2) (w/2)) (V2 (negate $ w/2) (w/2))] , [ blockLine (V2 (w/2) (w/2)) (V2 0 (w/2)) , blockLine (V2 (-29) w) (V2 0 (w/2)) ] @@ -142,10 +152,7 @@ quarterRoomTri w = do ,(V2 0 (w-20),V2 0 0) ,(V2 (55-w) (w-20),V2 0 0) ] - , _rmPmnts = b ++ [ mntLS iShape (V2 (w-20) w) (V3 (w-20) (w-20) 70) - , sPS (V2 (w-20) (w-20)) pi PutNothing - , sPS (V2 (w-15) (w-25)) pi PutNothing - ] + , _rmPmnts = b ++ [ mntLS iShape (V2 (w-20) w) (V3 (w-20) (w-20) 70) ] , _rmPos = [ RoomPos (V2 (w-20) (w-20)) pi S.empty NotLink 0 , RoomPos (V2 (w-15) (w-25)) pi S.empty NotLink 0 @@ -167,9 +174,9 @@ quarterRoomSquare w = do ] pure $ defaultRoom { _rmPolys = [ map toV2 [(0,0),(w,w),(0,2*w),(-w,w)] ] - , _rmLinks = - [toBothLnk (V2 (w/2) (3*w/2), negate $ pi/4) - ,toBothLnk (V2 (negate $ w/2) (3*w/2), pi/4) + , _rmLinks = map toBothLnk + [ (V2 (w/2) (3*w/2), negate $ pi/4) + , (V2 (negate $ w/2) (3*w/2), pi/4) ] , _rmPath = concatMap doublePair [(V2 (0.5*w) (1.5*w),V2 (0.5*w-20) (1.5*w-20)) @@ -183,15 +190,9 @@ quarterRoomSquare w = do ,(V2 0 0,V2 0 (w-40)) -- ,(V2 (20-w) (w-20),V2 (40-w) (w)) ] - , _rmPmnts = b ++ - [ blockLine (V2 (w/2) (w/2)) (V2 0 w) - , sPS (V2 20 (2*w-40)) pi PutNothing - , sPS (V2 25 (2*w-45)) pi PutNothing - ] - , _rmPos = - [ RoomPos (V2 20 (2*w-40)) pi S.empty NotLink 0 - , RoomPos (V2 25 (2*w-45)) pi S.empty NotLink 0 - ] + , _rmPmnts = b ++ [ blockLine (V2 (w/2) (w/2)) (V2 0 w) ] + , _rmPos = [ RoomPos p pi S.empty NotLink 0 + | p <- [V2 20 (2*w-40),V2 25 (2*w-45)] ] , _rmBound = [map toV2 [(w,w),(0,2*w),(-w,w)]] } {- | Randomise the ordering of placements in a room. diff --git a/src/Dodge/Room/RunPast.hs b/src/Dodge/Room/RunPast.hs index 950cf243b..36c919153 100644 --- a/src/Dodge/Room/RunPast.hs +++ b/src/Dodge/Room/RunPast.hs @@ -57,7 +57,7 @@ runPastRoom i = do let linkcor = critRoom & rmPmnts .~ [ spanLS thels (V2 0 65) (V2 40 65) ] critroom = linkcor & rmPmnts .:~ plRRpt 0 randC1 aswitchroom = corridorWallN - {_rmExtPmnt = Just $ putLitButOnPosExtTrig red useLnkRoomPos + {_rmExtPmnt = Just $ putLitButOnPosExtTrig red useUnusedLnk ,_rmLabel = Just i ,_rmPmnts = [] } diff --git a/src/Dodge/Room/Start.hs b/src/Dodge/Room/Start.hs index 93adce29a..370f01012 100644 --- a/src/Dodge/Room/Start.hs +++ b/src/Dodge/Room/Start.hs @@ -5,6 +5,7 @@ import Dodge.LevelGen.Data import Dodge.Room.RunPast import Dodge.Room.Tanks import Dodge.Room.Containing +import Dodge.Room.LongDoor --import Dodge.RoomLink --import Dodge.Data --import Dodge.Default @@ -65,6 +66,7 @@ randomChallenges :: RandomGen g => State g (SubCompTree Room) randomChallenges = join $ takeOne [fmap (return . UseAll) doubleCorridorBarrels ,shootingRange + ,fmap (return . UseAll) twinSlowDoorChasers ] runPastStart :: RandomGen g => Int -> State g (SubCompTree Room) diff --git a/src/Dodge/RoomLink.hs b/src/Dodge/RoomLink.hs index 8d9d41ed7..c17714d87 100644 --- a/src/Dodge/RoomLink.hs +++ b/src/Dodge/RoomLink.hs @@ -1,4 +1,26 @@ -module Dodge.RoomLink where +module Dodge.RoomLink + ( muout + , muin + , outLink + , inLink + , restrictLinkType + , overLnkType + , lnkPosDir + , overLnkPosDir + , toBothLnk + , rmInLinks + , rmOutLinks + , setOutLinksPD + , setOutLinksByType + , setInLinksPD + , restrictOutLinks + , restrictInLinks + , setInLinks + , setInLinksByType + , setLinkType + , getLinksOfType + , swapInOutLinks + ) where import Dodge.LevelGen.Data import Geometry @@ -21,12 +43,6 @@ restrictInLinks = over rmLinks . restrictLinkType InLink restrictOutLinks :: ((Point2,Float) -> Bool) -> Room -> Room restrictOutLinks f = rmLinks %~ restrictLinkType OutLink f -addLabelLink :: Int -> (RoomLink -> Bool) -> [RoomLink] -> [RoomLink] -addLabelLink i t = map f - where - f rl | t rl = rl & rlType %~ S.insert (LabLink i) - | otherwise = rl - setOutLinks :: (RoomLink -> Bool) -> [RoomLink] -> [RoomLink] setOutLinks = setLinkType OutLink @@ -93,24 +109,11 @@ inLink p a = RoomLink ,_rlPos = p , _rlDir = a } -lnkBothAnd :: RoomLinkType -> (Point2,Float) -> RoomLink -lnkBothAnd rlt (p,a) = RoomLink - {_rlType = S.fromList [OutLink,InLink,rlt] - ,_rlPos = p - , _rlDir = a - } - -lnkBothAnd' :: RoomLinkType -> (Int -> RoomLinkType) -> Int -> (Point2,Float) -> RoomLink -lnkBothAnd' rlt ltcon i (p,a) = RoomLink - {_rlType = S.fromList [OutLink,InLink,rlt,ltcon i] - ,_rlPos = p - , _rlDir = a - } toBothLnk :: (Point2,Float) -> RoomLink toBothLnk (p,a) = RoomLink - {_rlType = S.fromList [OutLink,InLink] - ,_rlPos = p + { _rlType = S.fromList [OutLink,InLink] + , _rlPos = p , _rlDir = a } muout :: [(Point2,Float)] -> [RoomLink]