diff --git a/src/Dodge/Data/GenWorld.hs b/src/Dodge/Data/GenWorld.hs index a4fe8221f..c1afba84d 100644 --- a/src/Dodge/Data/GenWorld.hs +++ b/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" diff --git a/src/Dodge/Data/LWorld.hs b/src/Dodge/Data/LWorld.hs index 8177b4398..a15e9a88f 100644 --- a/src/Dodge/Data/LWorld.hs +++ b/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 diff --git a/src/Dodge/Data/PressPlate.hs b/src/Dodge/Data/PressPlate.hs deleted file mode 100644 index 29527fb49..000000000 --- a/src/Dodge/Data/PressPlate.hs +++ /dev/null @@ -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 diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index a571bd013..12962dec5 100644 --- a/src/Dodge/Default.hs +++ b/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 diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index f641e7f9f..0a2e853bd 100644 --- a/src/Dodge/Default/World.hs +++ b/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 diff --git a/src/Dodge/Placement/PlaceSpot.hs b/src/Dodge/Placement/PlaceSpot.hs index 7fefad8d9..43ad8bc5b 100644 --- a/src/Dodge/Placement/PlaceSpot.hs +++ b/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 diff --git a/src/Dodge/PressPlate.hs b/src/Dodge/PressPlate.hs deleted file mode 100644 index 822bd7973..000000000 --- a/src/Dodge/PressPlate.hs +++ /dev/null @@ -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 diff --git a/src/Dodge/Render/ShapePicture.hs b/src/Dodge/Render/ShapePicture.hs index ec25b5554..dbaf9f252 100644 --- a/src/Dodge/Render/ShapePicture.hs +++ b/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) $ diff --git a/src/Dodge/Room.hs b/src/Dodge/Room.hs index 6982f7bda..c7377fb25 100644 --- a/src/Dodge/Room.hs +++ b/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 diff --git a/src/Dodge/Room/Teleport.hs b/src/Dodge/Room/Teleport.hs deleted file mode 100644 index ef205c303..000000000 --- a/src/Dodge/Room/Teleport.hs +++ /dev/null @@ -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 diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 470ea0d97..4b839a672 100644 --- a/src/Dodge/Update.hs +++ b/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 @@ -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