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

Work on airlocks

Browse Source
This commit is contained in:
justin
2025-08-23 17:42:36 +01:00
parent f641805845
commit 32d7120177
19 changed files with 380 additions and 334 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Room/Airlock.hs
+26 -1
View File
@@ -3,6 +3,7 @@
{- Rooms that contain two doors and a switch alternating both. -}
module Dodge.Room.Airlock where
import Dodge.Annotation.Data
import Dodge.Data.GenWorld
import Dodge.Default.Door
import Dodge.Default.Room
@@ -14,12 +15,36 @@ import Dodge.RoomLink
import Geometry
import Picture
import RandomHelp
import Control.Lens
-- | A passage with a switch that opens forward access while closing backwards access.
airlock :: RandomGen g => State g Room
airlock = takeOne [airlock0, airlock90, airlockCrystal, airlockZ]
--airlock = takeOne [airlockCrystal]
decontamRoom :: State LayoutVars Room
decontamRoom = do
return $ defaultRoom
& rmPolys .~ [rectNSWE 100 0 0 40, switchcut]
& rmLinks .~ muout lnks ++ muin [last lnks]
& rmPath .~ foldMap doublePairSet [(V2 20 95, V2 20 45), (V2 20 45, V2 20 5)]
& rmPmnts .~
[ pContID (PS (V2 (-35) 50) (negate $ pi / 2)) (PutButton $ makeSwitch col red NoWorldEffect NoWorldEffect) $
\btid -> Just $
putDoubleDoorThen DoorObstacle thewall (WdBlNegate $ WdBlBtOn btid) 1 (V2 0 20) (V2 40 20) 2 $
\_ _ -> Just $ putDoubleDoor DoorObstacle thewall (WdBlBtOn btid) (V2 0 80) (V2 40 80) 2
, invisibleWall $ rectNSWE 60 40 (-40) (-30)
, spanLightI (V2 (-2) 30) (V2 (-2) 70)
]
& rmBound .~ [rectNSWE 75 15 0 40, switchcut]
where
thewall = switchWallCol col
switchcut = rectNSWE 65 35 (-40) 80
lnks =
[ (V2 20 95, 0)
, (V2 20 5, pi)
]
col = dim $ dim $ bright red
-- | Straight airlock
airlock0 :: Room
@@ -124,7 +149,7 @@ airlock90 =
defaultRoom
{ _rmPolys =
[ rectNSWE 100 10 10 100
, rectNSWE 20 0 20 60
, rectNSWE 20 (-0.1) 20 60
, rectNSWE 20 60 20 0
, map
toV2
src/Dodge/Room/Door.hs
+2 -2
View File
@@ -39,6 +39,6 @@ triggerDoorRoom inplid =
-- note no bounds
}
where
f (pmnt : _) = putDoubleDoor DoorObstacle (switchWallCol red) (cond pmnt) (V2 0 20) (V2 40 20) 2
f _ = error "tried to put a door using an empty placement list"
f _ (pmnt : _) = putDoubleDoor DoorObstacle (switchWallCol red) (cond pmnt) (V2 0 20) (V2 40 20) 2
f _ _ = error "tried to put a door using an empty placement list"
cond pmnt = WdTrig $ fromJust (_plMID pmnt)
src/Dodge/Room/LasTurret.hs
+7 -9
View File
@@ -35,24 +35,24 @@ cenLasTur =
covershape = rectNSWE 10 (-10) (-20) 20
lightSensInsideDoor :: Int -> Room -> Room
lightSensInsideDoor outplid rm =
lightSensInsideDoor i rm =
rm
& 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)
]
& rmOutPmnt .~ [OutPlacement (sensAboveDoor LaserSensor 10 (atFstLnkOutShiftInward 100)) outplid]
& rmOutPmnt . at i ?~ (sensAboveDoor LaserSensor 10 (atFstLnkOutShiftInward 100))
lightSensByDoor :: Int -> Room -> Room
lightSensByDoor outplid rm =
lightSensByDoor i rm =
rm
& rmPmnts
.++~ [ psPt atFstLnkOut $ PutForeground $ verticalWire (V2 20 0) 0 80
, heightWallPS (atNthLnkOutShiftInward 1 100) 30 covershape
, heightWallPS (atFstLnkOutShiftInward 100) 30 covershape
]
& rmOutPmnt .~ [OutPlacement (sensAboveDoor LaserSensor 20 (atFstLnkOutShiftBy sensorshift)) outplid]
& rmOutPmnt . at i ?~ (sensAboveDoor LaserSensor 20 (atFstLnkOutShiftBy sensorshift))
where
covershape = rectNSWE 10 (-10) (-20) 20
sensorshift (p, a) = (p +.+ rotateV a (V2 60 (-20)), a)
@@ -76,21 +76,19 @@ healthAnalyserByDoor :: Int -> Room -> Room
healthAnalyserByDoor = analyserByDoor (RequireHealth 1100)
analyserByNthLink :: Int -> ProximityRequirement -> Int -> Room -> Room
analyserByNthLink n proxreq outplid rm =
analyserByNthLink n proxreq i rm =
rm
& rmPmnts
.++~ [ psPt (atNthLinkOut n) $ PutForeground $ verticalWire (V2 20 0) 0 80
]
& rmOutPmnt
.:~ OutPlacement
& rmOutPmnt . at i ?~
( analyser
proxreq
(atNthLnkOutShiftBy n (\(p, a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a)))
(atNthLnkOutShiftBy n sensorshift)
)
outplid
where
sensorshift (p, a) = (p +.+ rotateV a (V2 30 (-10)), a)
sensorshift (p, a) = (p +.+ rotateV a (V2 (-30) (-10)), a)
analyserByDoor :: ProximityRequirement -> Int -> Room -> Room
analyserByDoor = analyserByNthLink 0
src/Dodge/Room/RoadBlock.hs
+1 -1
View File
@@ -61,7 +61,7 @@ longBlockedCorridor maxn = do
n <- state $ randomR (0, maxn)
let plmnts =
[ sPS (V2 20 40) r $ dirtPoly $ square 10
, sPS (V2 20 15) 0 putLamp
-- , sPS (V2 20 15) 0 putLamp
]
sequence $
treeFromPost (replicate n $ shuffleLinks corridor) $
src/Dodge/Room/RunPast.hs
+2 -1
View File
@@ -2,6 +2,7 @@ module Dodge.Room.RunPast (
lockedStart,
) where
import qualified Data.IntMap.Strict as IM
import Color
import qualified Data.Set as S
import Dodge.Cleat
@@ -50,7 +51,7 @@ lockedStart i = do
map (over root $ rmConnectsTo .~ S.member theedge) doorrooms
++ [ return
smallRoom
{ _rmOutPmnt = [OutPlacement (putLitButOnPosExtTrig red useUnusedLnk) i]
{ _rmOutPmnt = IM.singleton i (putLitButOnPosExtTrig red useUnusedLnk)
, _rmPmnts = [plRRpt 0 (PutFlIt theweapon)]
, _rmBound = [rectNSWE 70 30 0 40]
}
src/Dodge/Room/SensorDoor.hs
+2 -2
View File
@@ -56,7 +56,7 @@ sensAboveDoor sensetype wth ps =
(\tp -> Just $ damageSensor sensetype wth (_plMID tp) ps)
sensInsideDoor :: SensorType -> Int -> Room -> Room
sensInsideDoor senseType outplid rm = rm
sensInsideDoor senseType i rm = rm
& rmName .++~ take 4 (show senseType)
& rmPmnts
.++~ [ psPt atFstLnkOut . PutForeground $ floorWire (V2 20 0) (V2 20 (-100))
@@ -66,4 +66,4 @@ sensInsideDoor senseType outplid rm = rm
(textTerminal & tmCommands .:~ TCDamageCommand)
& plSpot .~ rprBoolShift isUnusedLnk (shiftInBy 10)
]
& rmOutPmnt .~ [OutPlacement (sensAboveDoor senseType 10 (atFstLnkOutShiftInward 100)) outplid]
& rmOutPmnt . at i ?~ (sensAboveDoor senseType 10 (atFstLnkOutShiftInward 100))
src/Dodge/Room/Tutorial.hs
+21 -19
View File
@@ -1,5 +1,9 @@
module Dodge.Room.Tutorial (tutAnoTree) where
import Dodge.Room.Corridor
import Dodge.Room.Airlock
import Dodge.Room.RoadBlock
import Dodge.Room.Room
import Dodge.Item.Held.Cane
import Dodge.Item.Ammo
import Dodge.Annotation.Data
@@ -22,7 +26,6 @@ import Dodge.Room.Ngon
--import Dodge.Room.Link
import Dodge.Room.Procedural
import Dodge.Room.RezBox
import Dodge.Room.Room
import Dodge.Room.Warning
--import Dodge.Room.RoadBlock
import Dodge.RoomLink
@@ -40,25 +43,21 @@ import TreeHelp
tutAnoTree :: Annotation
tutAnoTree =
OnwardList $
[ AnTree $ tToBTree "TutStartRez" . return . cleatOnward <$> tutRezBox
[ AnTree $ return $ tToBTree "teststart" $ return $ cleatOnward corridor
, AnTree $ tutDrop
, AnTree $ tToBTree "TutStartRez" . return . cleatOnward <$> tutRezBox
, AnTree corDoor
, AnTree $ tutRooms
, AnTree $ pickupTut
, AnTree $ weaponTut
, AnTree $ tutDrop
-- , AnTree $ pickupTut
-- , AnTree $ weaponTut
]
weaponTut :: State LayoutVars (MetaTree Room String)
weaponTut = do
tutDrop :: State LayoutVars (MetaTree Room String)
tutDrop = do
x <- shuffleLinks $ roomNgon 6 100
& rmPmnts .:~ sps (PS 0 0) (PutFlIt $ burstRifle)
return $ tToBTree "WeaponTestTest" $ treePost $ [x]
pickupTut :: State LayoutVars (MetaTree Room String)
pickupTut = do
i <- nextLayoutInt
x <- shuffleLinks $ analyserByDoor (RequireEquipment (AMMOMAG DRUMMAG)) i $ roomNgon 6 100
& rmPmnts .:~ sps (PS 0 0) (PutFlIt $ drumMag & itConsumables ?~ 100)
return $ tToBTree "PickupTest" $ treePost $ [x, cleatOnward $ triggerDoorRoom i]
y <- decontamRoom
return $ tToBTree "TutDrop" $ treePost [x,y,roomRectAutoLinks 40 100]
tutRooms :: State LayoutVars (MetaTree Room String)
tutRooms = do
@@ -67,12 +66,15 @@ tutRooms = do
x <- shuffleLinks $ analyserByDoor (RequireEquipment (AMMOMAG DRUMMAG)) i
$ addDoorAtNthLinkToggleTerminal 1 (makeTermPara s) j
$ roomNgon 6 100
bcor <- blockedCorridor
return $ tToBTree "DoorTest" $ Node x
[Node (cleatOnward $ triggerDoorRoom i) []
,Node ( triggerDoorRoom j) []
[treeFromPost [triggerDoorRoom i] (r burstRifle)
,treeFromPost [triggerDoorRoom j] (r (drumMag & itConsumables ?~ 100))
,bcor
]
where
s = "INTERACTION TEST 1: USE KEYBOARD OR SCROLL TO ENTER COMMANDS."
s = "INTERACTION TEST: USE KEYBOARD OR SCROLL TO ENTER COMMANDS."
r x = roomRectAutoLinks 100 100 & rmPmnts .:~ sps (PS 50 0) (PutFlIt x)
tutRezBox :: RandomGen g => State g Room
tutRezBox = do
@@ -91,4 +93,4 @@ tutRezBox = do
s = tutorialMessage1
tutorialMessage1 :: String
tutorialMessage1 = "SYNTHESIS SUCCESSFUL. MOVEMENT TEST 1 INITIATED [WASD]. INTERACTION TEST 1 IN QUEUE [SPACE]."
tutorialMessage1 = "SYNTHESIS SUCCESSFUL. MOBILITY TEST INITIATED [WASD]. INTERACTION TEST IN QUEUE [SPACE]."
src/Dodge/Room/Warning.hs
+1 -1
View File
@@ -36,7 +36,7 @@ addDoorToggleTerminal = addDoorAtNthLinkToggleTerminal 0
addDoorAtNthLinkToggleTerminal :: Int -> [TerminalLine] -> Int -> Room -> Room
addDoorAtNthLinkToggleTerminal j xs i = (rmName .++~ "doorToggle-")
. (rmOutPmnt .:~ OutPlacement outplace i)
. (rmOutPmnt . at i ?~ outplace)
where
outplace =
extTrigLitPos