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

Start to remove explicit "outplacements"

Browse Source
This commit is contained in:
justin
2025-09-23 17:11:07 +01:00
parent ef90e5702b
commit a6ca90d7d8
15 changed files with 67 additions and 44 deletions
Download Patch File Download Diff File Expand all files Collapse all files
saveSlot/LevelStart0
+1 -1
View File
File diff suppressed because one or more lines are too long
src/Dodge/Data/GenWorld.hs
+1
View File
@@ -81,6 +81,7 @@ data Placement = Placement
{ _plSpot :: PlacementSpot { _plSpot :: PlacementSpot
, _plType :: PSType , _plType :: PSType
, _plMID :: Maybe Int , _plMID :: Maybe Int
, _plExternalID :: Maybe Int
, _plIDCont :: GenWorld -> Placement -> Maybe Placement , _plIDCont :: GenWorld -> Placement -> Maybe Placement
} }
src/Dodge/Layout.hs
+1 -1
View File
@@ -91,7 +91,7 @@ doRoomInPlacements w rm = foldr f (w, rm) $ _rmInPmnt rm
doOutPlacements :: GenWorld -> GenWorld doOutPlacements :: GenWorld -> GenWorld
doOutPlacements w = doOutPlacements w =
let ((pmnts, gw), rms) = mapAccumR doRoomOutPlacements (IM.empty, w) (_genRooms w) let ((pmnts, gw), rms) = mapAccumR doRoomOutPlacements (IM.empty, w) (_genRooms w)
in gw & genRooms .~ rms & genPmnt .~ pmnts in gw & genRooms .~ rms & genPmnt <>~ pmnts
doRoomOutPlacements :: doRoomOutPlacements ::
(IM.IntMap [Placement], GenWorld) -> (IM.IntMap [Placement], GenWorld) ->
src/Dodge/LevelGen/PlacementHelper.hs
+20 -20
View File
@@ -7,34 +7,34 @@ import Geometry
--spNoID --spNoID
psPtPl :: PlacementSpot -> PSType -> Placement psPtPl :: PlacementSpot -> PSType -> Placement
psPtPl ps pst = Placement ps pst Nothing (const . const Nothing) psPtPl ps pst = Placement ps pst Nothing Nothing (const . const Nothing)
psPtJpl :: PlacementSpot -> PSType -> Maybe Placement psPtJpl :: PlacementSpot -> PSType -> Maybe Placement
psPtJpl ps = Just . psPtPl ps psPtJpl ps = Just . psPtPl ps
pContID :: PlacementSpot -> PSType -> (Int -> Maybe Placement) -> Placement pContID :: PlacementSpot -> PSType -> (Int -> Maybe Placement) -> Placement
pContID ps pt = Placement ps pt Nothing . contToIDCont pContID ps pt = Placement ps pt Nothing Nothing . contToIDCont
psPtCont :: PlacementSpot -> PSType -> (Placement -> Maybe Placement) -> Placement psPtCont :: PlacementSpot -> PSType -> (Placement -> Maybe Placement) -> Placement
psPtCont ps pt = Placement ps pt Nothing . const psPtCont ps pt = Placement ps pt Nothing Nothing . const
ptCont :: PSType -> (Placement -> Maybe Placement) -> Placement ptCont :: PSType -> (Placement -> Maybe Placement) -> Placement
ptCont = psPtCont (PS 0 0) ptCont = psPtCont (PS 0 0)
psPt :: PlacementSpot -> PSType -> Placement psPt :: PlacementSpot -> PSType -> Placement
psPt ps pt = Placement ps pt Nothing (const . const Nothing) psPt ps pt = Placement ps pt Nothing Nothing (const . const Nothing)
sPS :: Point2 -> Float -> PSType -> Placement sPS :: Point2 -> Float -> PSType -> Placement
sPS p a pt = Placement (PS p a) pt Nothing (const . const Nothing) sPS p a pt = Placement (PS p a) pt Nothing Nothing (const . const Nothing)
sps :: PlacementSpot -> PSType -> Placement sps :: PlacementSpot -> PSType -> Placement
sps ps pt = Placement ps pt Nothing (const . const Nothing) sps ps pt = Placement ps pt Nothing Nothing (const . const Nothing)
plRRpt :: Int -> PSType -> Placement plRRpt :: Int -> PSType -> Placement
plRRpt i pt = Placement (PSRoomRand i (uncurry PS)) pt Nothing (const . const Nothing) plRRpt i pt = Placement (PSRoomRand i (uncurry PS)) pt Nothing Nothing (const . const Nothing)
jsps :: Point2 -> Float -> PSType -> Maybe Placement jsps :: Point2 -> Float -> PSType -> Maybe Placement
jsps p a pst = Just $ Placement (PS p a) pst Nothing $ const . const Nothing jsps p a pst = Just $ Placement (PS p a) pst Nothing Nothing $ const . const Nothing
jsps0 :: PSType -> Maybe Placement jsps0 :: PSType -> Maybe Placement
jsps0 = Just . sPS (V2 0 0) 0 jsps0 = Just . sPS (V2 0 0) 0
@@ -43,51 +43,51 @@ sps0 :: PSType -> Placement
sps0 = sPS (V2 0 0) 0 sps0 = sPS (V2 0 0) 0
jspsJ :: Point2 -> Float -> PSType -> Placement -> Maybe Placement jspsJ :: Point2 -> Float -> PSType -> Placement -> Maybe Placement
jspsJ p a pst plm = Just $ Placement (PS p a) pst Nothing $ \_ _ -> Just plm jspsJ p a pst plm = Just $ Placement (PS p a) pst Nothing Nothing $ \_ _ -> Just plm
jsps0J :: PSType -> Placement -> Maybe Placement jsps0J :: PSType -> Placement -> Maybe Placement
jsps0J pst plm = Just $ Placement (PS (V2 0 0) 0) pst Nothing $ \_ _ -> Just plm jsps0J pst plm = Just $ Placement (PS (V2 0 0) 0) pst Nothing Nothing $ \_ _ -> Just plm
ps0 :: PSType -> (Int -> Maybe Placement) -> Placement ps0 :: PSType -> (Int -> Maybe Placement) -> Placement
ps0 pst = Placement (PS (V2 0 0) 0) pst Nothing . contToIDCont ps0 pst = Placement (PS (V2 0 0) 0) pst Nothing Nothing . contToIDCont
pt0 :: PSType -> (Placement -> Maybe Placement) -> Placement pt0 :: PSType -> (Placement -> Maybe Placement) -> Placement
pt0 pst = Placement (PS (V2 0 0) 0) pst Nothing . const pt0 pst = Placement (PS (V2 0 0) 0) pst Nothing Nothing . const
contToIDCont :: (Int -> Maybe Placement) -> GenWorld -> Placement -> Maybe Placement contToIDCont :: (Int -> Maybe Placement) -> GenWorld -> Placement -> Maybe Placement
contToIDCont f _ = f . fromJust . _plMID contToIDCont f _ = f . fromJust . _plMID
jps0' :: PSType -> (Placement -> Maybe Placement) -> Maybe Placement jps0' :: PSType -> (Placement -> Maybe Placement) -> Maybe Placement
jps0' pst = Just . Placement (PS (V2 0 0) 0) pst Nothing . const jps0' pst = Just . Placement (PS (V2 0 0) 0) pst Nothing Nothing . const
jps0PushPS :: PSType -> (Int -> Maybe Placement) -> Maybe Placement jps0PushPS :: PSType -> (Int -> Maybe Placement) -> Maybe Placement
jps0PushPS pst f = Just . Placement (PSNoShiftCont (V2 0 0) 0) pst Nothing $ jps0PushPS pst f = Just . Placement (PSNoShiftCont (V2 0 0) 0) pst Nothing Nothing $
\_ plmnt -> f (fromJust $ _plMID plmnt) <&> plSpot .~ _plSpot plmnt \_ plmnt -> f (fromJust $ _plMID plmnt) <&> plSpot .~ _plSpot plmnt
ps0j :: PSType -> Placement -> Placement ps0j :: PSType -> Placement -> Placement
ps0j pst plmnt = Placement (PS (V2 0 0) 0) pst Nothing (\_ -> const $ Just plmnt) ps0j pst plmnt = Placement (PS (V2 0 0) 0) pst Nothing Nothing (\_ -> const $ Just plmnt)
psj :: PlacementSpot -> PSType -> Placement -> Placement psj :: PlacementSpot -> PSType -> Placement -> Placement
psj ps pst plmnt = Placement ps pst Nothing (\_ -> const $ Just plmnt) psj ps pst plmnt = Placement ps pst Nothing Nothing (\_ -> const $ Just plmnt)
-- the NoShiftCont is necessary when shifting then combining rooms -- the NoShiftCont is necessary when shifting then combining rooms
ps0jPushPS :: PSType -> Placement -> Placement ps0jPushPS :: PSType -> Placement -> Placement
ps0jPushPS pst plmnt = Placement (PSNoShiftCont (V2 0 0) 0) pst Nothing $ ps0jPushPS pst plmnt = Placement (PSNoShiftCont (V2 0 0) 0) pst Nothing Nothing $
\_ p -> Just $ plmnt & plSpot .~ _plSpot p \_ p -> Just $ plmnt & plSpot .~ _plSpot p
-- the NoShiftCont is necessary when shifting then combining rooms -- the NoShiftCont is necessary when shifting then combining rooms
ps0PushPS :: PSType -> (Placement -> Maybe Placement) -> Placement ps0PushPS :: PSType -> (Placement -> Maybe Placement) -> Placement
ps0PushPS pst f = Placement (PSNoShiftCont (V2 0 0) 0) pst Nothing $ ps0PushPS pst f = Placement (PSNoShiftCont (V2 0 0) 0) pst Nothing Nothing $
\_ pl -> f pl & _Just . plSpot %~ const (_plSpot pl) \_ pl -> f pl & _Just . plSpot %~ const (_plSpot pl)
ps0PushPSw :: PSType -> (GenWorld -> Placement -> Maybe Placement) -> Placement ps0PushPSw :: PSType -> (GenWorld -> Placement -> Maybe Placement) -> Placement
ps0PushPSw pst f = Placement (PSNoShiftCont (V2 0 0) 0) pst Nothing $ ps0PushPSw pst f = Placement (PSNoShiftCont (V2 0 0) 0) pst Nothing Nothing $
\w pl -> f w pl & _Just . plSpot %~ const (_plSpot pl) \w pl -> f w pl & _Just . plSpot %~ const (_plSpot pl)
addPlmnt :: Placement -> Placement -> Placement addPlmnt :: Placement -> Placement -> Placement
addPlmnt pl pl2 = case pl2 of addPlmnt pl pl2 = case pl2 of
-- (RandomPlacement rp) -> RandomPlacement $ fmap (addPlmnt pl) rp -- (RandomPlacement rp) -> RandomPlacement $ fmap (addPlmnt pl) rp
(Placement ps pt mi f) -> Placement ps pt mi (fmap (fmap g) f) (Placement ps pt mi mj f) -> Placement ps pt mi mj (fmap (fmap g) f)
where where
g Nothing = Just pl g Nothing = Just pl
g (Just pl') = Just $ addPlmnt pl pl' g (Just pl') = Just $ addPlmnt pl pl'
src/Dodge/Placement/Instance/Door.hs
+2 -2
View File
@@ -76,8 +76,8 @@ divideDoorPane mid wl cond soff speed ppairs g = case ppairs of
& drPushedBy .~ maybe PushesItself PushedBy mid & drPushedBy .~ maybe PushesItself PushedBy mid
putAutoDoor :: Point2 -> Point2 -> Placement putAutoDoor :: Point2 -> Point2 -> Placement
putAutoDoor a b = Placement (PS 0 0) (PutCoord a) Nothing $ \_ apl -> putAutoDoor a b = Placement (PS 0 0) (PutCoord a) Nothing Nothing $ \_ apl ->
Just $ Placement (PS 0 0) (PutCoord b) Nothing $ \w bpl -> Just $ Placement (PS 0 0) (PutCoord b) Nothing Nothing $ \w bpl ->
let x = w ^?! gwWorld . coordinates . ix (apl ^?! plMID . _Just) let x = w ^?! gwWorld . coordinates . ix (apl ^?! plMID . _Just)
y = w ^?! gwWorld . coordinates . ix (bpl ^?! plMID . _Just) y = w ^?! gwWorld . coordinates . ix (bpl ^?! plMID . _Just)
in Just $ putDoubleDoor in Just $ putDoubleDoor
src/Dodge/Placement/Instance/LightSource.hs
+1 -1
View File
@@ -174,7 +174,7 @@ spanLSLightI ls h a b =
spanLS :: LightSource -> Point2 -> Point2 -> Placement spanLS :: LightSource -> Point2 -> Point2 -> Placement
spanLS ls a b = spanLS ls a b =
Placement (PS (V2 x y) 0) (PutLS ls) Nothing $ Placement (PS (V2 x y) 0) (PutLS ls) Nothing Nothing $
const $ const $ Just $ sps0 $ putShape $ thinHighBar h a b const $ const $ Just $ sps0 $ putShape $ thinHighBar h a b
where where
V3 _ _ h = _lsPos (_lsParam ls) + 5 V3 _ _ h = _lsPos (_lsParam ls) + 5
src/Dodge/Placement/PlaceSpot.hs
+6 -1
View File
@@ -6,6 +6,7 @@
-} -}
module Dodge.Placement.PlaceSpot (placeSpot) where module Dodge.Placement.PlaceSpot (placeSpot) where
import Data.Maybe
import Color import Color
import Control.Monad.State import Control.Monad.State
import Data.Bifunctor import Data.Bifunctor
@@ -41,9 +42,13 @@ placePlainPSSpot
placePlainPSSpot w rm plmnt shift = placePlainPSSpot w rm plmnt shift =
let (i, w') = placeSpotID rm (shiftPSBy shift (_plSpot plmnt)) (_plType plmnt) w let (i, w') = placeSpotID rm (shiftPSBy shift (_plSpot plmnt)) (_plType plmnt) w
newplmnt = plmnt & plMID ?~ i newplmnt = plmnt & plMID ?~ i
in maybe ((w', rm & rmPmnts .:~ newplmnt), [newplmnt]) ((gw,rm'),plist) = maybe ((w', rm & rmPmnts .:~ newplmnt), [newplmnt])
(recrPlace newplmnt w') (_plIDCont plmnt w' newplmnt) (recrPlace newplmnt w') (_plIDCont plmnt w' newplmnt)
in ((f newplmnt gw,rm'),plist)
where where
f x gw = fromMaybe gw $ do
j <- x ^. plExternalID
return $ gw & genPmnt . at j ?~ [x]
recrPlace newplmnt w' pl = recrPlace newplmnt w' pl =
let (wr, newplmnts) = placeSpot (w', rm & rmPmnts .:~ newplmnt) pl let (wr, newplmnts) = placeSpot (w', rm & rmPmnts .:~ newplmnt) pl
in (wr, newplmnt : newplmnts) in (wr, newplmnt : newplmnts)
src/Dodge/PlacementSpot.hs
+2 -2
View File
@@ -155,9 +155,9 @@ twoRoomPoss ::
(RoomPos -> Room -> Bool) -> (RoomPos -> Room -> Bool) ->
(PlacementSpot -> PlacementSpot -> Placement) -> (PlacementSpot -> PlacementSpot -> Placement) ->
Placement Placement
twoRoomPoss cond1 cond2 f = Placement (rprBool cond1) PutNothing Nothing $ twoRoomPoss cond1 cond2 f = Placement (rprBool cond1) PutNothing Nothing Nothing $
\_ pl1 -> Just $ \_ pl1 -> Just $
Placement (rprBool cond2) PutNothing Nothing $ Placement (rprBool cond2) PutNothing Nothing Nothing $
\_ pl2 -> Just $ f (_plSpot pl1) (_plSpot pl2) \_ pl2 -> Just $ f (_plSpot pl1) (_plSpot pl2)
--isUnusedLnk :: RoomPos -> Bool --isUnusedLnk :: RoomPos -> Bool
src/Dodge/Room/Airlock.hs
+3 -2
View File
@@ -39,9 +39,10 @@ decontamRoom i =
\_ _ -> Just $ putDoubleDoor DoorObstacle thewall (WdBlBtOn btid) (V2 0 80) (V2 40 80) 2 \_ _ -> Just $ putDoubleDoor DoorObstacle thewall (WdBlBtOn btid) (V2 0 80) (V2 40 80) 2
, invisibleWall $ rectNSWE 60 40 (-40) (-30) , invisibleWall $ rectNSWE 60 40 (-40) (-30)
, spanLightI (V2 (-20) 30) (V2 (-20) 70) , spanLightI (V2 (-20) 30) (V2 (-20) 70)
, analyser (NoItemZone ps) (PS 50 0) (PS mcpos 0) & plExternalID ?~ i
] ]
& rmOutPmnt . at i ?~ -- & rmOutPmnt . at i ?~
analyser (NoItemZone ps) (PS 50 0) (PS mcpos 0) -- analyser (NoItemZone ps) (PS 50 0) (PS mcpos 0)
& rmInPmnt .~ [f] & rmInPmnt .~ [f]
& rmBound .~ [rectNSWE 75 15 0 40, switchcut] & rmBound .~ [rectNSWE 75 15 0 40, switchcut]
where where
src/Dodge/Room/LasTurret.hs
+20 -7
View File
@@ -42,8 +42,9 @@ lightSensInsideDoor i rm =
.++~ [ psPt atFstLnkOut (PutForeground $ floorWire (V2 20 0) (V2 20 (-100))) .++~ [ psPt atFstLnkOut (PutForeground $ floorWire (V2 20 0) (V2 20 (-100)))
, psPt atFstLnkOut (PutForeground $ floorWire (V2 0 (-100)) (V2 20 (-100))) , psPt atFstLnkOut (PutForeground $ floorWire (V2 0 (-100)) (V2 20 (-100)))
, psPt atFstLnkOut (PutForeground $ verticalWire (V2 20 0) 0 80) , psPt atFstLnkOut (PutForeground $ verticalWire (V2 20 0) 0 80)
, sensAboveDoor LaserSensor 10 (atFstLnkOutShiftInward 100) & plExternalID ?~ i
] ]
& rmOutPmnt . at i ?~ sensAboveDoor LaserSensor 10 (atFstLnkOutShiftInward 100) -- & rmOutPmnt . at i ?~ sensAboveDoor LaserSensor 10 (atFstLnkOutShiftInward 100)
lightSensByDoor :: Int -> Room -> Room lightSensByDoor :: Int -> Room -> Room
lightSensByDoor i rm = lightSensByDoor i rm =
@@ -52,8 +53,9 @@ lightSensByDoor i rm =
.++~ [ psPt atFstLnkOut $ PutForeground $ verticalWire (V2 20 0) 0 80 .++~ [ psPt atFstLnkOut $ PutForeground $ verticalWire (V2 20 0) 0 80
, heightWallPS (atNthLnkOutShiftInward 1 100) 30 covershape , heightWallPS (atNthLnkOutShiftInward 1 100) 30 covershape
, heightWallPS (atFstLnkOutShiftInward 100) 30 covershape , heightWallPS (atFstLnkOutShiftInward 100) 30 covershape
, sensAboveDoor LaserSensor 20 (atFstLnkOutShiftBy sensorshift) & plExternalID ?~ i
] ]
& rmOutPmnt . at i ?~ sensAboveDoor LaserSensor 20 (atFstLnkOutShiftBy sensorshift) -- & rmOutPmnt . at i ?~ sensAboveDoor LaserSensor 20 (atFstLnkOutShiftBy sensorshift)
where where
covershape = rectNSWE 10 (-10) (-20) 20 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)
@@ -81,12 +83,17 @@ analyserByNthLink n proxreq i rm =
rm rm
& rmPmnts & rmPmnts
.++~ [ psPt (atNthLinkOut n) $ PutForeground $ verticalWire (V2 20 0) 0 80 .++~ [ psPt (atNthLinkOut n) $ PutForeground $ verticalWire (V2 20 0) 0 80
] , analyser
& rmOutPmnt . at i ?~
analyser
(SensorWithRequirement proxreq) (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)))
(atNthLnkOutShiftBy n sensorshift) (atNthLnkOutShiftBy n sensorshift)
& plExternalID ?~ i
]
-- & rmOutPmnt . at i ?~
-- analyser
-- (SensorWithRequirement proxreq)
-- (atNthLnkOutShiftBy n (\(p, a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a)))
-- (atNthLnkOutShiftBy n sensorshift)
where where
sensorshift (p, a) = (p +.+ rotateV a (V2 (-30) (-10)), a) sensorshift (p, a) = (p +.+ rotateV a (V2 (-30) (-10)), a)
@@ -96,12 +103,18 @@ analyserByNthLinkWithPrompt n l proxreq i rm =
rm rm
& rmPmnts & rmPmnts
.++~ [ psPt (atNthLinkOut n) $ PutForeground $ verticalWire (V2 20 0) 0 80 .++~ [ psPt (atNthLinkOut n) $ PutForeground $ verticalWire (V2 20 0) 0 80
] ,
& rmOutPmnt . at i ?~
analyserWithPrompt l analyserWithPrompt l
(SensorWithRequirement proxreq) (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)))
(atNthLnkOutShiftBy n sensorshift) (atNthLnkOutShiftBy n sensorshift)
& plExternalID ?~ i
]
-- & rmOutPmnt . at i ?~
-- analyserWithPrompt l
-- (SensorWithRequirement proxreq)
-- (atNthLnkOutShiftBy n (\(p, a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a)))
-- (atNthLnkOutShiftBy n sensorshift)
where where
sensorshift (p, a) = (p +.+ rotateV a (V2 (-30) (-10)), a) sensorshift (p, a) = (p +.+ rotateV a (V2 (-30) (-10)), a)
src/Dodge/Room/Pillar.hs
+1 -1
View File
@@ -126,5 +126,5 @@ roomPillars pillarsize w h wn hn = do
where where
pilw = ((w - 40 * (fromIntegral wn + 1)) / fromIntegral wn) - pillarsize pilw = ((w - 40 * (fromIntegral wn + 1)) / fromIntegral wn) - pillarsize
pilh = ((h - 40 * (fromIntegral hn + 1)) / fromIntegral hn) - pillarsize pilh = ((h - 40 * (fromIntegral hn + 1)) / fromIntegral hn) - pillarsize
testchasm = Placement (PS 0 0) (PutChasm (map (+V2 50 120) (rectWH 50 25))) Nothing testchasm = Placement (PS 0 0) (PutChasm (map (+V2 50 120) (rectWH 50 25))) Nothing Nothing
(\_ _ -> Nothing) (\_ _ -> Nothing)
src/Dodge/Room/RunPast.hs
+3 -2
View File
@@ -51,8 +51,9 @@ lockedStart i = do
map (over root $ rmConnectsTo .~ S.member theedge) doorrooms map (over root $ rmConnectsTo .~ S.member theedge) doorrooms
++ [ return ++ [ return
smallRoom smallRoom
{ _rmOutPmnt = IM.singleton i (putLitButOnPosExtTrig red useUnusedLnk) { --_rmOutPmnt = IM.singleton i (putLitButOnPosExtTrig red useUnusedLnk)
, _rmPmnts = [plRRpt 0 (PutFlIt theweapon)] _rmPmnts = [plRRpt 0 (PutFlIt theweapon)
,(putLitButOnPosExtTrig red useUnusedLnk) & plExternalID ?~ i]
, _rmBound = [rectNSWE 70 30 0 40] , _rmBound = [rectNSWE 70 30 0 40]
} }
] ]
src/Dodge/Room/SensorDoor.hs
+2 -1
View File
@@ -66,5 +66,6 @@ sensInsideDoor senseType i rm = rm
, putMessageTerminal terminalColor , putMessageTerminal terminalColor
(textTerminal & tmCommands .:~ TCDamageCommand) (textTerminal & tmCommands .:~ TCDamageCommand)
& plSpot .~ rprBoolShift isUnusedLnk (shiftInBy 10) & plSpot .~ rprBoolShift isUnusedLnk (shiftInBy 10)
, sensAboveDoor senseType 10 (atFstLnkOutShiftInward 100) & plExternalID ?~ i
] ]
& rmOutPmnt . at i ?~ sensAboveDoor senseType 10 (atFstLnkOutShiftInward 100) -- & rmOutPmnt . at i ?~ sensAboveDoor senseType 10 (atFstLnkOutShiftInward 100)
src/Dodge/Room/Tutorial.hs
+1 -1
View File
@@ -166,7 +166,7 @@ tutRezBox = do
roomRect 40 60 1 1 roomRect 40 60 1 1
& rmPmnts & rmPmnts
.~ [ sPS (V2 20 1) 0 $ PutLS ls .~ [ sPS (V2 20 1) 0 $ PutLS ls
, Placement (PS 0 0) PutNothing Nothing $ \w _ -> Just $ putImmediateMessageTerminal , Placement (PS 0 0) PutNothing Nothing Nothing $ \w _ -> Just $ putImmediateMessageTerminal
terminalColor terminalColor
( defaultTerminal & tmBootLines .~ s w ( defaultTerminal & tmBootLines .~ s w
<> tlSetStatus (TerminalPressTo "QUIT") <> tlSetStatus (TerminalPressTo "QUIT")
src/Dodge/Room/Warning.hs
+3 -2
View File
@@ -35,7 +35,8 @@ addDoorToggleTerminal = addDoorAtNthLinkToggleTerminal 0
addDoorAtNthLinkToggleTerminal :: Int -> [TerminalLine] -> Int -> Room -> Room addDoorAtNthLinkToggleTerminal :: Int -> [TerminalLine] -> Int -> Room -> Room
addDoorAtNthLinkToggleTerminal j xs i = (rmName .++~ "doorToggle-") addDoorAtNthLinkToggleTerminal j xs i = (rmName .++~ "doorToggle-")
. (rmOutPmnt . at i ?~ outplace) -- . (rmOutPmnt . at i ?~ outplace)
. (rmPmnts .:~ outplace)
where where
outplace = outplace =
extTrigLitPos extTrigLitPos
@@ -43,7 +44,7 @@ addDoorAtNthLinkToggleTerminal j xs i = (rmName .++~ "doorToggle-")
( Just . set plSpot (rprShift (moveToSideNthOutLink j)) ( Just . set plSpot (rprShift (moveToSideNthOutLink j))
. putMessageTerminal terminalColor . putMessageTerminal terminalColor
. termMessages . termMessages
) ) & plExternalID ?~ i
termMessages trpl = termMessages trpl =
lineOutputTerminal xs --(makeColorTermLine red "WARNING" : makeTermPara str) lineOutputTerminal xs --(makeColorTermLine red "WARNING" : makeTermPara str)
& tmToggles .~ M.fromList & tmToggles .~ M.fromList