Cleanup

src/Dodge/Data/GenWorld.hs

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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
@@ -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 =
@@ -458,8 +459,8 @@ pbFlicker pt =
     d = 4 * fromIntegral (10 + abs ((_pbTimer pt `mod` 20) - 10))
 
 zoneClouds :: World -> World
-zoneClouds w = w 
+zoneClouds w =
-    & clZoning .~ foldl' (flip zoneCloud) mempty (w ^. cWorld . lWorld . clouds)
+    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
+    w & crZoning .~ foldl' zoneCreature mempty (w ^. cWorld . lWorld . creatures)
-        .~ foldl' zoneCreature mempty (w ^. cWorld . lWorld . creatures)
 
 updateCreatureSoundPositions :: World -> World
 updateCreatureSoundPositions w =
@@ -505,7 +505,8 @@ 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
+    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
@@ -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 
+simpleCrSprings w =
-    $ IM.filter (\cr -> cr ^. crPos . _z >= 0) $ w ^. cWorld . lWorld . creatures
+    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
+    overlap1 = ((comRad - diff) * crMass (_crType c2) * 0.5 / massT) *^ signorm vec
-    overlap2 = ((comRad - diff) * crMass (_crType c1) * 0.5 / massT) *.* errorNormalizeV 56 vec
+    overlap2 = ((comRad - diff) * crMass (_crType c1) * 0.5 / massT) *^ signorm vec
     massT = crMass (_crType c1) + crMass (_crType c2)
 
 updateDelayedEvents :: World -> World