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

Cleanup

Browse Source
This commit is contained in:
justin
2025-10-24 23:22:16 +01:00
parent b4012af312
commit 3f5f5d2c6b
12 changed files with 77 additions and 117 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Block/Debris.hs
-2
View File
@@ -39,12 +39,10 @@ makeBlockDebris bl w = foldl' (flip $ makeDebris mt) w ps
where
dsize = debrisSize mt
ps = gridInPolygon dsize $ shrinkPolyOnEdges dsize $ reverse (_blFootprint bl)
--(mt, col) = fromMaybe (Stone, greyN 0.5) $ do
mt = fromMaybe Stone $ do
wlids <- w ^? cWorld . lWorld . blocks . ix (_blID bl) . blWallIDs
(wlid, _) <- IS.minView wlids
wl <- w ^? cWorld . lWorld . walls . ix wlid
--return (_wlMaterial wl, _wlColor wl)
return $ _wlMaterial wl
--makeDebris :: Material -> Color -> Point2 -> World -> World
src/Dodge/Data/GenWorld.hs
+2 -6
View File
@@ -52,9 +52,7 @@ data PSType
, _putEndPoint :: Point2
}
| PutWall {_pwPoly :: [Point2], _pwWall :: Wall}
-- | PutSlideDr Door Wall Float Point2 Point2
| PutDoor' Door Wall
-- | PutDoor WdBl Float Point2A Point2A
| PutDoor Door Wall
| RandPS (State StdGen PSType)
| PutForeground ForegroundShape
| PutWorldUpdate (Int -> PlacementSpot -> GenWorld -> GenWorld)
@@ -79,9 +77,7 @@ instance ShortShow PSType where
shortShow PutTrigger {} = "PutTrigger"
shortShow PutLineBlock {} = "PutLineBlock"
shortShow PutWall {} = "PutWall"
-- shortShow PutSlideDr {} = "PutSlideDr"
-- shortShow PutDoor {} = "PutDoor"
shortShow PutDoor' {} = "PutDoor'"
shortShow PutDoor {} = "PutDoor"
shortShow RandPS {} = "RandPS"
shortShow PutForeground {} = "PutForeground"
shortShow PutWorldUpdate {} = "PutWorldUpdate"
src/Dodge/Default/Wall.hs
+8 -10
View File
@@ -38,20 +38,18 @@ defaultCrystalWall = defaultWall & wlOpacity .~ SeeThrough & wlMaterial .~ Cryst
defaultMachineWall :: Wall
defaultMachineWall =
defaultWall
{ _wlOpacity = SeeAbove
, _wlRotateTo = False
, _wlStructure = MachinePart 0
, _wlMaterial = Metal
, _wlTouchThrough = True
}
& wlOpacity .~ SeeAbove
& wlRotateTo .~ False
& wlStructure .~ MachinePart 0
& wlMaterial .~ Metal
& wlTouchThrough .~ True
defaultDirtWall :: Wall
defaultDirtWall =
defaultWall
{ _wlOpacity = Opaque 6
, _wlRotateTo = False
, _wlMaterial = Dirt
}
& wlOpacity .~ Opaque 6
& wlRotateTo .~ False
& wlMaterial .~ Dirt
defaultWindow :: Wall
defaultWindow = defaultWall & wlOpacity .~ SeeThrough & wlMaterial .~ Glass
src/Dodge/Placement/Instance/Door.hs
+9 -14
View File
@@ -15,18 +15,16 @@ import Geometry
import Linear
putDoubleDoor ::
Bool ->
Wall ->
WdBl ->
Point2 ->
Point2 ->
Float ->
Placement
putDoubleDoor isauto wl cond a b speed =
putDoubleDoorThen isauto wl cond 1 a b speed (const $ const Nothing)
putDoubleDoor wl cond a b speed =
putDoubleDoorThen wl cond 1 a b speed (const $ const Nothing)
putDoubleDoorThen ::
Bool ->
Wall ->
WdBl ->
Float ->
@@ -35,16 +33,15 @@ putDoubleDoorThen ::
Float ->
(Placement -> Placement -> Maybe Placement) ->
Placement
putDoubleDoorThen isauto wl cond soff a b speed cont =
doorBetween isauto wl cond soff a half speed $
putDoubleDoorThen wl cond soff a b speed cont =
doorBetween wl cond soff a half speed $
\pl1 -> Just $
doorBetween isauto wl cond soff b half speed $
doorBetween wl cond soff b half speed $
\pl2 -> cont pl1 pl2
where
half = 0.5 *.* (a +.+ b)
doorBetween ::
Bool ->
Wall ->
WdBl ->
Float ->
@@ -53,9 +50,9 @@ doorBetween ::
Float ->
(Placement -> Maybe Placement) ->
Placement
doorBetween isauto wl cond soff pa pb speed g = case divideLine 40 pa pb of
doorBetween wl cond soff pa pb speed g = case divideLine 40 pa pb of
[x, y] -> ptCont (putSlideDr adoor wl soff x y) g
(x : y : zs) -> divideDoorPane isauto Nothing wl cond (soff - dist y pb) speed (zip (x : y : zs) (y : zs)) g
(x : y : zs) -> divideDoorPane Nothing wl cond (soff - dist y pb) speed (zip (x : y : zs) (y : zs)) g
_ -> error "tried to create doorBetween with too few points"
where
adoor =
@@ -65,7 +62,6 @@ doorBetween isauto wl cond soff pa pb speed g = case divideLine 40 pa pb of
divideDoorPane ::
Bool ->
Maybe Int ->
Wall ->
WdBl ->
@@ -74,9 +70,9 @@ divideDoorPane ::
[(Point2, Point2)] ->
(Placement -> Maybe Placement) ->
Placement
divideDoorPane isauto mid wl cond soff speed ppairs g = case ppairs of
divideDoorPane mid wl cond soff speed ppairs g = case ppairs of
[p] -> ptCont (adoor p) g
(p : ps) -> ptCont (adoor p) $ \pl -> Just $ divideDoorPane isauto (_plMID pl) wl cond soff speed ps g
(p : ps) -> ptCont (adoor p) $ \pl -> Just $ divideDoorPane (_plMID pl) wl cond soff speed ps g
_ -> undefined
where
adoor (x, y) = putSlideDr thedoor wl soff x y
@@ -92,7 +88,6 @@ putAutoDoor a b = Placement (PS 0 0) (PutCoord a) Nothing Nothing $ \_ apl ->
y = w ^?! gwWorld . coordinates . ix (bpl ^?! plMID . _Just)
in Just $
putDoubleDoor
True
defaultAutoWall
(WdBlCrFilterNearPoint 40 (0.5 *^ (x + y)) CrIsAnimate)
a
src/Dodge/Placement/PlaceSpot.hs
+1 -3
View File
@@ -134,9 +134,7 @@ placeSpotID rid ps pt w = case pt of
PutMachine pps mc mitm -> plMachine (map doShift pps) mc mitm p rot w
PutLS ls -> plNewUpID (gwWorld . cWorld . lWorld . lightSources) lsID (mvLS p' rot ls) w
RandPS _ -> error "RandPS should not be reachable here" --evaluateRandPS rid rgn ps w
-- PutDoor f l p1 p2 -> plDoor f l (pashift p1) (pashift p2) w
PutDoor' dr wl -> plDoor' (dr & drZeroPos %~ pashift & drOnePos %~ pashift) wl w
-- PutSlideDr wl dr off a b -> plSlideDoor wl dr off (doShift a) (doShift b) w
PutDoor dr wl -> plDoor' (dr & drZeroPos %~ pashift & drOnePos %~ pashift) wl w
PutCoord cp -> plNewID (gwWorld . coordinates) (doShift cp) w
PutBlock bl wl ps' ->
plBlock
src/Dodge/Placement/PlaceSpot/Block.hs
+2 -3
View File
@@ -42,9 +42,8 @@ insertStructureWalls ::
Int ->
World ->
World
insertStructureWalls f wl ps sid wid = insertWalls wls
where
wls =
insertStructureWalls f wl ps sid wid =
insertWalls $
zipWith
(\i xy -> wl & wlLine .~ xy & wlID .~ i & wlStructure .~ f sid)
[wid ..]
src/Dodge/Room/Airlock.hs
+27 -50
View File
@@ -3,6 +3,7 @@
{- Rooms that contain two doors and a switch alternating both. -}
module Dodge.Room.Airlock where
import Dodge.PlacementSpot
import Dodge.LevelGen.DoorPane
import Dodge.Default.Door
import qualified Data.IntMap.Strict as IM
@@ -38,8 +39,8 @@ decontamRoom i =
& rmPmnts
.~ [ pContID (PS (V2 (-35) 50) (negate $ pi / 2)) (PutButton $ makeSwitch col red NoWorldEffect NoWorldEffect) $
\btid -> Just $
putDoubleDoorThen False thewall (WdBlNegate $ WdBlBtOn btid) 1 (V2 0 20) (V2 40 20) 2 $
\_ _ -> Just $ putDoubleDoor False thewall (WdBlBtOn btid) (V2 0 80) (V2 40 80) 2
putDoubleDoorThen defaultDoorWall (WdBlNegate $ WdBlBtOn btid) 1 (V2 0 20) (V2 40 20) 2 $
\_ _ -> Just $ putDoubleDoor defaultDoorWall (WdBlBtOn btid) (V2 0 80) (V2 40 80) 2
, invisibleWall $ rectNSWE 60 40 (-40) (-30)
, spanLightI (V2 (-20) 30) (V2 (-20) 70)
, analyser (NoItemZone ps) (PS 50 0) (PS mcpos 0) & plExternalID ?~ i
@@ -52,7 +53,7 @@ decontamRoom i =
f gw = fromMaybe (error "tried to put a door using an empty placement list") $ do
pmnt <- gw ^? genPmnt . ix i
return $
putDoubleDoor False
putDoubleDoor
defaultDoorWall
(cond pmnt)
(V2 (-10) 35)
@@ -62,8 +63,6 @@ decontamRoom i =
mcpos = V2 70 50
cutps = [rectNSWE 100 0 0 40, switchcut]
ps = (\p -> p - mcpos) <$> orderPolygon (concat cutps)
--thewall = switchWallCol col
thewall = defaultDoorWall
switchcut = rectNSWE 65 35 (-40) 80
lnks =
[ (V2 20 95, 0)
@@ -81,8 +80,8 @@ airlock0 =
, _rmPmnts =
[ pContID (PS (V2 (-35) 50) (negate $ pi / 2)) (PutButton $ makeSwitch col red NoWorldEffect NoWorldEffect) $
\btid -> Just $
putDoubleDoorThen False thewall (WdBlNegate $ WdBlBtOn btid) 1 (V2 0 20) (V2 40 20) 2 $
\_ _ -> Just $ putDoubleDoor False thewall (WdBlBtOn btid) (V2 0 80) (V2 40 80) 2
putDoubleDoorThen defaultDoorWall (WdBlNegate $ WdBlBtOn btid) 1 (V2 0 20) (V2 40 20) 2 $
\_ _ -> Just $ putDoubleDoor defaultDoorWall (WdBlBtOn btid) (V2 0 80) (V2 40 80) 2
, invisibleWall $ rectNSWE 60 40 (-40) (-30)
, spanLightI (V2 (-2) 30) (V2 (-2) 70)
, sps0 $ putShape $ thinHighBar 75 (V2 40 50) (V2 (-1) 50)
@@ -90,7 +89,6 @@ airlock0 =
, _rmBound = [rectNSWE 75 15 0 40, switchcut]
}
where
thewall = defaultDoorWall
switchcut = rectNSWE 65 35 (-40) 20
lnks =
[ (V2 20 95, 0)
@@ -99,22 +97,19 @@ airlock0 =
col = dim $ dim $ bright red
airlockDoubleDoor ::
Point2 ->
Point2 ->
WdBl ->
Float ->
Point2A ->
Point2A ->
Float ->
Point2A ->
Point2A ->
Maybe Placement
airlockDoubleDoor p1 p2 cond l1 x1 y1 l2 x2 y2 =
jspsJ p1 0 (putDoor cond l1 x1 y1) $
sPS p2 0 (putDoor cond l2 x2 y2)
airlockDoubleDoor cond l x1 y1 x2 y2 =
jspsJ 0 0 (putDoor cond l x1 y1) $
sPS 0 0 (putDoor cond l x2 y2)
putDoor :: WdBl -> Float -> Point2A -> Point2A -> PSType
putDoor cond l p1 p2 = PutDoor' dr wl
putDoor cond l p1 p2 = PutDoor dr wl
where
wl = defaultDoorWall
dr = defaultDoor
@@ -125,26 +120,26 @@ putDoor cond l p1 p2 = PutDoor' dr wl
& drFootPrint .~ IM.fromList (zip [0..] $ wlps')
wlps' = rectanglePairs 9 0 (V2 l 0)
airlockSimple :: Room
airlockSimple =
defaultRoom
airlockSimple :: RandomGen g => State g Room
airlockSimple = do
light1 <- mntLightLnkCond $ resetPLUse $ rprBool $ \rp _ -> isInLnk rp
light2 <- mntLightLnkCond $ resetPLUse $ rprBool $ \rp _ -> isOutLnk rp
return $ defaultRoom
{ _rmPolys =
[rectNSWE 120 0 0 180]
, _rmLinks = map (uncurry outLink) (init lnks) ++ [uncurry inLink $ last lnks]
, _rmPath = foldMap (doublePairSet . (V2 90 30,) . fst) lnks
, _rmPmnts =
[ pContID (PS (V2 90 115) pi) (PutButton $ makeSwitch col red NoWorldEffect NoWorldEffect) $
[ light1,light2,
pContID (PS (V2 90 115) pi) (PutButton $ makeSwitch col red NoWorldEffect NoWorldEffect) $
\btid ->
airlockDoubleDoor
0
(V2 180 0)
(WdBlBtOn btid)
l1
x1
y1
l2
x2
y2
55
(0, pi / 2)
(0, 0)
(V2 180 0, pi / 2)
(V2 180 0, pi)
-- outDoorps inDoorps
]
, _rmBound =
@@ -156,12 +151,6 @@ airlockSimple =
, (V2 180 30, 1.5 * pi)
]
col = dim $ dim $ bright red
l1 = 55
l2 = 55
x1 = (0, pi / 2)
y1 = (0, 0)
y2 = (0, pi / 2)
x2 = (0, pi)
airlockZ :: RandomGen g => State g Room
airlockZ = do
@@ -180,15 +169,12 @@ airlockZ = do
[ pContID (PS (V2 90 115) pi) (PutButton $ makeSwitch col red NoWorldEffect NoWorldEffect) $
\btid ->
airlockDoubleDoor
(V2 0 60)
(V2 180 60)
(WdBlBtOn btid)
l1
x1
y1
l2
x2
y2
61
(V2 0 60, - pi / 2)
(V2 0 60, 0)
(V2 180 60, - pi)
(V2 180 60, - pi / 2)
, sps0 $ PutWall (reverse $ rectNSWE 70 50 60 120) defaultWall
, lighting
]
@@ -198,15 +184,6 @@ airlockZ = do
where
lnks = muout [(V2 0 30, pi / 2)] ++ muin [(V2 180 30, 1.5 * pi)]
col = dim $ dim $ bright red
l1 = 61
l2 = 61
x1 = (0, - pi / 2)
y1 = (0, 0)
x2 = (0, - pi)
y2 = (0, - pi / 2)
-- outDoorps = (V2 0 0,) <$> arcStepwise 3 (pi / 2) (V2 0 0) (V2 0 (-61))
-- inDoorps = (V2 0 0,) <$> arcStepwise 3 (pi / 2) (V2 0 0) (V2 (-61) 0)
airlock90 :: Room
airlock90 =
src/Dodge/Room/Door.hs
+1 -2
View File
@@ -41,6 +41,5 @@ triggerDoorRoom i =
where
f gw = fromMaybe (error "tried to put a door using an empty placement list") $ do
pmnt <- gw ^? genPmnt . ix i
return $ putDoubleDoor False
defaultDoorWall (cond pmnt) (V2 0 20) (V2 40 20) 2
return $ putDoubleDoor defaultDoorWall (cond pmnt) (V2 0 20) (V2 40 20) 2
cond pmnt = WdTrig $ fromJust (_plMID pmnt)
src/Dodge/Room/LongDoor.hs
+1 -1
View File
@@ -138,7 +138,7 @@ addButtonSlowDoor x h rm = do
col
(rprBool (isUnusedLnkType InLink))
$ \btplmnt -> Just $
putDoubleDoorThen False
putDoubleDoorThen
thewall
(WdBlBtOn $ fromJust $ _plMID btplmnt)
30
src/Dodge/Room/Procedural.hs
-1
View File
@@ -332,7 +332,6 @@ centerVaultRoom w h d =
jspsJ (V2 0 (d -10)) 0 (putSlideDr (thedoor btid) thewall 1 (V2 (-21) 0) (V2 0 0)) $
sPS (V2 0 (d -10)) 0 (putSlideDr (thedoor btid) thewall 1 (V2 21 0) (V2 0 0))
]
--thewall = switchWallCol col
thewall = defaultDoorWall
thedoor btid =
defaultDoor
src/Dodge/Room/Tutorial.hs
+1
View File
@@ -45,6 +45,7 @@ tutAnoTree = do
foldMTRS
[ tToBTree "TutStartRez" . return . cleatOnward <$> tutRezBox
, corDoor
, tToBTree "x" . return . cleatOnward <$> airlockSimple
-- , tToBTree "lastun" . return . cleatOnward <$> tanksRoom [] []
-- , return $ tToBTree "cor" $ return $ cleatOnward corridor
-- , return $ tToBTree "cor" $ return $ cleatOnward corridor