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

Move toward moving lights on doors

Browse Source
This commit is contained in:
justin
2022-03-09 22:41:17 +00:00
parent 027b4b7d8b
commit c583d33b57
6 changed files with 31 additions and 25 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data.hs
+3 -3
View File
@@ -739,9 +739,9 @@ data Door = Door
, _drStatus :: DoorStatus
, _drTrigger :: World -> Bool
, _drMech :: Door -> World -> World
, _drPos :: Point2
, _drOpenPos :: Point2
, _drClosePos :: Point2
, _drPos :: (Point2,Point2)
, _drOpenPos :: (Point2,Point2)
, _drClosePos :: (Point2,Point2)
}
data DoorStatus = DoorOpen | DoorClosed | DoorHalfway | DoorInt Int
deriving (Eq, Ord, Show)
src/Dodge/Placement/Instance/Door.hs
+8 -4
View File
@@ -15,12 +15,16 @@ import Dodge.LevelGen.Switch
import qualified Data.IntMap.Strict as IM
putDoubleDoor :: Bool -> Color -> (World -> Bool) -> Point2 -> Point2 -> Float -> Placement
putDoubleDoor pathing col cond a b speed = putDoubleDoorThen pathing col cond a b speed Nothing
putDoubleDoor pathing col cond a b speed
= putDoubleDoorThen pathing col cond a b speed (const $ const Nothing)
putDoubleDoorThen :: Bool -> Color -> (World -> Bool)
-> Point2 -> Point2 -> Float -> Maybe Placement -> Placement
putDoubleDoorThen pathing col cond a b speed mayp = ps0j (PutSlideDr pathing col cond a half speed)
$ Placement (PS (V2 0 0) 0) ( PutSlideDr pathing col cond b half speed) Nothing $ const mayp
-> Point2 -> Point2 -> Float
-> (Placement -> Placement -> Maybe Placement)
-> Placement
putDoubleDoorThen pathing col cond a b speed cont = pt0 (PutSlideDr pathing col cond a half speed)
$ \pl1 -> Just $ Placement (PS (V2 0 0) 0) ( PutSlideDr pathing col cond b half speed) Nothing
$ \pl2 -> cont pl1 pl2
where
half = 0.5 *.* (a +.+ b)
src/Dodge/Placement/PlaceSpot/TriggerDoor.hs
+16 -15
View File
@@ -33,12 +33,10 @@ 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
, _drPos = head pss
, _drOpenPos = head pss
, _drClosePos = last pss
}
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
@@ -56,6 +54,8 @@ addDoorWall col pathableStatus w (wlid,wlps) = w & walls %~ IM.insert wlid defau
-- 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
-- perhaps only store intermediate door pos pairs, calculate all wall positions
-- on the fly
doorMechanismStepwise :: Int -> Int -> [Int] -> [(Point2,Point2)] -> Door -> World -> World
doorMechanismStepwise nsteps drid wlids pss dr w
| toOpen = case _drStatus dr of
@@ -78,19 +78,20 @@ 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)
& doors . ix drid . drPos %~ mvPs speed (_drOpenPos dr)
| not toOpen && dstatus /= DoorClosed = moveUpdate $ foldl' doClose w wlidOpCps
& doors . ix drid . drPos %~ mvP speed (_drClosePos dr)
& doors . ix drid . drPos %~ mvPs speed (_drClosePos dr)
| otherwise = w
where
moveUpdate = playSound . setStatus
playSound = soundContinue (WallSound drid) (fst cpos) slideDoorS (Just 1)
playSound = soundContinue (WallSound drid) dpos slideDoorS (Just 1)
dpos = snd $ _drPos dr
dop = snd $ _drOpenPos dr
dcp = snd $ _drClosePos dr
setStatus
| dist (_drPos dr) (_drOpenPos dr) < 1 = doors . ix drid . drStatus .~ DoorOpen
| dist (_drPos dr) (_drClosePos dr) < 1 = doors . ix drid . drStatus .~ DoorClosed
| dist dpos dop < 1 = doors . ix drid . drStatus .~ DoorOpen
| dist dpos dcp < 1 = doors . ix drid . drStatus .~ DoorClosed
| otherwise = doors . ix drid . drStatus .~ DoorHalfway
(wlid',opos,cpos) = head wlidOpCps
wlpos = _wlLine $ _walls w IM.! wlid'
toOpen = _drTrigger dr w
dstatus = _drStatus dr
doOpen w' (wlid,opp, _) = moveWallIDToward wlid speed opp w'
@@ -109,9 +110,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
, _drPos = (a,b)
, _drOpenPos = (shiftLeft a,shiftLeft b)
, _drClosePos = (a,b)
}
addWalls w' = foldl' (addDoorWall col isPathable) w' $ zip wlids pairs
pairs = rectanglePairs 9 a b
src/Dodge/Room/Airlock.hs
+1 -1
View File
@@ -29,7 +29,7 @@ airlock0 = defaultRoom
, _rmPmnts =
[pContID (PS (V2 (-35) 50) (negate $ pi/2)) (PutButton $ makeSwitch col red id id)
$ \btid -> Just $ putDoubleDoorThen False col (not . cond' btid) (V2 (-1) 20) (V2 41 20) 2
$ Just $ putDoubleDoorThen False col (cond' btid) (V2 (-1) 80) (V2 41 80) 2 Nothing
$ \_ _ -> Just $ putDoubleDoor False col (cond' btid) (V2 (-1) 80) (V2 41 80) 2
,spanLightI (V2 (-2) 30) (V2 (-2) 70)
,sps0 $ PutShape $ thinHighBar 75 (V2 40 50) (V2 (-1) 50)
]
src/Dodge/Room/LongDoor.hs
+2 -1
View File
@@ -117,7 +117,8 @@ addButtonSlowDoor x h rm = do
belowH y = (sndV2 . fst) y < h - 40
aboveH y = (sndV2 . fst) y > h + 40
butDoor _ _ = putLitButOnPos col butPosCond
$ \btid -> Just $ putDoubleDoor False col (cond' btid) (V2 0 h) (V2 x h) 2
$ \btid -> Just $ putDoubleDoorThen False col (cond' btid) (V2 0 h) (V2 x h) 2
$ \dr1 dr2 -> Nothing
butPosCond (UnusedLink (V2 x' y') a' _) _ | y' < 0.5 * h
= Just (PS (V2 x' y') a' , UsedSpot (V2 x' y') a' (S.singleton RoomPosExLink))
butPosCond _ _ = Nothing
src/Dodge/Wall/Move.hs
+1 -1
View File
@@ -3,7 +3,7 @@ module Dodge.Wall.Move
( moveWallID
, moveWall
, moveWallIDToward
, mvP
, mvPs
) where
import Dodge.Data
import Dodge.Base