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

Allow to log position of placement spot

Browse Source
This commit is contained in:
justin
2025-09-29 22:34:44 +01:00
parent bf9a2250da
commit a2eb0e026b
13 changed files with 180 additions and 152 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Room/LasTurret.hs
+9 -6
View File
@@ -1,3 +1,4 @@
{-# LANGUAGE TupleSections #-}
module Dodge.Room.LasTurret where
--import Dodge.Item.Held.Cane
@@ -27,7 +28,7 @@ cenLasTur = do
roomNgon 8 200 <&> rmPmnts
.~ [ putLasTurret 0.02
, heightWallPS
(resetPLUse $ rprBoolShift (const . isInLnk) (shiftInBy 100))
(resetPLUse $ rprBoolShift (const . isInLnk) (shiftInBy 100 <&> (,S.singleton UsedPosLow)))
30
covershape
, thelight
@@ -60,7 +61,7 @@ lightSensByDoor i rm =
-- & rmOutPmnt . at i ?~ sensAboveDoor LaserSensor 20 (atFstLnkOutShiftBy sensorshift)
covershape = rectNSWE 10 (-10) (-20) 20
sensorshift (p, a) = (p +.+ rotateV a (V2 60 (-20)), a)
sensorshift (p, a) = ((p +.+ rotateV a (V2 60 (-20)), a),S.singleton UsedPosLow)
keyCardRoomRunPast :: RandomGen g => Int -> Int -> State g (MetaTree Room String)
keyCardRoomRunPast keyid rmid = do
@@ -87,12 +88,13 @@ analyserByNthLink n proxreq i rm =
.++~ [ psPt (atNthLinkOut n) $ PutForeground $ verticalWire (V2 20 0) 0 80
, analyser
(SensorWithRequirement proxreq)
(atNthLnkOutShiftBy n (\(p, a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a)))
(atNthLnkOutShiftBy n (\(p, a) ->
((p +.+ rotateV a (V2 18.5 (-2.5)), a), S.singleton UsedPosLow)))
(atNthLnkOutShiftBy n sensorshift)
& plExternalID ?~ i
]
where
sensorshift (p, a) = (p +.+ rotateV a (V2 (-30) (-10)), a)
sensorshift (p, a) = ((p +.+ rotateV a (V2 (-30) (-10)), a), S.singleton UsedPosLow)
analyserByNthLinkWithPrompt ::
Int -> [TerminalLine] -> ProximityRequirement -> Int -> Placement
@@ -103,12 +105,13 @@ analyserByNthLinkWithPrompt n l proxreq i =
analyserWithPrompt
l
(SensorWithRequirement proxreq)
(atNthLnkOutShiftBy n (\(p, a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a)))
(atNthLnkOutShiftBy n (\(p, a) ->
((p +.+ rotateV a (V2 18.5 (-2.5)), a),S.singleton UsedPosLow)))
(atNthLnkOutShiftBy n sensorshift)
& plExternalID ?~ i
-- ]
where
sensorshift (p, a) = (p +.+ rotateV a (V2 (-30) (-10)), a)
sensorshift (p, a) = ((p +.+ rotateV a (V2 (-30) (-10)), a), S.singleton UsedPosLow)
analyserByDoor :: ProximityRequirement -> Int -> Room -> Room
analyserByDoor = analyserByNthLink 0
src/Dodge/Room/LongDoor.hs
+3 -1
View File
@@ -1,3 +1,4 @@
{-# LANGUAGE TupleSections #-}
-- | Rooms containing long doors, probably with a big reveal behind them.
module Dodge.Room.LongDoor where
@@ -105,7 +106,8 @@ addButtonSlowDoor x h rm = do
where
theterminal =
putMessageTerminal terminalColor (simpleTermMessage themessage)
& plSpot .~ rprBoolShift (isUnusedLnkType InLink) (shiftByV2 (V2 0 (-10)))
& plSpot .~ rprBoolShift (isUnusedLnkType InLink)
(shiftByV2 (V2 0 (-10)) <&> (,S.singleton UsedPosLow))
themessage =
[ "WARNING:"
, "LARGE BIOMASS DETECTED"
src/Dodge/Room/Pillar.hs
+2 -2
View File
@@ -87,7 +87,7 @@ roomPillarsSquare = do
++ concatMap (replicate nlns . makepill) [East, West]
where
makepill edge = sps (rprBool $ \rp _ -> t edge rp) smallPillar
t edge rp = any (f edge) (_rpType rp) && _rpPlacementUse rp == 0
t edge rp = any (f edge) (_rpType rp) && null (_rpPlacementUse rp)
f edge rpt = maybe False (PathFromEdge edge 0 `S.member`) (rpt ^? offPathFromEdges)
roomPillarsPassage :: RandomGen g => State g Room
@@ -114,7 +114,7 @@ roomPillars pillarsize w h wn hn = do
.~ rprBool
( \rp _ ->
rpIsOffPath rp
&& _rpPlacementUse rp == 0
&& null (_rpPlacementUse rp)
&& _rpLinkStatus rp == NotLink
)
)
src/Dodge/Room/Procedural.hs
+7 -5
View File
@@ -96,7 +96,8 @@ roomRect x y xn yn =
zipWith (lnkBothAnd (OnEdge edge) edgefrom1 edgefrom2) [0 ..]
. zipCountDown
pth = linksAndPath' lnks $ map (bimap (+.+ V2 20 20) (+.+ V2 20 20)) (makeGrid xd xn yd yn)
makeonpos (p, a) = RoomPos p 0 (S.singleton $ RoomPosOnPath $ makerpedges a) NotLink 0
makeonpos (p, a) = RoomPos p 0 (S.singleton $ RoomPosOnPath $ makerpedges a)
NotLink mempty
makerpedges (a, b) =
S.fromList
[ PathFromEdge South b
@@ -106,7 +107,8 @@ roomRect x y xn yn =
]
posps' = map (over _1 (+.+ V2 20 20)) $ gridPoints'' xd (xn + 1) yd (yn + 1)
interposps' = map (over _1 (+.+ V2 (20 + xd / 2) (20 + yd / 2))) $ gridPoints'' xd xn yd yn
makeoffpos (p, a) = RoomPos p 0 (S.singleton $ RoomPosOffPath $ makerpedges' a) NotLink 0
makeoffpos (p, a) = RoomPos
p 0 (S.singleton $ RoomPosOffPath $ makerpedges' a) NotLink mempty
makerpedges' (a, b) =
S.fromList
[ PathFromEdge South b
@@ -203,8 +205,8 @@ quarterRoomTri w = do
]
, _rmPmnts = b ++ [mntLS iShape (V2 (w -20) w) (V3 (w -20) (w -20) 70)]
, _rmPos =
[ RoomPos (V2 (w -20) (w -20)) pi S.empty NotLink 0
, RoomPos (V2 (w -15) (w -25)) pi S.empty NotLink 0
[ RoomPos (V2 (w -20) (w -20)) pi S.empty NotLink mempty
, RoomPos (V2 (w -15) (w -25)) pi S.empty NotLink mempty
]
, _rmBound = [[V2 0 0, V2 w w, V2 (- w) w]]
}
@@ -252,7 +254,7 @@ quarterRoomSquare w = do
]
, _rmPmnts = b ++ [blockLine (V2 (w / 2) (w / 2)) (V2 0 w)]
, _rmPos =
[ RoomPos p pi S.empty NotLink 0
[ RoomPos p pi S.empty NotLink mempty
| p <- [V2 20 (2 * w -40), V2 25 (2 * w -45)]
]
, --, _rmBound = [map toV2 [(w,w),(0,2*w),(-w,w)]]
src/Dodge/Room/Room.hs
+4 -4
View File
@@ -201,7 +201,7 @@ weaponBetweenPillars = do
let wpPos = rprBool $ \rp r ->
and
[ rpIsOnPath rp
, _rpPlacementUse rp == 0
, null $ _rpPlacementUse rp
, _rpLinkStatus rp == NotLink
, any ((< 100) . dist (_rpPos rp)) (usedRoomInLinkPoss r)
]
@@ -211,7 +211,7 @@ weaponBetweenPillars = do
randDirPS $
rprBool $ \rp r ->
rpIsOnPath rp
&& _rpPlacementUse rp == 0
&& null (_rpPlacementUse rp)
&& all ((> 100) . dist (_rpPos rp)) (usedRoomLinkPoss r)
( roomPillars 30 w h wn hn
<&> rmPmnts .++~ map (`sps` randC1) critPlacementSpots ++ [sps wpPos (PutFlIt wp)]
@@ -329,7 +329,7 @@ pistolerRoom = do
.++~ replicate
3
( psPtPl
(rprBool $ \rp _ -> _rpPlacementUse rp == 0 && rpIsOnPath rp)
(rprBool $ \rp _ -> null (_rpPlacementUse rp) && rpIsOnPath rp)
(PutCrit chaseCrit)
)
@@ -369,7 +369,7 @@ spawnerRoom = do
roomC x y <&> rmPmnts
.:~ psPtPl
( rprBool $ \rp _ ->
_rpPlacementUse rp == 0 && rpIsOnPath rp
null (_rpPlacementUse rp) && rpIsOnPath rp
&& xV2 (_rpPos rp) < x / 2
&& yV2 (_rpPos rp) < y / 2
)
src/Dodge/Room/SensorDoor.hs
+3 -3
View File
@@ -1,4 +1,4 @@
--{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TupleSections #-}
module Dodge.Room.SensorDoor (sensAboveDoor,sensorRoomRunPast) where
import Dodge.Data.MTRS
@@ -53,7 +53,7 @@ sensorRoomRunPast dt n = do
sensAboveDoor :: SensorType -> Float -> PlacementSpot -> Placement
sensAboveDoor sensetype wth ps =
extTrigLitPos
(atFstLnkOutShiftBy (\(p, a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a)))
(atFstLnkOutShiftBy (\(p, a) -> ((p +.+ rotateV a (V2 18.5 (-2.5)), a), S.singleton UsedPosHigh)))
(\tp -> Just $ damageSensor sensetype wth (_plMID tp) ps)
sensInsideDoor :: SensorType -> Int -> Room -> Room
@@ -65,7 +65,7 @@ sensInsideDoor senseType i rm = rm
, psPt atFstLnkOut . PutForeground $ verticalWire (V2 20 0) 0 80
, putMessageTerminal terminalColor
(textTerminal & tmCommands .:~ TCDamageCommand)
& plSpot .~ rprBoolShift isUnusedLnk (shiftInBy 10)
& plSpot .~ rprBoolShift isUnusedLnk (shiftInBy 10 <&> (, S.singleton UsedPosHigh))
, sensAboveDoor senseType 10 (atFstLnkOutShiftInward 100) & plExternalID ?~ i
]
-- & rmOutPmnt . at i ?~ sensAboveDoor senseType 10 (atFstLnkOutShiftInward 100)
src/Dodge/Room/Tanks.hs
+2 -2
View File
@@ -56,7 +56,7 @@ randEdgeTank = do
& plSpot
.~ rprBool
( \rp _ ->
_rpPlacementUse rp == 0
null (_rpPlacementUse rp)
&& rpOffPathFromEdge (PathFromEdge edge 0) rp
)
@@ -85,7 +85,7 @@ randEdgeTanks i = do
& plSpot
.~ rprBool
( \rp _ ->
_rpPlacementUse rp == 0
null (_rpPlacementUse rp)
&& rpOffPathFromEdge (PathFromEdge edge 0) rp
)
src/Dodge/Room/Tutorial.hs
+3 -2
View File
@@ -1,5 +1,6 @@
module Dodge.Room.Tutorial where
import qualified Data.Set as S
import ShortShow
import Dodge.Data.MTRS
import Dodge.Room.Room
@@ -86,7 +87,7 @@ tutDrop = do
terminalColor
(defaultTerminal & tmBootLines .~ ss <> tlSetStatus (TerminalPressTo $ show x <>"QUIT") <> tlDoEffect TmWdWdPowerDownTerminal)
& plSpot .~ rprBoolShift isUnusedLnk
(\(p, a) -> (p + 10 *.* unitVectorAtAngle (a - pi/2), a))
(\(p, a) -> ((p + 10 *.* unitVectorAtAngle (a - pi/2), a), S.singleton UsedPosLow))
ss =
[makeTermLine "--------------------------------------------"
,makeTermLine "YOU CAN ONLY CARRY A LIMITED AMOUNT OF ITEMS"
@@ -151,7 +152,7 @@ tutHub = do
terminalColor
(defaultTerminal & tmBootLines .~ ss' <> tlSetStatus (TerminalPressTo "QUIT") <> tlDoEffect TmWdWdPowerDownTerminal)
& plSpot .~ rprBoolShift isUnusedLnk
(\(p, a) -> (p + 10 *.* unitVectorAtAngle (a - pi/2), a))
(\(p, a) -> ((p + 10 *.* unitVectorAtAngle (a - pi/2), a),S.singleton UsedPosLow))
ss' =
[ makeTermLine "---------------------------------------------"
, makeTermLine "HOLD [CAPS] AND SCROLL"
src/Dodge/Room/Warning.hs
+29 -19
View File
@@ -1,15 +1,19 @@
--{-# LANGUAGE TupleSections #-}
module Dodge.Room.Warning (warningRooms,addDoorToggleTerminal
, addDoorAtNthLinkToggleTerminal) where
module Dodge.Room.Warning (
warningRooms,
addDoorToggleTerminal,
addDoorAtNthLinkToggleTerminal,
) where
import Control.Monad
import Dodge.Default.Terminal
import Dodge.Data.BlBl
import Color
import Control.Monad
import qualified Data.Map.Strict as M
import Data.Maybe
import qualified Data.Set as S
import Dodge.Cleat
import Dodge.Data.BlBl
import Dodge.Data.GenWorld
import Dodge.Default.Terminal
import Dodge.Placement.Instance
import Dodge.PlacementSpot
import Dodge.Room.Door
@@ -34,32 +38,37 @@ addDoorToggleTerminal :: [TerminalLine] -> Int -> Room -> Room
addDoorToggleTerminal = addDoorAtNthLinkToggleTerminal 0
addDoorAtNthLinkToggleTerminal :: Int -> [TerminalLine] -> Int -> Room -> Room
addDoorAtNthLinkToggleTerminal j xs i = (rmName .++~ "doorToggle-")
-- . (rmOutPmnt . at i ?~ outplace)
addDoorAtNthLinkToggleTerminal j xs i =
(rmName .++~ "doorToggle-")
-- . (rmOutPmnt . at i ?~ outplace)
. (rmPmnts .:~ outplace)
where
outplace =
extTrigLitPos
(atNthLnkOutShiftBy j (\(p, a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a)))
( Just . set plSpot (rprShift (moveToSideNthOutLink j))
(atNthLnkOutShiftBy j (\(p, a) -> ((p +.+ rotateV a (V2 18.5 (-2.5)), a), S.singleton UsedPosLow)))
( Just . set plSpot (rprShift (moveToSideNthOutLink (S.singleton UsedPosLow) j))
. putMessageTerminal terminalColor
. termMessages
) & plExternalID ?~ i
)
& plExternalID
?~ i
termMessages trpl =
lineOutputTerminal xs --(makeColorTermLine red "WARNING" : makeTermPara str)
& tmToggles .~ M.fromList
& tmToggles
.~ M.fromList
[("DOOR", TerminalToggle (fromJust $ _plMID trpl) (BlConst True))]
addWarningTerminal :: String -> Int -> Room -> Room
addWarningTerminal str = addDoorToggleTerminal
(makeColorTermLine red "WARNING" : makeTermPara str)
addWarningTerminal str =
addDoorToggleTerminal
(makeColorTermLine red "WARNING" : makeTermPara str)
lineOutputTerminal :: [TerminalLine] -> Terminal
lineOutputTerminal tls = defaultTerminal & tmBootLines .~ textInputBlurb tls
moveToSideNthOutLink :: Int -> RoomPos -> Room -> Maybe (Point2, Float)
moveToSideNthOutLink i rp rm = do
moveToSideNthOutLink :: S.Set UsedPos
-> Int -> RoomPos -> Room -> Maybe ((Point2, Float), S.Set UsedPos)
moveToSideNthOutLink xs i rp rm = do
j <- rp ^? rpLinkStatus . rplsChildNum
guard $ i == j
let rppos = _rpPos rp
@@ -67,11 +76,12 @@ moveToSideNthOutLink i rp rm = do
inpos = rppos +.+ rotateV rpdir (V2 0 (-12.5))
rtpos = inpos +.+ rotateV rpdir (V2 30 0)
ltpos = inpos +.+ rotateV rpdir (V2 (-30) 0)
return $ if any (isJust . intersectSegPolyFirst inpos ltpos) (_rmPolys rm)
return $
if any (isJust . intersectSegPolyFirst inpos ltpos) (_rmPolys rm)
then -- the above test may not work properly if the room polys are
-- complicated, it should really use created walls...
(rtpos, rpdir)
else (ltpos, rpdir)
((rtpos, rpdir), xs)
else ((ltpos, rpdir), xs)
--moveToSideFirstOutLink :: RoomPos -> Room -> Maybe (Point2, Float)
--moveToSideFirstOutLink rp rm = do