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-12 21:13:06 +01:00
parent 408b39f160
commit 8b44538048
11 changed files with 23 additions and 137 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data/GenWorld.hs
-2
View File
@@ -42,7 +42,6 @@ data PSType
| PutProp Prop
| PutTerminal {_unputTerminal :: Terminal}
| PutFlIt {_putItem :: Item}
| PutPPlate PressPlate
| PutBlock {_putBlock :: Block, _putWall :: Wall, _putPoly :: [Point2]}
| PutCoord Point2
| PutMod Modification
@@ -74,7 +73,6 @@ instance ShortShow PSType where
shortShow PutProp {} = "PutProp"
shortShow PutTerminal {} = "PutTerminal"
shortShow PutFlIt {} = "PutFlIt"
shortShow PutPPlate {} = "PutPPlate"
shortShow PutBlock {} = "PutBlock"
shortShow PutCoord {} = "PutCoord"
shortShow PutMod {} = "PutMod"
src/Dodge/Data/LWorld.hs
-3
View File
@@ -30,7 +30,6 @@ module Dodge.Data.LWorld (
module Dodge.Data.Magnet,
module Dodge.Data.Modification,
-- module Dodge.Data.PathGraph,
module Dodge.Data.PressPlate,
module Dodge.Data.Projectile,
module Dodge.Data.Prop,
module Dodge.Data.RadarBlip,
@@ -77,7 +76,6 @@ import Dodge.Data.LinearShockwave
import Dodge.Data.Machine
import Dodge.Data.Magnet
import Dodge.Data.Modification
import Dodge.Data.PressPlate
import Dodge.Data.Projectile
import Dodge.Data.Prop
import Dodge.Data.RadarBlip
@@ -132,7 +130,6 @@ data LWorld = LWorld
, _modifications :: IM.IntMap Modification
, _worldEvents :: [WdWd]
, _delayedEvents :: [(Int, WdWd)]
, _pressPlates :: IM.IntMap PressPlate
, _buttons :: IM.IntMap Button
, _foreShapes :: IM.IntMap ForegroundShape
, _lightSources :: IM.IntMap LightSource
src/Dodge/Data/PressPlate.hs
-31
View File
@@ -1,31 +0,0 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.PressPlate where
import Control.Lens
import Data.Aeson
import Data.Aeson.TH
import Geometry.Data
import Picture
data PressPlateEvent
= PressPlateId
| PPLevelReset
deriving (Eq, Ord, Show, Read) --Generic, Flat)
data PressPlate = PressPlate
{ _ppPict :: Picture
, _ppPos :: Point2
, _ppRot :: Float
, _ppEvent :: PressPlateEvent
, _ppID :: Int
, _ppText :: String
}
deriving (Eq, Ord, Show, Read) --Generic, Flat)
makeLenses ''PressPlate
deriveJSON defaultOptions ''PressPlateEvent
deriveJSON defaultOptions ''PressPlate
src/Dodge/Default.hs
-11
View File
@@ -51,17 +51,6 @@ defaultButton = Button
, _btID = 0
}
defaultPP :: PressPlate
defaultPP =
PressPlate
{ _ppPict = setDepth 1 . color (dim . dim $ bright blue) $ circleSolid 5
, _ppPos = V2 0 0
, _ppRot = 0
, _ppEvent = PressPlateId
, _ppID = -1
, _ppText = "Pressure plate"
}
defaultProximitySensor :: ProximitySensor
defaultProximitySensor =
ProxSensor
src/Dodge/Default/World.hs
-1
View File
@@ -133,7 +133,6 @@ defaultLWorld =
, _floorItems = mempty
, _worldEvents = []
, _delayedEvents = []
, _pressPlates = IM.empty
, _buttons = IM.empty
-- , _corpses = IM.empty
, _lightSources = IM.empty
src/Dodge/Placement/PlaceSpot.hs
-5
View File
@@ -132,8 +132,6 @@ placeSpotID rid ps pt w = case pt of
w
PutMachine pps mc wl mitm -> plMachine (map doShift pps) mc wl mitm p rot w
PutLS ls -> plNewUpID (gwWorld . cWorld . lWorld . lightSources) lsID (mvLS p' rot ls) w
PutPPlate pp ->
plNewUpID (gwWorld . cWorld . lWorld . pressPlates) ppID (mvPP p rot pp) w
RandPS _ -> error "RandPS should not be reachable here" --evaluateRandPS rid rgn ps w
PutDoor col eo f pss -> plDoor col eo f (map (bimap doShift doShift) pss) w
PutCoord cp -> plNewID (gwWorld . coordinates) (doShift cp) w
@@ -188,9 +186,6 @@ mvProp p a = (prRot +~ a) . (prPos %~ ((p +.+) . rotateV a))
mvButton :: Point2 -> Float -> Button -> Button
mvButton p a = (btRot +~ a) . (btPos %~ ((p +.+) . rotateV a))
mvPP :: Point2 -> Float -> PressPlate -> PressPlate
mvPP p rot pp = pp & ppPos .~ p & ppRot .~ rot
mvCr :: Point2 -> Float -> Creature -> Creature
mvCr p rot cr =
cr
src/Dodge/PressPlate.hs
-19
View File
@@ -1,19 +0,0 @@
module Dodge.PressPlate where
import Control.Lens
import Linear
import Dodge.Base.You
import Dodge.Data.World
import Dodge.WorldEvent.Explosion
import Geometry
doPressPlateEvent :: PressPlateEvent -> PressPlate -> World -> World
doPressPlateEvent ppe = case ppe of
PressPlateId -> const id
PPLevelReset -> ppLevelReset
ppLevelReset :: PressPlate -> World -> World
ppLevelReset pp w
| dist (you w ^. crPos . _xy) (_ppPos pp) < 20
= makeExplosionAt (_ppPos pp `v2z` 20) 0 w
| otherwise = w
src/Dodge/Render/ShapePicture.hs
-4
View File
@@ -109,7 +109,6 @@ extraPics cfig u =
<> foldMap drawBlip (_radarBlips lw)
<> _flares lw
<> foldMap drawLightSource (_lightSources lw)
<> foldMap ppDraw (_pressPlates lw)
<> viewClipBounds cfig w
<> showEnabledDebugs cfig
<> foldMap _debugPic (_uvDebug u) -- debug messages are in fixed coord pics
@@ -117,9 +116,6 @@ extraPics cfig u =
w = u ^. uvWorld
lw = w ^. cWorld . lWorld
ppDraw :: PressPlate -> Picture
ppDraw c = uncurryV translate (_ppPos c) $ rotate (_ppRot c) (_ppPict c)
floorItemSPic :: Item -> FloorItem -> SPic
floorItemSPic itm flit =
uncurryV translateSPxy (_flItPos flit) $
src/Dodge/Room.hs
-2
View File
@@ -15,7 +15,6 @@ module Dodge.Room (
module Dodge.Room.LongDoor,
module Dodge.Room.LongRoom,
module Dodge.Room.Branch,
module Dodge.Room.Teleport,
module Dodge.Room.BlinkAcross,
module Dodge.Room.Start,
module Dodge.Room.Boss,
@@ -51,6 +50,5 @@ import Dodge.Room.Room
import Dodge.Room.SensorDoor
import Dodge.Room.Start
import Dodge.Room.Tanks
import Dodge.Room.Teleport
import Dodge.Room.Treasure
import Dodge.Room.Warning
src/Dodge/Room/Teleport.hs
-36
View File
@@ -1,36 +0,0 @@
{- Specification of rooms that teleport (between levels). -}
module Dodge.Room.Teleport where
import Control.Lens
import Control.Monad.State
import Dodge.Data.GenWorld
import Dodge.LevelGen.PlacementHelper
import Dodge.Placement.Instance
import Dodge.Room.Procedural
import Geometry
import Picture
import System.Random
telRoomLev ::
RandomGen g =>
-- | Level number to teleport to
Int ->
State g Room
telRoomLev _ = do
w <- state $ randomR (200, 300)
h <- state $ randomR (200, 300)
roomRectAutoLinks w h <&> rmPmnts
.~ [ sPS (V2 (w / 2) (h / 2)) 0 $ PutPPlate telPP
, sPS (V2 (w / 2) (h / 2 + 30)) 0 putLamp
]
where
telPP =
PressPlate
{ _ppPict = setDepth 0.5 . color red $ polygon ppFootprint
, _ppPos = V2 0 0
, _ppRot = 0
, _ppEvent = PPLevelReset
, _ppID = 0
, _ppText = "NEW LEVEL"
}
ppFootprint = reverse $ rectNSWE 20 (-20) (-20) 20
src/Dodge/Update.hs
+23 -23
View File
@@ -1,4 +1,5 @@
{-# LANGUAGE LambdaCase #-}
module Dodge.Update (updateUniverse) where
import Color
@@ -32,7 +33,6 @@ import Dodge.LinearShockwave.Update
import Dodge.ListDisplayParams
import Dodge.Machine.Update
import Dodge.ModificationEffect
import Dodge.PressPlate
import Dodge.Projectile.Update
import Dodge.Prop.Moving
import Dodge.Prop.Update
@@ -161,7 +161,7 @@ updateUniverseMid u = case _uvScreenLayers u of
. updateUseInputInGame
$ over
uvWorld
(updateMouseInGame (u ^. uvConfig) . updateCamera (u ^. uvConfig))
(updateMouseInGame (u ^. uvConfig) . updateCamera (u ^. uvConfig))
u
timeFlowUpdate :: Universe -> Universe
@@ -237,13 +237,12 @@ scrollTimeForward w = case w ^? timeFlow . futureWorlds . _head of
-- | The update step.
functionalUpdate :: Universe -> Universe
functionalUpdate u =
functionalUpdate =
checkEndGame
. over (uvWorld . cWorld . lWorld) updateMagnets
. over uvWorld (cWorld . lWorld . lClock +~ 1)
. over uvWorld updateDistortions
. over uvWorld updateCreatureSoundPositions
. over uvWorld ppEvents
. colCrsWalls
. over uvWorld simpleCrSprings
. over uvWorld (updateIMl' (_doors . _lWorld . _cWorld) updateDoor)
@@ -270,7 +269,9 @@ functionalUpdate u =
. over uvWorld updatePulseLasers
. over uvWorld updateTeslaArcs
. over uvWorld updateTractorBeams
. over uvWorld (updateIMl' (_linearShockwaves . _lWorld . _cWorld) updateLinearShockwave)
. over
uvWorld
(updateIMl' (_linearShockwaves . _lWorld . _cWorld) updateLinearShockwave)
. over uvWorld (updateIMl' (_props . _lWorld . _cWorld) updateProp)
. over uvWorld (updateIMl' (_projectiles . _lWorld . _cWorld) updateProjectile)
. over uvWorld updateClouds
@@ -297,7 +298,7 @@ functionalUpdate u =
. set (uvWorld . cWorld . lWorld . flares) []
. set (uvWorld . cWorld . lWorld . lights) []
. updateAimPos
$ over uvWorld updatePastWorlds u
. over uvWorld updatePastWorlds
updateAimPos :: Universe -> Universe
updateAimPos u =
@@ -317,7 +318,7 @@ checkTermDist w = fromMaybe w $ do
tmid <- w ^? hud . subInventory . termID
btid <- w ^? cWorld . lWorld . terminals . ix tmid . tmButtonID
btpos <- w ^? cWorld . lWorld . buttons . ix btid . btPos
guard $ dist btpos ( you w ^. crPos . _xy) > 40
guard $ dist btpos (you w ^. crPos . _xy) > 40
return $ w & hud . subInventory .~ NoSubInventory
updateMouseContext :: Config -> Universe -> Universe
@@ -327,7 +328,7 @@ updateMouseContext cfig u = case u ^? uvScreenLayers . ix 0 of
updateMouseContextGame :: Config -> Universe -> MouseContext -> MouseContext
updateMouseContextGame cfig u = \case
OverInvDrag i _ -> OverInvDrag i (inverseSelNumPos cfig invDP mpos disss)
OverInvDrag i _ -> OverInvDrag i (inverseSelNumPos cfig invDP mpos disss)
x@OverInvDragSelect{} -> x
_ -> fromMaybe aimcontext (isrotatedrag <|> overterm <|> overinv <|> overcomb)
where
@@ -458,8 +459,8 @@ pbFlicker pt =
d = 4 * fromIntegral (10 + abs ((_pbTimer pt `mod` 20) - 10))
zoneClouds :: World -> World
zoneClouds w = w
& clZoning .~ foldl' (flip zoneCloud) mempty (w ^. cWorld . lWorld . clouds)
zoneClouds w =
w & clZoning .~ foldl' (flip zoneCloud) mempty (w ^. cWorld . lWorld . clouds)
zoneDusts :: World -> World
zoneDusts w = w & dsZoning .~ foldl' (flip zoneDust) mempty (w ^. cWorld . lWorld . dusts)
@@ -495,8 +496,7 @@ setOldPos cr = cr & crOldPos .~ _crPos cr
zoneCreatures :: World -> World
zoneCreatures w =
w & crZoning
.~ foldl' zoneCreature mempty (w ^. cWorld . lWorld . creatures)
w & crZoning .~ foldl' zoneCreature mempty (w ^. cWorld . lWorld . creatures)
updateCreatureSoundPositions :: World -> World
updateCreatureSoundPositions w =
@@ -505,9 +505,10 @@ updateCreatureSoundPositions w =
$ _playingSounds w
where
insertSound w' k s = w' & toPlaySounds %~ M.insertWith (const id) k s
updateSound (CrMouth cid) s = case w ^? cWorld . lWorld . creatures . ix cid . crPos . _xy of
Just p -> Just s{_soundPos = p, _soundAngDist = Just (soundAngle p w, 0)}
Nothing -> Just s{_soundTime = Just 0}
updateSound (CrMouth cid) s =
case w ^? cWorld . lWorld . creatures . ix cid . crPos . _xy of
Just p -> Just s{_soundPos = p, _soundAngDist = Just (soundAngle p w, 0)}
Nothing -> Just s{_soundTime = Just 0}
updateSound _ _ = Nothing
--updateIMr :: (World -> IM.IntMap a) -> (a -> a -> World -> World) -> World -> World
@@ -599,7 +600,8 @@ updatePulseLaser pz = case pz ^. pzTimer of
5 -> (Endo f, [pz & pzTimer -~ 1])
_ -> (Endo g, [pz & pzTimer -~ 1])
where
f w = dodam thHit w
f w =
dodam thHit w
& cWorld . lWorld . flares <>~ drawLaser cyan (sp : ps)
where
(thHit, ps) = reflectPulseLaserAlong phasev sp xp w
@@ -730,9 +732,6 @@ updateDusts w = updateObjMapMaybe dusts (updateDust w) w
-- (intersectSegSegss x y ass)
--intersectSegsSegss _ _ = Nothing
ppEvents :: World -> World
ppEvents w = IM.foldl' (flip $ \pp -> doPressPlateEvent (_ppEvent pp) pp) w $ w ^. cWorld . lWorld . pressPlates
--updateSeenWalls :: World -> World
--updateSeenWalls w = alaf Endo foldMap (markWallSeen . _wlID . snd) (allVisibleWalls w) w
@@ -845,8 +844,9 @@ dustSpringVel a v b
radDist = 10
simpleCrSprings :: World -> World
simpleCrSprings w = IM.foldl' (flip crSpring) w
$ IM.filter (\cr -> cr ^. crPos . _z >= 0) $ w ^. cWorld . lWorld . creatures
simpleCrSprings w =
IM.foldl' (flip crSpring) w $
IM.filter (\cr -> cr ^. crPos . _z >= 0) $ w ^. cWorld . lWorld . creatures
-- note that this may in rare cases not push creatures away from each other
crSpring :: Creature -> World -> World
@@ -868,8 +868,8 @@ crCrSpring c1 c2
vec = c1 ^. crPos . _xy - c2 ^. crPos . _xy
diff = magV vec
comRad = crRad (c1 ^. crType) + crRad (c2 ^. crType)
overlap1 = ((comRad - diff) * crMass (_crType c2) * 0.5 / massT) *.* errorNormalizeV 55 vec
overlap2 = ((comRad - diff) * crMass (_crType c1) * 0.5 / massT) *.* errorNormalizeV 56 vec
overlap1 = ((comRad - diff) * crMass (_crType c2) * 0.5 / massT) *^ signorm vec
overlap2 = ((comRad - diff) * crMass (_crType c1) * 0.5 / massT) *^ signorm vec
massT = crMass (_crType c1) + crMass (_crType c2)
updateDelayedEvents :: World -> World