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

Add explicit door position field

Browse Source
This commit is contained in:
justin
2022-03-09 22:14:34 +00:00
parent 4a1ca905f7
commit 027b4b7d8b
14 changed files with 53 additions and 37 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data.hs
+4 -1
View File
@@ -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)
src/Dodge/Default/Room.hs
+1 -1
View File
@@ -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 = []
src/Dodge/LevelGen/Data.hs
+1 -1
View File
@@ -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]
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/Door.hs
+6 -3
View File
@@ -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)
src/Dodge/Placement/PlaceSpot/TriggerDoor.hs
+13 -2
View File
@@ -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
src/Dodge/Room/GlassLesson.hs
+12 -14
View File
@@ -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
src/Dodge/Room/LasTurret.hs
+1 -1
View File
@@ -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)
]
src/Dodge/Room/LongDoor.hs
+1 -1
View File
@@ -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)
]
src/Dodge/Room/LongRoom.hs
+1 -1
View File
@@ -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)
]
)
src/Dodge/Room/RezBox.hs
+4 -4
View File
@@ -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
src/Dodge/Room/RunPast.hs
+1 -1
View File
@@ -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]
src/Dodge/Tree/Shift.hs
+2 -2
View File
@@ -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
src/Dodge/Wall/Move.hs
+1
View File
@@ -3,6 +3,7 @@ module Dodge.Wall.Move
( moveWallID
, moveWall
, moveWallIDToward
, mvP
) where
import Dodge.Data
import Dodge.Base