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

Cleanup, fix damage code terminal bug

Browse Source
This commit is contained in:
justin
2025-08-20 15:59:22 +01:00
parent 9daa27ee8b
commit 4bf9ce59d5
12 changed files with 153 additions and 177 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Room/SensorDoor.hs
+16 -27
View File
@@ -1,7 +1,5 @@
--{-# LANGUAGE TupleSections #-}
module Dodge.Room.SensorDoor where
--import Dodge.RoomLink
module Dodge.Room.SensorDoor (sensAboveDoor,sensorRoomRunPast) where
import qualified Data.Set as S
import Dodge.Annotation.Data
@@ -28,8 +26,7 @@ sensorRoom :: RandomGen g => SensorType -> Int -> State g (Tree Room)
sensorRoom senseType n = do
rm <- takeOne [roomNgon 8 200, roomRectAutoLinks 200 200]
cenroom <- shuffleLinks $ sensInsideDoor senseType n rm
return $
treePost
return $ treePost
[ door
, cenroom & rmLinkEff .~ f
, triggerDoorRoom n
@@ -48,17 +45,9 @@ sensorRoom senseType n = do
sensorRoomRunPast :: RandomGen g => SensorType -> Int -> State g MTRS
sensorRoomRunPast dt n = do
t <- sensorRoom dt n
rToOnward "sensorRoomRunPast" $
t
& applyToSubforest
[0]
( ++
[ treePost
[ door & rmConnectsTo .~ (\s -> S.member InLink s && not (S.member BlockedLink s))
, cleatLabel n corridor
]
]
)
rToOnward "sensorRoomRunPast" $ t
& applyToSubforest [0]
( ++ [ treePost [ door & rmConnectsTo .~ (\s -> S.member InLink s && not (S.member BlockedLink s)) , cleatLabel n corridor ] ])
sensAboveDoor :: SensorType -> Float -> PlacementSpot -> Placement
sensAboveDoor sensetype wth ps =
@@ -67,14 +56,14 @@ sensAboveDoor sensetype wth ps =
(\tp -> Just $ damageSensor sensetype wth (_plMID tp) ps)
sensInsideDoor :: SensorType -> Int -> Room -> Room
sensInsideDoor senseType outplid rm =
rm
& rmName .++~ take 4 (show senseType)
& rmPmnts
.++~ [ psPt atFstLnkOut . PutForeground $ floorWire (V2 20 0) (V2 20 (-100))
, psPt atFstLnkOut . PutForeground $ floorWire (V2 0 (-100)) (V2 20 (-100))
, psPt atFstLnkOut . PutForeground $ verticalWire (V2 20 0) 0 80
, putMessageTerminal terminalColor (textTerminal & tmCommands .:~ TCDamageCommand)
& plSpot .~ rprBoolShift isUnusedLnk (shiftInBy 10)
]
& rmOutPmnt .~ [OutPlacement (sensAboveDoor senseType 10 (atFstLnkOutShiftInward 100)) outplid]
sensInsideDoor senseType outplid rm = rm
& rmName .++~ take 4 (show senseType)
& rmPmnts
.++~ [ psPt atFstLnkOut . PutForeground $ floorWire (V2 20 0) (V2 20 (-100))
, psPt atFstLnkOut . PutForeground $ floorWire (V2 0 (-100)) (V2 20 (-100))
, psPt atFstLnkOut . PutForeground $ verticalWire (V2 20 0) 0 80
, putMessageTerminal terminalColor
(textTerminal & tmCommands .:~ TCDamageCommand)
& plSpot .~ rprBoolShift isUnusedLnk (shiftInBy 10)
]
& rmOutPmnt .~ [OutPlacement (sensAboveDoor senseType 10 (atFstLnkOutShiftInward 100)) outplid]