Hlint, cleanup

This commit is contained in:
2026-03-30 09:29:50 +01:00
parent 1919757fca
commit 4598deb70f
8 changed files with 59 additions and 47 deletions
+15 -6
View File
@@ -181,7 +181,7 @@ slowCrushRoom = do
dr1 = dr
& drOnePos .~ (V2 145 (-40), 0)
& drZeroPos .~ (V2 145 50, 0)
apos edge = (rprBool (t edge) & psSelect . mapped . mapped . _Just . _1 %~ f)
apos edge = rprBool (t edge) & psSelect . mapped . mapped . _Just . _1 %~ f
f ps = case ps of
PS _ r -> ps & psRot +~ pi & psPos +~ rotateV r (V2 0 (-5))
_ -> ps
@@ -191,7 +191,7 @@ slowCrushRoom = do
pushCaverns :: RandomGen g => State g Room
pushCaverns = do
rm <- shuffleLinks =<< removeLights <$> roomRectAutoLights 250 100
rm <- shuffleLinks . removeLights =<< roomRectAutoLights 250 100
iside <- takeOne [North,South]
oside <- takeOne [North,South]
crs <- takeOne [[] ]
@@ -199,10 +199,14 @@ pushCaverns = do
[ [MountedLight (V3 55 0 50) 200 0.5 , MountedSPic (noPic $ aBar 55 [V2 10 0,V2 60 0])]
, [MountedLight (V3 20 0 50) 200 0.5 , MountedSPic (noPic $ aBar 55 [V2 10 0,V2 22 0])]
, [MountedLight (V3 30 45 50) 200 0.5 , MountedSPic (noPic $ aBar 55 [V2 10 45,V2 32 45])]
, [MountedLight (V3 55 45 50) 200 0.5
, [MountedLight (V3 20 45 50) 200 0.5
, MountedSPic (noPic $ aBar 55 [V2 10 45,V2 60 45])
, MountedSPic (noPic $ aBar 55 [V2 10 (-45),V2 60 (-45)])]
]
let lts = [spanColLightI (V3 0.5 0 0) 40 (V2 5 (g iside)) (V2 10 (g iside - dorot' iside 10))
& plType . putLS . lsParam . lsRad .~ 30
,spanColLightI (V3 0.5 0 0) 40 (V2 245 (g oside)) (V2 240 (g oside - dorot' oside 10))
& plType . putLS . lsParam . lsRad .~ 30]
return $ rm
& rmPolys <>~ [dorot iside (trapTBH 20 10 10) & each +~ V2 20 (g iside)
,dorot oside (trapTBH 20 10 10) & each +~ V2 230 (g oside)]
@@ -222,11 +226,16 @@ pushCaverns = do
& drMounts .~ (l & each . moPos . _xy %~ rotateV pi)) defaultDoorWall)
, psPtPl (spos (slinks West $ cardReverse iside) f') (lowBlock Stone (greyN 0.5) 10 $ rectWH 20 10)
, psPtPl (spos (slinks East $ cardReverse oside) f') (lowBlock Stone (greyN 0.5) 10 $ rectWH 20 10)
] <> crs
]
<> lts
<> crs
where
dorot = \case
North -> id
_ -> fmap negate
dorot' = \case
North -> id
_ -> negate
slinks x y s = (FromEdge x 0 `S.member` s) && OnEdge y `S.member` s
dr = defaultDoor
& drUpdate .~ DoorLerp 0.005
@@ -242,7 +251,7 @@ pushCaverns = do
f' ps = case ps of
PS _ r -> ps & psRot +~ pi & psPos +~ rotateV r (V2 0 10)
_ -> ps
spos h f'' = (rprBool (t' h) & psSelect . mapped . mapped . _Just . _1 %~ f'')
spos h f'' = rprBool (t' h) & psSelect . mapped . mapped . _Just . _1 %~ f''
t' h rp _ = case _rpType rp of
UnusedLink s -> h s
_ -> False
@@ -292,7 +301,7 @@ slowCrush90 = do
f ps = case ps of
PS _ r -> ps & psRot +~ pi & psPos +~ rotateV r (V2 0 (-5))
_ -> ps
spos h = (rprBool (t' h) & psSelect . mapped . mapped . _Just . _1 %~ f)
spos h = rprBool (t' h) & psSelect . mapped . mapped . _Just . _1 %~ f
t' h rp _ = case _rpType rp of
UnusedLink s -> h s
_ -> False