justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Commit before making out and in placements have ids

Browse Source
This commit is contained in:
justin
2022-03-11 12:34:19 +00:00
parent 73a35bb3f1
commit 219e4e15ee
13 changed files with 166 additions and 179 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Layout.hs
+3 -2
View File
@@ -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)
src/Dodge/LevelGen/Data.hs
+11 -2
View File
@@ -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
src/Dodge/LockAndKey.hs
+5 -5
View File
@@ -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))]
src/Dodge/Placement/Instance/Button.hs
+2 -3
View File
@@ -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
src/Dodge/Placement/Instance/LightSource.hs
+1 -1
View File
@@ -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
src/Dodge/PlacementSpot.hs
+80 -107
View File
@@ -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 ( (<x) . dist p ) (usedRoomInLinkPoss r)
= Just $ (PS p (_rpDir rp), rp & rpPlacementUse +~ 1)
| otherwise = Nothing
where
p = _rpPos rp
unusedSpotNearInLink x = roomPosRoomBool $ \rp r -> _rpLinkStatus rp == NotLink
&& _rpPlacementUse rp == 0
&& any ( (<x) . dist (_rpPos rp) ) (usedRoomInLinkPoss r)
usedRoomInLinkPoss :: Room -> [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
src/Dodge/Room/Door.hs
+1 -1
View File
@@ -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
src/Dodge/Room/LasTurret.hs
+3 -2
View File
@@ -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)
src/Dodge/Room/LongDoor.hs
+2 -4
View File
@@ -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
src/Dodge/Room/Procedural.hs
+30 -29
View File
@@ -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.
src/Dodge/Room/RunPast.hs
+1 -1
View File
@@ -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 = []
}
src/Dodge/Room/Start.hs
+2
View File
@@ -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)
src/Dodge/RoomLink.hs
+25 -22
View File
@@ -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]