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

Cleanup, improve auto wall rotate

Browse Source
This commit is contained in:
justin
2026-03-24 11:28:11 +00:00
parent be2f7160ba
commit 32f1740577
25 changed files with 226 additions and 252 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Room/Airlock.hs
+4 -4
View File
@@ -55,8 +55,8 @@ decontamRoom i =
& rmInPmnt .~ [(0, return . f)]
& rmBound .~ [rectNSWE 75 15 0 40, switchcut]
where
dr1 btid = defaultDoor & drTrigger .~ (WdBlNegate $ WdBlBtOn btid)
dr2 btid = defaultDoor & drTrigger .~ (WdBlBtOn btid)
dr1 btid = defaultDoor & drTrigger .~ WdBlNegate (WdBlBtOn btid)
dr2 btid = defaultDoor & drTrigger .~ WdBlBtOn btid
f gw = fromMaybe (error "tried to put a door using an empty placement list") $ do
pmnt <- gw ^? genPmnt . ix i
return $
@@ -94,8 +94,8 @@ airlock0 =
, _rmBound = [rectNSWE 75 15 0 40, switchcut]
}
where
dr1 btid = defaultDoor & drTrigger .~ (WdBlNegate $ WdBlBtOn btid)
dr2 btid = defaultDoor & drTrigger .~ (WdBlBtOn btid)
dr1 btid = defaultDoor & drTrigger .~ WdBlNegate (WdBlBtOn btid)
dr2 btid = defaultDoor & drTrigger .~ WdBlBtOn btid
switchcut = rectNSWE 65 35 (-40) 20
lnks =
[ (V2 20 95, 0)
src/Dodge/Room/Door.hs
+1 -1
View File
@@ -44,5 +44,5 @@ triggerDoorRoom i =
f gw = return $ fromMaybe (error "tried to put a door using an empty placement list") $ do
pmnt <- gw ^? genPmnt . ix i
return $ putDoubleDoor defaultDoorWall (V2 0 20) (V2 40 20)
(defaultDoor & drTrigger .~ (cond pmnt))
(defaultDoor & drTrigger .~ cond pmnt)
cond pmnt = WdTrig $ fromJust (_plMID pmnt)
src/Dodge/Room/Foreground.hs
+1 -1
View File
@@ -121,7 +121,7 @@ girderZ h d w x y =
[ thinHighBar h xt yt
, thinHighBar h xb yb
]
<> zipWith (thinHighBar (h )) ps qs
<> zipWith (thinHighBar (h-1)) ps qs
where
n = w *.* normalizeV (vNormal $ y -.- x)
xb = x +.+ n
src/Dodge/Room/LasTurret.hs
+26 -26
View File
@@ -49,7 +49,7 @@ import Shape
-- no lights!
cenLasTur :: (RandomGen g) => State g Room
cenLasTur = do
cenLasTur =
roomNgon 8 200
<&> rmPmnts
.~ [ putLasTurret 0.02
@@ -168,7 +168,7 @@ lasCenSensEdge n = do
lshape <- takeOne [vShape, lShape, jShape, liShape]
let alight a rp = mntLSCond (fmap (fmap $ colorSH black) lshape) (PS (rotateV a $ _rpPos rp) (a + _rpDir rp))
blight a = (0, return . alight a . f i)
let cenroom = cenroom' & rmInPmnt <>~ map blight [pi, (0.5 * pi), (1.5 * pi)]
let cenroom = cenroom' & rmInPmnt <>~ map blight [pi, 0.5 * pi, 1.5 * pi]
let doorroom = triggerDoorRoom n
rToOnward "lasCenSensEdge" $
treeFromTrunk [door] $
@@ -194,7 +194,7 @@ lasRunYinYang = do
const
. ( \rp ->
PolyEdge ((npoly + 1) `div` 4)
`S.member` (fold $ rp ^? rpType . rplsType)
`S.member` fold (rp ^? rpType . rplsType)
)
thelight3 <-
mntLightLnkCond $
@@ -202,7 +202,7 @@ lasRunYinYang = do
const
. ( \rp ->
PolyEdge (3 * (npoly + 1) `div` 4)
`S.member` (fold $ rp ^? rpType . rplsType)
`S.member` fold (rp ^? rpType . rplsType)
)
r <-
shuffleLinks
@@ -231,16 +231,16 @@ lasRunYinYang = do
)
rToOnward "lasCenRunClose" $ return $ cleatOnward r
where
awall x v = heightWallPS (PS x 0) 30 v
awall x = heightWallPS (PS x 0) 30
-- angwall a = awall (V2 0 100 + rotateV a (V2 0 100)) (fmap (rotateV (pi/4 + a/2)) $ rectWH 5 (25 - a*10/pi ))
rf = 0.8
offxy = V2 0 (-100)
angwall a = awall (V2 0 100 + rotateV a (V2 0 100)) (fmap (rotateV (pi / 4 + a * rf)) $ rectWH 5 (23 - a * 13 / pi))
angwall a = awall (V2 0 100 + rotateV a (V2 0 100)) (rotateV (pi / 4 + a * rf) <$> rectWH 5 (23 - a * 13 / pi))
apath a' = addNodesCrossing $ (\x -> (x + f (V2 0 100), x - f (V2 0 100))) (V2 0 100 + rotateV a (V2 0 100))
where
a = a' + pi / 16
f = rotateV (pi / 4 + a * 0.8)
bngwall a = awall (V2 0 (-100) + rotateV a (V2 0 (-100))) (fmap (rotateV (pi / 4 + a * rf)) $ rectWH 5 (23 - a * 13 / pi))
bngwall a = awall (V2 0 (-100) + rotateV a (V2 0 (-100))) (rotateV (pi / 4 + a * rf) <$> rectWH 5 (23 - a * 13 / pi))
bpath a' = addNodesCrossing $ (\x -> (x + f (V2 0 100), x - f (V2 0 100))) (V2 0 (-100) + rotateV a (V2 0 (-100)))
where
a = a' + pi / 16
@@ -257,7 +257,7 @@ lasRunYinYangCenter = do
const
. ( \rp ->
PolyEdge ((npoly + 1) `div` 4)
`S.member` (fold $ rp ^? rpType . rplsType)
`S.member` fold (rp ^? rpType . rplsType)
)
thelight3 <-
mntLightLnkCond $
@@ -265,7 +265,7 @@ lasRunYinYangCenter = do
const
. ( \rp ->
PolyEdge (3 * (npoly + 1) `div` 4)
`S.member` (fold $ rp ^? rpType . rplsType)
`S.member` fold (rp ^? rpType . rplsType)
)
-- thelight3 <- mntLightLnkCond $ rprBool $ const . isOutLnk
r <-
@@ -293,14 +293,14 @@ lasRunYinYangCenter = do
)
rToOnward "lasCenRunClose" $ return $ cleatOnward r
where
awall x v = heightWallPS (PS x 0) 30 v
awall x = heightWallPS (PS x 0) 30
-- angwall a = awall (V2 0 100 + rotateV a (V2 0 100)) (fmap (rotateV (pi/4 + a/2)) $ rectWH 5 (25 - a*10/pi ))
angwall a = awall (V2 0 100 + rotateV a (V2 0 100)) (fmap (rotateV (pi / 4 + a * 0.8)) $ rectWH 5 (23 - a * 13 / pi))
angwall a = awall (V2 0 100 + rotateV a (V2 0 100)) (rotateV (pi / 4 + a * 0.8) <$> rectWH 5 (23 - a * 13 / pi))
apath a' = addNodesCrossing $ (\x -> (x + f (V2 0 100), x - f (V2 0 100))) (V2 0 100 + rotateV a (V2 0 100))
where
a = a' + pi / 16
f = rotateV (pi / 4 + a * 0.8)
bngwall a = awall (V2 0 (-100) + rotateV a (V2 0 (-100))) (fmap (rotateV (pi / 4 + a * 0.8)) $ rectWH 5 (23 - a * 13 / pi))
bngwall a = awall (V2 0 (-100) + rotateV a (V2 0 (-100))) (rotateV (pi / 4 + a * 0.8) <$> rectWH 5 (23 - a * 13 / pi))
bpath a' = addNodesCrossing $ (\x -> (x + f (V2 0 100), x - f (V2 0 100))) (V2 0 (-100) + rotateV a (V2 0 (-100)))
where
a = a' + pi / 16
@@ -334,24 +334,24 @@ lasCenRunClose' = do
rToOnward "lasCenRunClose" $ return $ cleatOnward r
where
swall =
[ (70, (rectNSWE 10 (-10) (-10) 30))
, (125, (rectNSWE 55 (-55) (-10) 10))
, (180, (rectNSWE 10 (-10) (-30) 10))
[ (70, rectNSWE 10 (-10) (-10) 30)
, (125, rectNSWE 55 (-55) (-10) 10)
, (180, rectNSWE 10 (-10) (-30) 10)
]
zwall =
[ (70, (rectNSWE 10 (-10) (-30) 10))
, (125, (rectNSWE 55 (-55) (-10) 10))
, (180, (rectNSWE 10 (-10) (-10) 30))
[ (70, rectNSWE 10 (-10) (-30) 10)
, (125, rectNSWE 55 (-55) (-10) 10)
, (180, rectNSWE 10 (-10) (-10) 30)
]
iwall =
[ (70, (rectNSWE 10 (-10) (-15) 20))
, (180, (rectNSWE 10 (-10) (-30) (-5)))
[ (70, rectNSWE 10 (-10) (-15) 20)
, (180, rectNSWE 10 (-10) (-30) (-5))
]
jwall =
[ (70, (rectNSWE 10 (-10) (-20) 15))
, (180, (rectNSWE 10 (-10) 5 30))
[ (70, rectNSWE 10 (-10) (-20) 15)
, (180, rectNSWE 10 (-10) 5 30)
]
uwall = [(180, (rectNSWE 10 (-10) (-20) 20))]
uwall = [(180, rectNSWE 10 (-10) (-20) 20)]
obwalls = [swall, zwall, iwall, jwall, uwall]
linkwall f x =
heightWallPS
@@ -390,7 +390,7 @@ lasCenRunCloseLongCor = do
where
llinks = memtest (FromEdge South 1) (OnEdge West)
rlinks = memtest (FromEdge South 1) (OnEdge East)
awall x v = heightWallPS (PS x 0) 30 v
awall x = heightWallPS (PS x 0) 30
memtest a b x =
let y = _rlType x
in a `S.member` y && b `S.member` y
@@ -459,7 +459,7 @@ lasCenRunClose1 = do
etest
(memtest (FromEdge East 0) (OnEdge South))
(memtest (FromEdge South 0) (OnEdge East))
awall x v = heightWallPS (PS x 0) 30 v
awall x = heightWallPS (PS x 0) 30
etest f g x = f x || g x
memtest a b x =
let y = _rlType x
@@ -500,7 +500,7 @@ lasCenRunClose2 = do
etest
(memtest (FromEdge East 0) (OnEdge North))
(memtest (FromEdge North 0) (OnEdge East))
awall x v = heightWallPS (PS x 0) 30 v
awall x = heightWallPS (PS x 0) 30
etest f g x = f x || g x
memtest a b x =
let y = _rlType x
src/Dodge/Room/LongDoor.hs
+1 -1
View File
@@ -118,7 +118,7 @@ addButtonSlowDoor x h =
30
(V2 0 h)
(V2 x h)
(defaultDoor & drTrigger .~ (WdBlBtOn $ fromJust $ _plMID btplmnt)
(defaultDoor & drTrigger .~ WdBlBtOn (fromJust $ _plMID btplmnt)
& drUpdate . drLerpSpeed .~ 0.5)
$ \dr1 dr2 ->
Just
src/Dodge/Room/Modify.hs
+3 -3
View File
@@ -48,10 +48,10 @@ addLightsNGon rm = do
x = y * tan (0.5 * a)
f i gw = do
lshape <- takeOne [vShape, lShape, jShape, liShape]
let ps = fromMaybe (PS (V2 y 0) 0) $ rpToPS <$> find iscolorlight (grm ^. rmPos)
let ps = maybe (PS (V2 y 0) 0) rpToPS $ find iscolorlight (grm ^. rmPos)
alight a' = mntLSCond (fmap (fmap $ colorSH black) lshape) (rotateps a' ps)
takeOne
[ spanLightY (V2 0 0) (V2 y x) (V2 (x) y) (V2 (x) (-y))
[ spanLightY (V2 0 0) (V2 y x) (V2 x y) (V2 x (-y))
, spanLightY (V2 20 20) (V2 y 20) (V2 (-y) 20) (V2 20 (-y))
, spanLightI (V2 22 y) (V2 22 (-y))
, spanLightI (V2 x y) (V2 (-x) (-y))
@@ -61,7 +61,7 @@ addLightsNGon rm = do
grm = getRoomFromID i gw
rotateps a' (PS v d) = PS (rotateV a' v) (a' + d)
rotateps _ _ = error "in addLightsNGon"
rpToPS rp = (PS (_rpPos rp) (_rpDir rp))
rpToPS rp = PS (_rpPos rp) (_rpDir rp)
iscolorlight rp =
(ColoredLightRP `S.member` (rp ^. rpFlags))
&& islinkroompos rp
src/Dodge/Room/Pillar.hs
+2 -2
View File
@@ -61,7 +61,7 @@ roomPillarsSquare = do
[ mntLS
vShape
(rotateVAround (V2 150 150) a (V2 30 30))
(_xy %~ (rotateVAround (V2 150 150) a) $ V3 60 60 95)
(_xy %~ rotateVAround (V2 150 150) a $ V3 60 60 95)
| a <- [0, pi / 2, pi, 3 * pi / 2]
]
, return
@@ -70,7 +70,7 @@ roomPillarsSquare = do
[ mntLS
vShape
(rotateVAround (V2 150 150) a (V2 150 0))
(_xy %~ (rotateVAround (V2 150 150) a) $ V3 150 20 95)
(_xy %~ rotateVAround (V2 150 150) a $ V3 150 20 95)
| a <- [0, pi / 2, pi, 3 * pi / 2]
]
, addGirderLights . set rmPmnts []
src/Dodge/Room/Tutorial.hs
+13 -13
View File
@@ -8,7 +8,6 @@ import Control.Monad
import qualified Data.IntMap.Strict as IM
import qualified Data.IntSet as IS
import Data.Maybe
import Data.Maybe (mapMaybe)
import qualified Data.Set as S
import Dodge.Cleat
import Dodge.Data.AmmoType
@@ -304,20 +303,21 @@ chasmSpitTerminal = do
l3 = mntLightLnkShape shp $ resetPLUse $ rprBool $ \rp _ -> f rp East North
l4 = mntLightLnkShape shp $ resetPLUse $ rprBool $ \rp _ -> f rp East South
ls <- takeOne [[l1,l2],[l3,l4]
--j ,[spanLightI (V2 120 0) (V2 120 300)]
--j , [spanLightI (V2 0 128) (V2 300 128)]
--j , [spanLightI (V2 300 0) (V2 0 300), sps0 $ putShape $ thinHighBar 95 0 300]
,[spanLightI (V2 120 0) (V2 120 300)]
, [spanLightI (V2 0 128) (V2 300 128)]
, [spanLightI (V2 300 0) (V2 0 300), sps0 $ putShape $ thinHighBar 95 0 300]
]
gh <- takeOne [55,75,97]
gird <- takeOne [girderZ gh 30 10,girder gh 30 10,girderV gh 30 10]
dec <- takeOne $ -- replicate 3 [] <>
[--[]
-- ,[sps0 $ putShape $ gird (V2 30 0) (V2 30 300)
-- ,sps0 $ putShape $ gird (V2 270 0) (V2 270 300)]
-- ,[sps0 $ putShape $ gird (V2 0 20) (V2 300 20)]
[sps0 $ putShape $ gird (V2 0 200) (V2 300 200)]
dec <- takeOne $ replicate 3 [] <>
[[sps0 $ putShape $ gird (V2 30 0) (V2 30 300)]
,[sps0 $ putShape $ gird (V2 270 0) (V2 270 300)]
,[sps0 $ putShape $ gird (V2 30 0) (V2 30 300),sps0 $ putShape $ gird (V2 270 0) (V2 270 300)]
,[sps0 $ putShape $ gird (V2 0 20) (V2 300 20)]
,[sps0 $ putShape $ gird (V2 0 200) (V2 300 200)]
,[sps0 $ putShape $ gird (V2 0 280) (V2 300 280)]
,[sps0 $ putShape $ gird (V2 0 20) (V2 300 20),sps0 $ putShape $ gird (V2 0 280) (V2 300 280)]
]
-- let y' = y & rmPmnts <>~ [l3, l4, l5]
let y' = y & rmPmnts <>~ ls <> dec
return $
tToBTree "chasmTerm" $
@@ -328,8 +328,8 @@ chasmSpitTerminal = do
, return $ cleatOnward $ triggerDoorRoom i1
]
where
f rp a b = FromEdge a 2 `S.member` (fold $ rp ^? rpType . rplsType)
&& OnEdge b `S.member` (fold $ rp ^? rpType . rplsType)
f rp a b = FromEdge a 2 `S.member` fold (rp ^? rpType . rplsType)
&& OnEdge b `S.member` fold (rp ^? rpType . rplsType)
polyChasm :: Int -> Float -> State LayoutVars Room
polyChasm n x =