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

Migrate more doors to lerp

Browse Source
This commit is contained in:
justin
2025-10-22 09:22:10 +01:00
parent fdee74ff0c
commit 2f06c56185
8 changed files with 187 additions and 144 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data/GenWorld.hs
+2 -1
View File
@@ -54,7 +54,8 @@ data PSType
}
| PutWall {_pwPoly :: [Point2], _pwWall :: Wall}
| PutSlideDr Door Wall EdgeObstacle Float Point2 Point2
| PutDoor Color EdgeObstacle WdBl [(Point2, Point2)]
-- | PutDoor Color EdgeObstacle WdBl [(Point2, Point2)]
| PutDoor Color EdgeObstacle WdBl Float Point2A Point2A -- [(Point2, Point2)]
| RandPS (State StdGen PSType)
| PutForeground ForegroundShape
| PutWorldUpdate (Int -> PlacementSpot -> GenWorld -> GenWorld)
src/Dodge/LevelGen/DoorPane.hs
+1 -3
View File
@@ -1,6 +1,4 @@
module Dodge.LevelGen.DoorPane
( rectanglePairs
) where
module Dodge.LevelGen.DoorPane ( rectanglePairs) where
import Geometry.Vector
import Geometry.Data
src/Dodge/Placement/PlaceSpot.hs
+3 -1
View File
@@ -133,7 +133,8 @@ placeSpotID rid ps pt w = case pt of
PutMachine pps mc wl mitm -> plMachine (map doShift pps) mc wl mitm p rot w
PutLS ls -> plNewUpID (gwWorld . cWorld . lWorld . lightSources) lsID (mvLS p' rot ls) w
RandPS _ -> error "RandPS should not be reachable here" --evaluateRandPS rid rgn ps w
PutDoor col eo f pss -> plDoor col eo f (map (bimap doShift doShift) pss) w
--PutDoor col eo f pss -> plDoor col eo f (map (bimap doShift doShift) pss) w
PutDoor col eo f l p1 p2 -> plDoor col eo f l (pashift p1) (pashift p2) w
PutCoord cp -> plNewID (gwWorld . coordinates) (doShift cp) w
PutSlideDr wl dr eo off a b ->
plSlideDoor wl dr eo off (doShift a) (doShift b) w
@@ -155,6 +156,7 @@ placeSpotID rid ps pt w = case pt of
p' = V3 px py 0
rot = _psRot ps
doShift = shiftPointBy (p, rot)
pashift = compP2A (p, rot)
placeChasm :: GenWorld -> Int -> [Point2] -> [Point2] -> GenWorld
placeChasm gw rid ps shiftps =
src/Dodge/Placement/PlaceSpot/TriggerDoor.hs
+20 -9
View File
@@ -4,6 +4,7 @@ module Dodge.Placement.PlaceSpot.TriggerDoor (
updateDoorEdges,
) where
import Dodge.ShiftPoint
import Linear
import Dodge.Data.GenWorld
import qualified Data.IntSet as IS
@@ -23,10 +24,12 @@ plDoor ::
WdBl ->
-- | Door positions, closed to open.
-- Bumped out up and down by 9, not widened
[(Point2, Point2)] ->
Float ->
Point2A ->
Point2A ->
GenWorld ->
(Int, GenWorld)
plDoor col eo cond pss gw = (drid, over gwWorld addWalls $ gw & gwWorld . cWorld . lWorld . doors %~ addDoor) -- carefull with the ordering of addWalls
plDoor col eo cond l p1 p2 gw = (drid, over gwWorld addWalls $ gw & gwWorld . cWorld . lWorld . doors %~ addDoor) -- carefull with the ordering of addWalls
where
drid = IM.newKey $ _doors (_lWorld (_cWorld $ _gwWorld gw))
addDoor =
@@ -36,16 +39,24 @@ plDoor col eo cond pss gw = (drid, over gwWorld addWalls $ gw & gwWorld . cWorld
, _drWallIDs = IS.fromList wlids
, _drStatus = DoorInt 0
, _drTrigger = cond
, _drMech = DrWdMechanismStepwise nsteps wlids pss
, _drPos = head pss
, _drOpenPos = head pss
, _drClosePos = last pss
--, _drMech = DrWdMechanismStepwise nsteps wlids pss
, _drMech = DoorLerp
-- , _drPos = head pss
-- , _drOpenPos = head pss
-- , _drClosePos = last pss
, _drZeroPos = p1
, _drOnePos = p2
, _drLerp = 0
, _drFootPrint = IM.fromList . zip wlids $ wlps'
, _drObstacleType = eo
, _drSpeed = 0.01
}
nsteps = length pss - 1
-- nsteps = length pss - 1
wlids = take 4 [IM.newKey $ _walls (_lWorld (_cWorld $ _gwWorld gw)) ..]
wlps' = uncurry (rectanglePairs 9) $ head pss
addWalls w' = foldl' (addDoorWall eo drid $ switchWallCol col) w' $ zip wlids wlps'
--wlps' = uncurry (rectanglePairs 9) $ head pss
wlps' = rectanglePairs 9 0 (V2 l 0)
addWalls w' = foldl' (addDoorWall eo drid $ switchWallCol col) w' $ zip wlids
$ wlps' & each . each %~ shiftPointBy p1
addDoorWall :: EdgeObstacle -> Int -> Wall -> World -> (Int, (Point2, Point2)) -> World
addDoorWall eo drid wl w (wlid, wlps) =
src/Dodge/Room/Airlock.hs
+46 -26
View File
@@ -90,7 +90,8 @@ airlock0 =
]
col = dim $ dim $ bright red
airlockDoor :: Color -> WdBl -> [(Point2, Point2)] -> PSType
--airlockDoor :: Color -> WdBl -> [(Point2, Point2)] -> PSType
airlockDoor :: Color -> WdBl -> Float -> Point2A -> Point2A -> PSType
airlockDoor col = PutDoor col DoorObstacle
airlockDoubleDoor ::
@@ -98,12 +99,12 @@ airlockDoubleDoor ::
Point2 ->
Color ->
WdBl ->
[(Point2, Point2)] ->
[(Point2, Point2)] ->
Float -> Point2A -> Point2A ->
Float -> Point2A -> Point2A ->
Maybe Placement
airlockDoubleDoor p1 p2 col cond outDoorps inDoorps =
jspsJ p1 0 (airlockDoor col cond outDoorps) $
sPS p2 0 (airlockDoor col cond inDoorps)
airlockDoubleDoor p1 p2 col cond l1 x1 y1 l2 x2 y2 =
jspsJ p1 0 (airlockDoor col cond l1 x1 y1) $
sPS p2 0 (airlockDoor col cond l2 x2 y2)
airlockSimple :: Room
airlockSimple =
@@ -114,9 +115,10 @@ airlockSimple =
, _rmPath = foldMap (doublePairSet . (V2 90 30,) . fst) lnks
, _rmPmnts =
[ pContID (PS (V2 90 115) pi) (PutButton $ makeSwitch col red NoWorldEffect NoWorldEffect) $
\btid -> airlockDoubleDoor 0 (V2 180 0) col (WdBlBtOn btid) outDoorps inDoorps
-- jspsJ (V2 0 0) 0 (airlockDoor col (cond btid) outDoorps)
-- $ sPS (V2 180 0) 0 (airlockDoor col (cond btid) inDoorps)
\btid -> airlockDoubleDoor 0 (V2 180 0) col (WdBlBtOn btid)
l1 x1 y1
l2 x2 y2
-- outDoorps inDoorps
]
, _rmBound =
[rectNSWE 120 0 0 180]
@@ -127,8 +129,14 @@ airlockSimple =
, (V2 180 30, 1.5 * pi)
]
col = dim $ dim $ bright red
outDoorps = (V2 0 0,) <$> arcStepwise 3 (negate $ pi / 2) (V2 0 0) (V2 0 55)
inDoorps = (V2 0 0,) <$> arcStepwise 3 (negate $ pi / 2) (V2 0 0) (V2 (-55) 0)
l1 = 55
l2 = 55
x1 = (0,pi/2)
y1 = (0, 0)
y2 = (0,pi/2)
x2 = (0, pi)
-- outDoorps = (V2 0 0,) <$> arcStepwise 3 (negate $ pi / 2) (V2 0 0) (V2 0 55)
-- inDoorps = (V2 0 0,) <$> arcStepwise 3 (negate $ pi / 2) (V2 0 0) (V2 (-55) 0)
airlockZ :: RandomGen g => State g Room
airlockZ = do
@@ -148,10 +156,10 @@ airlockZ = do
-- ]
_rmPmnts =
[ pContID (PS (V2 90 115) pi) (PutButton $ makeSwitch col red NoWorldEffect NoWorldEffect) $
\btid -> airlockDoubleDoor (V2 0 60) (V2 180 60) col (WdBlBtOn btid) outDoorps inDoorps
, -- jspsJ (V2 0 60) 0 (airlockDoor col (cond btid) outDoorps)
-- $ sPS (V2 180 60) 0 (airlockDoor col (cond btid) inDoorps)
sps0 $ PutWall (reverse $ rectNSWE 70 50 60 120) defaultWall
\btid -> airlockDoubleDoor (V2 0 60) (V2 180 60) col (WdBlBtOn btid)
l1 x1 y1 l2 x2 y2
-- outDoorps inDoorps
, sps0 $ PutWall (reverse $ rectNSWE 70 50 60 120) defaultWall
, lighting
]
, _rmBound =
@@ -159,8 +167,14 @@ airlockZ = do
}
where
col = dim $ dim $ bright red
outDoorps = (V2 0 0,) <$> arcStepwise 3 (pi / 2) (V2 0 0) (V2 0 (-61))
inDoorps = (V2 0 0,) <$> arcStepwise 3 (pi / 2) (V2 0 0) (V2 (-61) 0)
l1 = 61
l2 = 61
x1 = (0, -pi/2)
y1 = (0,0)
x2 = (0,-pi)
y2 = (0, -pi/2)
-- outDoorps = (V2 0 0,) <$> arcStepwise 3 (pi / 2) (V2 0 0) (V2 0 (-61))
-- inDoorps = (V2 0 0,) <$> arcStepwise 3 (pi / 2) (V2 0 0) (V2 (-61) 0)
airlock90 :: Room
airlock90 =
@@ -181,7 +195,7 @@ airlock90 =
, _rmPath = doublePairSet (V2 0 40, V2 40 0)
, _rmPmnts =
[ pContID (PS (V2 120 120) (3 * pi / 4)) (PutButton $ makeSwitch col red NoWorldEffect NoWorldEffect) $
\btid -> jsps (V2 5 5) 0 $ airlockDoor col (WdBlBtOn btid) pss
\btid -> jsps (V2 5 5) 0 $ airlockDoor col (WdBlBtOn btid) l1 x1 y1
, mntLS vShape (V2 35 35) (V3 70 70 50)
]
, _rmBound =
@@ -199,7 +213,10 @@ airlock90 =
where
--cond w = or $ M.lookup (DoorNumOpen n) (_worldState w)
col = dim $ dim $ bright red
pss = (V2 0 0,) <$> arcStepwise 3 (negate $ pi / 2) (V2 0 0) (V2 0 55)
l1 = 55
y1 = (0,0)
x1 = (0,pi/2)
-- pss = (V2 0 0,) <$> arcStepwise 3 (negate $ pi / 2) (V2 0 0) (V2 0 55)
airlockCrystal :: Room
airlockCrystal =
@@ -209,7 +226,7 @@ airlockCrystal =
, _rmPath = mempty
, _rmPmnts =
[ pContID (PS (V2 145 70) (pi / 2)) (PutButton $ makeSwitch col red NoWorldEffect NoWorldEffect) $
\btid -> jsps0 $ airlockDoor col (WdBlBtOn btid) pss
\btid -> jsps (V2 40 70) 0 $ airlockDoor col (WdBlBtOn btid) l1 x1 y1
, crystalLine (V2 0 70) (V2 40 70)
, mntLS vShape (V2 150 70) (V3 110 70 70)
]
@@ -218,9 +235,12 @@ airlockCrystal =
where
switchcutout = orderPolygon $ map toV2 [(39, 20), (150, 60), (150, 80), (39, 120)]
col = dim $ dim $ bright red
pss :: [(Point2, Point2)]
pss =
reverse $
fmap
((\x -> (V2 50 (x - 10), V2 50 (x + 60))) . fromIntegral)
[20 :: Int, 22 .. 70]
l1 = 55
x1 = (0,pi/2)
y1 = (V2 0 (-55),pi/2)
--pss :: [(Point2, Point2)]
--pss =
-- reverse $
-- fmap
-- ((\x -> (V2 50 (x - 10), V2 50 (x + 60))) . fromIntegral)
-- [20 :: Int, 22 .. 70]
src/Dodge/Room/Tutorial.hs
+8 -1
View File
@@ -43,9 +43,16 @@ tutAnoTree = do
foldMTRS
[ tToBTree "TutStartRez" . return . cleatOnward <$> tutRezBox
, corDoor
, tToBTree "asdf" . return . cleatOnward <$> airlockZ
--, tToBTree "asdf" . return . cleatOnward <$> airlockZ
, return $ tToBTree "cor" $ return $ cleatOnward corridor
, return $ tToBTree "cor" $ return $ cleatOnward corridor
, return . tToBTree "asdf" . return . cleatOnward $ airlockCrystal
, return $ tToBTree "cor" $ return $ cleatOnward corridor
, return $ tToBTree "cor" $ return $ cleatOnward corridor
, tToBTree "t" . return . cleatOnward <$> slowDoorRoom
, return $ tToBTree "cor" $ return $ cleatOnward corridor
, return $ tToBTree "cor" $ return $ cleatOnward corridor
, return $ tToBTree "cor" $ return $ cleatOnward corridor
, corDoor
, return $ tToBTree "cor" $ return $ cleatOnward corridor
, tutHub
src/Dodge/ShiftPoint.hs
+3
View File
@@ -7,6 +7,9 @@ import Geometry
shiftPointBy :: Point2A -> Point2 -> Point2
shiftPointBy (pos, rot) !p = pos +.+ rotateV rot p
compP2A :: Point2A -> Point2A -> Point2A
compP2A (p1,r1) (p2,r2) = (p1 +.+ rotateV r1 p2, r1 + r2)
invShiftPointBy :: (Point2, Float) -> Point2 -> Point2
invShiftPointBy (p1, r) p2 = rotateV (- r) $ p2 -.- p1