From 7e790b715357984549fc0537197a95dc200297af Mon Sep 17 00:00:00 2001 From: justin Date: Fri, 28 Oct 2022 12:24:51 +0100 Subject: [PATCH] Add in "linear" lWorld to separate time reversable worlds --- src/Dodge/Barreloid.hs | 6 +- src/Dodge/Base/Collide.hs | 15 +- src/Dodge/Base/Coordinate.hs | 33 +++-- src/Dodge/Base/Window.hs | 15 +- src/Dodge/Base/You.hs | 4 +- src/Dodge/Beam.hs | 9 +- src/Dodge/Block.hs | 30 ++-- src/Dodge/Block/Debris.hs | 12 +- src/Dodge/Bullet.hs | 10 +- src/Dodge/Button/Event.hs | 8 +- src/Dodge/Combine.hs | 6 +- src/Dodge/Creature/Action.hs | 16 +-- src/Dodge/Creature/Action/Blink.hs | 12 +- src/Dodge/Creature/Boid.hs | 18 +-- src/Dodge/Creature/Damage.hs | 10 +- src/Dodge/Creature/Impulse.hs | 7 +- src/Dodge/Creature/Impulse/UseItem.hs | 14 +- src/Dodge/Creature/Perception.hs | 4 +- src/Dodge/Creature/Picture/Awareness.hs | 4 +- src/Dodge/Creature/ReaderUpdate.hs | 3 +- src/Dodge/Creature/SetTarget.hs | 4 +- src/Dodge/Creature/State.hs | 32 ++--- src/Dodge/Creature/YourControl.hs | 10 +- src/Dodge/CreatureEffect.hs | 7 +- src/Dodge/CullBox.hs | 8 +- src/Dodge/Cuse.hs | 2 +- src/Dodge/Damage.hs | 8 +- src/Dodge/DamageCircle.hs | 4 +- src/Dodge/Data/CWorld.hs | 19 +-- src/Dodge/Data/World.hs | 2 + src/Dodge/Debug/LinkDecoration.hs | 4 +- src/Dodge/Debug/Picture.hs | 12 +- src/Dodge/Debug/Terminal.hs | 16 +-- src/Dodge/Default/World.hs | 8 +- src/Dodge/DrWdWd.hs | 10 +- src/Dodge/EnergyBall.hs | 6 +- src/Dodge/Euse.hs | 12 +- src/Dodge/Event.hs | 113 --------------- src/Dodge/Event/Keyboard.hs | 44 +++--- src/Dodge/Flame.hs | 10 +- src/Dodge/FloorItem.hs | 6 +- src/Dodge/HeldScroll.hs | 2 +- src/Dodge/HeldUse.hs | 12 +- src/Dodge/Humanoid.hs | 3 +- src/Dodge/Initialisation.hs | 8 +- src/Dodge/InputFocus.hs | 6 +- src/Dodge/Inventory.hs | 86 +++++------ src/Dodge/Inventory/Add.hs | 11 +- src/Dodge/Inventory/Lock.hs | 4 +- src/Dodge/ItEffect.hs | 4 +- src/Dodge/Item/Consumable.hs | 7 +- src/Dodge/Item/Location.hs | 12 +- src/Dodge/Item/Location/Initialize.hs | 28 ++-- src/Dodge/Item/Weapon/BatteryGuns.hs | 10 +- src/Dodge/Item/Weapon/ExtraEffect.hs | 10 +- src/Dodge/Item/Weapon/Launcher.hs | 9 +- src/Dodge/Item/Weapon/Remote.hs | 23 ++- src/Dodge/Item/Weapon/Shell.hs | 2 +- src/Dodge/Item/Weapon/Spawn.hs | 4 +- src/Dodge/Item/Weapon/TriggerType.hs | 60 ++++---- src/Dodge/Item/Weapon/Utility.hs | 6 +- src/Dodge/Lampoid.hs | 12 +- src/Dodge/Layout.hs | 17 +-- src/Dodge/LevelGen.hs | 4 +- src/Dodge/LightSource.hs | 8 +- src/Dodge/LightSource/Torch.hs | 2 +- src/Dodge/LinearShockwave/Update.hs | 4 +- src/Dodge/Luse.hs | 7 +- src/Dodge/Machine.hs | 8 +- src/Dodge/Machine/Damage.hs | 2 +- src/Dodge/Machine/Destroy.hs | 6 +- src/Dodge/Machine/Update.hs | 24 ++-- src/Dodge/ModificationEffect.hs | 4 +- src/Dodge/Path.hs | 16 ++- src/Dodge/Picture/SizeInvariant.hs | 16 +-- .../Placement/Instance/LightSource/Flicker.hs | 8 +- src/Dodge/Placement/Instance/Terminal.hs | 8 +- src/Dodge/Placement/PlaceSpot.hs | 35 +++-- src/Dodge/Placement/PlaceSpot/Block.hs | 16 +-- src/Dodge/Placement/PlaceSpot/TriggerDoor.hs | 20 +-- src/Dodge/Projectile/Create.hs | 4 +- src/Dodge/Projectile/Update.hs | 28 ++-- src/Dodge/Prop/Gib.hs | 6 +- src/Dodge/Prop/Moving.hs | 6 +- src/Dodge/Prop/Update.hs | 10 +- src/Dodge/RadarSweep.hs | 8 +- src/Dodge/Reloading.hs | 6 +- src/Dodge/Render.hs | 12 +- src/Dodge/Render/HUD.hs | 17 ++- src/Dodge/Render/Lights.hs | 8 +- src/Dodge/Render/ShapePicture.hs | 66 ++++----- src/Dodge/Render/Walls.hs | 2 +- src/Dodge/Room/LongDoor.hs | 2 +- src/Dodge/Shockwave/Update.hs | 4 +- src/Dodge/SoundLogic.hs | 4 +- src/Dodge/Spark.hs | 4 +- src/Dodge/Terminal.hs | 12 +- src/Dodge/Terminal/LeftButton.hs | 12 +- src/Dodge/Tesla/Arc.hs | 6 +- src/Dodge/Tesla/Arc/Default.hs | 2 +- src/Dodge/TestString.hs | 15 +- src/Dodge/TractorBeam/Update.hs | 4 +- src/Dodge/Update.hs | 135 +++++++++--------- src/Dodge/Update/Camera.hs | 53 +++---- src/Dodge/Update/Cloud.hs | 2 +- src/Dodge/Update/Scroll.hs | 91 ++++-------- src/Dodge/Update/UsingInput.hs | 26 ++-- src/Dodge/Update/WallDamage.hs | 6 +- src/Dodge/Wall/Create.hs | 4 +- src/Dodge/Wall/Damage.hs | 12 +- src/Dodge/Wall/DamageEffect.hs | 2 +- src/Dodge/Wall/Delete.hs | 9 +- src/Dodge/Wall/Move.hs | 14 +- src/Dodge/Wall/Zone.hs | 4 +- src/Dodge/WallCreatureCollisions.hs | 2 +- src/Dodge/WdP2f.hs | 2 +- src/Dodge/WorldBool.hs | 12 +- src/Dodge/WorldEffect.hs | 24 ++-- src/Dodge/WorldEvent/Cloud.hs | 2 +- src/Dodge/WorldEvent/Damage.hs | 2 +- src/Dodge/WorldEvent/Explosion.hs | 4 +- src/Dodge/WorldEvent/Flash.hs | 6 +- src/Dodge/WorldEvent/Shockwave.hs | 4 +- src/Dodge/WorldEvent/SpawnParticle.hs | 12 +- src/Dodge/WorldEvent/ThingsHit.hs | 2 +- src/Dodge/Zoning/Cloud.hs | 6 +- src/Dodge/Zoning/Creature.hs | 14 +- src/Dodge/Zoning/Pathing.hs | 12 +- src/Dodge/Zoning/Wall.hs | 8 +- src/Dodge/Zoning/World.hs | 2 +- 130 files changed, 827 insertions(+), 980 deletions(-) diff --git a/src/Dodge/Barreloid.hs b/src/Dodge/Barreloid.hs index a08d32e25..2930a9cba 100644 --- a/src/Dodge/Barreloid.hs +++ b/src/Dodge/Barreloid.hs @@ -18,8 +18,8 @@ updateBarreloid cr = case cr ^?! crType . barrelType of -- should generate the sparks externally using new random generators updateExpBarrel :: Creature -> World -> World updateExpBarrel cr w - | _crHP cr > 0 = foldl' (flip ($)) (hiss w & cWorld . creatures . at (_crID cr) .~ newCr) pierceSparks - | otherwise = makeExplosionAt (_crPos cr) $ stopSounds w & cWorld . creatures . at (_crID cr) .~ Nothing + | _crHP cr > 0 = foldl' (flip ($)) (hiss w & cWorld . lWorld . creatures . at (_crID cr) .~ newCr) pierceSparks + | otherwise = makeExplosionAt (_crPos cr) $ stopSounds w & cWorld . lWorld . creatures . at (_crID cr) .~ Nothing where g = _randGen w damages = _csDamage $ _crState cr @@ -45,7 +45,7 @@ updateExpBarrel cr w updateBarrel :: Creature -> World -> World updateBarrel cr | _crHP cr > 0 = doDamage cr - | otherwise = cWorld . creatures . at (_crID cr) .~ Nothing + | otherwise = cWorld . lWorld . creatures . at (_crID cr) .~ Nothing damsToExpBarrel :: [Damage] -> Creature -> Creature damsToExpBarrel ds cr = foldl' damToExpBarrel (foldl' damToExpBarrel cr pierceDam) otherDam diff --git a/src/Dodge/Base/Collide.hs b/src/Dodge/Base/Collide.hs index 982664405..41f97884a 100644 --- a/src/Dodge/Base/Collide.hs +++ b/src/Dodge/Base/Collide.hs @@ -44,7 +44,6 @@ import Dodge.Data.World import Dodge.Zoning import FoldableHelp import Geometry -import qualified IntMapHelp as IM collidePoint :: Point2 -> @@ -141,7 +140,7 @@ allVisibleWalls :: World -> [(Point2, Wall)] {-# INLINE allVisibleWalls #-} allVisibleWalls w = concatMap (flip (visibleWalls vPos) w . (+.+ vPos)) $ nRays 20 where - vPos = w ^. cWorld . cwCam . cwcViewFrom + vPos = w ^. cWorld . lWorld . cwCam . cwcViewFrom --allVisibleWalls :: World -> StreamOf (Point2,Wall) --{-# INLINE allVisibleWalls #-} @@ -217,7 +216,7 @@ circOnAnyCr :: Point2 -> Float -> World -> Bool {-# INLINE circOnAnyCr #-} circOnAnyCr p r w = IS.foldr f False $ crIXsNearPoint p w where - f cid bl = maybe False (\cr -> dist p (_crPos cr) < r + _crRad cr) (w ^? cWorld . creatures . ix cid) || bl + f cid bl = maybe False (\cr -> dist p (_crPos cr) < r + _crRad cr) (w ^? cWorld . lWorld . creatures . ix cid) || bl -- | More general collision tests follow hasLOS :: Point2 -> Point2 -> World -> Bool @@ -252,15 +251,15 @@ canSee :: Int -> Int -> World -> Bool {-# INLINE canSee #-} canSee i j w = hasLOS p1 p2 w where - p1 = _crPos (_creatures (_cWorld w) IM.! i) - p2 = _crPos (_creatures (_cWorld w) IM.! j) -- unsafe + p1 = w ^?! cWorld . lWorld . creatures . ix i . crPos -- _crPos (_creatures (_cWorld w) IM.! i) + p2 = w ^?! cWorld . lWorld . creatures . ix j . crPos -- _crPos (_creatures (_cWorld w) IM.! j) -- unsafe canSeeIndirect :: Int -> Int -> World -> Bool {-# INLINE canSeeIndirect #-} canSeeIndirect i j w = hasLOSIndirect ipos jpos w where - ipos = _crPos (_creatures (_cWorld w) IM.! i) - jpos = _crPos (_creatures (_cWorld w) IM.! j) + ipos = w ^?! cWorld . lWorld . creatures . ix i . crPos + jpos = w ^?! cWorld . lWorld . creatures . ix j . crPos anythingHitCirc :: Float -> Point2 -> Point2 -> World -> Bool anythingHitCirc rad sp ep w = hitCr || isJust (sequence hitWl) @@ -270,7 +269,7 @@ anythingHitCirc rad sp ep w = hitCr || isJust (sequence hitWl) maybe False (\cr -> null $ intersectCircSeg (_crPos cr) (rad + _crRad cr) sp ep) - (w ^? cWorld . creatures . ix cid) + (w ^? cWorld . lWorld . creatures . ix cid) || bl hitWl = collideCircWalls sp ep rad $ wlsNearPoint ep w diff --git a/src/Dodge/Base/Coordinate.hs b/src/Dodge/Base/Coordinate.hs index 8d52ba738..ac9a04c48 100644 --- a/src/Dodge/Base/Coordinate.hs +++ b/src/Dodge/Base/Coordinate.hs @@ -9,9 +9,9 @@ import Control.Lens worldPosToScreenNorm :: Configuration -> World -> Point2 -> Point2 worldPosToScreenNorm cfig w = doWindowScale cfig . doRotate . doZoom . doTranslate where - doTranslate p = p -.- (w ^. cWorld . cwCam . cwcCenter) - doZoom p = (w ^. cWorld . cwCam . cwcZoom) *.* p - doRotate p = rotateV (negate (w ^. cWorld . cwCam . cwcRot)) p + doTranslate p = p -.- (w ^. cWorld . lWorld . cwCam . cwcCenter) + doZoom p = (w ^. cWorld . lWorld . cwCam . cwcZoom) *.* p + doRotate p = rotateV (negate (w ^. cWorld . lWorld . cwCam . cwcRot)) p {- | Transform world coordinates to scaled screen coordinates. - These have to be scaled according to the size of the window to get actual screen positions. @@ -19,9 +19,9 @@ worldPosToScreenNorm cfig w = doWindowScale cfig . doRotate . doZoom . doTransla -} worldPosToScreen :: World -> Point2 -> Point2 worldPosToScreen w = - rotateV (negate $ w ^. cWorld . cwCam . cwcRot) - . ((w ^. cWorld . cwCam . cwcZoom) *.*) - . (-.- (w ^. cWorld . cwCam . cwcCenter)) + rotateV (negate $ w ^. cWorld . lWorld . cwCam . cwcRot) + . ((w ^. cWorld . lWorld . cwCam . cwcZoom) *.*) + . (-.- (w ^. cWorld . lWorld . cwCam . cwcCenter)) {- | Transform coordinates from the map position to screen coordinates. @@ -29,9 +29,11 @@ coordinates. cartePosToScreen :: Configuration -> World -> Point2 -> Point2 cartePosToScreen cfig w = doWindowScale cfig . doRotate . doZoom . doTranslate where - doTranslate p = p -.- _carteCenter (_hud (_cWorld w)) - doZoom p = _carteZoom (_hud (_cWorld w)) *.* p - doRotate p = rotateV (negate $ _carteRot (_hud (_cWorld w))) p + doTranslate p = p -.- (w ^. cWorld . lWorld . hud . carteCenter) -- _carteCenter (_hud (_cWorld w)) + --doZoom p = _carteZoom (_hud (_cWorld w)) *.* p + doZoom p = (w ^. cWorld . lWorld . hud . carteZoom) *.* p + --doRotate p = rotateV (negate $ _carteRot (_hud (_cWorld w))) p + doRotate p = rotateV (negate $ w ^. cWorld . lWorld . hud . carteRot) p crToMousePosOffset :: Creature -> World -> (Point2, Float) crToMousePosOffset cr w = (mouseWorldPos w -.- _crPos cr, 0) @@ -39,11 +41,14 @@ crToMousePosOffset cr w = (mouseWorldPos w -.- _crPos cr, 0) -- | The mouse position in world coordinates. mouseWorldPos :: World -> Point2 mouseWorldPos w = - (w ^. cWorld . cwCam . cwcCenter) - +.+ (1 / (w ^. cWorld . cwCam . cwcZoom)) *.* rotateV (w ^. cWorld . cwCam . cwcRot) (_mousePos w) + (w ^. cWorld . lWorld . cwCam . cwcCenter) + +.+ (1 / (w ^. cWorld . lWorld . cwCam . cwcZoom)) *.* rotateV (w ^. cWorld . lWorld . cwCam . cwcRot) (_mousePos w) -- | The mouse position in map coordinates mouseCartePos :: World -> Point2 -mouseCartePos w = - _carteCenter (_hud (_cWorld w)) - +.+ (1 / _carteZoom (_hud (_cWorld w))) *.* rotateV (_carteRot (_hud (_cWorld w))) (_mousePos w) +mouseCartePos w = (w ^. cWorld . lWorld . hud . carteCenter) + +.+ + (1 / (w ^. cWorld . lWorld . hud . carteZoom)) + *.* rotateV (w ^. cWorld . lWorld . hud . carteRot) (_mousePos w) +-- _carteCenter (_hud (_cWorld w)) +-- +.+ (1 / _carteZoom (_hud (_cWorld w))) *.* rotateV (_carteRot (_hud (_cWorld w))) (_mousePos w) diff --git a/src/Dodge/Base/Window.hs b/src/Dodge/Base/Window.hs index e1e22963e..6311cec72 100644 --- a/src/Dodge/Base/Window.hs +++ b/src/Dodge/Base/Window.hs @@ -15,16 +15,11 @@ import Control.Lens screenPolygon :: Configuration -> World -> [Point2] screenPolygon cfig w = map (scTran . scRot . scZoom) $ screenBox cfig where - scRot = rotateV (w ^. cWorld . cwCam . cwcRot) + scRot = rotateV (w ^. cWorld . lWorld . cwCam . cwcRot) scZoom p - | (w ^. cWorld . cwCam . cwcZoom) /= 0 = (1 / (w ^. cWorld . cwCam . cwcZoom)) *.* p + | (w ^. cWorld . lWorld . cwCam . cwcZoom) /= 0 = (1 / (w ^. cWorld . lWorld . cwCam . cwcZoom)) *.* p | otherwise = p - scTran p = p +.+ (w ^. cWorld . cwCam . cwcCenter) - --- tr = scTran $ scRot $ scZoom (V2 ( halfWidth w) ( halfHeight w)) --- tl = scTran $ scRot $ scZoom (V2 (-halfWidth w) ( halfHeight w)) --- br = scTran $ scRot $ scZoom (V2 ( halfWidth w) (-halfHeight w)) --- bl = scTran $ scRot $ scZoom (V2 (-halfWidth w) (-halfHeight w)) + scTran p = p +.+ (w ^. cWorld . lWorld . cwCam . cwcCenter) -- | A box covering the screen in world coordinates, with a x and y border screenPolygonBord :: @@ -40,9 +35,9 @@ screenPolygonBord xbord ybord cfig w = [tr, tl, bl, br] hw = halfWidth cfig - xbord hh = halfHeight cfig - ybord scZoom p - | (w ^. cWorld . cwCam . cwcZoom) /= 0 = (1 / (w ^. cWorld . cwCam . cwcZoom)) *.* p + | (w ^. cWorld . lWorld . cwCam . cwcZoom) /= 0 = (1 / (w ^. cWorld . lWorld . cwCam . cwcZoom)) *.* p | otherwise = p - theTransform = (+.+ (w ^. cWorld . cwCam . cwcCenter)) . rotateV (w ^. cWorld . cwCam . cwcRot) . scZoom + theTransform = (+.+ (w ^. cWorld . lWorld . cwCam . cwcCenter)) . rotateV (w ^. cWorld . lWorld . cwCam . cwcRot) . scZoom tr = theTransform (V2 hw hh) tl = theTransform (V2 (- hw) hh) br = theTransform (V2 hw (- hh)) diff --git a/src/Dodge/Base/You.hs b/src/Dodge/Base/You.hs index b44e1a944..69a7fb67f 100644 --- a/src/Dodge/Base/You.hs +++ b/src/Dodge/Base/You.hs @@ -2,9 +2,11 @@ module Dodge.Base.You where import Dodge.Data.World import qualified IntMapHelp as IM +import Control.Lens you :: World -> Creature -you w = _creatures (_cWorld w) IM.! _yourID (_cWorld w) +--you w = _creatures (_cWorld w) IM.! _yourID (_cWorld w) +you w = w ^?! cWorld . lWorld . creatures . ix (w ^. cWorld . lWorld . yourID) yourItem :: World -> Maybe Item yourItem w = _crInv (you w) IM.!? crSel (you w) diff --git a/src/Dodge/Beam.hs b/src/Dodge/Beam.hs index 7d4524d48..3d35e108c 100644 --- a/src/Dodge/Beam.hs +++ b/src/Dodge/Beam.hs @@ -6,7 +6,6 @@ import Dodge.Flame import Dodge.Item.Location import Dodge.Tesla.Arc import Geometry -import qualified IntMapHelp as IM import LensHelp import Picture @@ -34,15 +33,15 @@ lasBeamCombine :: World -> World lasBeamCombine (p, (a, b, _), (x, y, _)) = - cWorld . lasers .:~ lasRayAt yellow 11 1 p (argV (normalizeV (b -.- a) +.+ normalizeV (y -.- x))) + cWorld . lWorld . lasers .:~ lasRayAt yellow 11 1 p (argV (normalizeV (b -.- a) +.+ normalizeV (y -.- x))) splitBeamCombine :: (Point2, (Point2, Point2, Beam), (Point2, Point2, Beam)) -> World -> World splitBeamCombine (p, (a, b, _), (x, y, _)) = - (cWorld . lasers .:~ lasRayAt yellow 11 1 p (dir + 0.5 * pi)) - . (cWorld . lasers .:~ lasRayAt yellow 11 1 p (dir -0.5 * pi)) + (cWorld . lWorld . lasers .:~ lasRayAt yellow 11 1 p (dir + 0.5 * pi)) + . (cWorld . lWorld . lasers .:~ lasRayAt yellow 11 1 p (dir -0.5 * pi)) where dir = argV (normalizeV (b -.- a) +.+ normalizeV (y -.- x)) @@ -51,7 +50,7 @@ teslaBeamCombine :: World -> World teslaBeamCombine (p, (a, b, bm), (x, y, _)) w = - w' & pointerToItemLocation (_itemLocations (_cWorld w) IM.! itid) . itParams . subParams ?~ ip + w' & pointerToItemLocation (w ^?! cWorld . lWorld . itemLocations . ix itid) . itParams . subParams ?~ ip where itid = fromJust $ _bmOrigin bm dir = argV (normalizeV (b -.- a) +.+ normalizeV (y -.- x)) diff --git a/src/Dodge/Block.hs b/src/Dodge/Block.hs index ec69b6f32..048cfd98c 100644 --- a/src/Dodge/Block.hs +++ b/src/Dodge/Block.hs @@ -31,15 +31,15 @@ splinterBlock bl w = (_blPos bl) where bm = fromMaybe Stone $ do - wlids <- w ^? cWorld . blocks . ix (_blID bl) . blWallIDs + wlids <- w ^? cWorld . lWorld . blocks . ix (_blID bl) . blWallIDs (wlid, _) <- IS.minView wlids - w ^? cWorld . walls . ix wlid . wlMaterial + w ^? cWorld . lWorld . walls . ix wlid . wlMaterial unshadowBlock :: World -> Int -> World -unshadowBlock w wlid = case w ^? cWorld . walls . ix wlid of +unshadowBlock w wlid = case w ^? cWorld . lWorld . walls . ix wlid of Just wl -> w - & cWorld . walls . ix wlid . wlUnshadowed .~ True + & cWorld . lWorld . walls . ix wlid . wlUnshadowed .~ True & insertWallInZones (wl & wlUnshadowed .~ True) Nothing -> w @@ -55,13 +55,14 @@ destroyBlock bl w = & makeBlockDebris bl & deleteWallIDs wlids & maybeClearPaths (_blObstructs bl) -- must happen after the walls are deleted - & cWorld . blocks %~ IM.delete (_blID bl) + & cWorld . lWorld . blocks %~ IM.delete (_blID bl) -- & matDesSound (_blMaterial bl) pos & flip (foldl' $ flip (wlDustAt awl)) (map (pos +.+) ps) where wlids = _blWallIDs bl - awl = _walls (_cWorld w) IM.! IS.findMin wlids - pos = fst . _wlLine $ _walls (_cWorld w) IM.! IS.findMin wlids + --awl = _walls (_cWorld w) IM.! IS.findMin wlids + awl = w ^?! cWorld . lWorld . walls . ix (IS.findMin wlids) + pos = fst . _wlLine $ awl ps = replicateM 25 (randInCirc 20) & evalState $ _randGen w -- this does not handle eg doors blocking the path as well @@ -72,21 +73,22 @@ maybeClearPath :: World -> PathEdgeNodes -> World maybeClearPath w (PathEdgeNodes x y pe) | not . null $ overlapSegWalls (_peStart pe) (_peEnd pe) $ wlsNearSeg (_peStart pe) (_peEnd pe) w = w - | otherwise = w & cWorld . pathGraph %~ FGL.insEdge (x, y, pe & peObstacles .~ mempty) . FGL.delEdge (x, y) + | otherwise = w & cWorld . lWorld . pathGraph %~ FGL.insEdge (x, y, pe & peObstacles .~ mempty) . FGL.delEdge (x, y) destroyDoor :: Door -> World -> World destroyDoor dr w = w & doDrWdWd (_drDeath dr) dr & deleteWallIDs wlids - & cWorld . doors %~ IM.delete (_drID dr) + & cWorld . lWorld . doors %~ IM.delete (_drID dr) & flip (foldl' (flip $ wlDustAt awl)) (map (pos +.+) ps) & stopPushing (_drPushes dr) & destroyMounts (_drMounts dr) where wlids = _drWallIDs dr - awl = _walls (_cWorld w) IM.! IS.findMin wlids - pos = fst . _wlLine $ _walls (_cWorld w) IM.! IS.findMin wlids + --awl = _walls (_cWorld w) IM.! IS.findMin wlids + awl = w ^?! cWorld . lWorld . walls . ix (IS.findMin wlids) + pos = fst . _wlLine $ awl ps = replicateM 25 (randInCirc 20) & evalState $ _randGen w destroyMounts :: [MountedObject] -> World -> World @@ -95,12 +97,12 @@ destroyMounts mos w = foldl' (flip destroyMount) w mos destroyMount :: MountedObject -> World -> World destroyMount mo = case mo of MountedLS lsid -> destroyLS lsid - MountedProp prid -> cWorld . props . at prid .~ Nothing + MountedProp prid -> cWorld . lWorld . props . at prid .~ Nothing stopPushing :: Maybe Int -> World -> World stopPushing mdrid w = fromMaybe w $ do drid <- mdrid - dr <- w ^? cWorld . doors . ix drid + dr <- w ^? cWorld . lWorld . doors . ix drid return $ - w & cWorld . doors . ix drid . drMech .~ DrWdId + w & cWorld . lWorld . doors . ix drid . drMech .~ DrWdId & stopPushing (_drPushes dr) diff --git a/src/Dodge/Block/Debris.hs b/src/Dodge/Block/Debris.hs index ccbb8c558..3e2b55d4e 100644 --- a/src/Dodge/Block/Debris.hs +++ b/src/Dodge/Block/Debris.hs @@ -20,9 +20,9 @@ makeDoorDebris dr w = w & makeDebris mt col p where p = uncurry midPoint (_drPos dr) (mt, col) = fromMaybe (Stone, greyN 0.5) $ do - wlids <- w ^? cWorld . doors . ix (_drID dr) . drWallIDs + wlids <- w ^? cWorld . lWorld . doors . ix (_drID dr) . drWallIDs (wlid, _) <- IS.minView wlids - wl <- w ^? cWorld . walls . ix wlid + wl <- w ^? cWorld . lWorld . walls . ix wlid return (_wlMaterial wl, _wlColor wl) makeBlockDebris :: Block -> World -> World @@ -31,9 +31,9 @@ makeBlockDebris bl w = foldl' (flip $ makeDebris mt col) w ps dsize = debrisSize mt ps = gridInPolygon dsize $ shrinkPolyOnEdges dsize $ reverse (_blFootprint bl) (mt, col) = fromMaybe (Stone, greyN 0.5) $ do - wlids <- w ^? cWorld . blocks . ix (_blID bl) . blWallIDs + wlids <- w ^? cWorld . lWorld . blocks . ix (_blID bl) . blWallIDs (wlid, _) <- IS.minView wlids - wl <- w ^? cWorld . walls . ix wlid + wl <- w ^? cWorld . lWorld . walls . ix wlid return (_wlMaterial wl, _wlColor wl) makeDebrisToHeight :: Float -> Material -> Color -> Point2 -> World -> World @@ -55,7 +55,7 @@ makeDebrisDirectedHeight :: World makeDebrisDirectedHeight mindist maxdist arcrad dir maxh bm col p w = w - & flip (foldl' (flip $ plNew (cWorld . props) prID)) thedebris + & flip (foldl' (flip $ plNew (cWorld . lWorld . props) prID)) thedebris & randGen .~ newg & originsIDsAt [MaterialSound bm i | i <- [0, 1, 2]] (destroyMatS bm) p where @@ -88,7 +88,7 @@ makeDebrisDirected :: World makeDebrisDirected mindist maxdist arcrad dir bm col p w = w - & flip (foldl' (flip $ plNew (cWorld . props) prID)) thedebris + & flip (foldl' (flip $ plNew (cWorld . lWorld . props) prID)) thedebris & randGen .~ newg & originsIDsAt [MaterialSound bm i | i <- [0, 1, 2]] (destroyMatS bm) p where diff --git a/src/Dodge/Bullet.hs b/src/Dodge/Bullet.hs index f638c00ba..4a70e552c 100644 --- a/src/Dodge/Bullet.hs +++ b/src/Dodge/Bullet.hs @@ -40,7 +40,7 @@ mvBullet x w bu applyMagnetsToBul :: Bullet -> World -> Bullet applyMagnetsToBul bu = - foldl' (flip doMagnetBuBu) bu . _magnets . _cWorld + foldl' (flip doMagnetBuBu) bu . _magnets . _lWorld . _cWorld updateBulVel :: Bullet -> Bullet updateBulVel bt = case _buTrajectory bt of @@ -55,7 +55,7 @@ updateBulVel bt = case _buTrajectory bt of useAmmoParams :: Item -> Creature -> World -> World useAmmoParams it cr w = - w & cWorld . instantBullets + w & cWorld . lWorld . instantBullets .:~ ( _amBullet bultype & buPos .~ sp & buTrajectory %~ settrajectory @@ -89,7 +89,7 @@ bulletSpawn :: Bullet -> Maybe (Point2 -> World -> World) bulletSpawn bu = case _buSpawn bu of BulSpark -> Nothing BulBall IncBall -> Just incBallAt - BulBall ConcBall -> Just $ \p -> cWorld . shockwaves .:~ concBall p + BulBall ConcBall -> Just $ \p -> cWorld . lWorld . shockwaves .:~ concBall p BulBall TeslaBall -> Just makeStaticBall hitEffFromBul :: @@ -125,8 +125,8 @@ setFromToDams bu p = map f (_buDamages bu) damageThingHit :: Bullet -> (Point2, Either Creature Wall) -> World -> World damageThingHit bu (p, crwl) = case crwl of - Left cr -> cWorld . creatures . ix (_crID cr) . crState . csDamage .++~ dams - Right wl -> cWorld . wallDamages %~ IM.insertWith (++) (_wlID wl) dams + Left cr -> cWorld . lWorld . creatures . ix (_crID cr) . crState . csDamage .++~ dams + Right wl -> cWorld . lWorld . wallDamages %~ IM.insertWith (++) (_wlID wl) dams where dams = setFromToDams bu p diff --git a/src/Dodge/Button/Event.hs b/src/Dodge/Button/Event.hs index 421f83739..debfe56ef 100644 --- a/src/Dodge/Button/Event.hs +++ b/src/Dodge/Button/Event.hs @@ -10,8 +10,8 @@ doButtonEvent be = case be of ButtonDoNothing -> const id ButtonPress newstate newevent thesound f -> \b -> doWdWd f - . set (cWorld . buttons . ix (_btID b) . btState) newstate - . set (cWorld . buttons . ix (_btID b) . btEvent) newevent + . set (cWorld . lWorld . buttons . ix (_btID b) . btState) newstate + . set (cWorld . lWorld . buttons . ix (_btID b) . btEvent) newevent . soundStart (LeverSound 0) (_btPos b) thesound Nothing --ButtonSwitch onstate onevent onsound oneff offstate offevent offsound offeff -> undefined ButtonSimpleSwith oneff offeff -> flipSwitch oneff offeff @@ -21,10 +21,10 @@ flipSwitch :: WdWd -> WdWd -> Button -> World -> World flipSwitch oneff offeff bt | _btState bt == BtOff = doWdWd oneff . dosound - . over (cWorld . buttons . ix (_btID bt)) turnon + . over (cWorld . lWorld . buttons . ix (_btID bt)) turnon | otherwise = doWdWd offeff . dosound - . over (cWorld . buttons . ix (_btID bt)) turnoff + . over (cWorld . lWorld . buttons . ix (_btID bt)) turnoff where turnon = (btState .~ BtOn) . (btText .~ "SWITCH\\") turnoff = (btState .~ BtOff) . (btText .~ "SWITCH/") diff --git a/src/Dodge/Combine.hs b/src/Dodge/Combine.hs index 16980efb2..78c34d24a 100644 --- a/src/Dodge/Combine.hs +++ b/src/Dodge/Combine.hs @@ -86,12 +86,12 @@ fullModuleName :: ItemModuleType -> String fullModuleName = fromMaybe "EMPTYMODULE" . moduleName toggleCombineInv :: World -> World -toggleCombineInv w = case _hudElement (_hud (_cWorld w)) of - DisplayInventory CombineInventory{} -> w & cWorld . hud . hudElement .~ DisplayInventory NoSubInventory +toggleCombineInv w = case w ^. cWorld . lWorld . hud . hudElement of + DisplayInventory CombineInventory{} -> w & cWorld . lWorld . hud . hudElement .~ DisplayInventory NoSubInventory _ -> w & enterCombineInv enterCombineInv :: World -> World -enterCombineInv w = w & cWorld . hud . hudElement .~ DisplayInventory (CombineInventory mi) +enterCombineInv w = w & cWorld . lWorld . hud . hudElement .~ DisplayInventory (CombineInventory mi) where mi = 0 <$ listToMaybe (combineItemListYou w) diff --git a/src/Dodge/Creature/Action.hs b/src/Dodge/Creature/Action.hs index 8d0474b3a..c7fab1094 100644 --- a/src/Dodge/Creature/Action.hs +++ b/src/Dodge/Creature/Action.hs @@ -57,7 +57,7 @@ performAimAt cr w tcid p = ([TurnToward tpos aimSp], Just $ AimAt tcid tpos) Just f -> doFloatFloat f $ safeAngleVV (unitVectorAtAngle cdir) (tpos - cpos) Nothing -> error "creature without aiming type" tpos - | canSee' = _crPos (_creatures (_cWorld w) IM.! tcid) + | canSee' = w ^?! cWorld . lWorld . creatures . ix tcid . crPos | otherwise = p performPathTo :: Creature -> World -> Point2 -> OutAction @@ -146,23 +146,23 @@ performAction cr w ac = case ac of setMinInvSize :: Int -> Creature -> World -> World -setMinInvSize n cr = cWorld . creatures . ix (_crID cr) . crInvCapacity .~ n +setMinInvSize n cr = cWorld . lWorld . creatures . ix (_crID cr) . crInvCapacity .~ n -- maybe this should be removed... stripNoItems :: Creature -> World -> World stripNoItems cr = organiseInvKeys (_crID cr) - . (cWorld . creatures . ix (_crID cr) . crInv %~ IM.mapMaybe Just) + . (cWorld . lWorld . creatures . ix (_crID cr) . crInv %~ IM.mapMaybe Just) organiseInvKeys :: Int -> World -> World organiseInvKeys cid w = - w & cWorld . creatures . ix cid + w & cWorld . lWorld . creatures . ix cid %~ ( (crInvSel . iselPos .~ newSelKey) . (crInv .~ newInv) . (crInvSel . iselAction .~ NoInvSelAction) ) where - cr = _creatures (_cWorld w) IM.! cid + cr = w ^?! cWorld . lWorld . creatures . ix cid-- _creatures (_cWorld w) IM.! cid pairs = IM.toList (_crInv cr) newSelKey = fromMaybe 0 $ findIndex ((== crSel cr) . fst) pairs newInv = IM.fromAscList $ zip [0 ..] $ map snd pairs @@ -216,8 +216,8 @@ sizeSelf x cr w Just $ w & soundMultiFrom [TeleSound 0, TeleSound 1] cpos teleS Nothing - & cWorld . distortions .:~ distortionBulge - & cWorld . creatures . ix cid + & cWorld . lWorld . distortions .:~ distortionBulge + & cWorld . lWorld . creatures . ix cid %~ ( (crRad .~ 10 * x) . (crMvType . mvSpeed .~ yourDefaultSpeed * x) . (crStance . strideLength .~ ceiling (fromIntegral yourDefaultStrideLength * x)) @@ -234,7 +234,7 @@ sizeSelf x cr w cpos = _crPos cr pickUpItemID :: Int -> Int -> World -> World -pickUpItemID cid flid w = pickUpItem cid (_floorItems (_cWorld w) IM.! flid) w +pickUpItemID cid flid w = pickUpItem cid (w ^?! cWorld . lWorld . floorItems . ix flid) w -- | Pick up a specific item. pickUpItem :: Int -> FloorItem -> World -> World diff --git a/src/Dodge/Creature/Action/Blink.hs b/src/Dodge/Creature/Action/Blink.hs index 300ec2c8b..95aa0de3f 100644 --- a/src/Dodge/Creature/Action/Blink.hs +++ b/src/Dodge/Creature/Action/Blink.hs @@ -21,7 +21,7 @@ blinkActionMousePos cr w = w & soundMultiFrom [TeleSound 0, TeleSound 1] p3 teleS Nothing & blinkDistortions cpos p3 - & cWorld . creatures . ix cid . crPos .~ p3 + & cWorld . lWorld . creatures . ix cid . crPos .~ p3 & blinkShockwave cid p3 & inverseShockwaveAt cpos 40 2 2 where @@ -38,7 +38,7 @@ blinkActionMousePos cr w = pushIntoMaybe (x,my) = (x,) <$> my blinkDistortions :: Point2 -> Point2 -> World -> World -blinkDistortions sp ep = cWorld . distortions .++~ distortionBulge +blinkDistortions sp ep = cWorld . lWorld . distortions .++~ distortionBulge where distR = 120 distortionBulge = @@ -57,13 +57,13 @@ unsafeBlinkAction cr w | success = soundMultiFrom [TeleSound 0, TeleSound 1] mwp teleS Nothing . blinkDistortions cpos mwp - . set (cWorld . creatures . ix cid . crPos) mwp + . set (cWorld . lWorld . creatures . ix cid . crPos) mwp . blinkShockwave cid mwp $ inverseShockwaveAt cpos 40 2 2 w | otherwise = w & blinkActionFail cr - & cWorld . creatures . ix cid . crState . csDamage + & cWorld . lWorld . creatures . ix cid . crState . csDamage .:~ Damage ENTERREMENT 10000 mwp mwp mwp NoDamageEffect where success = fromMaybe True $ do @@ -89,8 +89,8 @@ blinkActionFail :: blinkActionFail cr w = w & soundMultiFrom [TeleSound 0, TeleSound 1] p3 teleS Nothing - & cWorld . distortions .:~ distortionBulge - & cWorld . creatures . ix cid . crPos .~ p3 + & cWorld . lWorld . distortions .:~ distortionBulge + & cWorld . lWorld . creatures . ix cid . crPos .~ p3 & inverseShockwaveAt cpos 40 2 2 where distR = 120 diff --git a/src/Dodge/Creature/Boid.hs b/src/Dodge/Creature/Boid.hs index 9661f5e54..f904031ed 100644 --- a/src/Dodge/Creature/Boid.hs +++ b/src/Dodge/Creature/Boid.hs @@ -179,7 +179,7 @@ swarmUsingCenter updT upd w cr = case _targetCr $ _crIntention cr of Just tcr -> updT tcr cenp cr where cid = _crID cr - cenp = _crGroupCenter $ _creatureGroups (_cWorld w) IM.! _crGroupID (_crGroup $ _creatures (_cWorld w) IM.! cid) + cenp = _crGroupCenter $ _creatureGroups (_lWorld (_cWorld w)) IM.! _crGroupID (_crGroup $ _creatures (_lWorld (_cWorld w)) IM.! cid) flockChaseTarget :: -- | Update with target @@ -194,7 +194,7 @@ flockChaseTarget updT upd w cr = case _targetCr $ _crIntention cr of Just tcr -> updT tcr crs cr where is = _swarm $ _crGroup cr - crs = IM.restrictKeys (_creatures (_cWorld w)) is + crs = IM.restrictKeys (w ^. cWorld . lWorld . creatures) is flockPointTarget :: (Creature -> IM.IntMap Creature -> Creature -> Point2) -> @@ -208,7 +208,7 @@ flockPointTarget f targFunc w cr = case targFunc cr w of Just crTarg -> cr & crActionPlan . apImpulse .~ mvPointMeleeTarg p cr crTarg where is = _swarm $ _crGroup cr - crs = IM.restrictKeys (_creatures (_cWorld w)) is + crs = IM.restrictKeys (w ^. cWorld . lWorld . creatures) is p = f crTarg crs cr flockToPointUsing :: @@ -220,7 +220,8 @@ flockToPointUsing pf mvf cr = reader $ \w -> case _targetCr $ _crIntention cr of Nothing -> cr Just tcr -> cr & crActionPlan . apImpulse .~ mvf ptarg cr tcr where - cenp = _crGroupCenter $ _creatureGroups (_cWorld w) IM.! _crGroupID (_crGroup cr) + cenp = w ^?! cWorld . lWorld . creatureGroups . ix (cr ^?! crGroup . crGroupID) . crGroupCenter + -- crGroupCenter $ _creatureGroups (_cWorld w) IM.! _crGroupID (_crGroup cr) ptarg = pf tcr cenp cr flockToPointUsing' :: @@ -233,7 +234,7 @@ flockToPointUsing' pf mvf w cr = case _targetCr $ _crIntention cr of Nothing -> cr Just tcr -> cr & crActionPlan . apImpulse .~ mvf ptarg cr tcr where - cenp = _crGroupCenter $ _creatureGroups (_cWorld w) IM.! _crGroupID (_crGroup cr) + cenp = w ^?! cWorld . lWorld . creatureGroups . ix (cr ^?! crGroup . crGroupID) . crGroupCenter ptarg = pf tcr cenp cr flockFunc :: @@ -246,7 +247,7 @@ flockFunc f targFunc cr = reader $ \w -> case targFunc cr w of Nothing -> cr Just crTarg -> cr & crActionPlan . apImpulse .~ mvPointMeleeTarg p cr crTarg where - cenp = _crGroupCenter $ _creatureGroups (_cWorld w) IM.! _crGroupID (_crGroup cr) + cenp = w ^?! cWorld . lWorld . creatureGroups . ix (cr ^?! crGroup . crGroupID) . crGroupCenter p = f crTarg cenp cr flockCenterFunc :: @@ -259,7 +260,7 @@ flockCenterFunc f targFunc cr = reader $ \w -> case targFunc cr w of Nothing -> cr Just crTarg -> cr & crActionPlan . apImpulse .~ mvPointMeleeTarg p cr crTarg where - cenp = _crGroupCenter $ _creatureGroups (_cWorld w) IM.! _crGroupID (_crGroup cr) + cenp = w ^?! cWorld . lWorld . creatureGroups . ix (cr ^?! crGroup . crGroupID) . crGroupCenter p = f crTarg cenp cr flockPointTargetR :: @@ -273,7 +274,8 @@ flockPointTargetR f targFunc cr = reader $ \w -> case targFunc cr w of Just crTarg -> cr & crActionPlan . apImpulse .~ mvPointMeleeTarg p cr crTarg where is = _swarm $ _crGroup cr - crs = IM.restrictKeys (_creatures (_cWorld w)) is + --crs = IM.restrictKeys (_creatures (_cWorld w)) is + crs = IM.restrictKeys (w ^. cWorld . lWorld . creatures) is p = f crTarg crs cr meleeHeadingMove :: diff --git a/src/Dodge/Creature/Damage.hs b/src/Dodge/Creature/Damage.hs index def11606e..0da32a626 100644 --- a/src/Dodge/Creature/Damage.hs +++ b/src/Dodge/Creature/Damage.hs @@ -20,7 +20,7 @@ applyCreatureDamage dms cr = case _crMaterial cr of defaultApplyDamage :: [Damage] -> Creature -> World -> World defaultApplyDamage ds cr w = foldl' (applyIndividualDamage cr) w ds' - & cWorld . creatures . ix (_crID cr) %~ doPoisonDam + & cWorld . lWorld . creatures . ix (_crID cr) %~ doPoisonDam where (ps, ds') = partition isPoison ds isPoison Damage{_dmType = POISONDAM} = True @@ -31,15 +31,15 @@ defaultApplyDamage ds cr w = applyDamageEffect :: Damage -> DamageEffect -> Creature -> World -> World applyDamageEffect dm de cr = case de of PushDamage push pushexp pushRad -> - cWorld . creatures . ix (_crID cr) . crPos .+.+~ pushAmount *.* squashNormalizeV (_crPos cr -.- fromDir) + cWorld . lWorld . creatures . ix (_crID cr) . crPos .+.+~ pushAmount *.* squashNormalizeV (_crPos cr -.- fromDir) where pushAmount | dist (_crPos cr) fromDir == 0 = 0 | otherwise = min 5 $ (push * 5 * pushRad / (dist (_crPos cr) fromDir * _crMass cr)) ** pushexp PushBackDamage pback -> - cWorld . creatures . ix (_crID cr) . crPos .+.+~ (pback / _crMass cr) *.* (_dmTo dm -.- fromDir) + cWorld . lWorld . creatures . ix (_crID cr) . crPos .+.+~ (pback / _crMass cr) *.* (_dmTo dm -.- fromDir) TorqueDamage rot -> - cWorld . creatures . ix (_crID cr) . crDir +~ rot + cWorld . lWorld . creatures . ix (_crID cr) . crDir +~ rot NoDamageEffect -> id where fromDir = _dmFrom dm @@ -64,7 +64,7 @@ applyPiercingDamage cr dm damageHP :: Creature -> Int -> World -> World damageHP cr x = - cWorld . creatures . ix (_crID cr) + cWorld . lWorld . creatures . ix (_crID cr) %~ ( (crHP -~ x) . (crPastDamage +~ x) ) diff --git a/src/Dodge/Creature/Impulse.hs b/src/Dodge/Creature/Impulse.hs index 11fe32e53..8ef26cab8 100644 --- a/src/Dodge/Creature/Impulse.hs +++ b/src/Dodge/Creature/Impulse.hs @@ -16,7 +16,6 @@ import Dodge.FloatFunction import Dodge.RandImpulse import Dodge.SoundLogic import Geometry -import qualified IntMapHelp as IM import LensHelp import System.Random @@ -25,7 +24,7 @@ impulsiveAIBefore :: Creature -> World -> World -impulsiveAIBefore f cr w = g w & cWorld . creatures . ix (_crID cr) .~ cr' +impulsiveAIBefore f cr w = g w & cWorld . lWorld . creatures . ix (_crID cr) .~ cr' where (g, cr') = followImpulses w $ f w cr @@ -80,10 +79,10 @@ followImpulse cr w imp = case imp of cpos = _crPos cr cdir = _crDir cr cid = _crID cr - posFromID cid' = _crPos $ _creatures (_cWorld w) IM.! cid' + posFromID cid' = w ^?! cWorld . lWorld . creatures . ix cid' . crPos rr a = randomR (- a, a) $ _randGen w hitCr i = - ( cWorld . creatures . ix i . crState . csDamage + ( cWorld . lWorld . creatures . ix i . crState . csDamage .:~ Damage BLUNT 100 cpos (posFromID i) (posFromID i) NoDamageEffect ) . soundStart (CrSound cid) cpos hitS Nothing diff --git a/src/Dodge/Creature/Impulse/UseItem.hs b/src/Dodge/Creature/Impulse/UseItem.hs index e6dd3231e..eb52d1d6c 100644 --- a/src/Dodge/Creature/Impulse/UseItem.hs +++ b/src/Dodge/Creature/Impulse/UseItem.hs @@ -21,11 +21,11 @@ import qualified SDL useItem :: Creature -> World -> World useItem cr' w = fromMaybe (f w) $ do - cr <- w ^? cWorld . creatures . ix (_crID cr') + cr <- w ^? cWorld . lWorld . creatures . ix (_crID cr') it <- cr ^? crInv . ix (crSel cr) return $ itemEffect cr it w where - f = cWorld . creatures . ix (_crID cr') . crHammerPosition .~ HammerDown + f = cWorld . lWorld . creatures . ix (_crID cr') . crHammerPosition .~ HammerDown itemEffect :: Creature -> Item -> World -> World itemEffect cr it w = case it ^. itUse of @@ -41,7 +41,7 @@ itemEffect cr it w = case it ^. itUse of hammerTest f = case _crHammerPosition cr of HammerUp -> f w _ -> w & setuhamdown - setuhamdown = cWorld . creatures . ix (_crID cr) . crHammerPosition .~ HammerDown + setuhamdown = cWorld . lWorld . creatures . ix (_crID cr) . crHammerPosition .~ HammerDown doequipmentchange = setuhamdown $ hammerTest @@ -51,7 +51,7 @@ itemEffect cr it w = case it ^. itUse of tryReload :: Creature -> Item -> World -> (World -> World) -> World -> World tryReload cr it w f - | _crID cr == _yourID (_cWorld w) && itNeedsLoading it && _mouseButtons w M.!? SDL.ButtonLeft == Just False = + | _crID cr == (w ^. cWorld . lWorld . yourID) && itNeedsLoading it && _mouseButtons w M.!? SDL.ButtonLeft == Just False = crToggleReloading cr | otherwise = (runIdentity . pointerToItemLocation (_itLocation it) (return . (itUse . heldHammer .~ HammerDown))) @@ -64,7 +64,7 @@ itNeedsLoading it = _laLoaded ic == 0 || not (_laPrimed ic) activateEquipmentAt :: RightButtonOptions -> Creature -> World -> World activateEquipmentAt rbo cr = - cWorld . creatures . ix (_crID cr) %~ case (rbo ^? opActivateEquipment . activateEquipment, rbo ^? opActivateEquipment . deactivateEquipment) of + cWorld . lWorld . creatures . ix (_crID cr) %~ case (rbo ^? opActivateEquipment . activateEquipment, rbo ^? opActivateEquipment . deactivateEquipment) of (Just i, _) -> crLeftInvSel ?~ i (_, Just _) -> crLeftInvSel .~ Nothing _ -> id @@ -102,7 +102,7 @@ toggleEquipmentAt rbops invid cr w = case rbops ^? opAllocateEquipment of & onremove itm cr Nothing -> error "tried to toggle equipment whilst not prepared" where - crpoint = cWorld . creatures . ix (_crID cr) + crpoint = cWorld . lWorld . creatures . ix (_crID cr) itmat i = _crInv cr IM.! i itm = itmat (crSel cr) onequip itm' = useE ((_eeOnEquip . _equipEffect . _itUse) itm') itm' @@ -122,7 +122,7 @@ useLeftItem cid w . useL f itm cr $ w where - cr = _creatures (_cWorld w) IM.! cid + cr = w ^?! cWorld . lWorld . creatures . ix cid-- _creatures (_cWorld w) IM.! cid itmIsConsumable = isJust (cr ^? crInv . ix (crSel cr) . itUse . cUse) itmIsEquipable = diff --git a/src/Dodge/Creature/Perception.hs b/src/Dodge/Creature/Perception.hs index 5278eaa31..95acbe9a3 100644 --- a/src/Dodge/Creature/Perception.hs +++ b/src/Dodge/Creature/Perception.hs @@ -99,7 +99,7 @@ chaseCritAwarenessUpdate w cr = case _cpAttention $ _crPerception cr of replicate numjits [RandomImpulse thejitter] ++ [[ChangeStrategy $ CloseToMelee 0]] ) - , AimAt 0 (_crPos $ _creatures (_cWorld w) IM.! 0) + , AimAt 0 (w ^?! cWorld . lWorld . creatures . ix 0 . crPos) --_crPos $ _creatures (_cWorld w) IM.! 0) ] | otherwise = id @@ -152,7 +152,7 @@ newExtraAwareness cr w cid | otherwise = Just . Suspicious $ doFloatFloat (_viFOV vi) ang * doFloatFloat (_viDist vi) d * awakeLevelPerception cr where vi = _cpVision $ _crPerception cr - tpos = _crPos $ _creatures (_cWorld w) IM.! cid + tpos = w ^?! cWorld . lWorld . creatures . ix cid . crPos -- _crPos $ _creatures (_cWorld w) IM.! cid cpos = _crPos cr ang = angleVV (unitVectorAtAngle (_crDir cr)) (tpos - cpos) d = dist tpos cpos diff --git a/src/Dodge/Creature/Picture/Awareness.hs b/src/Dodge/Creature/Picture/Awareness.hs index 9c097d4f3..db189407e 100644 --- a/src/Dodge/Creature/Picture/Awareness.hs +++ b/src/Dodge/Creature/Picture/Awareness.hs @@ -27,8 +27,8 @@ creatureDisplayText w cr = w cr where - campos = w ^. cWorld . cwCam . cwcViewFrom - theScale = 0.15 / (w ^. cWorld . cwCam . cwcZoom) + campos = w ^. cWorld . lWorld . cwCam . cwcViewFrom + theScale = 0.15 / (w ^. cWorld . lWorld . cwCam . cwcZoom) cpos = _crPos cr v = cpos -.- campos (V2 x y) = campos +.+ v +.+ _crRad cr *.* normalizeV v diff --git a/src/Dodge/Creature/ReaderUpdate.hs b/src/Dodge/Creature/ReaderUpdate.hs index 512f0b01c..7deeb030e 100644 --- a/src/Dodge/Creature/ReaderUpdate.hs +++ b/src/Dodge/Creature/ReaderUpdate.hs @@ -26,7 +26,6 @@ import Dodge.Data.World import Dodge.Zoning.Creature import FoldableHelp import Geometry -import qualified IntMapHelp as IM overrideMeleeCloseTarget :: Creature -> Creature overrideMeleeCloseTarget cr = maybe cr (tryMeleeAttack cr) (_targetCr $ _crIntention cr) @@ -192,7 +191,7 @@ targetYouWhenCognizant :: World -> Creature -> Creature targetYouWhenCognizant w cr = case cr ^? crPerception . cpAwareness . ix 0 of -- so this caused a space leak: be careful with ?~ -- consider changing targeted creature to be just an index - Just (Cognizant _) -> _creatures (_cWorld w) IM.! 0 `seq` cr & crIntention . targetCr ?~ _creatures (_cWorld w) IM.! 0 + Just (Cognizant _) -> (w ^?! cWorld . lWorld . creatures . ix 0) `seq` cr & crIntention . targetCr ?~ (w ^?! cWorld . lWorld . creatures . ix 0) _ -> cr & crIntention . targetCr .~ Nothing searchIfDamaged :: Creature -> Creature diff --git a/src/Dodge/Creature/SetTarget.hs b/src/Dodge/Creature/SetTarget.hs index a2ffe4344..354acf5d7 100644 --- a/src/Dodge/Creature/SetTarget.hs +++ b/src/Dodge/Creature/SetTarget.hs @@ -3,7 +3,6 @@ module Dodge.Creature.SetTarget where import Control.Lens import Dodge.Data.World -import qualified IntMapHelp as IM -- | Assumes that you are id 0: if creature is cognizant of you, sets you as target targetYouWhenCognizant :: @@ -11,5 +10,6 @@ targetYouWhenCognizant :: Creature -> Creature targetYouWhenCognizant w cr = case cr ^? crPerception . cpAwareness . ix 0 of - Just (Cognizant _) -> cr & crIntention . targetCr ?~ _creatures (_cWorld w) IM.! 0 + --Just (Cognizant _) -> cr & crIntention . targetCr ?~ _creatures (_cWorld w) IM.! 0 + Just (Cognizant _) -> cr & crIntention . targetCr ?~ (w ^?! cWorld . lWorld . creatures . ix 0) _ -> cr & crIntention . targetCr .~ Nothing diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index 33c1047c3..89b36dbe8 100644 --- a/src/Dodge/Creature/State.hs +++ b/src/Dodge/Creature/State.hs @@ -37,7 +37,7 @@ foldCr :: World foldCr xs cr w = foldl' f w xs where - f w' g = case w' ^? cWorld . creatures . ix (_crID cr) of + f w' g = case w' ^? cWorld . lWorld . creatures . ix (_crID cr) of Just cr' -> g cr' w' Nothing -> w' @@ -85,16 +85,16 @@ checkDeath cr w where removecr | _crID cr == 0 = - (cWorld . creatures . ix (_crID cr) . crType .~ NonDrawnCreature) - . (cWorld . creatures . ix (_crID cr) . crHP .~ 0) + (cWorld . lWorld . creatures . ix (_crID cr) . crType .~ NonDrawnCreature) + . (cWorld . lWorld . creatures . ix (_crID cr) . crHP .~ 0) -- hack to get around player creature being killed but left with more than 0 hp - | otherwise = cWorld . creatures . at (_crID cr) .~ Nothing + | otherwise = cWorld . lWorld . creatures . at (_crID cr) .~ Nothing corpseOrGib :: Creature -> World -> World corpseOrGib cr w = case maxDamageType (_csDamage (_crState cr)) of - Just (FLAMING, _) -> w & plNew (cWorld . corpses) cpID (thecorpse & cpSPic %~ scorchSPic) - Just (ELECTRICAL, _) -> w & plNew (cWorld . corpses) cpID thecorpse - Just (POISONDAM, _) -> w & plNew (cWorld . corpses) cpID (thecorpse & cpSPic %~ poisonSPic) + Just (FLAMING, _) -> w & plNew (cWorld . lWorld . corpses) cpID (thecorpse & cpSPic %~ scorchSPic) + Just (ELECTRICAL, _) -> w & plNew (cWorld . lWorld . corpses) cpID thecorpse + Just (POISONDAM, _) -> w & plNew (cWorld . lWorld . corpses) cpID (thecorpse & cpSPic %~ poisonSPic) _ | _crPastDamage cr > 200 -> w & addCrGibs cr @@ -105,7 +105,7 @@ corpseOrGib cr w = case maxDamageType (_csDamage (_crState cr)) of w & bloodPuddleAt cpos & bloodPuddleAt cpos - & plNew (cWorld . corpses) cpID thecorpse + & plNew (cWorld . lWorld . corpses) cpID thecorpse where cpos = _crPos cr thecorpse = makeDefaultCorpse cr @@ -132,7 +132,7 @@ bloodPuddleAt p w = w & snd . plNewID - (cWorld . decorations) + (cWorld . lWorld . decorations) (color (dark $ dark red) . setDepth 01 . uncurryV translate (p +.+ q) $ circleSolid 10) & randGen .~ g where @@ -140,7 +140,7 @@ bloodPuddleAt p w = internalUpdate :: Creature -> World -> World internalUpdate cr = - cWorld . creatures . ix (_crID cr) + cWorld . lWorld . creatures . ix (_crID cr) %~ ( (crHammerPosition %~ moveHammerUp) . stepReloading . updateMovement @@ -158,7 +158,7 @@ dropByState cr w = foldr (dropItem cr) w $ case cr ^. crState . csDropsOnDeath o clearDamage :: Creature -> World -> World clearDamage cr w = w - & cWorld . creatures . ix (_crID cr) . crState . csDamage .~ [] + & cWorld . lWorld . creatures . ix (_crID cr) . crState . csDamage .~ [] doDamage :: Creature -> World -> World doDamage cr w = @@ -173,15 +173,15 @@ applyPastDamages :: Creature -> World -> World applyPastDamages cr w | _crPastDamage cr > 200 = let (p, g) = runState (randInCirc 3) (_randGen w) - in w & cWorld . creatures . ix (_crID cr) %~ (crMvBy p . (crPastDamage -~ 100)) + in w & cWorld . lWorld . creatures . ix (_crID cr) %~ (crMvBy p . (crPastDamage -~ 100)) & randGen .~ g | _crPastDamage cr > 20 = let (p, g) = runState (randInCirc 2) (_randGen w) - in w & cWorld . creatures . ix (_crID cr) %~ (crMvBy p . (crPastDamage -~ 10)) + in w & cWorld . lWorld . creatures . ix (_crID cr) %~ (crMvBy p . (crPastDamage -~ 10)) & randGen .~ g | _crPastDamage cr > 0 = let (p, g) = runState (randInCirc 1) (_randGen w) - in w & cWorld . creatures . ix (_crID cr) %~ (crMvBy p . (crPastDamage -~ 1)) + in w & cWorld . lWorld . creatures . ix (_crID cr) %~ (crMvBy p . (crPastDamage -~ 1)) & randGen .~ g | otherwise = w @@ -225,7 +225,7 @@ useEquipment cr i = useE (_eeUse (_equipEffect $ _itUse itm)) itm cr -- a map updating all inventory items upInv :: Creature -> World -> World -upInv cr = cWorld . creatures . ix (_crID cr) . crInv %~ IM.mapWithKey (itemUpdate cr) +upInv cr = cWorld . lWorld . creatures . ix (_crID cr) . crInv %~ IM.mapWithKey (itemUpdate cr) -- a loop going over equipped items equipmentEffects :: Creature -> World -> World @@ -275,7 +275,7 @@ doItemTargeting invid cr w = case cr ^? crInv . ix invid . itTargeting of Just NoTargeting -> w Just t -> let (w', t') = updateTargeting (_tgUpdate t) (_crInv cr IM.! invid) cr w t - in w' & cWorld . creatures . ix (_crID cr) . crInv . ix invid . itTargeting .~ t' + in w' & cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix invid . itTargeting .~ t' weaponReloadSounds :: Creature -> World -> World weaponReloadSounds cr w = case cr ^? crInvSel . iselAction of diff --git a/src/Dodge/Creature/YourControl.hs b/src/Dodge/Creature/YourControl.hs index ca5a68812..e8af5be94 100644 --- a/src/Dodge/Creature/YourControl.hs +++ b/src/Dodge/Creature/YourControl.hs @@ -21,12 +21,12 @@ yourControl cr w | inTermFocus w = dimCreatureLight cr w & updateUsingInput | otherwise = dimCreatureLight cr w - & cWorld . creatures . ix (_crID cr) + & cWorld . lWorld . creatures . ix (_crID cr) %~ (wasdWithAiming w (_mvSpeed $ _crMvType cr) . mouseActionsCr (_mouseButtons w)) & updateUsingInput dimCreatureLight :: Creature -> World -> World -dimCreatureLight cr = cWorld . tempLightSources .:~ tlsTimeRadColPos 1 300 0.1 (addZ 100 $ _crPos cr) +dimCreatureLight cr = cWorld . lWorld . tempLightSources .:~ tlsTimeRadColPos 1 300 0.1 (addZ 100 $ _crPos cr) -- note the order of operation, setting the posture first--this prevents the twist fire bug @@ -57,12 +57,12 @@ wasdWithAiming w speed cr | otherwise = crMvAbsolute (speed *.* movAbs) . set crMvDir dir theTurn cr' = creatureTurnTowardDir (_crMvDir cr') 0.2 cr' movDir = wasdDir w - dir = (w ^. cWorld . cwCam . cwcRot) + argV movDir - movAbs = rotateV (w ^. cWorld . cwCam . cwcRot) $ normalizeV movDir + dir = (w ^. cWorld . lWorld . cwCam . cwcRot) + argV movDir + movAbs = rotateV (w ^. cWorld . lWorld . cwCam . cwcRot) $ normalizeV movDir isAiming = _posture (_crStance cr) == Aiming mouseDir = case cr ^? crInv . ix (crSel cr) . itScope . scopePos of Just _ -> argV $ mouseWorldPos w -.- _crPos cr - _ -> argV (_mousePos w) + (w ^. cWorld . cwCam . cwcRot) + _ -> argV (_mousePos w) + (w ^. cWorld . lWorld . cwCam . cwcRot) wasdM :: SDL.Scancode -> Point2 wasdM scancode = case scancode of diff --git a/src/Dodge/CreatureEffect.hs b/src/Dodge/CreatureEffect.hs index afab01b80..0e7aa4250 100644 --- a/src/Dodge/CreatureEffect.hs +++ b/src/Dodge/CreatureEffect.hs @@ -7,7 +7,7 @@ import Dodge.Data.CreatureEffect import Dodge.Data.World import Dodge.Path import Geometry -import qualified IntMapHelp as IM +import Control.Lens doWdCrCr :: WdCrCr -> World -> Creature -> Creature doWdCrCr ce = case ce of @@ -97,7 +97,8 @@ chooseMovementSpreadGun cr w where d = dist cpos p cpos = _crPos cr - tcr = _creatures (_cWorld w) IM.! 0 + --tcr = _creatures (_cWorld w) IM.! 0 + tcr = w ^?! cWorld . lWorld . creatures . ix 0 p = _crPos tcr chooseMovementLtAuto :: Creature -> World -> Action @@ -110,7 +111,7 @@ chooseMovementLtAuto cr w DoImpulses [UseItem, TurnToward p' 0.05, Move (V2 0 3)] where cpos = _crPos cr - tcr = _creatures (_cWorld w) IM.! 0 + tcr = w ^?! cWorld . lWorld . creatures . ix 0 p = _crPos tcr v = vNormal $ p -.- cpos p' = p +.+ 0.5 *.* (v -.- 20 *.* normalizeV v) diff --git a/src/Dodge/CullBox.hs b/src/Dodge/CullBox.hs index e7e8b416f..ed288373f 100644 --- a/src/Dodge/CullBox.hs +++ b/src/Dodge/CullBox.hs @@ -12,7 +12,7 @@ import Geometry findBoundDists :: Configuration -> World -> (Float, Float, Float, Float) findBoundDists cfig w | debugOn Bound_box_screen cfig = (hh, - hh, hw, - hw) - | otherwise = fromMaybe (0, 0, 0, 0) $ farWallDistDirection (w ^. cWorld . cwCam . cwcCenter) w + | otherwise = fromMaybe (0, 0, 0, 0) $ farWallDistDirection (w ^. cWorld . lWorld . cwCam . cwcCenter) w where hw = halfWidth cfig hh = halfHeight cfig @@ -20,9 +20,9 @@ findBoundDists cfig w updateBounds :: Universe -> Universe updateBounds uv = uv - & uvWorld . cWorld . cwCam . cwcBoundDist .~ bdists - & uvWorld . cWorld . cwCam . cwcBoundBox - .~ map ((+.+ w ^. cWorld . cwCam . cwcCenter) . rotateV (w ^. cWorld . cwCam . cwcRot)) (rectNSWE n s w' e) + & uvWorld . cWorld . lWorld . cwCam . cwcBoundDist .~ bdists + & uvWorld . cWorld . lWorld . cwCam . cwcBoundBox + .~ map ((+.+ w ^. cWorld . lWorld . cwCam . cwcCenter) . rotateV (w ^. cWorld . lWorld . cwCam . cwcRot)) (rectNSWE n s w' e) where w = _uvWorld uv cfig = _uvConfig uv diff --git a/src/Dodge/Cuse.hs b/src/Dodge/Cuse.hs index 8fe71ba74..2935959bc 100644 --- a/src/Dodge/Cuse.hs +++ b/src/Dodge/Cuse.hs @@ -6,4 +6,4 @@ import Dodge.Data.World useC :: Cuse -> Item -> Creature -> World -> World useC cu = case cu of CDoNothing -> const $ const id - CHeal x -> const $ \cr -> cWorld . creatures . ix (_crID cr) . crHP +~ x + CHeal x -> const $ \cr -> cWorld . lWorld . creatures . ix (_crID cr) . crHP +~ x diff --git a/src/Dodge/Damage.hs b/src/Dodge/Damage.hs index 24994aa9f..c1fe7d702 100644 --- a/src/Dodge/Damage.hs +++ b/src/Dodge/Damage.hs @@ -17,12 +17,12 @@ import qualified IntMapHelp as IM damageCrWlID :: Damage -> CrWlID -> World -> World damageCrWlID dam = \case NothingID -> id - CrID cid -> cWorld . creatures . ix cid . crState . csDamage .:~ dam - WlID wlid -> cWorld . wallDamages %~ IM.insertWith (++) wlid [dam] + CrID cid -> cWorld . lWorld . creatures . ix cid . crState . csDamage .:~ dam + WlID wlid -> cWorld . lWorld . wallDamages %~ IM.insertWith (++) wlid [dam] damageCrWl :: Damage -> Either Creature Wall -> World -> World -damageCrWl dt (Left cr) = cWorld . creatures . ix (_crID cr) . crState . csDamage .:~ dt -damageCrWl dt (Right wl) = cWorld . wallDamages %~ IM.insertWith (++) (_wlID wl) [dt] +damageCrWl dt (Left cr) = cWorld . lWorld . creatures . ix (_crID cr) . crState . csDamage .:~ dt +damageCrWl dt (Right wl) = cWorld . lWorld . wallDamages %~ IM.insertWith (++) (_wlID wl) [dt] damageDirection :: [Damage] -> Maybe Float damageDirection ds = do diff --git a/src/Dodge/DamageCircle.hs b/src/Dodge/DamageCircle.hs index e4e9734d5..b5d1dd6bd 100644 --- a/src/Dodge/DamageCircle.hs +++ b/src/Dodge/DamageCircle.hs @@ -12,8 +12,8 @@ import LensHelp damageCircle :: Float -> Point2 -> DamageType -> Int -> World -> World damageCircle r sp dt da w = w - & cWorld . wallDamages %~ addwalldamages - & cWorld . creatures %~ addcreaturedamages + & cWorld . lWorld . wallDamages %~ addwalldamages + & cWorld . lWorld . creatures %~ addcreaturedamages where --addwalldamages wlds = runIdentity $ S.fold_ (damageWlCircle wldam) wlds id wlstodam addwalldamages wlds = foldl' (damageWlCircle wldam) wlds wlstodam diff --git a/src/Dodge/Data/CWorld.hs b/src/Dodge/Data/CWorld.hs index 8bb3b92f8..a50670ede 100644 --- a/src/Dodge/Data/CWorld.hs +++ b/src/Dodge/Data/CWorld.hs @@ -114,6 +114,11 @@ data CWCam = CWCam } data CWorld = CWorld + { _lWorld :: LWorld + , _cwGen :: CWGen + } + +data LWorld = LWorld { _cwCam :: CWCam , _creatures :: IM.IntMap Creature , _crZoning :: IM.IntMap (IM.IntMap IS.IntSet) @@ -165,7 +170,6 @@ data CWorld = CWorld , _corpses :: IM.IntMap Corpse , _pathGraph :: Gr Point2 PathEdge , _pnZoning :: IM.IntMap (IM.IntMap [(Int, Point2)]) --Zoning IM.IntMap Creature - --, _peZoning :: IM.IntMap (IM.IntMap [(Int, Int, PathEdge)]) --Zoning IM.IntMap Creature , _peZoning :: IM.IntMap (IM.IntMap (Set PathEdgeNodes)) , _hud :: HUD , _lightSources :: IM.IntMap LightSource @@ -174,16 +178,8 @@ data CWorld = CWorld , _seenLocations :: IM.IntMap (WdP2, String) , _selLocation :: Int , _distortions :: [Distortion] - , _cwGen :: CWGen } ---deriving (Eq, Show, Read) --, Generic) ---h--deriving (Eq, Show, Read) --Generic, Flat) - - ---deriving (Eq, Show, Read) --, Generic) ---h--deriving (Eq, Show, Read) --Generic, Flat) - data CWGen = CWGen { _cwgParams :: GenParams , _cwgWorldBounds :: Bounds @@ -201,9 +197,8 @@ data WorldBeams = WorldBeams , _electronBeams :: [Beam] } ---deriving (Eq, Ord, Show, Read) --Generic, Flat) - makeLenses ''CWorld +makeLenses ''LWorld makeLenses ''WorldBeams makeLenses ''CWCam makeLenses ''CWGen @@ -213,6 +208,6 @@ concat [ ''WorldBeams , ''CWCam , ''CWGen --- , ''CWTime , ''CWorld + , ''LWorld ] diff --git a/src/Dodge/Data/World.hs b/src/Dodge/Data/World.hs index 996039fa9..5b2b95a0a 100644 --- a/src/Dodge/Data/World.hs +++ b/src/Dodge/Data/World.hs @@ -60,6 +60,8 @@ data TimeFlowStatus , _futureWorlds :: [CWorld] , _scrollItemLocation :: Int } + | RewindLeftClick + { _reverseAmount :: Int } -- deriving (Eq, Ord, Show, Read) --Generic, Flat) data WorldHammer diff --git a/src/Dodge/Debug/LinkDecoration.hs b/src/Dodge/Debug/LinkDecoration.hs index d8be82c48..8b5c91298 100644 --- a/src/Dodge/Debug/LinkDecoration.hs +++ b/src/Dodge/Debug/LinkDecoration.hs @@ -13,12 +13,12 @@ import Picture addRoomPolyDecorations :: [Room] -> World -> World addRoomPolyDecorations rms w = - w & cWorld . decorations + w & cWorld . lWorld . decorations %~ IM.insertWithNewKeys (map roomPolyDecorations rms) addRoomLinkDecorations :: [Room] -> World -> World addRoomLinkDecorations rms w = - w & cWorld . decorations + w & cWorld . lWorld . decorations %~ IM.insertWithNewKeys (map roomLinkDecorations rms) roomLinkDecorations :: Room -> Picture diff --git a/src/Dodge/Debug/Picture.hs b/src/Dodge/Debug/Picture.hs index ce3b81d70..a4c90f6cf 100644 --- a/src/Dodge/Debug/Picture.hs +++ b/src/Dodge/Debug/Picture.hs @@ -20,11 +20,11 @@ printRotPoint r p = outsideScreenPolygon :: Configuration -> World -> [Point2] outsideScreenPolygon cfig w = [tr, tl, bl, br] where - scRot = rotateV (w ^. cWorld . cwCam . cwcRot) + scRot = rotateV (w ^. cWorld . lWorld . cwCam . cwcRot) scZoom p - | (w ^. cWorld . cwCam . cwcZoom) /= 0 = (1 / (w ^. cWorld . cwCam . cwcZoom)) *.* p + | (w ^. cWorld . lWorld . cwCam . cwcZoom) /= 0 = (1 / (w ^. cWorld . lWorld . cwCam . cwcZoom)) *.* p | otherwise = error "Trying to set screen zoom to zero" - scTran p = p +.+ (w ^. cWorld . cwCam . cwcCenter) + scTran p = p +.+ (w ^. cWorld . lWorld . cwCam . cwcCenter) tr = f 3 3 tl = f (-3) 3 br = f 3 (-3) @@ -40,10 +40,10 @@ lineOnScreenCone cfig w p1 p2 = || any (isJust . uncurry (intersectSegSeg p1 p2)) sps where sp' = screenPolygon cfig w - vp = w ^. cWorld . cwCam . cwcViewFrom + vp = w ^. cWorld . lWorld . cwCam . cwcViewFrom sp | pointInPolygon vp sp' = sp' - | otherwise = orderPolygon ((w ^. cWorld . cwCam . cwcViewFrom) : sp') + | otherwise = orderPolygon ((w ^. cWorld . lWorld . cwCam . cwcViewFrom) : sp') sps = zip sp (tail sp ++ [head sp]) pointOnScreen :: Configuration -> World -> Point2 -> Bool @@ -56,7 +56,7 @@ drawWallFace cfig w wall where (x, y) = _wlLine wall points = extendConeToScreenEdge cfig w sightFrom (x, y) - sightFrom = w ^. cWorld . cwCam . cwcViewFrom + sightFrom = w ^. cWorld . lWorld . cwCam . cwcViewFrom extendConeToScreenEdge :: Configuration -> World -> Point2 -> (Point2, Point2) -> [Point2] extendConeToScreenEdge cfig w c (x, y) = orderPolygon $ wallScreenIntersect ++ [x, y] ++ borderPs ++ cornerPs diff --git a/src/Dodge/Debug/Terminal.hs b/src/Dodge/Debug/Terminal.hs index 9fda85245..be1818d0e 100644 --- a/src/Dodge/Debug/Terminal.hs +++ b/src/Dodge/Debug/Terminal.hs @@ -30,10 +30,10 @@ applyTerminalCommand s = case s of "NOCLIP" -> uvConfig . debug_booleans . at Noclip %~ toggleJust ['L', x] -> (uvWorld . cWorld %~ initSpecificCrItemLocations 0) - . (uvWorld . cWorld . creatures . ix 0 . crInv .~ IM.fromList (zip [0 ..] $ inventoryX x)) - . (uvWorld . cWorld . creatures . ix 0 . crInvCapacity .~ 50) - "GODON" -> uvWorld . cWorld . creatures . ix 0 . crMaterial .~ Crystal - "GODOFF" -> uvWorld . cWorld . creatures . ix 0 . crMaterial .~ Flesh + . (uvWorld . cWorld . lWorld . creatures . ix 0 . crInv .~ IM.fromList (zip [0 ..] $ inventoryX x)) + . (uvWorld . cWorld . lWorld . creatures . ix 0 . crInvCapacity .~ 50) + "GODON" -> uvWorld . cWorld . lWorld . creatures . ix 0 . crMaterial .~ Crystal + "GODOFF" -> uvWorld . cWorld . lWorld . creatures . ix 0 . crMaterial .~ Flesh _ -> id applyTerminalCommandArguments :: String -> [String] -> Universe -> Universe @@ -65,10 +65,10 @@ applySetTerminalString :: String -> Universe -> Universe applySetTerminalString [] = id applySetTerminalString var = case key' of "" -> showTerminalError ("set " ++ var) ("Unable to read as argument as float: " ++ val) - "hp" -> uvWorld . cWorld . creatures . ix 0 . crHP .~ round (fromJust val') - "invcap" -> uvWorld . cWorld . creatures . ix 0 . crInvCapacity .~ round (fromJust val') - "mass" -> uvWorld . cWorld . creatures . ix 0 . crMass .~ fromJust val' - "mvspeed" -> uvWorld . cWorld . creatures . ix 0 . crMvType . mvSpeed .~ fromJust val' + "hp" -> uvWorld . cWorld . lWorld . creatures . ix 0 . crHP .~ round (fromJust val') + "invcap" -> uvWorld . cWorld . lWorld . creatures . ix 0 . crInvCapacity .~ round (fromJust val') + "mass" -> uvWorld . cWorld . lWorld . creatures . ix 0 . crMass .~ fromJust val' + "mvspeed" -> uvWorld . cWorld . lWorld . creatures . ix 0 . crMvType . mvSpeed .~ fromJust val' _ -> showTerminalError ("set " ++ var) ("Invalid set command: " ++ key) -- never reached? where (key, val) = getSplitString var diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index de6556870..57f964a54 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -64,8 +64,14 @@ defaultCWCam = defaultCWorld :: CWorld defaultCWorld = CWorld - { _cwCam = defaultCWCam + { _lWorld = defaultLWorld , _cwGen = defaultCWGen + } + +defaultLWorld :: LWorld +defaultLWorld = + LWorld + { _cwCam = defaultCWCam , _magnets = IM.empty , _modifications = IM.empty , _creatures = IM.empty diff --git a/src/Dodge/DrWdWd.hs b/src/Dodge/DrWdWd.hs index 46f5238bb..99862e8c8 100644 --- a/src/Dodge/DrWdWd.hs +++ b/src/Dodge/DrWdWd.hs @@ -27,7 +27,7 @@ doorMechanism dr w = case mvDir of w & flip (IS.foldl' (flip (`translateWallID` d))) (_drWallIDs dr) & moveUpdate - & cWorld . doors . ix drid . drPos . each %~ (+.+ d) + & cWorld . lWorld . doors . ix drid . drPos . each %~ (+.+ d) & maybeClearDoorPaths (_drObstacleType dr) (_drObstructs dr) Nothing -> w where @@ -47,9 +47,9 @@ doorMechanism dr w = case mvDir of dop = snd $ _drOpenPos dr dcp = snd $ _drClosePos dr setStatus - | dist dpos dop < 1 = cWorld . doors . ix drid . drStatus .~ DoorOpen - | dist dpos dcp < 1 = cWorld . doors . ix drid . drStatus .~ DoorClosed - | otherwise = cWorld . doors . ix drid . drStatus .~ DoorHalfway + | dist dpos dop < 1 = cWorld . lWorld . doors . ix drid . drStatus .~ DoorOpen + | dist dpos dcp < 1 = cWorld . lWorld . doors . ix drid . drStatus .~ DoorClosed + | otherwise = cWorld . lWorld . doors . ix drid . drStatus .~ DoorHalfway -- TODO use vector instead of list, perhaps also memoisation of rectanglePairs -- TODO update _drPos @@ -72,7 +72,7 @@ doorMechanismStepwise nsteps wlids pss dr w toOpen = doWdBl (_drTrigger dr) w setWalls n = playSound (foldl' (&) w (zipWith moveWallID wlids newps)) - & cWorld . doors . ix drid . drStatus .~ DoorInt n + & cWorld . lWorld . doors . ix drid . drStatus .~ DoorInt n where newps = uncurry (rectanglePairs 9) (pss !! n) diff --git a/src/Dodge/EnergyBall.hs b/src/Dodge/EnergyBall.hs index f54b3d349..998420bc7 100644 --- a/src/Dodge/EnergyBall.hs +++ b/src/Dodge/EnergyBall.hs @@ -24,7 +24,7 @@ makeFlamelet :: makeFlamelet (V2 x y) z vel size time w = w & randGen .~ g - & cWorld . energyBalls + & cWorld . lWorld . energyBalls .:~ EnergyBall { _ebVel = vel , _ebColor = red @@ -48,7 +48,7 @@ moveEnergyBall w eb incBallAt :: Point2 -> World -> World incBallAt p w = - w & cWorld . energyBalls .:~ theincball + w & cWorld . lWorld . energyBalls .:~ theincball & randGen .~ g where (theincball, g) = runState thestate (_randGen w) @@ -69,6 +69,6 @@ incBallAt p w = ebFlicker :: EnergyBall -> World -> World ebFlicker pt | _ebTimer pt `mod` 7 == 0 = - cWorld . tempLightSources + cWorld . lWorld . tempLightSources .:~ tlsTimeRadColPos 1 70 (0.5 *.*.* xyzV4 (_ebColor pt)) (addZ 20 $ _ebPos pt) | otherwise = id diff --git a/src/Dodge/Euse.hs b/src/Dodge/Euse.hs index e316222fd..0c11e3598 100644 --- a/src/Dodge/Euse.hs +++ b/src/Dodge/Euse.hs @@ -31,7 +31,7 @@ useE eo = case eo of EoffWristShield -> onRemoveWristShield useMagShield :: Item -> Creature -> World -> World -useMagShield it cr w = w & cWorld . magnets . at mgid ?~ themagnet +useMagShield it cr w = w & cWorld . lWorld . magnets . at mgid ?~ themagnet where themagnet = Magnet @@ -42,16 +42,16 @@ useMagShield it cr w = w & cWorld . magnets . at mgid ?~ themagnet } mgid = case it ^? itParams . magShieldMgMIX . _Just of Just mgid' -> mgid' - Nothing -> IM.newKey $ _magnets (_cWorld w) + Nothing -> IM.newKey $ w ^. cWorld . lWorld . magnets onEquipWristShield :: Item -> Creature -> World -> World onEquipWristShield itm cr w = w & pointerToItem itm . itUse . equipEffect . eeParams .~ EquipID i - & cWorld . walls . at i ?~ forceField{_wlID = i} + & cWorld . lWorld . walls . at i ?~ forceField{_wlID = i} & setWristShieldPos (itm & itUse . equipEffect . eeParams .~ EquipID i) cr where - i = IM.newKey (_walls (_cWorld w)) + i = IM.newKey (w ^. cWorld . lWorld . walls) onRemoveWristShield :: Item -> Creature -> World -> World onRemoveWristShield itm _ = @@ -122,7 +122,7 @@ removeShieldWall it _ w = case it ^? itParams . flatShieldWlMIX . _Just of createHeadLamp :: Item -> Creature -> World -> World createHeadLamp _ cr = - cWorld . tempLightSources + cWorld . lWorld . tempLightSources .:~ tlsTimeRadColPos 1 200 @@ -130,4 +130,4 @@ createHeadLamp _ cr = ((_crPos cr `v2z` 0) +.+.+ rotate3 (_crDir cr) (translatePointToHead cr (V3 5 0 3))) overCID :: (Creature -> Creature) -> Item -> Creature -> World -> World -overCID f _ cr = cWorld . creatures . ix (_crID cr) %~ f +overCID f _ cr = cWorld . lWorld . creatures . ix (_crID cr) %~ f diff --git a/src/Dodge/Event.hs b/src/Dodge/Event.hs index 9f352e5d6..b2cd820ff 100644 --- a/src/Dodge/Event.hs +++ b/src/Dodge/Event.hs @@ -16,22 +16,9 @@ module Dodge.Event ( ) where import LensHelp -import qualified Data.Map.Strict as M -import Data.Maybe -import qualified Data.Set as S -import qualified Data.Text as T -import Dodge.Base -import Dodge.Combine import Dodge.Data.Universe import Dodge.Event.Keyboard -import Dodge.HeldScroll -import Dodge.InputFocus -import Dodge.Inventory import Dodge.PreloadData -import Dodge.SoundLogic -import Dodge.Terminal -import Dodge.Tweak -import qualified IntMapHelp as IM import SDL handleEvent :: Event -> Universe -> IO (Maybe Universe) @@ -95,103 +82,3 @@ handleMouseWheelEvent mwev w = case _uvScreenLayers w of V2 _ y -> Just $ w -- & uvWorld %~ wheelEvent (fromIntegral y) & uvWorld . scrollAmount +~ fromIntegral y _ -> Just w - -wheelEvent :: Float -> World -> World -wheelEvent y w = case _hudElement $ _hud (_cWorld w) of - DisplayCarte - | rbDown -> w & cWorld . hud . carteZoom %~ min 0.75 . max 0.05 . ((1 + y * 0.1) *) - | otherwise -> w & cWorld . selLocation %~ (`mod` numLocs) . (+ yi) - DisplayInventory NoSubInventory - -- functions that modify the inventory should be centralised so that - -- this lock can be sensibly applied, perhaps - | _crInvLock (_creatures (_cWorld w) IM.! _yourID (_cWorld w)) -> w - | rbDown -> case (yourItem w ^? _Just . itUse . heldScroll, _rbOptions w) of - (_, EquipOptions{}) -> scrollRBOption y w - (Nothing, _) -> closeObjScrollDir y w - (Just f, _) -> doHeldScroll f y (you w) w - | lbDown -> w & cWorld . cwCam . cwcZoom +~ y - | invKeyDown -> changeSwapInvSel yi w - | otherwise -> stopSoundFrom (CrReloadSound 0) $ changeAugInvSel yi w - DisplayInventory (TweakInventory mi) - | invKeyDown && rbDown -> w & moveTweakSel yi - | invKeyDown -> stopSoundFrom (CrReloadSound 0) $ changeInvSel yi w - | rbDown -> w & changeTweakParam mi yi - | otherwise -> w & moveTweakSel yi - DisplayInventory CombineInventory{} -> - w - & cWorld . hud . hudElement . subInventory . combineInvSel . _Just %~ ((`mod` numcombs) . subtract yi) - DisplayInventory (DisplayTerminal tmid) - | rbDown && inTermFocus w -> - guardDisconnectedID tmid w $ - w - & cWorld . terminals . ix tmid %~ updatetermsubsel - | inTermFocus w -> - w - & cWorld . terminals . ix tmid %~ updatetermsel - _ -> w - where - updatetermsel tm = case tm ^? tmInput . tiSel of - Nothing -> tm & tmInput . tiSel .~ (0, 0) - Just (i, _) -> - let newi = (i - yi) `mod` length (scrollCommands tm) - in tm & setInput newi 0 w - updatetermsubsel tm = case tm ^? tmInput . tiSel of - Nothing -> tm & tmInput . tiSel .~ (0, 0) - Just (i, j) -> - let newj = (j - yi) `mod` length (getArguments' (scrollCommands tm !! i) tm w) - in tm & setInput i newj w - setInput i j w' tm = - tm - & tmInput . tiSel .~ (i, j) - & tmInput . tiText .~ T.pack (_tcString tc ++ " " ++ arg) - where - tc = scrollCommands tm !! i - arg = getArguments' tc tm w' !! j - numcombs = length $ combineItemListYou w - yi = round $ signum y - numLocs = (fst . IM.findMax $ _seenLocations (_cWorld w)) + 1 - rbDown = ButtonRight `M.member` _mouseButtons w - lbDown = ButtonLeft `M.member` _mouseButtons w - invKeyDown = ScancodeCapsLock `S.member` _keys w - -getArguments' :: TerminalCommand -> Terminal -> World -> [String] -getArguments' tc tm = ("" :) . getArguments tc tm - -getArguments :: TerminalCommand -> Terminal -> World -> [String] -getArguments tc tm w = case doTerminalCommandEffect (_tcEffect tc) tm w of - NoArguments{} -> [] - OneArgument _ m -> M.keys m - -scrollCommands :: Terminal -> [TerminalCommand] -scrollCommands = (nullCommand :) . _tmScrollCommands - -nullCommand :: TerminalCommand -nullCommand = - TerminalCommand - { _tcString = "" - , _tcAlias = [] - , _tcHelp = "" - , _tcEffect = TerminalCommandEffectNone -- \_ _ -> NoArguments [] - } - -scrollRBOption :: Float -> World -> World -scrollRBOption y w - | y < 0 = w & rbOptions . opSel %~ (min (length (_opEquip (_rbOptions w)) -1) . (+ 1)) - | y > 0 = w & rbOptions . opSel %~ (max 0 . subtract 1) - | otherwise = w - -moveTweakSel :: Int -> World -> World -moveTweakSel i w = case yourItem w ^? _Just . itTweaks . tweakParams of - Just l -> w & cWorld . hud . hudElement . subInventory . tweakInvSel . _Just %~ (`mod` length l) . subtract i - _ -> w - -changeTweakParam :: Maybe Int -> Int -> World -> World -changeTweakParam mi i w = fromMaybe w $ do - paramid <- mi - params <- yourItem w ^? _Just . itTweaks . tweakParams . ix paramid - let x = (_tweakVal params + i) `mod` _tweakMax params - return $ - w & cWorld . creatures . ix (_yourID (_cWorld w)) . crInv . ix (crSel (you w)) - %~ ( (itTweaks . tweakParams . ix paramid . tweakVal .~ x) - . doTweak (_tweakType params) x - ) diff --git a/src/Dodge/Event/Keyboard.hs b/src/Dodge/Event/Keyboard.hs index 800a0d3ce..f41909769 100644 --- a/src/Dodge/Event/Keyboard.hs +++ b/src/Dodge/Event/Keyboard.hs @@ -27,7 +27,6 @@ import Dodge.Reloading import Dodge.Save import Dodge.Terminal.LeftButton import Dodge.WorldPos -import qualified IntMapHelp as IM import LensHelp import SDL @@ -41,18 +40,18 @@ handleTextInput text u = & uvScreenLayers . ix 0 . scInput %~ updateText & updateTerminalText where - updateTerminalText = case u ^? uvWorld . cWorld . hud . hudElement . subInventory of + updateTerminalText = case u ^? uvWorld . cWorld . lWorld . hud . hudElement . subInventory of Just (DisplayTerminal tmid) | hasfocus tmid -> - uvWorld %~ \w -> guardDisconnectedID tmid w (w & cWorld . terminals . ix tmid . tmInput . tiText %~ updateText) + uvWorld %~ \w -> guardDisconnectedID tmid w (w & cWorld . lWorld . terminals . ix tmid . tmInput . tiText %~ updateText) _ -> id - hasfocus tmid = fromMaybe False $ u ^? uvWorld . cWorld . terminals . ix tmid . tmInput . tiFocus + hasfocus tmid = fromMaybe False $ u ^? uvWorld . cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus updateText s = case T.unpack text of ";" -> s _ -> s `T.append` T.toUpper text guardDisconnectedID :: Int -> World -> World -> World -guardDisconnectedID tmid w w' = case w ^? cWorld . terminals . ix tmid . tmStatus of +guardDisconnectedID tmid w w' = case w ^? cWorld . lWorld . terminals . ix tmid . tmStatus of Just TerminalReady -> w' _ -> w @@ -85,7 +84,7 @@ handlePressedKey _ scode u = case scode of ScancodeF5 -> return . Just $ doQuicksave u ScancodeF9 -> return . Just $ loadSaveSlot QuicksaveSlot u ScancodeSemicolon -> return . Just $ gotoTerminal u - _ | null (_uvScreenLayers u) -> case u ^? uvWorld . cWorld . hud . hudElement . subInventory of + _ | null (_uvScreenLayers u) -> case u ^? uvWorld . cWorld . lWorld . hud . hudElement . subInventory of Just (DisplayTerminal tmid) | inTermFocus (_uvWorld u) -> return $ uvWorld (Just . handlePressedKeyTerminal tmid scode) u @@ -103,18 +102,18 @@ handlePressedKeyInGame scode uv = case scode of ScancodeT -> over uvWorld testEvent uv ScancodeX -> uv & uvWorld %~ toggleTweakInv ScancodeC -> over uvWorld toggleCombineInv uv - ScancodeI -> uv & uvWorld . cWorld . hud . hudElement %~ toggleInspectInv + ScancodeI -> uv & uvWorld . cWorld . lWorld . hud . hudElement %~ toggleInspectInv _ -> uv where w = _uvWorld uv handlePressedKeyTerminal :: Int -> Scancode -> World -> World handlePressedKeyTerminal tmid scode w = case scode of - ScancodeEscape -> w & cWorld . terminals . ix tmid . tmInput . tiFocus %~ const False - ScancodeReturn -> w & terminalReturnEffect (w ^?! cWorld . terminals . ix tmid) + ScancodeEscape -> w & cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus %~ const False + ScancodeReturn -> w & terminalReturnEffect (w ^?! cWorld . lWorld . terminals . ix tmid) ScancodeBackspace -> w - & cWorld . terminals . ix tmid . tmInput . tiText %~ doBackspace + & cWorld . lWorld . terminals . ix tmid . tmInput . tiText %~ doBackspace & backspaceTimer .~ 5 _ -> w where @@ -123,11 +122,11 @@ handlePressedKeyTerminal tmid scode w = case scode of Just (t', _) -> t' toggleTweakInv :: World -> World -toggleTweakInv w = case w ^. cWorld . hud . hudElement of +toggleTweakInv w = case w ^. cWorld . lWorld . hud . hudElement of DisplayInventory TweakInventory{} -> w & thepointer .~ DisplayInventory NoSubInventory _ -> w & thepointer .~ DisplayInventory (TweakInventory mi) where - thepointer = cWorld . hud . hudElement + thepointer = cWorld . lWorld . hud . hudElement mi = 0 <$ (yourItem w >>= (^? itTweaks . tweakParams . ix 0)) toggleInspectInv :: HUDElement -> HUDElement @@ -141,16 +140,17 @@ gotoTerminal w = case _uvScreenLayers w of _ -> w & uvScreenLayers .:~ InputScreen T.empty "Enter command" spaceAction :: World -> World -spaceAction w = case _hudElement $ _hud (_cWorld w) of - DisplayCarte -> w & cWorld . hud . carteCenter .~ theLoc +spaceAction w = case w ^?! cWorld . lWorld . hud . hudElement of + DisplayCarte -> w & cWorld . lWorld . hud . carteCenter .~ theLoc DisplayInventory NoSubInventory -> case selectedCloseObject w of Just (_, Left flit) -> pickUpItem 0 flit w Just (_, Right but) -> doButtonEvent (_btEvent but) but w _ -> w - DisplayInventory DisplayTerminal{} -> w & cWorld . hud . hudElement .~ DisplayInventory NoSubInventory - _ -> w & cWorld . hud . hudElement .~ DisplayInventory NoSubInventory + DisplayInventory DisplayTerminal{} -> w & cWorld . lWorld . hud . hudElement .~ DisplayInventory NoSubInventory + _ -> w & cWorld . lWorld . hud . hudElement .~ DisplayInventory NoSubInventory where - theLoc = doWorldPos (fst (_seenLocations (_cWorld w) IM.! _selLocation (_cWorld w))) w + --theLoc = doWorldPos (fst (_seenLocations (_cWorld w) IM.! _selLocation (_cWorld w))) w + theLoc = doWorldPos (w ^?! cWorld . lWorld . seenLocations . ix (w ^. cWorld . lWorld . selLocation) . _1) w -- updateTopCloseObject i w' = w' & closeObjects %~ ( Right (_buttons w' IM.! i) : ) . tail @@ -158,11 +158,11 @@ pauseGame :: Universe -> Universe pauseGame = uvScreenLayers .~ [pauseMenu] toggleMap :: World -> World -toggleMap w = case _hudElement $ _hud (_cWorld w) of - DisplayCarte -> w & cWorld . hud . hudElement .~ DisplayInventory NoSubInventory - _ -> w & cWorld . hud . hudElement .~ DisplayCarte +toggleMap w = case w ^?! cWorld . lWorld . hud . hudElement of + DisplayCarte -> w & cWorld . lWorld . hud . hudElement .~ DisplayInventory NoSubInventory + _ -> w & cWorld . lWorld . hud . hudElement .~ DisplayCarte escapeMap :: World -> World -escapeMap w = case _hudElement $ _hud (_cWorld w) of - DisplayCarte -> w & cWorld . hud . hudElement .~ DisplayInventory NoSubInventory +escapeMap w = case w ^?! cWorld . lWorld . hud . hudElement of + DisplayCarte -> w & cWorld . lWorld . hud . hudElement .~ DisplayInventory NoSubInventory _ -> w diff --git a/src/Dodge/Flame.hs b/src/Dodge/Flame.hs index a978ed6c3..1e4e409eb 100644 --- a/src/Dodge/Flame.hs +++ b/src/Dodge/Flame.hs @@ -62,8 +62,8 @@ doDamagesFL :: World -> World doDamagesFL fdm (p, thhit) bt = case thhit of - Left cr -> cWorld . creatures . ix (_crID cr) . crState . csDamage .++~ dams - Right wl -> cWorld . wallDamages %~ IM.insertWith (++) (_wlID wl) dams + Left cr -> cWorld . lWorld . creatures . ix (_crID cr) . crState . csDamage .++~ dams + Right wl -> cWorld . lWorld . wallDamages %~ IM.insertWith (++) (_wlID wl) dams where dams = fdm bt p @@ -112,7 +112,7 @@ flDamageInArea :: (Creature -> Bool) -> (Wall -> Bool) -> Flame -> World -> Worl flDamageInArea crt wlt pt w = damwls damcrs where p = _flPos pt - damcrs = foldl' (flip $ \cr -> fst . hiteff [(p, Left cr)]) w $ IM.filter crt $ _creatures (_cWorld w) + damcrs = foldl' (flip $ \cr -> fst . hiteff [(p, Left cr)]) w $ IM.filter crt $ w ^. cWorld . lWorld . creatures--_creatures (_cWorld w) damwls w' = foldl' (flip $ \wl -> fst . hiteff [(p, Right wl)]) @@ -124,14 +124,14 @@ flDamageInArea crt wlt pt w = damwls damcrs flFlicker :: Flame -> World -> World flFlicker pt | _flTimer pt `mod` 7 == 0 = - cWorld . tempLightSources + cWorld . lWorld . tempLightSources .:~ tlsTimeRadColPos 1 70 (0.5 *.*.* xyzV4 (_flColor pt)) (addZ 10 $ _flPos pt) | otherwise = id makeFlame :: Point2 -> Point2 -> World -> World makeFlame pos vel w = w - & cWorld . flames .:~ aFlameParticle t pos vel + & cWorld . lWorld . flames .:~ aFlameParticle t pos vel & randGen .~ g where (t, g) = randomR (99, 101) (_randGen w) diff --git a/src/Dodge/FloorItem.hs b/src/Dodge/FloorItem.hs index cbd7c8876..d56f28043 100644 --- a/src/Dodge/FloorItem.hs +++ b/src/Dodge/FloorItem.hs @@ -20,13 +20,13 @@ copyItemToFloorID :: Point2 -> Item -> World -> (Int, World) copyItemToFloorID pos it w = (,) flid $ w' - & cWorld . floorItems %~ IM.insert flid theflit + & cWorld . lWorld . floorItems %~ IM.insert flid theflit & updateLocation where (p', w') = findWallFreeDropPoint (_dimRad $ _itDimension it) pos w rot = fst . randomR (- pi, pi) $ _randGen w - updateLocation = cWorld . itemLocations . ix (_itID it) .~ OnFloor flid - flid = IM.newKey $ _floorItems (_cWorld w) + updateLocation = cWorld . lWorld . itemLocations . ix (_itID it) .~ OnFloor flid + flid = IM.newKey $ _floorItems (_lWorld (_cWorld w)) theflit = FlIt { _flIt = it & itUse . useAmount %~ const 1 diff --git a/src/Dodge/HeldScroll.hs b/src/Dodge/HeldScroll.hs index 3742ac242..96ad7a1fd 100644 --- a/src/Dodge/HeldScroll.hs +++ b/src/Dodge/HeldScroll.hs @@ -19,7 +19,7 @@ doHeldScroll hs = case hs of HeldScrollTime -> doScrollTime HeldScrollInt{} -> undefined where - overYourItem f x cr w = w & cWorld . creatures . ix 0 . crInv . ix (crSel $ you w) %~ f x cr + overYourItem f x cr w = w & cWorld . lWorld . creatures . ix 0 . crInv . ix (crSel $ you w) %~ f x cr doScrollTime :: Float -> Creature -> World -> World doScrollTime _ _ w = w diff --git a/src/Dodge/HeldUse.hs b/src/Dodge/HeldUse.hs index 406663fe1..70ebeca99 100644 --- a/src/Dodge/HeldUse.hs +++ b/src/Dodge/HeldUse.hs @@ -404,10 +404,10 @@ overNozzles' :: Creature -> World -> World -overNozzles' eff it cr w = neww & cWorld . creatures . ix cid . crInv . ix i . itParams . sprayNozzles .~ newNozzles +overNozzles' eff it cr w = neww & cWorld . lWorld . creatures . ix cid . crInv . ix i . itParams . sprayNozzles .~ newNozzles where cid = _crID cr - i = crSel $ _creatures (_cWorld w) IM.! cid + i = crSel $ w ^?! cWorld . lWorld . creatures . ix cid (neww, newNozzles) = mapAccumR (eff it cr) w $ _sprayNozzles (_itParams it) overNozzle :: @@ -443,12 +443,12 @@ useGasParams nz it cr = fireRemoteShell :: Item -> Creature -> World -> World fireRemoteShell it cr w = set - (cWorld . creatures . ix cid . crInv . ix j . itUse . heldUse) + (cWorld . lWorld . creatures . ix cid . crInv . ix j . itUse . heldUse) (HeldExplodeRemoteShell itid i) $ addRemRocket w where itid = _itID it - i = IM.newKey $ _props (_cWorld w) + i = IM.newKey $ w ^. cWorld . lWorld . props cid = _crID cr addRemRocket = makeShell @@ -488,7 +488,7 @@ coneRandItemParams = do } mcShootLaser :: Item -> Machine -> World -> World -mcShootLaser it mc = cWorld . lasers .:~ lasRayAt (_lasColor $ _itParams it) dam phasev pos dir +mcShootLaser it mc = cWorld . lWorld . lasers .:~ lasRayAt (_lasColor $ _itParams it) dam phasev pos dir where pos = _mcPos mc +.+ 20 *.* unitVectorAtAngle dir dir = mc ^?! mcType . _McTurret . tuDir @@ -499,7 +499,7 @@ mcShootLaser it mc = cWorld . lasers .:~ lasRayAt (_lasColor $ _itParams it) dam shootTeslaArc :: Item -> Creature -> World -> World shootTeslaArc it cr w = w' - & cWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) . itParams .~ ip + & cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) . itParams .~ ip where (w', ip) = shootTeslaArc' (_itParams it) pos dir w pos = _crPos cr +.+ aimingMuzzlePos cr it *.* unitVectorAtAngle dir diff --git a/src/Dodge/Humanoid.hs b/src/Dodge/Humanoid.hs index c65e1d276..af5c1e72f 100644 --- a/src/Dodge/Humanoid.hs +++ b/src/Dodge/Humanoid.hs @@ -6,7 +6,6 @@ import Dodge.Creature import Dodge.Data.CreatureEffect import Dodge.Data.World import Geometry -import qualified IntMapHelp as IM import LensHelp import RandomHelp @@ -221,7 +220,7 @@ chooseMovementPistol' cr w = where g = _randGen w cpos = _crPos cr - ycr = _creatures (_cWorld w) IM.! 0 + ycr = w ^?! cWorld . lWorld . creatures . ix 0 ypos = _crPos ycr chargeProb | dist cpos ypos > 300 = 5 diff --git a/src/Dodge/Initialisation.hs b/src/Dodge/Initialisation.hs index 0a5c506bf..3ae465e97 100644 --- a/src/Dodge/Initialisation.hs +++ b/src/Dodge/Initialisation.hs @@ -11,12 +11,12 @@ import qualified IntMapHelp as IM splashScreen :: World splashScreen = defaultWorld - & cWorld . creatures .~ IM.fromList [(0, startCr)] + & cWorld . lWorld . creatures .~ IM.fromList [(0, startCr)] initialWorld :: World initialWorld = defaultWorld - & cWorld . cwCam . cwcZoom .~ 10 - & cWorld . creatures .~ IM.fromList [(0, startCr)] - & cWorld . worldEvents .~ SoundStart BackgroundSound (V2 0 0) foamSprayFadeOutS Nothing : + & cWorld . lWorld . cwCam . cwcZoom .~ 10 + & cWorld . lWorld . creatures .~ IM.fromList [(0, startCr)] + & cWorld . lWorld . worldEvents .~ SoundStart BackgroundSound (V2 0 0) foamSprayFadeOutS Nothing : [MakeStartCloudAt (V3 x y 5) | x <- [-5, -4 .. 5], y <- [-5, -4 .. 5]] diff --git a/src/Dodge/InputFocus.hs b/src/Dodge/InputFocus.hs index caf6dbdb3..c5bf5d545 100644 --- a/src/Dodge/InputFocus.hs +++ b/src/Dodge/InputFocus.hs @@ -6,7 +6,7 @@ import LensHelp inTermFocus :: World -> Bool inTermFocus w = fromMaybe False $ do - tmid <- w ^? cWorld . hud . hudElement . subInventory . termID - hasfocus <- w ^? cWorld . terminals . ix tmid . tmInput . tiFocus - connectionstatus <- w ^? cWorld . terminals . ix tmid . tmStatus + tmid <- w ^? cWorld . lWorld . hud . hudElement . subInventory . termID + hasfocus <- w ^? cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus + connectionstatus <- w ^? cWorld . lWorld . terminals . ix tmid . tmStatus return $ hasfocus && connectionstatus == TerminalReady diff --git a/src/Dodge/Inventory.hs b/src/Dodge/Inventory.hs index 7166f497d..0daca7326 100644 --- a/src/Dodge/Inventory.hs +++ b/src/Dodge/Inventory.hs @@ -49,26 +49,26 @@ rmInvItem :: Int -> World -> World -rmInvItem cid invid w = case w ^? cWorld . creatures . ix cid . crInv . ix invid . itUse . useAmount of - Just x | x > 1 -> w & cWorld . creatures . ix cid . crInv . ix invid . itUse . useAmount %~ subtract 1 +rmInvItem cid invid w = case w ^? cWorld . lWorld . creatures . ix cid . crInv . ix invid . itUse . useAmount of + Just x | x > 1 -> w & cWorld . lWorld . creatures . ix cid . crInv . ix invid . itUse . useAmount %~ subtract 1 _ -> w - & cWorld . creatures . ix cid . crInv %~ f - & cWorld . creatures . ix cid . crInvSel %~ stopCrInvSelAction - & cWorld . creatures . ix cid . crInvSel . iselPos %~ g - & cWorld . creatures . ix cid . crLeftInvSel %~ g' + & cWorld . lWorld . creatures . ix cid . crInv %~ f + & cWorld . lWorld . creatures . ix cid . crInvSel %~ stopCrInvSelAction + & cWorld . lWorld . creatures . ix cid . crInvSel . iselPos %~ g + & cWorld . lWorld . creatures . ix cid . crLeftInvSel %~ g' & removeAnySlotEquipment & dounequipfunction & doanyitemeffect - & cWorld . creatures . ix cid . crInvEquipped %~ IM.delete invid - & cWorld . creatures . ix cid . crInvEquipped %~ IM.mapKeys g + & cWorld . lWorld . creatures . ix cid . crInvEquipped %~ IM.delete invid + & cWorld . lWorld . creatures . ix cid . crInvEquipped %~ IM.mapKeys g where -- TODO check whether this can be mapKeysMonotonic stopCrInvSelAction (InvSel i a) | i == invid = InvSel i NoInvSelAction | otherwise = InvSel i a - cr = _creatures (_cWorld w) IM.! cid + cr = w ^?! cWorld . lWorld . creatures . ix cid itm = _crInv cr IM.! invid dounequipfunction = fromMaybe id $ do rmf <- itm ^? itUse . equipEffect . eeOnRemove @@ -76,10 +76,10 @@ rmInvItem cid invid w = case w ^? cWorld . creatures . ix cid . crInv . ix invid doanyitemeffect = fromMaybe id $ do rmf <- itm ^? itEffect . ieOnDrop return $ doInvEffect rmf itm cr - removeAnySlotEquipment = case w ^? cWorld . creatures . ix cid . crInvEquipped . ix invid of - Just epos -> cWorld . creatures . ix cid . crEquipment . at epos .~ Nothing + removeAnySlotEquipment = case w ^? cWorld . lWorld . creatures . ix cid . crInvEquipped . ix invid of + Just epos -> cWorld . lWorld . creatures . ix cid . crEquipment . at epos .~ Nothing Nothing -> id - maxk = fmap fst $ IM.lookupMax $ _crInv $ _creatures (_cWorld w) IM.! cid + maxk = fmap fst $ IM.lookupMax $ w ^?! cWorld . lWorld . creatures . ix cid . crInv f inv = let (xs, ys) = IM.split invid inv in xs `IM.union` IM.mapKeys (subtract 1) ys @@ -93,7 +93,7 @@ rmInvItem cid invid w = case w ^? cWorld . creatures . ix cid . crInv . ix invid | otherwise = Just x rmSelectedInvItem :: Int -> World -> World -rmSelectedInvItem cid w = rmInvItem cid (crSel (_creatures (_cWorld w) IM.! cid)) w +rmSelectedInvItem cid w = rmInvItem cid (crSel (w ^?! cWorld . lWorld . creatures . ix cid)) w augmentedInvSizes :: World -> IM.IntMap Int augmentedInvSizes = bimapAugmentInv itSlotsTaken closeObjectSize @@ -102,7 +102,7 @@ bimapAugmentInv :: (Item -> a) -> (Either FloorItem Button -> a) -> World -> IM. bimapAugmentInv f g w = IM.union (f <$> yourInv w) - (IM.fromAscList $ zip [length (yourInv w) ..] $ map g $ _closeObjects (_cWorld w)) + (IM.fromAscList $ zip [length (yourInv w) ..] $ map g $ w ^. cWorld . lWorld . closeObjects) invSelSize :: Int -> World -> Int invSelSize i w = fromMaybe 1 $ augmentedInvSizes w IM.!? i @@ -157,10 +157,10 @@ updateTerminal :: World -> World updateTerminal = checkTermDist checkTermDist :: World -> World -checkTermDist w = case w ^? cWorld . hud . hudElement . subInventory . termID of - Just tmid -> fromMaybe (w & cWorld . hud . hudElement .~ DisplayInventory NoSubInventory) $ do - btid <- w ^? cWorld . terminals . ix tmid . tmButtonID - btpos <- w ^? cWorld . buttons . ix btid . btPos +checkTermDist w = case w ^? cWorld . lWorld . hud . hudElement . subInventory . termID of + Just tmid -> fromMaybe (w & cWorld . lWorld . hud . hudElement .~ DisplayInventory NoSubInventory) $ do + btid <- w ^? cWorld . lWorld . terminals . ix tmid . tmButtonID + btpos <- w ^? cWorld . lWorld . buttons . ix btid . btPos if dist btpos (_crPos $ you w) < 40 then Just w else Nothing Nothing -> w @@ -168,8 +168,8 @@ checkTermDist w = case w ^? cWorld . hud . hudElement . subInventory . termID of updateCloseObjects :: World -> World updateCloseObjects w = w - & cWorld . closeObjects .~ unionBy closeObjEq oldCloseFiltered currentClose - & cWorld . creatures . ix (_yourID (_cWorld w)) . crInvSel . iselPos %~ updateinvsel + & cWorld . lWorld . closeObjects .~ unionBy closeObjEq oldCloseFiltered currentClose + & cWorld . lWorld . creatures . ix (_yourID (_lWorld (_cWorld w))) . crInvSel . iselPos %~ updateinvsel where updateinvsel curinvsel | length (augmentedInvSizes w) <= curinvsel = max 0 $ length (augmentedInvSizes w) - 1 @@ -180,12 +180,12 @@ updateCloseObjects w = map Right . filter ((/=) BtNoLabel . _btState) . IM.elems - $ _buttons (_cWorld w) - currentClose = filt $ map Left (IM.elems $ _floorItems (_cWorld w)) ++ activeButtons - oldClose = filt $ mapMaybe updatebyid $ _closeObjects (_cWorld w) + $ w ^. cWorld . lWorld . buttons + currentClose = filt $ map Left (IM.elems $ w ^. cWorld . lWorld . floorItems) ++ activeButtons + oldClose = filt $ mapMaybe updatebyid $ w ^. cWorld . lWorld . closeObjects oldCloseFiltered = intersectBy closeObjEq oldClose currentClose - updatebyid (Left flid) = fmap Left $ w ^? cWorld . floorItems . ix (_flItID flid) - updatebyid (Right btid) = fmap Right $ w ^? cWorld . buttons . ix (_btID btid) + updatebyid (Left flid) = fmap Left $ w ^? cWorld . lWorld . floorItems . ix (_flItID flid) + updatebyid (Right btid) = fmap Right $ w ^? cWorld . lWorld . buttons . ix (_btID btid) updateRBList :: World -> World updateRBList w @@ -310,8 +310,8 @@ equipSiteToPositions es = case es of closeObjScrollDir :: Float -> World -> World closeObjScrollDir x - | x > 0 = over (cWorld . closeObjects) rotU - | x < 0 = over (cWorld . closeObjects) rotD + | x > 0 = over (cWorld . lWorld . closeObjects) rotU + | x < 0 = over (cWorld . lWorld . closeObjects) rotD | otherwise = id changeInvSel :: Int -> World -> World @@ -319,29 +319,30 @@ changeInvSel i w | n == 0 = w | yourInvSel w < n = w - & cWorld . creatures . ix (_yourID (_cWorld w)) . crInvSel . iselPos %~ (`mod` n) . subtract i - & cWorld . creatures . ix (_yourID (_cWorld w)) . crInvSel . iselAction .~ NoInvSelAction + & cWorld . lWorld . creatures . ix (w ^. cWorld . lWorld . yourID) . crInvSel . iselPos %~ (`mod` n) . subtract i + & cWorld . lWorld . creatures . ix (w ^. cWorld . lWorld . yourID) . crInvSel . iselAction .~ NoInvSelAction | otherwise = w - & cWorld . creatures . ix (_yourID (_cWorld w)) . crInvSel . iselPos %~ ((+ n) . (`mod` numCO) . subtract (i + n)) - & cWorld . creatures . ix (_yourID (_cWorld w)) . crInvSel . iselAction .~ NoInvSelAction + & cWorld . lWorld . creatures . ix (w ^. cWorld . lWorld . yourID) . crInvSel . iselPos %~ ((+ n) . (`mod` numCO) . subtract (i + n)) + & cWorld . lWorld . creatures . ix (w ^. cWorld . lWorld . yourID) . crInvSel . iselAction .~ NoInvSelAction where -- arguably this should jump the invpos into the inventory proper - n = length $ _crInv $ _creatures (_cWorld w) IM.! _yourID (_cWorld w) - numCO = length $ _closeObjects (_cWorld w) + n = length $ _crInv $ _creatures (_lWorld (_cWorld w)) IM.! _yourID (_lWorld (_cWorld w)) + numCO = length $ w ^. cWorld . lWorld . closeObjects changeSwapInvSel :: Int -> World -> World changeSwapInvSel k w | n == 0 = w | yourInvSel w < n = w - & cWorld . creatures . ix (_yourID (_cWorld w)) %~ updatecreature + & cWorld . lWorld . creatures . ix yid %~ updatecreature | otherwise = w - & cWorld . creatures . ix (_yourID (_cWorld w)) . crInvSel . iselPos .~ ico' - & cWorld . closeObjects %~ swapIndices (i - n) (ico' - n) + & cWorld . lWorld . creatures . ix yid . crInvSel . iselPos .~ ico' + & cWorld . lWorld . closeObjects %~ swapIndices (i - n) (ico' - n) where + yid = w ^. cWorld . lWorld . yourID updatecreature = (crInv %~ IM.safeSwapKeys (i `mod` n) swapi) . (crLeftInvSel . _Just %~ updateLeftInvSel) @@ -361,20 +362,21 @@ changeSwapInvSel k w i = crSel cr ico' = ((i - (k + n)) `mod` numCO) + n n = length $ _crInv cr - numCO = length $ _closeObjects (_cWorld w) + numCO = length $ w ^. cWorld . lWorld . closeObjects changeAugInvSel :: Int -> World -> World changeAugInvSel i w | n == 0 = w | otherwise = w - & cWorld . creatures . ix (_yourID (_cWorld w)) . crInvSel . iselPos %~ (`mod` n) . subtract i - & cWorld . creatures . ix (_yourID (_cWorld w)) . crInvSel . iselAction .~ NoInvSelAction + & cWorld . lWorld . creatures . ix yid . crInvSel . iselPos %~ (`mod` n) . subtract i + & cWorld . lWorld . creatures . ix yid . crInvSel . iselAction .~ NoInvSelAction where - n = length (yourInv w) + length (_closeObjects (_cWorld w)) + yid = w ^. cWorld . lWorld . yourID + n = length (yourInv w) + length (w ^. cWorld . lWorld . closeObjects) bestCloseObjectIndex :: World -> Maybe Int -bestCloseObjectIndex w = findIndex f $ _closeObjects (_cWorld w) +bestCloseObjectIndex w = findIndex f $ w ^. cWorld . lWorld . closeObjects where f (Right _) = True f (Left flit) = itSlotsTaken (_flIt flit) <= _crInvCapacity ycr - crInvSize ycr @@ -390,4 +392,4 @@ selectedCloseObject w inv = _crInv cr selectNthCloseObject :: World -> Int -> Maybe (Int, Either FloorItem Button) -selectNthCloseObject w n = (length (yourInv w) + n,) <$> (_closeObjects (_cWorld w) !? n) +selectNthCloseObject w n = (length (yourInv w) + n,) <$> (_closeObjects (_lWorld (_cWorld w)) !? n) diff --git a/src/Dodge/Inventory/Add.hs b/src/Dodge/Inventory/Add.hs index 38a9239fe..e7dd82cc6 100644 --- a/src/Dodge/Inventory/Add.hs +++ b/src/Dodge/Inventory/Add.hs @@ -11,7 +11,8 @@ import qualified IntMapHelp as IM putItemInInvID :: Int -> Int -> World -> (Maybe Int, World) putItemInInvID cid flid w = fromMaybe (Nothing, w) $ do - (i, w') <- tryPutItemInInv cid (_floorItems (_cWorld w) IM.! flid) w + --(i, w') <- tryPutItemInInv cid (_floorItems (_cWorld w) IM.! flid) w + (i, w') <- tryPutItemInInv cid (w ^?! cWorld . lWorld . floorItems . ix flid) w return (Just i, w') putItemInInvSlot :: Int -> Item -> IM.IntMap Item -> IM.IntMap Item @@ -26,13 +27,13 @@ tryPutItemInInv cid flit w = case maybeInvSlot of ( i , w & updateItLocation i - & cWorld . floorItems %~ IM.delete (_flItID flit) - & cWorld . creatures . ix cid . crInv %~ putItemInInvSlot i it + & cWorld . lWorld . floorItems %~ IM.delete (_flItID flit) + & cWorld . lWorld . creatures . ix cid . crInv %~ putItemInInvSlot i it ) where it = _flIt flit maybeInvSlot = checkInvSlotsYou it w - updateItLocation invid w' = w' & cWorld . itemLocations . ix (_itID it) .~ InInv cid invid + updateItLocation invid w' = w' & cWorld . lWorld . itemLocations . ix (_itID it) .~ InInv cid invid --{- | Pick up a specific item. -} --putItemInInv :: Int -> FloorItem -> World -> World @@ -50,5 +51,5 @@ tryPutItemInInv cid flit w = case maybeInvSlot of -- Just j -> w' & itemPositions . ix j .~ InInv cid invid createPutItem :: Item -> World -> (Maybe Int, World) createPutItem it w = - uncurry (putItemInInvID (_yourID (_cWorld w))) $ + uncurry (putItemInInvID (_yourID (_lWorld (_cWorld w)))) $ copyItemToFloorID (_crPos $ you w) (applyModules it) w diff --git a/src/Dodge/Inventory/Lock.hs b/src/Dodge/Inventory/Lock.hs index ff6c1c0fe..b59ad7586 100644 --- a/src/Dodge/Inventory/Lock.hs +++ b/src/Dodge/Inventory/Lock.hs @@ -4,7 +4,7 @@ import Control.Lens import Dodge.Data.World lockInv :: Int -> World -> World -lockInv cid = cWorld . creatures . ix cid . crInvLock ||~ True +lockInv cid = cWorld . lWorld . creatures . ix cid . crInvLock ||~ True unlockInv :: Int -> World -> World -unlockInv cid = cWorld . creatures . ix cid . crInvLock &&~ False +unlockInv cid = cWorld . lWorld . creatures . ix cid . crInvLock &&~ False diff --git a/src/Dodge/ItEffect.hs b/src/Dodge/ItEffect.hs index 628cce341..cc09f406a 100644 --- a/src/Dodge/ItEffect.hs +++ b/src/Dodge/ItEffect.hs @@ -36,7 +36,7 @@ chargeIfInInventory itm cr w = w & ptrWpCharge %~ (min maxcharge . (+ 1)) where invid = _ipInvID $ _itLocation itm - ptrWpCharge = cWorld . creatures . ix (_crID cr) . crInv . ix invid . itUse . leftConsumption . wpCharge + ptrWpCharge = cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix invid . itUse . leftConsumption . wpCharge maxcharge = itm ^?! itUse . leftConsumption . wpMaxCharge @@ -48,7 +48,7 @@ chargeIfEquipped itm cr w w & ptrWpCharge .~ 0 where invid = _ipInvID $ _itLocation itm - ptrWpCharge = cWorld . creatures . ix (_crID cr) . crInv . ix invid . itUse . leftConsumption . wpCharge + ptrWpCharge = cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix invid . itUse . leftConsumption . wpCharge maxcharge = itm ^?! itUse . leftConsumption . wpMaxCharge diff --git a/src/Dodge/Item/Consumable.hs b/src/Dodge/Item/Consumable.hs index fca921870..8c56f28fd 100644 --- a/src/Dodge/Item/Consumable.hs +++ b/src/Dodge/Item/Consumable.hs @@ -4,7 +4,6 @@ import Control.Lens import Dodge.Data.World import Dodge.Default import Dodge.SoundLogic -import qualified IntMapHelp as IM medkit :: Int -> Item medkit i = @@ -17,10 +16,10 @@ heal25 = heal 25 heal :: Int -> Int -> World -> Maybe World heal hp n w - | _crHP (_creatures (_cWorld w) IM.! n) >= 10000 = Nothing + | (w ^?! cWorld . lWorld . creatures . ix n . crHP) >= 10000 = Nothing | otherwise = Just $ soundStart (CrSound $ _crID cr) (_crPos cr) healS Nothing w - & cWorld . creatures . ix n . crHP %~ min 10000 . (+ hp) + & cWorld . lWorld . creatures . ix n . crHP %~ min 10000 . (+ hp) where - cr = _creatures (_cWorld w) IM.! n + cr = w ^?! cWorld . lWorld . creatures . ix n --_creatures (_cWorld w) IM.! n diff --git a/src/Dodge/Item/Location.hs b/src/Dodge/Item/Location.hs index 7e486fc2d..3a3653b18 100644 --- a/src/Dodge/Item/Location.hs +++ b/src/Dodge/Item/Location.hs @@ -9,11 +9,11 @@ import Dodge.Data.World getItem :: Int -> World -> Maybe Item getItem itid w = do - itpos <- w ^? cWorld . itemLocations . ix itid + itpos <- w ^? cWorld . lWorld . itemLocations . ix itid case itpos of - OnFloor flitid -> w ^? cWorld . floorItems . ix flitid . flIt - InInv cid invid -> w ^? cWorld . creatures . ix cid . crInv . ix invid - OnTurret mcid -> w ^? cWorld . machines . ix mcid . mcType . _McTurret . tuWeapon + OnFloor flitid -> w ^? cWorld . lWorld . floorItems . ix flitid . flIt + InInv cid invid -> w ^? cWorld . lWorld . creatures . ix cid . crInv . ix invid + OnTurret mcid -> w ^? cWorld . lWorld . machines . ix mcid . mcType . _McTurret . tuWeapon InVoid -> Nothing pointerToItemLocation :: @@ -22,8 +22,8 @@ pointerToItemLocation :: (Item -> f Item) -> World -> f World -pointerToItemLocation (InInv cid invid) = cWorld . creatures . ix cid . crInv . ix invid -pointerToItemLocation (OnFloor flid) = cWorld . floorItems . ix flid . flIt +pointerToItemLocation (InInv cid invid) = cWorld . lWorld . creatures . ix cid . crInv . ix invid +pointerToItemLocation (OnFloor flid) = cWorld . lWorld . floorItems . ix flid . flIt pointerToItemLocation _ = const pure pointerToItem :: diff --git a/src/Dodge/Item/Location/Initialize.hs b/src/Dodge/Item/Location/Initialize.hs index cc1dda5ac..9b7c6b92d 100644 --- a/src/Dodge/Item/Location/Initialize.hs +++ b/src/Dodge/Item/Location/Initialize.hs @@ -9,24 +9,24 @@ initItemLocations :: CWorld -> CWorld initItemLocations = initCrsItemLocations . initFlItemsLocations . initTusItemLocations initCrsItemLocations :: CWorld -> CWorld -initCrsItemLocations w = w' & creatures .~ newcreatures +initCrsItemLocations w = w' & lWorld . creatures .~ newcreatures where - (w', newcreatures) = mapAccumR initCrItemLocations w (_creatures w) + (w', newcreatures) = mapAccumR initCrItemLocations w (w ^. lWorld . creatures) initFlItemsLocations :: CWorld -> CWorld -initFlItemsLocations w = w' & floorItems .~ newfloorItems +initFlItemsLocations w = w' & lWorld . floorItems .~ newfloorItems where - (w', newfloorItems) = mapAccumR initFlItemLocation w (_floorItems w) + (w', newfloorItems) = mapAccumR initFlItemLocation w (w ^. lWorld . floorItems) initTusItemLocations :: CWorld -> CWorld -initTusItemLocations w = w' & machines .~ newmachines +initTusItemLocations w = w' & lWorld . machines .~ newmachines where - (w', newmachines) = mapAccumR initTuItemLocation w (_machines w) + (w', newmachines) = mapAccumR initTuItemLocation w (w ^. lWorld . machines) initSpecificCrItemLocations :: Int -> CWorld -> CWorld -initSpecificCrItemLocations crid w = w' & creatures . ix crid .~ newcr +initSpecificCrItemLocations crid w = w' & lWorld . creatures . ix crid .~ newcr where - (w',newcr) = initCrItemLocations w (w ^?! creatures . ix crid) + (w',newcr) = initCrItemLocations w (w ^?! lWorld . creatures . ix crid) initCrItemLocations :: CWorld -> Creature -> (CWorld, Creature) initCrItemLocations w cr = (w', cr & crInv .~ newinv) @@ -34,30 +34,30 @@ initCrItemLocations w cr = (w', cr & crInv .~ newinv) (w',newinv) = imapAccumR (initCrItemLocation cr) w (_crInv cr) initCrItemLocation :: Creature -> Int -> CWorld -> Item -> (CWorld,Item) -initCrItemLocation cr invid w it = (w & itemLocations . at locid ?~ loc +initCrItemLocation cr invid w it = (w & lWorld . itemLocations . at locid ?~ loc ,it & itID .~ locid & itLocation .~ loc) where - locid = IM.newKey (_itemLocations w) + locid = IM.newKey ( w ^. lWorld . itemLocations) loc = InInv (_crID cr) invid initFlItemLocation :: CWorld -> FloorItem -> (CWorld, FloorItem) -initFlItemLocation w flit = (w & itemLocations . at locid ?~ loc +initFlItemLocation w flit = (w & lWorld . itemLocations . at locid ?~ loc , flit & flIt . itID .~ locid & flIt . itLocation .~ loc ) where - locid = IM.newKey (_itemLocations w) + locid = IM.newKey (w ^. lWorld . itemLocations ) loc = OnFloor (_flItID flit) initTuItemLocation :: CWorld -> Machine -> (CWorld, Machine) initTuItemLocation w mc = case mc ^? mcType . _McTurret . tuWeapon of Nothing -> (w, mc) Just _ -> - let locid = IM.newKey (_itemLocations w) + let locid = IM.newKey ( w ^. lWorld . itemLocations) loc = OnTurret (_mcID mc) - in ( w & itemLocations . at locid ?~ loc + in ( w & lWorld . itemLocations . at locid ?~ loc , mc & mcType . _McTurret . tuWeapon . itID .~ locid & mcType . _McTurret . tuWeapon . itLocation .~ loc ) diff --git a/src/Dodge/Item/Weapon/BatteryGuns.hs b/src/Dodge/Item/Weapon/BatteryGuns.hs index 5905e98ef..dcf02eb58 100644 --- a/src/Dodge/Item/Weapon/BatteryGuns.hs +++ b/src/Dodge/Item/Weapon/BatteryGuns.hs @@ -132,7 +132,7 @@ import Picture shootLaser :: Item -> Creature -> World -> World -shootLaser it cr = cWorld . lasers .:~ lasRayAt (_lasColor $ _itParams it) dam phasev pos dir +shootLaser it cr = cWorld . lWorld . lasers .:~ lasRayAt (_lasColor $ _itParams it) dam phasev pos dir where pos = _crPos cr dir = _crDir cr @@ -144,7 +144,7 @@ circleLaser :: Item -> Creature -> World -> World circleLaser it cr w | hasLOSIndirect cpos pos w = w - & cWorld . lasers .:~ lasRayAt (_lasColor $ _itParams it) dam phasev pos dir + & cWorld . lWorld . lasers .:~ lasRayAt (_lasColor $ _itParams it) dam phasev pos dir | otherwise = w where cpos = _crPos cr @@ -157,8 +157,8 @@ circleLaser it cr w shootDualLaser :: Item -> Creature -> World -> World shootDualLaser it cr w = w - & cWorld . newBeams . positronBeams .:~ dualRayAt (_lasBeam $ _itParams it) itid w (_lasColor $ _itParams it) dam phasev posl dirl - & cWorld . newBeams . electronBeams .:~ basicBeamAt itid w (_lasColor2 $ _itParams it) dam phasev posr dirr + & cWorld . lWorld . newBeams . positronBeams .:~ dualRayAt (_lasBeam $ _itParams it) itid w (_lasColor $ _itParams it) dam phasev posl dirl + & cWorld . lWorld . newBeams . electronBeams .:~ basicBeamAt itid w (_lasColor2 $ _itParams it) dam phasev posr dirr where itid = _itID it dir = _crDir cr @@ -200,7 +200,7 @@ dualRayAt bt itid w col dam phasev pos dir = & bmType .~ bt aTractorBeam :: Item -> Creature -> World -> World -aTractorBeam _ cr w = w & cWorld . tractorBeams .:~ tractorBeamAt spos outpos dir power +aTractorBeam _ cr w = w & cWorld . lWorld . tractorBeams .:~ tractorBeamAt spos outpos dir power where cpos = _crPos cr spos = cpos +.+ (_crRad cr + 10) *.* unitVectorAtAngle dir diff --git a/src/Dodge/Item/Weapon/ExtraEffect.hs b/src/Dodge/Item/Weapon/ExtraEffect.hs index c521869d9..7904d39d5 100644 --- a/src/Dodge/Item/Weapon/ExtraEffect.hs +++ b/src/Dodge/Item/Weapon/ExtraEffect.hs @@ -38,7 +38,7 @@ autoEffect :: (Item -> Creature -> World -> World) -> Int -> SoundID -> Item -> autoEffect eff t sid itm cr w | _eparamInt (_eeParams (_equipEffect $ _itUse itm)) < 1 = eff itm cr w - & cWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID $ _itLocation itm) + & cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID $ _itLocation itm) . itUse . equipEffect . eeParams @@ -47,7 +47,7 @@ autoEffect eff t sid itm cr w & soundStart OnceSound (_crPos cr) sid Nothing | otherwise = w - & cWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID $ _itLocation itm) + & cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID $ _itLocation itm) . itUse . equipEffect . eeParams @@ -86,10 +86,10 @@ targetRBCreatureUp it cr w t mwp = mouseWorldPos w updatePos t' = t' & tgPos .~ posFromMaybeID (_tgID t') posFromMaybeID Nothing = Nothing - posFromMaybeID (Just i) = w ^? cWorld . creatures . ix i . crPos + posFromMaybeID (Just i) = w ^? cWorld . lWorld . creatures . ix i . crPos canSeeTarget = fromMaybe False $ do cid <- t ^? tgID . _Just - cpos <- w ^? cWorld . creatures . ix cid . crPos + cpos <- w ^? cWorld . lWorld . creatures . ix cid . crPos Just $ hasLOS cpos (_crPos cr) w targetUpdateWith :: @@ -141,7 +141,7 @@ targetLaserUpdate _ cr w t sp = _crPos cr +.+ 15 *.* unitVectorAtAngle (_crDir cr) ep = sp +.+ 5000 *.* normalizeV (mouseWorldPos w -.- sp) addLaserPic = - cWorld . lasers + cWorld . lWorld . lasers .:~ LaserStart { _lpPhaseV = 1 , _lpDir = _crDir cr diff --git a/src/Dodge/Item/Weapon/Launcher.hs b/src/Dodge/Item/Weapon/Launcher.hs index 2193699c3..8aae314d6 100644 --- a/src/Dodge/Item/Weapon/Launcher.hs +++ b/src/Dodge/Item/Weapon/Launcher.hs @@ -6,7 +6,6 @@ import Control.Lens import Dodge.Data.World import Dodge.Item.Location import Dodge.Payload -import qualified IntMapHelp as IM explodeRemoteRocket :: -- | Item id @@ -17,10 +16,10 @@ explodeRemoteRocket :: World explodeRemoteRocket itid pjid w = w - & cWorld . projectiles . ix pjid . prjUpdates .~ [PJRetireRemote itid 30 pjid] - & cWorld . projectiles . ix pjid . prjDraw .~ DrawBlankProjectile + & cWorld . lWorld . projectiles . ix pjid . prjUpdates .~ [PJRetireRemote itid 30 pjid] + & cWorld . lWorld . projectiles . ix pjid . prjDraw .~ DrawBlankProjectile & itPoint . itUse . heldUse .~ HeldDoNothing & usePayload (_prjPayload thepj) (_prjPos thepj) where - itPoint = pointerToItemLocation $ _itemLocations (_cWorld w) IM.! itid - thepj = _projectiles (_cWorld w) IM.! pjid + itPoint = pointerToItemLocation $ w ^?! cWorld . lWorld . itemLocations . ix itid-- _itemLocations (_cWorld w) IM.! itid + thepj = w ^?! cWorld . lWorld . projectiles . ix pjid diff --git a/src/Dodge/Item/Weapon/Remote.hs b/src/Dodge/Item/Weapon/Remote.hs index 4eaa513c8..0598cf9f2 100644 --- a/src/Dodge/Item/Weapon/Remote.hs +++ b/src/Dodge/Item/Weapon/Remote.hs @@ -7,24 +7,23 @@ import Control.Lens import Dodge.Data.World import Dodge.Default import Geometry -import qualified IntMapHelp as IM setRemoteBombScope :: Int -> Prop -> World -> World -setRemoteBombScope itid pj w' = case _itemLocations (_cWorld w') IM.! itid of +setRemoteBombScope itid pj w = case w ^?! cWorld . lWorld . itemLocations . ix itid of InInv cid invid -> - w' - & cWorld . creatures . ix cid . crInv . ix invid . itScope + w + & cWorld . lWorld . creatures . ix cid . crInv . ix invid . itScope . scopePos - .~ (_prPos pj -.- _crPos (_creatures (_cWorld w') IM.! cid)) - & cWorld . creatures . ix cid . crInv . ix invid . itUse . heldAim . aimZoom + .~ (_prPos pj -.- (w ^?! cWorld . lWorld . creatures . ix cid . crPos)) + & cWorld . lWorld . creatures . ix cid . crInv . ix invid . itUse . heldAim . aimZoom .~ (defaultItZoom{_itZoomMax = 0.5, _itZoomMin = 0.5}) - _ -> w' + _ -> w setRemoteScope :: Int -> Point2 -> World -> World -setRemoteScope itid pos w' = case w' ^? cWorld . itemLocations . ix itid of +setRemoteScope itid pos w = case w ^? cWorld . lWorld . itemLocations . ix itid of Just (InInv cid' invid) -> - w' - & cWorld . creatures . ix cid' . crInv . ix invid . itScope + w + & cWorld . lWorld . creatures . ix cid' . crInv . ix invid . itScope . scopePos - .~ (pos -.- _crPos (_creatures (_cWorld w') IM.! cid')) - _ -> w' + .~ (pos -.- (w ^?! cWorld . lWorld . creatures . ix cid' . crPos)) + _ -> w diff --git a/src/Dodge/Item/Weapon/Shell.hs b/src/Dodge/Item/Weapon/Shell.hs index 9b1438881..de3c73ada 100644 --- a/src/Dodge/Item/Weapon/Shell.hs +++ b/src/Dodge/Item/Weapon/Shell.hs @@ -8,7 +8,7 @@ import Geometry.Vector decTimMvVel :: Proj -> World -> World decTimMvVel pj = - cWorld . projectiles . ix pjid + cWorld . lWorld . projectiles . ix pjid %~ ( (prjTimer -~ 1) . (prjPos %~ (+.+ vel)) . (prjAcc %~ rotateV rot) diff --git a/src/Dodge/Item/Weapon/Spawn.hs b/src/Dodge/Item/Weapon/Spawn.hs index dd61da622..0a7b98fb8 100644 --- a/src/Dodge/Item/Weapon/Spawn.hs +++ b/src/Dodge/Item/Weapon/Spawn.hs @@ -24,9 +24,9 @@ spawnCrNextTo :: Creature -> World -> World -spawnCrNextTo cr sCr w = w & cWorld . creatures %~ IM.insert k newCr +spawnCrNextTo cr sCr w = w & cWorld . lWorld . creatures %~ IM.insert k newCr where - k = IM.newKey $ _creatures (_cWorld w) + k = IM.newKey $ w ^?! cWorld . lWorld . creatures -- _creatures (_cWorld w) newCr = cr & crID .~ k diff --git a/src/Dodge/Item/Weapon/TriggerType.hs b/src/Dodge/Item/Weapon/TriggerType.hs index ff44d4d41..db0493d8c 100644 --- a/src/Dodge/Item/Weapon/TriggerType.hs +++ b/src/Dodge/Item/Weapon/TriggerType.hs @@ -90,7 +90,7 @@ type ChainEffect = lockInvFor :: Int -> ChainEffect lockInvFor i f it cr = - f it cr . (cWorld . delayedEvents .:~ (i, UnlockInv (_crID cr))) + f it cr . (cWorld . lWorld . delayedEvents .:~ (i, UnlockInv (_crID cr))) . lockInv (_crID cr) trigDoAlso' :: @@ -138,7 +138,7 @@ withThickSmokeI eff item cr w = ammoCheckI :: ChainEffect ammoCheckI eff itm cr w | _laLoaded ic <= 0 || not (_laPrimed ic) = w - | otherwise = eff itm cr $ w & cWorld . creatures . ix (_crID cr) %~ crCancelReloading + | otherwise = eff itm cr $ w & cWorld . lWorld . creatures . ix (_crID cr) %~ crCancelReloading where ic = _heldConsumption $ _itUse itm @@ -148,7 +148,7 @@ ammoHammerCheck :: ChainEffect ammoHammerCheck eff it cr w | _laLoaded ic <= 0 || not (_laPrimed ic) = w -- fromMaybe w (startReloadingWeapon cr w) | otherwise = case it ^? itUse . heldHammer of - Just HammerUp -> eff it cr $ w & cWorld . creatures . ix (_crID cr) %~ crCancelReloading + Just HammerUp -> eff it cr $ w & cWorld . lWorld . creatures . ix (_crID cr) %~ crCancelReloading _ -> w where ic = _heldConsumption $ _itUse it @@ -192,7 +192,7 @@ rateIncAB exeffFirst exeffCont eff item cr w startRate = _rateMaxMax . _heldDelay $ _itUse item cid = _crID cr itRef = crSel cr - pointItem = cWorld . creatures . ix cid . crInv . ix itRef + pointItem = cWorld . lWorld . creatures . ix cid . crInv . ix itRef currentRate = _rateMax (_heldDelay (_itUse item)) repeatFire = crWeaponReady cr && _rateTime (_heldDelay (_itUse item)) == 1 firstFire = crWeaponReady cr && _rateTime (_heldDelay (_itUse item)) == 0 @@ -216,7 +216,7 @@ withWarmUp soundID f item cr w where cid = _crID cr itRef = crSel cr - pointerToItem = cWorld . creatures . ix cid . crInv . ix itRef + pointerToItem = cWorld . lWorld . creatures . ix cid . crInv . ix itRef curWarmUp = _warmTime . _heldDelay $ _itUse item maxWarmUp = _warmMax . _heldDelay $ _itUse item @@ -291,13 +291,13 @@ afterRecoil :: -- | Recoil amount Float -> ChainEffect -afterRecoil recoilAmount eff item cr = eff item (pushback cr) . over (cWorld . creatures . ix cid) pushback +afterRecoil recoilAmount eff item cr = eff item (pushback cr) . over (cWorld . lWorld . creatures . ix cid) pushback where cid = _crID cr pushback = over crPos (+.+ rotateV (_crDir cr) (V2 ((- recoilAmount) / _crMass cr) 0)) withRecoil :: ChainEffect -withRecoil eff it cr = eff it cr . over (cWorld . creatures . ix cid) pushback +withRecoil eff it cr = eff it cr . over (cWorld . lWorld . creatures . ix cid) pushback where cid = _crID cr recoilAmount = fromMaybe 0 $ it ^? itParams . recoil @@ -313,7 +313,7 @@ withSidePushI :: withSidePushI maxSide eff item cr w = eff item (push cr) $ w - & cWorld . creatures . ix cid %~ push + & cWorld . lWorld . creatures . ix cid %~ push & randGen .~ g where cid = _crID cr @@ -330,7 +330,7 @@ withSidePushAfterI :: Float -> ChainEffect withSidePushAfterI maxSide eff item cr w = - over (cWorld . creatures . ix cid) push . eff item cr $ + over (cWorld . lWorld . creatures . ix cid) push . eff item cr $ w & randGen .~ g where @@ -341,19 +341,19 @@ withSidePushAfterI maxSide eff item cr w = useAllAmmo :: ChainEffect useAllAmmo eff item cr = eff item cr - . (cWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) . itUse . heldConsumption . laLoaded .~ 0) + . (cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) . itUse . heldConsumption . laLoaded .~ 0) useAmmoUpTo :: Int -> ChainEffect useAmmoUpTo amAmount eff item cr = eff item cr - . ( cWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) . itUse . heldConsumption . laLoaded + . ( cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) . itUse . heldConsumption . laLoaded %~ (max 0 . subtract amAmount) ) useAmmoAmount :: Int -> ChainEffect useAmmoAmount amAmount eff item cr = eff item cr - . (cWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) . itUse . heldConsumption . laLoaded -~ amAmount) + . (cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) . itUse . heldConsumption . laLoaded -~ amAmount) {- | Applies a world effect after an item use cooldown check. @@ -364,7 +364,7 @@ useTimeCheck f item cr w = case item ^? itUse . heldDelay . rateTime of _ -> w where cid = _crID cr - setUseTime = cWorld . creatures . ix cid . crInv . ix (crSel cr) . itUse . heldDelay . rateTime +~ userate + setUseTime = cWorld . lWorld . creatures . ix cid . crInv . ix (crSel cr) . itUse . heldDelay . rateTime +~ userate userate = fromMaybe 0 $ item ^? itUse . heldDelay . rateMax -- | Applies a world effect after a hammer position check. @@ -390,7 +390,7 @@ ammoUseCheck f item cr w where cid = _crID cr itRef = crSel cr - pointerToItem = cWorld . creatures . ix cid . crInv . ix itRef + pointerToItem = cWorld . lWorld . creatures . ix cid . crInv . ix itRef fireCondition = crWeaponReady cr && _rateTime (_heldDelay (_itUse item)) == 0 @@ -433,7 +433,7 @@ shootL f item cr w where cid = _crID cr invid = _ipInvID $ _itLocation item - pointerToItem = cWorld . creatures . ix cid . crInv . ix invid + pointerToItem = cWorld . lWorld . creatures . ix cid . crInv . ix invid fireCondition = _rateTime (_leftDelay (_itUse item)) == 0 && _arLoaded (_leftConsumption (_itUse item)) > 0 @@ -444,15 +444,15 @@ withItem g f it = g it f it -- not ideal withItemUpdate' :: (Item -> Item) -> ChainEffect -withItemUpdate' up f it cr = f (up it) cr . (cWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) %~ up) +withItemUpdate' up f it cr = f (up it) cr . (cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) %~ up) withItemUpdate :: (Item -> Item) -> (Item -> ChainEffect) -> ChainEffect -withItemUpdate up g f it cr = g it f it cr . (cWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) %~ up) +withItemUpdate up g f it cr = g it f it cr . (cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) %~ up) withTempLight :: Int -> Float -> V3 Float -> ChainEffect withTempLight time rad col eff item cr = eff item cr - . over (cWorld . tempLightSources) (theTLS :) + . over (cWorld . lWorld . tempLightSources) (theTLS :) where theTLS = tlsTimeRadColPos time rad col (V3 x y 10) V2 x y = _crPos cr +.+ 15 *.* unitVectorAtAngle (_crDir cr) @@ -578,9 +578,9 @@ torqueBefore torque feff item cr w feff item (cr & crDir +~ rot) $ w & randGen .~ g - & cWorld . creatures . ix cid . crDir +~ rot - & cWorld . cwCam . cwcRot +~ rot - | otherwise = feff item cr $ set randGen g $ over (cWorld . creatures . ix cid . crDir) (+ rot) w + & cWorld . lWorld . creatures . ix cid . crDir +~ rot + & cWorld . lWorld . cwCam . cwcRot +~ rot + | otherwise = feff item cr $ set randGen g $ over (cWorld . lWorld . creatures . ix cid . crDir) (+ rot) w where cid = _crID cr (rot, g) = randomR (- torque, torque) $ _randGen w @@ -599,9 +599,9 @@ torqueBeforeAtLeast minTorque exTorque feff item cr w feff item (cr & crDir +~ rot') $ w & randGen .~ g - & cWorld . creatures . ix cid . crDir +~ rot' - & cWorld . cwCam . cwcRot +~ rot' - | otherwise = feff item cr $ set randGen g $ over (cWorld . creatures . ix cid . crDir) (+ rot') w + & cWorld . lWorld . creatures . ix cid . crDir +~ rot' + & cWorld . lWorld . cwCam . cwcRot +~ rot' + | otherwise = feff item cr $ set randGen g $ over (cWorld . lWorld . creatures . ix cid . crDir) (+ rot') w where cid = _crID cr (rot, g) = randomR (- exTorque, exTorque) $ _randGen w @@ -613,8 +613,8 @@ torqueBeforeAtLeast minTorque exTorque feff item cr w withTorqueAfter :: ChainEffect withTorqueAfter feff item cr w -- | cid == 0 = rotateScope $ set randGen g $ over cameraRot (+rot) $ feff item cr w - | cid == 0 = set randGen g $ over (cWorld . cwCam . cwcRot) (+ rot) $ feff item cr w - | otherwise = set randGen g $ over (cWorld . creatures . ix cid . crDir) (+ rot) $ feff item cr w + | cid == 0 = set randGen g $ over (cWorld . lWorld . cwCam . cwcRot) (+ rot) $ feff item cr w + | otherwise = set randGen g $ over (cWorld . lWorld . creatures . ix cid . crDir) (+ rot) $ feff item cr w where cid = _crID cr (rot, g) = randomR (- torque, torque) $ _randGen w @@ -647,12 +647,12 @@ sideEffectOnFrame :: ChainEffect sideEffectOnFrame i sf f it cr w = f it cr w - & cWorld . delayedEvents .:~ (i, sf it cr) + & cWorld . lWorld . delayedEvents .:~ (i, sf it cr) torqueSideEffect :: Float -> Item -> Creature -> World -> World torqueSideEffect torque _ cr w - | cid == 0 = set randGen g $ over (cWorld . cwCam . cwcRot) (+ rot) w - | otherwise = set randGen g $ over (cWorld . creatures . ix cid . crDir) (+ rot) w + | cid == 0 = set randGen g $ over (cWorld . lWorld . cwCam . cwcRot) (+ rot) w + | otherwise = set randGen g $ over (cWorld . lWorld . creatures . ix cid . crDir) (+ rot) w where cid = _crID cr (rot, g) = randomR (- torque, torque) $ _randGen w @@ -663,7 +663,7 @@ repeatOnFrames :: [Int] -> HeldMod -> ChainEffect repeatOnFrames is hm f it cr w = f it cr $ w - & cWorld . delayedEvents .++~ (is <&> (,WdWdFromItCrixWdWd (it & itUse . heldMods .~ hm) (_crID cr) ItCrWdItemEffect)) + & cWorld . lWorld . delayedEvents .++~ (is <&> (,WdWdFromItCrixWdWd (it & itUse . heldMods .~ hm) (_crID cr) ItCrWdItemEffect)) -- where -- f' = fromMaybe w' $ do diff --git a/src/Dodge/Item/Weapon/Utility.hs b/src/Dodge/Item/Weapon/Utility.hs index 2f3fbb324..2d1c4245b 100644 --- a/src/Dodge/Item/Weapon/Utility.hs +++ b/src/Dodge/Item/Weapon/Utility.hs @@ -89,11 +89,11 @@ useForceFieldGun itm cr w = fromMaybe w $ do wlline = (a, b) return $ w - & cWorld . walls %~ IM.insertWith (\_ x -> x) i forceField{_wlID = i} - & cWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID (_itLocation itm)) . itParams . paramMID ?~ i + & cWorld . lWorld . walls %~ IM.insertWith (\_ x -> x) i forceField{_wlID = i} + & cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID (_itLocation itm)) . itParams . paramMID ?~ i & moveWallIDUnsafe i wlline where - i = fromMaybe (IM.newKey (_walls (_cWorld w))) $ itm ^? itParams . paramMID . _Just + i = fromMaybe (IM.newKey (_walls (_lWorld (_cWorld w)))) $ itm ^? itParams . paramMID . _Just -- grapGun = defaultGun -- { _itName = "grapGun" diff --git a/src/Dodge/Lampoid.hs b/src/Dodge/Lampoid.hs index 60a416228..d7059e0a7 100644 --- a/src/Dodge/Lampoid.hs +++ b/src/Dodge/Lampoid.hs @@ -13,19 +13,19 @@ import LensHelp updateLampoid :: Creature -> World -> World updateLampoid cr w = case cr ^?! crType . lampLSID of Nothing -> - let i = IM.newKey (_lightSources (_cWorld w)) - in w & cWorld . lightSources %~ IM.insert i (lsColPosID lcol (addZ h cpos) i) - & cWorld . creatures . ix (_crID cr) . crType . lampLSID ?~ i + let i = IM.newKey (w ^. cWorld . lWorld . lightSources) + in w & cWorld . lWorld . lightSources %~ IM.insert i (lsColPosID lcol (addZ h cpos) i) + & cWorld . lWorld . creatures . ix (_crID cr) . crType . lampLSID ?~ i Just i | _crHP cr < 0 -> w & explosionFlashAt cpos & originsIDsAt [MaterialSound Glass n | n <- [0, 1, 2]] (destroyMatS Glass) cpos - & cWorld . lightSources . at i .~ Nothing - & cWorld . creatures . at cid .~ Nothing + & cWorld . lWorld . lightSources . at i .~ Nothing + & cWorld . lWorld . creatures . at cid .~ Nothing | otherwise -> w - & cWorld . lightSources . ix i . lsParam . lsPos .~ addZ h cpos + & cWorld . lWorld . lightSources . ix i . lsParam . lsPos .~ addZ h cpos & doDamage cr where cpos = _crPos cr diff --git a/src/Dodge/Layout.hs b/src/Dodge/Layout.hs index c98328d9c..881e84e88 100644 --- a/src/Dodge/Layout.hs +++ b/src/Dodge/Layout.hs @@ -42,11 +42,11 @@ generateLevelFromRoomList gr' w = . doIndividualPlacements . setFloors . worldToGenWorld rs' - $ w & cWorld . walls .~ wallsFromRooms rs + $ w & cWorld . lWorld . walls .~ wallsFromRooms rs & cWorld . cwGen . cwgGameRooms .~ gameRoomsFromRooms (IM.elems rs') - & cWorld . pathGraph .~ path - & cWorld . pnZoning .~ foldl' (flip zonePn) mempty (labNodes path) - & cWorld . peZoning .~ foldl' (flip zonePe) mempty (map fromEdgeTuple $ labEdges path) + & cWorld . lWorld . pathGraph .~ path + & cWorld . lWorld . pnZoning .~ foldl' (flip zonePn) mempty (labNodes path) + & cWorld . lWorld . peZoning .~ foldl' (flip zonePe) mempty (map fromEdgeTuple $ labEdges path) where (_, path) = pairsToGraph pairPath' pairPath = foldMap _rmPath rs @@ -58,10 +58,10 @@ fromEdgeTuple :: (Int,Int,PathEdge) -> PathEdgeNodes fromEdgeTuple (a,b,pe) = PathEdgeNodes a b pe randomCompass :: World -> World -randomCompass w = w & cWorld . cwCam . cwcRot .~ (takeOne [0, 0.5 * pi, pi, 1.5 * pi] & evalState $ _randGen w) +randomCompass w = w & cWorld . lWorld . cwCam . cwcRot .~ (takeOne [0, 0.5 * pi, pi, 1.5 * pi] & evalState $ _randGen w) putFloorTiles :: GenWorld -> GenWorld -putFloorTiles gw = gw & gwWorld . cWorld . floorTiles .~ floorsFromGenWorld gw +putFloorTiles gw = gw & gwWorld . cWorld . lWorld . floorTiles .~ floorsFromGenWorld gw setFloors :: GenWorld -> GenWorld setFloors = putFloorTiles . setTiles @@ -139,7 +139,7 @@ setupWorldBounds w = ) where f = fromMaybe 0 - ps = IM.map (fst . _wlLine) $ _walls (_cWorld w) + ps = IM.map (fst . _wlLine) $ w ^. cWorld . lWorld . walls-- _walls (_cWorld w) (minx, maxx, miny, maxy) = L.fold ( (,,,) @@ -154,7 +154,8 @@ setupWorldBounds w = --polyhedrasToEdges = concatMap tflat4 . concatMap polyToEdges initWallZoning :: World -> World -initWallZoning w = foldl' (flip insertWallInZones) (w & cWorld . wlZoning .~ IM.empty) (_walls (_cWorld w)) +initWallZoning w = foldl' (flip insertWallInZones) (w & cWorld . lWorld . wlZoning .~ IM.empty) + (w ^. cWorld . lWorld . walls) --makePath :: Tree Room -> [(Point2,Point2)] --makePath = concatMap _rmPath . flatten diff --git a/src/Dodge/LevelGen.hs b/src/Dodge/LevelGen.hs index d42859ef7..3bb36e176 100644 --- a/src/Dodge/LevelGen.hs +++ b/src/Dodge/LevelGen.hs @@ -31,14 +31,14 @@ generateWorldFromSeed i = do & cWorld . cwGen . cwgSeed .~ i postGenerationProcessing :: World -> World -postGenerationProcessing w = foldl' assignPushDoors w (_doors (_cWorld w)) +postGenerationProcessing w = foldl' assignPushDoors w (w ^. cWorld . lWorld . doors) generateGraphs :: IO () generateGraphs = TIO.writeFile "graph/itemCombinations.gv" combinationsDotGraph assignPushDoors :: World -> Door -> World assignPushDoors w dr = case dr ^?! drPushedBy of - PushedBy i -> w & cWorld . doors . ix i . drPushes ?~ _drID dr + PushedBy i -> w & cWorld . lWorld . doors . ix i . drPushes ?~ _drID dr _ -> w layoutLevelFromSeed :: Int -> Int -> IO (IM.IntMap Room, [ConvexPoly]) diff --git a/src/Dodge/LightSource.hs b/src/Dodge/LightSource.hs index 7a2adc5ec..bd9ca1c94 100644 --- a/src/Dodge/LightSource.hs +++ b/src/Dodge/LightSource.hs @@ -93,21 +93,21 @@ tlsTimeRadColPos t rmax col (V3 x y z) = } makeTlsTimeRadColPos :: Int -> Float -> Point3 -> Point3 -> World -> World -makeTlsTimeRadColPos i rad (V3 r g b) p = cWorld . tempLightSources .:~ tlsTimeRadColPos i rad (V3 r g b) p +makeTlsTimeRadColPos i rad (V3 r g b) p = cWorld . lWorld . tempLightSources .:~ tlsTimeRadColPos i rad (V3 r g b) p destroyLS :: Int -> World -> World destroyLS lsid w = w - & cWorld . lightSources . at lsid .~ Nothing + & cWorld . lWorld . lightSources . at lsid .~ Nothing & destroyLSFlashAt p3 & originsIDsAt [MaterialSound Glass n | n <- [0, 1, 2]] (destroyMatS Glass) (xyV3 p3) where - ls = w ^?! cWorld . lightSources . ix lsid -- unsafe + ls = w ^?! cWorld . lWorld . lightSources . ix lsid -- unsafe p3 = _lsPos $ _lsParam ls destroyLSFlashAt :: Point3 -> World -> World destroyLSFlashAt (V3 x' y' z') = - cWorld . tempLightSources + cWorld . lWorld . tempLightSources .:~ tlsTimeRadFunPos 20 150 diff --git a/src/Dodge/LightSource/Torch.hs b/src/Dodge/LightSource/Torch.hs index b368f250e..834c91148 100644 --- a/src/Dodge/LightSource/Torch.hs +++ b/src/Dodge/LightSource/Torch.hs @@ -8,7 +8,7 @@ import LensHelp createTorchLightOffset :: Creature -> Item -> Point3 -> World -> World createTorchLightOffset cr it off = - cWorld . tempLightSources + cWorld . lWorld . tempLightSources .:~ tlsTimeRadColPos 1 250 diff --git a/src/Dodge/LinearShockwave/Update.hs b/src/Dodge/LinearShockwave/Update.hs index c2e5ecb90..0f0b8c16e 100644 --- a/src/Dodge/LinearShockwave/Update.hs +++ b/src/Dodge/LinearShockwave/Update.hs @@ -7,8 +7,8 @@ import Control.Lens updateLinearShockwave :: LinearShockwave -> World -> World updateLinearShockwave lw w - | t < 1 = w & cWorld . linearShockwaves %~ IM.delete lwid - | otherwise = w & cWorld . linearShockwaves . ix lwid . lwTimer -~ 1 + | t < 1 = w & cWorld . lWorld . linearShockwaves %~ IM.delete lwid + | otherwise = w & cWorld . lWorld . linearShockwaves . ix lwid . lwTimer -~ 1 where lwid = _lwID lw t = _lwTimer lw diff --git a/src/Dodge/Luse.hs b/src/Dodge/Luse.hs index 7e26e3c87..01fa14d02 100644 --- a/src/Dodge/Luse.hs +++ b/src/Dodge/Luse.hs @@ -29,7 +29,8 @@ useTimeScrollGun itm _ w = w & timeFlow .~ ScrollTimeFlow } useRewindGun :: Item -> Creature -> World -> World -useRewindGun _ _ w = w +useRewindGun itm _ w = w & timeFlow .~ RewindLeftClick (itm ^?! itUse . leftConsumption . wpCharge) + --useRewindGun _ _ w = case w ^. cwTime . rewindWorlds of -- [w'] -> w & cwTime . maybeWorld .~ Just' w' -- (w' : ws) -> w @@ -50,7 +51,7 @@ useShrinkGun it cr w = case it ^? itParams . shrinkGunStatus of invid = _ipInvID $ _itLocation it tryResize x g = maybe w g $ sizeSelf x cr w f isInUse cstatus = - cWorld . creatures . ix (_crID cr) . crInv . ix invid + cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix invid %~ ((itParams . shrinkGunStatus .~ isInUse) . (itCurseStatus .~ cstatus)) boostSelfL :: @@ -107,7 +108,7 @@ addBoostShockwave :: World -> World addBoostShockwave pjid p v w = - w & cWorld . linearShockwaves + w & cWorld . lWorld . linearShockwaves %~ IM.insertWith f pjid thePJ where thePJ = diff --git a/src/Dodge/Machine.hs b/src/Dodge/Machine.hs index fa10ad019..c7f2ab18e 100644 --- a/src/Dodge/Machine.hs +++ b/src/Dodge/Machine.hs @@ -24,9 +24,9 @@ machineUpdateLiveDieEff :: machineUpdateLiveDieEff livef dief mc | _mcHP mc < 1 = dief mc - . (cWorld . machines %~ IM.delete mcid) + . (cWorld . lWorld . machines %~ IM.delete mcid) . deleteWallIDs (_mcWallIDs mc) - | otherwise = livef mc . (cWorld . machines . ix mcid %~ ((mcDamage .~ []) . (mcHP -~ dams))) + | otherwise = livef mc . (cWorld . lWorld . machines . ix mcid %~ ((mcDamage .~ []) . (mcHP -~ dams))) where dams = sum $ map _dmAmount $ _mcDamage mc mcid = _mcID mc @@ -39,9 +39,9 @@ machineUpdateDeathEff :: machineUpdateDeathEff f mc | _mcHP mc < 1 = f mc - . (cWorld . machines %~ IM.delete mcid) + . (cWorld . lWorld . machines %~ IM.delete mcid) . deleteWallIDs (_mcWallIDs mc) - | otherwise = cWorld . machines . ix mcid %~ ((mcDamage .~ []) . (mcHP -~ dams)) + | otherwise = cWorld . lWorld . machines . ix mcid %~ ((mcDamage .~ []) . (mcHP -~ dams)) where dams = sum $ map _dmAmount $ _mcDamage mc mcid = _mcID mc diff --git a/src/Dodge/Machine/Damage.hs b/src/Dodge/Machine/Damage.hs index 9aa2d08de..01b07c45d 100644 --- a/src/Dodge/Machine/Damage.hs +++ b/src/Dodge/Machine/Damage.hs @@ -4,7 +4,7 @@ import Dodge.Data.World import LensHelp basicMachineApplyDamage :: Machine -> World -> World -basicMachineApplyDamage mc = cWorld . machines . ix mcid %~ ((mcDamage .~ []) . (mcHP -~ dams)) +basicMachineApplyDamage mc = cWorld . lWorld . machines . ix mcid %~ ((mcDamage .~ []) . (mcHP -~ dams)) where dams = sum $ map _dmAmount $ _mcDamage mc mcid = _mcID mc diff --git a/src/Dodge/Machine/Destroy.hs b/src/Dodge/Machine/Destroy.hs index 4b96d6632..ca98d5cb9 100644 --- a/src/Dodge/Machine/Destroy.hs +++ b/src/Dodge/Machine/Destroy.hs @@ -11,7 +11,7 @@ import LensHelp destroyMachine :: Machine -> World -> World destroyMachine mc = - (cWorld . machines %~ IM.delete (_mcID mc)) + (cWorld . lWorld . machines %~ IM.delete (_mcID mc)) . deleteWallIDs (_mcWallIDs mc) . makeExplosionAt (_mcPos mc) . mcKillTerm mc @@ -26,7 +26,7 @@ destroyMcType mt mc = case mt of mcKillTerm :: Machine -> World -> World mcKillTerm mc w = fromMaybe w $ do tmid <- mc ^? mcMounts . ix ObTerminal - tm <- w ^? cWorld . terminals . ix tmid + tm <- w ^? cWorld . lWorld . terminals . ix tmid return $ w & doTmWdWd (_tmDeathEffect tm) tm @@ -34,4 +34,4 @@ mcKillTerm mc w = fromMaybe w $ do mcKillBut :: Machine -> World -> World mcKillBut mc w = fromMaybe w $ do btid <- mc ^? mcMounts . ix ObButton - return $ w & cWorld . buttons . at btid .~ Nothing + return $ w & cWorld . lWorld . buttons . at btid .~ Nothing diff --git a/src/Dodge/Machine/Update.hs b/src/Dodge/Machine/Update.hs index 3f5c48174..6f669a716 100644 --- a/src/Dodge/Machine/Update.hs +++ b/src/Dodge/Machine/Update.hs @@ -36,7 +36,7 @@ updateTurret rotSpeed mc w = & elecDamBranch where dodamage = - cWorld . machines . ix mcid + cWorld . lWorld . machines . ix mcid %~ ( (mcDamage .~ [Damage ELECTRICAL (min 2500 $ max 0 (elecDam - 10)) 0 0 0 NoDamageEffect]) . (mcHP -~ dam) ) @@ -51,12 +51,12 @@ updateTurret rotSpeed mc w = dam = sum $ map _dmAmount dams elecDam = sum $ map _dmAmount elecDams doTurn - | seesYou = cWorld . machines . ix mcid . mcType . _McTurret . tuDir %~ turnTo rotSpeed mcpos ypos + | seesYou = cWorld . lWorld . machines . ix mcid . mcType . _McTurret . tuDir %~ turnTo rotSpeed mcpos ypos | otherwise = id closeFireAngle = seesYou -- && angleVV (ypos -.- mcpos) (unitVectorAtAngle mcdir) < 1 updateFiringStatus - | closeFireAngle = cWorld . machines . ix mcid . mcType . _McTurret . tuFireTime .~ 20 - | otherwise = cWorld . machines . ix mcid . mcType . _McTurret . tuFireTime %~ (max 0 . subtract 1) + | closeFireAngle = cWorld . lWorld . machines . ix mcid . mcType . _McTurret . tuFireTime .~ 20 + | otherwise = cWorld . lWorld . machines . ix mcid . mcType . _McTurret . tuFireTime %~ (max 0 . subtract 1) mcUseItem :: Machine -> World -> World mcUseItem mc = fromMaybe id $ do @@ -70,7 +70,7 @@ mcSensorTriggerUpdate :: Sensor -> Machine -> World -> World mcSensorTriggerUpdate se mc = fromMaybe id $ do trid <- mc ^? mcMounts . ix ObTrigger bval <- mcTriggerVal se - return $ cWorld . triggers . ix trid ||~ bval + return $ cWorld . lWorld . triggers . ix trid ||~ bval mcTriggerVal :: Sensor -> Maybe Bool mcTriggerVal se = case se of @@ -94,7 +94,7 @@ mcApplyDamage ds mc = case mc ^? mcType . _McSensor of _ -> mcpointer %~ (mcDamage .~ []) where - mcpointer = cWorld . machines . ix (_mcID mc) + mcpointer = cWorld . lWorld . machines . ix (_mcID mc) mcSensorUpdate :: Sensor -> Machine -> World -> World mcSensorUpdate se mc w = case se of @@ -110,13 +110,13 @@ mcProximitySensorUpdate mc w = case ( _proxStatus sens (_, True, _, _) -> w (_, False, True, True) -> w - & cWorld . machines . ix (_mcID mc) . mcType . _McSensor . sensToggle .~ True + & cWorld . lWorld . machines . ix (_mcID mc) . mcType . _McSensor . sensToggle .~ True & playsound dedaS - & cWorld . machines . ix (_mcID mc) . mcType . _McSensor . proxStatus .~ IsClose + & cWorld . lWorld . machines . ix (_mcID mc) . mcType . _McSensor . proxStatus .~ IsClose (NotClose, _, False, True) -> w & playsound dedumS - & cWorld . machines . ix (_mcID mc) . mcType . _McSensor . proxStatus .~ IsClose - (_, _, _, False) -> w & cWorld . machines . ix (_mcID mc) . mcType . _McSensor . proxStatus .~ NotClose + & cWorld . lWorld . machines . ix (_mcID mc) . mcType . _McSensor . proxStatus .~ IsClose + (_, _, _, False) -> w & cWorld . lWorld . machines . ix (_mcID mc) . mcType . _McSensor . proxStatus .~ NotClose _ -> w where playsound sid = soundContinue (MachineAltSound (_mcID mc)) (_mcPos mc) sid Nothing @@ -133,7 +133,7 @@ mcProxTest mc w = case mc ^? mcType . _McSensor . proxRequirement of senseDamage :: Int -> DamageType -> Machine -> World -> World senseDamage threshold dt mc = - (cWorld . machines . ix mcid %~ upmc) + (cWorld . lWorld . machines . ix mcid %~ upmc) . updatels where upmc = mcType . _McSensor . sensAmount %~ min (100 * threshold) . max 0 . (+ newsense) @@ -146,7 +146,7 @@ senseDamage threshold dt mc = ni = fromIntegral (mc ^?! mcType . _McSensor . sensAmount) / fromIntegral threshold updatels = fromMaybe id $ do lsid <- mc ^? mcMounts . ix ObLightSource - return $ cWorld . lightSources . ix lsid . lsParam . lsCol .~ V3 ni ni ni + return $ cWorld . lWorld . lightSources . ix lsid . lsParam . lsCol .~ V3 ni ni ni damageUsing :: DamageType -> Damage -> Either Int Int damageUsing dt dm diff --git a/src/Dodge/ModificationEffect.hs b/src/Dodge/ModificationEffect.hs index 71152bf2e..2ced5b23d 100644 --- a/src/Dodge/ModificationEffect.hs +++ b/src/Dodge/ModificationEffect.hs @@ -7,11 +7,11 @@ import Control.Lens doModificationEffect :: MdWdWd -> Modification -> World -> World doModificationEffect mww = case mww of MdWdId -> const id - MdTrigIf ftrue ffalse -> \md w -> if w ^?! cWorld . triggers . ix (_mdExternalID2 md) + MdTrigIf ftrue ffalse -> \md w -> if w ^?! cWorld . lWorld . triggers . ix (_mdExternalID2 md) then w & doModificationEffect ftrue md else w & doModificationEffect ffalse md -- note this uses the second external ix - MdSetLSCol col -> \md w -> w & cWorld . lightSources . ix (_mdExternalID1 md) . lsParam . lsCol .~ col + MdSetLSCol col -> \md w -> w & cWorld . lWorld . lightSources . ix (_mdExternalID1 md) . lsParam . lsCol .~ col -- note this uses the first external ix, this should be made more -- transparent MdFlickerUpdate -> flickerUpdate diff --git a/src/Dodge/Path.hs b/src/Dodge/Path.hs index d4ecda565..1224fe114 100644 --- a/src/Dodge/Path.hs +++ b/src/Dodge/Path.hs @@ -29,14 +29,16 @@ import Geometry import Data.Bifunctor getNodePos :: Int -> World -> Maybe Point2 -getNodePos i w = _pathGraph (_cWorld w) `lab` i +--getNodePos i w = _pathGraph (_cWorld w) `lab` i +getNodePos i w = (w ^. cWorld . lWorld . pathGraph) `lab` i makePathBetween :: Point2 -> Point2 -> World -> Maybe [Int] makePathBetween a b w = do -- join $ sp <$> a' <*> b' <*> return (_pathGraph w) na <- walkableNodeNear w a nb <- walkableNodeNear w b - sp na nb (second _peDist (efilter (not . pathEdgeObstructed . (^. _3)) $ _pathGraph (_cWorld w))) + sp na nb (second _peDist (efilter (not . pathEdgeObstructed . (^. _3)) $ w ^. cWorld . lWorld . pathGraph)) + --_pathGraph (_cWorld w))) pathEdgeObstructed :: PathEdge -> Bool pathEdgeObstructed pe = DoorObstacle `Set.member` obs || BlockObstacle `Set.member` obs @@ -47,15 +49,17 @@ walkableNodeNear :: World -> Point2 -> Maybe Int {-# INLINE walkableNodeNear #-} walkableNodeNear w p = fmap fst . find (flip (isWalkable p) w . snd) $ nodesNear where - nodesNear = zonesExtract (w ^. cWorld . pnZoning) $ zonesAroundPoint pnZoneSize p + nodesNear = zonesExtract (w ^. cWorld . lWorld . pnZoning) $ zonesAroundPoint pnZoneSize p makePathBetweenPs :: Point2 -> Point2 -> World -> Maybe [Point2] -makePathBetweenPs a b w = mapMaybe (lab $ _pathGraph (_cWorld w)) <$> makePathBetween a b w +--makePathBetweenPs a b w = mapMaybe (lab $ _pathGraph (_cWorld w)) <$> makePathBetween a b w +makePathBetweenPs a b w = mapMaybe (lab $ w ^. cWorld . lWorld . pathGraph) <$> makePathBetween a b w bfsNodePoints :: Int -> World -> [Point2] bfsNodePoints n w = mapMaybe (lab g) $ bfs n g where - g = _pathGraph (_cWorld w) + --g = _pathGraph (_cWorld w) + g = w ^. cWorld . lWorld . pathGraph pointTowardsImpulse :: Point2 -> Point2 -> World -> Maybe Point2 pointTowardsImpulse a b w = (find (flip (isWalkable a) w) . reverse) =<< makePathBetweenPs a b w @@ -134,7 +138,7 @@ addEdges nodemap gr = foldl' f (mempty, gr) obstructPathsCrossing :: EdgeObstacle -> Point2 -> Point2 -> World -> (World, Set PathEdgeNodes) obstructPathsCrossing obstacletype sp' ep w = - ( w & cWorld . pathGraph %~ updateedges + ( w & cWorld . lWorld . pathGraph %~ updateedges , es ) where diff --git a/src/Dodge/Picture/SizeInvariant.hs b/src/Dodge/Picture/SizeInvariant.hs index 3dcda7621..0459d0ca9 100644 --- a/src/Dodge/Picture/SizeInvariant.hs +++ b/src/Dodge/Picture/SizeInvariant.hs @@ -19,9 +19,9 @@ fixedSizePicAt pic p w = . scale theScale theScale $ pic where - campos = w ^. cWorld . cwCam . cwcViewFrom + campos = w ^. cWorld . lWorld . cwCam . cwcViewFrom v = p -.- campos - theScale = 1 / (w ^. cWorld . cwCam . cwcZoom) + theScale = 1 / (w ^. cWorld . lWorld . cwCam . cwcZoom) (V2 x y) = campos +.+ v fixedSizePicClamp :: @@ -41,11 +41,11 @@ fixedSizePicClamp xbord ybord pic p cfig w = . scale theScale theScale $ pic where - r = negate $ w ^. cWorld . cwCam . cwcRot - z = w ^. cWorld . cwCam . cwcZoom - campos = w ^. cWorld . cwCam . cwcViewFrom + r = negate $ w ^. cWorld . lWorld . cwCam . cwcRot + z = w ^. cWorld . lWorld . cwCam . cwcZoom + campos = w ^. cWorld . lWorld . cwCam . cwcViewFrom v = p -.- campos - theScale = 1 / (w ^. cWorld . cwCam . cwcZoom) + theScale = 1 / (w ^. cWorld . lWorld . cwCam . cwcZoom) (V2 x y) = campos +.+ rotateV (negate r) (V2 xr' yr') (V2 xr yr) = rotateV r v xr' = absClamp ((halfWidth cfig - fromIntegral xbord) / z) xr @@ -75,8 +75,8 @@ fixedSizePicClampArrow xbord ybord pic p cfig w = Nothing -> blank Just bp -> thickLine 5 [bp, fromMaybe p windowPoint] (V2 x y) = fromMaybe p borderPoint - campos = w ^. cWorld . cwCam . cwcCenter - theScale = 1 / (w ^. cWorld . cwCam . cwcZoom) + campos = w ^. cWorld . lWorld . cwCam . cwcCenter + theScale = 1 / (w ^. cWorld . lWorld . cwCam . cwcZoom) absClamp :: -- | clamping value, assumed positive diff --git a/src/Dodge/Placement/Instance/LightSource/Flicker.hs b/src/Dodge/Placement/Instance/LightSource/Flicker.hs index 0c6eefeb1..5fe981f71 100644 --- a/src/Dodge/Placement/Instance/LightSource/Flicker.hs +++ b/src/Dodge/Placement/Instance/LightSource/Flicker.hs @@ -23,14 +23,14 @@ flickerMod pl = flickerUpdate :: Modification -> World -> World flickerUpdate md w - | _mdTimer md > 0 = w & cWorld . modifications . ix mdid . mdTimer -~ 1 + | _mdTimer md > 0 = w & cWorld . lWorld . modifications . ix mdid . mdTimer -~ 1 | otherwise = - w & cWorld . lightSources . ix lsid . lsParam . lsCol .~ mdcol - & cWorld . modifications . ix mdid + w & cWorld . lWorld . lightSources . ix lsid . lsParam . lsCol .~ mdcol + & cWorld . lWorld . modifications . ix mdid %~ ((mdTimer .~ newtime) . (mdPoint3 .~ lscol) . (mdBool %~ not)) where mdcol = _mdPoint3 md - lscol = w ^?! cWorld . lightSources . ix lsid . lsParam . lsCol -- _lsCol $ _lsParam $ _lightSources w IM.! lsid + lscol = w ^?! cWorld . lWorld . lightSources . ix lsid . lsParam . lsCol -- _lsCol $ _lsParam $ _lightSources w IM.! lsid lsid = _mdExternalID md mdid = _mdID md timerange diff --git a/src/Dodge/Placement/Instance/Terminal.hs b/src/Dodge/Placement/Instance/Terminal.hs index d2e6d8a3a..9bfeb5df2 100644 --- a/src/Dodge/Placement/Instance/Terminal.hs +++ b/src/Dodge/Placement/Instance/Terminal.hs @@ -31,10 +31,10 @@ putTerminal mc tm = where setids tmpl btpl mcpl w = w - & cWorld . terminals . ix tmid . tmButtonID .~ btid - & cWorld . terminals . ix tmid . tmMachineID .~ mcid - & cWorld . machines . ix mcid . mcMounts . at ObTerminal ?~ tmid - & cWorld . buttons . ix btid . btTermMID ?~ tmid + & cWorld . lWorld . terminals . ix tmid . tmButtonID .~ btid + & cWorld . lWorld . terminals . ix tmid . tmMachineID .~ mcid + & cWorld . lWorld . machines . ix mcid . mcMounts . at ObTerminal ?~ tmid + & cWorld . lWorld . buttons . ix btid . btTermMID ?~ tmid where tmid = fromJust (_plMID tmpl) btid = fromJust (_plMID btpl) diff --git a/src/Dodge/Placement/PlaceSpot.hs b/src/Dodge/Placement/PlaceSpot.hs index bfe33322b..3ac783b40 100644 --- a/src/Dodge/Placement/PlaceSpot.hs +++ b/src/Dodge/Placement/PlaceSpot.hs @@ -94,21 +94,21 @@ placeSpotID ps pt gw = -- the Int here is some id that is assigned when the placement is placed placeSpotID' :: PlacementSpot -> PSType -> World -> (Int, World) placeSpotID' ps pt w = case pt of - PutTrigger cnd -> plNewID (cWorld . triggers) cnd w - PutMod mdi -> plNewUpID (cWorld . modifications) mdID mdi w - PutProp prp -> plNewUpID (cWorld . props) prID (mvProp p rot prp) w - PutButton bt -> plNewUpID (cWorld . buttons) btID (mvButton p rot bt) w - PutTerminal tm -> plNewUpID (cWorld . terminals) tmID tm w - PutFlIt itm -> plNewUpID (cWorld . floorItems) flItID (createFlIt p rot itm) w - PutCrit cr -> plNewUpID (cWorld . creatures) crID (mvCr p rot cr) w - PutForeground fs -> plNewUpID (cWorld . foregroundShapes) fsID (mvFS p rot fs) w - PutDecoration pic -> plNewID (cWorld . decorations) (shiftDec p rot pic) w + PutTrigger cnd -> plNewID (cWorld . lWorld . triggers) cnd w + PutMod mdi -> plNewUpID (cWorld . lWorld . modifications) mdID mdi w + PutProp prp -> plNewUpID (cWorld . lWorld . props) prID (mvProp p rot prp) w + PutButton bt -> plNewUpID (cWorld . lWorld . buttons) btID (mvButton p rot bt) w + PutTerminal tm -> plNewUpID (cWorld . lWorld . terminals) tmID tm w + PutFlIt itm -> plNewUpID (cWorld . lWorld . floorItems) flItID (createFlIt p rot itm) w + PutCrit cr -> plNewUpID (cWorld . lWorld . creatures) crID (mvCr p rot cr) w + PutForeground fs -> plNewUpID (cWorld . lWorld . foregroundShapes) fsID (mvFS p rot fs) w + PutDecoration pic -> plNewID (cWorld . lWorld . decorations) (shiftDec p rot pic) w PutMachine pps mc wl -> plMachine (map doShift pps) mc wl p rot w - PutLS ls -> plNewUpID (cWorld . lightSources) lsID (mvLS p' rot ls) w - PutPPlate pp -> plNewUpID (cWorld . pressPlates) ppID (mvPP p rot pp) w + PutLS ls -> plNewUpID (cWorld . lWorld . lightSources) lsID (mvLS p' rot ls) w + PutPPlate pp -> plNewUpID (cWorld . lWorld . pressPlates) ppID (mvPP p rot pp) w RandPS rgn -> evaluateRandPS rgn ps w PutDoor col eo f pss -> plDoor col eo f (map (bimap doShift doShift) pss) w - PutCoord cp -> plNewID (cWorld . coordinates) (doShift cp) w + PutCoord cp -> plNewID (cWorld . lWorld . coordinates) (doShift cp) w PutSlideDr wl dr eo off a b -> plSlideDoor wl dr eo off (doShift a) (doShift b) w PutBlock bl wl ps' -> @@ -160,7 +160,7 @@ placeWallPoly qs wl w = foldl' (addPane wl) w pairs addPane :: Wall -> World -> (Point2, Point2) -> World --addPane wl w l = w & walls %~ IM.insert wlid (wl { _wlLine = l, _wlID = wlid }) addPane wl w l = - w & plNew (cWorld . walls) wlID (wl & wlLine .~ l) + w & plNew (cWorld . lWorld . walls) wlID (wl & wlLine .~ l) & fst . uncurry (obstructPathsCrossing WallObstacle) l -- where @@ -188,14 +188,13 @@ mvFS p a = (fsDir +~ a) . (fsPos %~ ((p +.+) . rotateV a)) plMachine :: [Point2] -> Machine -> Wall -> Point2 -> Float -> World -> (Int, World) plMachine wallpoly mc wl p rot gw = ( mcid - , gw & cWorld . machines %~ addMc - & cWorld . walls %~ placeMachineWalls wl col wallpoly mcid wlid + , gw & cWorld . lWorld . machines %~ addMc + & cWorld . lWorld . walls %~ placeMachineWalls wl col wallpoly mcid wlid ) where col = _mcColor mc - w' = gw - mcid = IM.newKey $ _machines (_cWorld w') - wlid = IM.newKey $ _walls (_cWorld w') + mcid = IM.newKey $ gw ^. cWorld . lWorld . machines + wlid = IM.newKey $ gw ^. cWorld . lWorld . walls wlids = IS.fromList [wlid .. wlid + length wallpoly - 1] --addMc = IM.insert mcid (mc {_mcPos = centroid wallpoly,_mcDir = rot,_mcID = mcid, _mcWallIDs = wlids}) addMc = IM.insert mcid (mc{_mcPos = p, _mcDir = rot, _mcID = mcid, _mcWallIDs = wlids}) diff --git a/src/Dodge/Placement/PlaceSpot/Block.hs b/src/Dodge/Placement/PlaceSpot/Block.hs index a98c53a4f..c06ee7d1d 100644 --- a/src/Dodge/Placement/PlaceSpot/Block.hs +++ b/src/Dodge/Placement/PlaceSpot/Block.hs @@ -27,7 +27,7 @@ plBlock [] _ _ _ = error "Trying to add a block with incomplete polygon" plBlock (p : ps) bl wl w = (,) blid $ w - & cWorld . blocks . at blid + & cWorld . lWorld . blocks . at blid ?~ bl { _blID = blid , _blWallIDs = IS.fromList is @@ -36,9 +36,9 @@ plBlock (p : ps) bl wl w = } & insertWalls blid wls where - blid = IM.newKey $ _blocks (_cWorld w) + blid = IM.newKey $ w ^. cWorld . lWorld . blocks lns = zip (p : ps) (ps ++ [p]) - i = IM.newKey $ _walls (_cWorld w) + i = IM.newKey $ w ^. cWorld . lWorld . walls is = [i .. i + length lns -1] wls = zipWith @@ -72,12 +72,12 @@ plLineBlock basePane blwidth a b gw = cornerPoints = reverse $ rectWH halfBlockWidth depth -- goes clockwise around the block cornersAt p = fmap ((p +.+) . rotateV (argV (b -.- a))) cornerPoints linesAt p = loopPairs $ cornersAt p - wlid = IM.newKey $ _walls (_cWorld gw) - blid = IM.newKey $ _blocks (_cWorld gw) + wlid = IM.newKey $ gw ^. cWorld . lWorld . walls + blid = IM.newKey $ gw ^. cWorld . lWorld . blocks insertBlock (i, p) = insertWalls (i + blid) (makeWallAt p i) . over - (cWorld . blocks) + (cWorld . lWorld . blocks) ( IM.insert (i + blid) Block @@ -115,11 +115,11 @@ plLineBlock basePane blwidth a b gw = -- | Must be done after inserting the block insertWalls :: Int -> [Wall] -> World -> World -insertWalls blid wls w = w' & cWorld . blocks . ix blid . blObstructs .~ Set.unions paths +insertWalls blid wls w = w' & cWorld . lWorld . blocks . ix blid . blObstructs .~ Set.unions paths where (w', paths) = mapAccumR (flip insertWall) w wls insertWall :: Wall -> World -> (World, Set PathEdgeNodes) insertWall wl = uncurry (obstructPathsCrossing BlockObstacle) (_wlLine wl) - . (cWorld . walls . at (_wlID wl) ?~ wl) + . (cWorld . lWorld . walls . at (_wlID wl) ?~ wl) diff --git a/src/Dodge/Placement/PlaceSpot/TriggerDoor.hs b/src/Dodge/Placement/PlaceSpot/TriggerDoor.hs index d4ec852b0..ba39a8483 100644 --- a/src/Dodge/Placement/PlaceSpot/TriggerDoor.hs +++ b/src/Dodge/Placement/PlaceSpot/TriggerDoor.hs @@ -29,9 +29,9 @@ plDoor :: [(Point2, Point2)] -> World -> (Int, World) -plDoor col eo cond pss gw = (drid, addWalls $ gw & cWorld . doors %~ addDoor) -- carefull with the ordering of addWalls +plDoor col eo cond pss gw = (drid, addWalls $ gw & cWorld . lWorld . doors %~ addDoor) -- carefull with the ordering of addWalls where - drid = IM.newKey $ _doors (_cWorld gw) + drid = IM.newKey $ _doors (_lWorld (_cWorld gw)) addDoor = IM.insert drid $ defaultDoor @@ -46,14 +46,14 @@ plDoor col eo cond pss gw = (drid, addWalls $ gw & cWorld . doors %~ addDoor) -- , _drObstacleType = eo } nsteps = length pss - 1 - wlids = take 4 [IM.newKey $ _walls (_cWorld gw) ..] + wlids = take 4 [IM.newKey $ _walls (_lWorld (_cWorld gw)) ..] wlps' = uncurry (rectanglePairs 9) $ head pss addWalls w' = foldl' (addDoorWall eo drid $ switchWallCol col) w' $ zip wlids wlps' addDoorWall :: EdgeObstacle -> Int -> Wall -> World -> (Int, (Point2, Point2)) -> World addDoorWall eo drid wl w (wlid, wlps) = w' - & cWorld . walls + & cWorld . lWorld . walls %~ IM.insert wlid wl @@ -61,7 +61,7 @@ addDoorWall eo drid wl w (wlid, wlps) = , _wlID = wlid , _wlStructure = DoorPart drid } - & cWorld . doors . ix drid . drObstructs <>~ es + & cWorld . lWorld . doors . ix drid . drObstructs <>~ es where (w', es) = uncurry (obstructPathsCrossing eo) wlps w @@ -71,9 +71,9 @@ maybeClearDoorPaths eo es w = foldl' (maybeClearDoorPath eo) w es maybeClearDoorPath :: EdgeObstacle -> World -> PathEdgeNodes -> World maybeClearDoorPath eo w (PathEdgeNodes x y pe) | not . null $ overlapSegWalls (_peStart pe) (_peEnd pe) $ wlsNearSeg (_peStart pe) (_peEnd pe) w = - w & cWorld . pathGraph %~ FGL.insEdge (x, y, pe & peObstacles . at eo ?~ ()) . FGL.delEdge (x, y) + w & cWorld . lWorld . pathGraph %~ FGL.insEdge (x, y, pe & peObstacles . at eo ?~ ()) . FGL.delEdge (x, y) | otherwise = - w & cWorld . pathGraph %~ FGL.insEdge (x, y, pe & peObstacles . at eo .~ Nothing) . FGL.delEdge (x, y) + w & cWorld . lWorld . pathGraph %~ FGL.insEdge (x, y, pe & peObstacles . at eo .~ Nothing) . FGL.delEdge (x, y) plSlideDoor :: Door -> @@ -85,9 +85,9 @@ plSlideDoor :: World -> (Int, World) plSlideDoor dr wl eo shiftOffset a b gw = - (drid, addDoorWalls $ gw & cWorld . doors %~ addDoor) + (drid, addDoorWalls $ gw & cWorld . lWorld . doors %~ addDoor) where - drid = IM.newKey $ _doors (_cWorld gw) + drid = IM.newKey $ _doors (_lWorld (_cWorld gw)) addDoor = IM.insert drid $ dr @@ -103,7 +103,7 @@ plSlideDoor dr wl eo shiftOffset a b gw = addDoorWalls w' = foldl' (addDoorWall eo drid wl) w' $ zip wlids pairs pairs = rectanglePairs 9 a b shiftLeft = (+.+ (a -.- b +.+ shiftOffset *.* normalizeV (b -.- a))) - wlids = take 4 [IM.newKey $ _walls (_cWorld gw) ..] + wlids = take 4 [IM.newKey $ _walls (_lWorld (_cWorld gw)) ..] -- old code that may help with pathing --import Dodge.LevelGen.Pathing diff --git a/src/Dodge/Projectile/Create.hs b/src/Dodge/Projectile/Create.hs index 8a9f0894a..81d06519d 100644 --- a/src/Dodge/Projectile/Create.hs +++ b/src/Dodge/Projectile/Create.hs @@ -29,7 +29,7 @@ fireShell it cr = makeShell :: Item -> Creature -> [ProjectileUpdate] -> World -> World makeShell it cr theupdate w = - w & cWorld . projectiles . at i + w & cWorld . lWorld . projectiles . at i ?~ Shell { _prjPos = pos , _prjZ = 20 @@ -46,7 +46,7 @@ makeShell it cr theupdate w = , _prjMITID = Just $ _itID it } where - i = IM.newKey $ _props (_cWorld w) + i = IM.newKey $ w ^. cWorld . lWorld . props-- _props (_cWorld w) dir = _crDir cr pos = _crPos cr +.+ rotateV dir (V2 (_crRad cr + 1) 0) am = _heldConsumption $ _itUse it diff --git a/src/Dodge/Projectile/Update.hs b/src/Dodge/Projectile/Update.hs index 3944210e9..8e381bdb4 100644 --- a/src/Dodge/Projectile/Update.hs +++ b/src/Dodge/Projectile/Update.hs @@ -48,7 +48,7 @@ plainShellCollisionCheck :: Proj -> World -> World plainShellCollisionCheck = shellCollisionCheck $ \pj -> usePayload (_prjPayload pj) (_prjPos pj) . stopSoundFrom (ShellSound (_prjID pj)) - . (cWorld . projectiles %~ IM.delete (_prjID pj)) + . (cWorld . lWorld . projectiles %~ IM.delete (_prjID pj)) upsProjectile :: Proj -> World -> World upsProjectile pj w' = foldr (`upProjectile` pj) w' (_prjUpdates pj) @@ -73,7 +73,7 @@ upProjectile pu pj = case pu of | otherwise -> id PJSetScope itid -> setRemoteScope itid (_prjPos pj) PJRetireRemote itid 0 pjid -> retireRemoteProj itid pjid - PJRetireRemote _ _ pjid -> cWorld . projectiles . ix pjid . prjUpdates . ix 0 . pjuTimer -~ 1 + PJRetireRemote _ _ pjid -> cWorld . lWorld . projectiles . ix pjid . prjUpdates . ix 0 . pjuTimer -~ 1 where time = _prjTimer pj act st et = time <= st && time >= et @@ -82,29 +82,29 @@ upProjectile pu pj = case pu of retireRemoteProj :: Int -> Int -> World -> World retireRemoteProj itid pjid w = w - & pointerToItemLocation (_itemLocations (_cWorld w) IM.! itid) + & pointerToItemLocation (w ^?! cWorld . lWorld . itemLocations . ix itid) %~ ( (itScope . scopePos .~ V2 0 0) . (itUse . heldUse .~ HeldFireRemoteShell) ) - & cWorld . props %~ IM.delete pjid + & cWorld . lWorld . props %~ IM.delete pjid setRemoteDir :: Int -> Int -> Proj -> World -> World -setRemoteDir cid itid pj w = w & cWorld . projectiles . ix (_prjID pj) . prjAcc .~ turntonewdir +setRemoteDir cid itid pj w = w & cWorld . lWorld . projectiles . ix (_prjID pj) . prjAcc .~ turntonewdir where turntonewdir = magV (_prjAcc pj) *.* unitVectorAtAngle newdir --i = _prjID pj newdir | SDL.ButtonRight `M.member` _mouseButtons w - && w ^? cWorld . creatures . ix cid . crInvSel . iselPos - == w ^? cWorld . itemLocations . ix itid . ipInvID - = (w ^. cWorld . cwCam . cwcRot) + argV (_mousePos w) + && w ^? cWorld . lWorld . creatures . ix cid . crInvSel . iselPos + == w ^? cWorld . lWorld . itemLocations . ix itid . ipInvID + = (w ^. cWorld . lWorld . cwCam . cwcRot) + argV (_mousePos w) | otherwise = _prjDir pj doThrust :: Proj -> World -> World doThrust pj w = w & randGen .~ g - & cWorld . projectiles . ix i . prjVel %~ (\v -> accel +.+ frict *.* v) + & cWorld . lWorld . projectiles . ix i . prjVel %~ (\v -> accel +.+ frict *.* v) & soundContinue (ShellSound i) newPos missileLaunchS (Just 1) & makeFlamelet (oldPos -.- vel) 0 (vel +.+ rotateV (pi + sparkD) accel) 3 10 & shellTrailCloud (addZ 20 (oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos))) @@ -126,11 +126,11 @@ trySpinByCID :: Proj -> World -> World -trySpinByCID cid i pj w = w & cWorld . projectiles . ix pjid . prjSpin .~ newSpin +trySpinByCID cid i pj w = w & cWorld . lWorld . projectiles . ix pjid . prjSpin .~ newSpin where pjid = _prjID pj dir = argV $ _prjVel pj - newSpin = case w ^? cWorld . creatures . ix cid of + newSpin = case w ^? cWorld . lWorld . creatures . ix cid of Just cr -> negate $ min 0.2 $ max (-0.2) $ normalizeAnglePi (dir - _crDir cr) / spinFactor _ -> 0 spinFactor = 5 * (6 - fromIntegral i) @@ -141,13 +141,13 @@ pjTrack itid pj w = rotateToTarget pj w rotateToTarget _ = fromMaybe id $ do tpos <- w ^? itPoint . itTargeting . tgPos . _Just return $ - cWorld . projectiles . ix (_prjID pj) . prjSpin + cWorld . lWorld . projectiles . ix (_prjID pj) . prjSpin .~ turnToAmount 0.15 (_prjPos pj) tpos (argV $ _prjAcc pj) - itPoint = pointerToItemLocation $ _itemLocations (_cWorld w) IM.! itid + itPoint = pointerToItemLocation $ w ^?! cWorld . lWorld . itemLocations . ix itid reduceSpinBy :: Float -> Proj -> World -> World -reduceSpinBy x pj = cWorld . projectiles . ix (_prjID pj) . prjSpin *~ x +reduceSpinBy x pj = cWorld . lWorld . projectiles . ix (_prjID pj) . prjSpin *~ x diff --git a/src/Dodge/Prop/Gib.hs b/src/Dodge/Prop/Gib.hs index 45d6f6c94..6d95e2daa 100644 --- a/src/Dodge/Prop/Gib.hs +++ b/src/Dodge/Prop/Gib.hs @@ -79,7 +79,7 @@ addGib4 :: World addGib4 p col (v, zs, q, h) = plNew - (cWorld . props) + (cWorld . lWorld . props) prID ( aGib & prPos .~ p +.+ (5 *.* normalizeV v) & prColor .~ col @@ -93,7 +93,7 @@ addGib4 p col (v, zs, q, h) = addGibAt :: Float -> Color -> Point2 -> World -> World addGibAt h col p w = w - & plNew (cWorld . props) prID gib + & plNew (cWorld . lWorld . props) prID gib & randGen .~ newg where (gib, newg) = runState f $ _randGen w @@ -116,7 +116,7 @@ addGibAt h col p w = addGibAtDir :: Float -> Float -> Color -> Point2 -> World -> World addGibAtDir dir h col p w = w - & plNew (cWorld . props) prID gib + & plNew (cWorld . lWorld . props) prID gib & randGen .~ newg where (gib, newg) = runState f $ _randGen w diff --git a/src/Dodge/Prop/Moving.hs b/src/Dodge/Prop/Moving.hs index a65cf4b34..ac70bc848 100644 --- a/src/Dodge/Prop/Moving.hs +++ b/src/Dodge/Prop/Moving.hs @@ -12,12 +12,12 @@ fallSmallBounceDamage :: Prop -> World -> World fallSmallBounceDamage pr w = w & dodamage - & cWorld . props . ix (_prID pr) %~ fallSmallBounce' w + & cWorld . lWorld . props . ix (_prID pr) %~ fallSmallBounce' w where p = _prPos pr v = _prVel pr dodamage - | _prPosZ pr < 25 = cWorld . creatures %~ fmap dodamage' + | _prPosZ pr < 25 = cWorld . lWorld . creatures %~ fmap dodamage' | otherwise = id dodamage' cr | dist (_crPos cr) p < _crRad cr + 5 = @@ -28,7 +28,7 @@ fallSmallBounceDamage pr w = fallSmallBounce :: Prop -> World -> World fallSmallBounce pr w = w - & cWorld . props . ix (_prID pr) %~ fallSmallBounce' w + & cWorld . lWorld . props . ix (_prID pr) %~ fallSmallBounce' w fallSmallBounce' :: World -> Prop -> Prop fallSmallBounce' w pr diff --git a/src/Dodge/Prop/Update.hs b/src/Dodge/Prop/Update.hs index e5018fcc4..f96d0355c 100644 --- a/src/Dodge/Prop/Update.hs +++ b/src/Dodge/Prop/Update.hs @@ -16,7 +16,7 @@ updateProp pr = case _prUpdate pr of PropRotate x -> rotateProp x pr PropSetToggleAnd wb pu -> propSetToggleAnd wb pu pr PropUpdates pus -> doPropUpdates pr pus - PropUpdateLS lsid x -> \w -> w & cWorld . lightSources . ix lsid %~ doPrWdLsLs x pr w + PropUpdateLS lsid x -> \w -> w & cWorld . lWorld . lightSources . ix lsid %~ doPrWdLsLs x pr w PropUpdatePosition x -> propUpdatePosition x pr PropUpdateWhen t x -> propUpdateIf t x PropUpdateId pr PropUpdateAnd x y -> doPropUpdates pr [x, y] @@ -30,8 +30,8 @@ propUpdateIf wb x y pr w propUpdatePosition :: WdP2f -> Prop -> World -> World propUpdatePosition x pr w = w - & cWorld . props . ix (_prID pr) . prPos .~ fst (doWdP2f x w) - & cWorld . props . ix (_prID pr) . prRot .~ snd (doWdP2f x w) + & cWorld . lWorld . props . ix (_prID pr) . prPos .~ fst (doWdP2f x w) + & cWorld . lWorld . props . ix (_prID pr) . prRot .~ snd (doWdP2f x w) doPropUpdates :: Prop -> [PropUpdate] -> World -> World doPropUpdates pr pus w = foldl' f w pus @@ -44,9 +44,9 @@ propSetToggleAnd wb pu pr = setToggle (doWdBl wb) pr . updateProp (pr & prUpdate -- fugly setToggle :: (World -> Bool) -> Prop -> World -> World -setToggle cond pr w = w & cWorld . props . ix (_prID pr) . prToggle .~ cond w +setToggle cond pr w = w & cWorld . lWorld . props . ix (_prID pr) . prToggle .~ cond w rotateProp :: Float -> Prop -> World -> World rotateProp rotAmount pr w = w - & cWorld . props . ix (_prID pr) . prRot +~ rotAmount + & cWorld . lWorld . props . ix (_prID pr) . prRot +~ rotAmount diff --git a/src/Dodge/RadarSweep.hs b/src/Dodge/RadarSweep.hs index 79cd303fc..0c8124589 100644 --- a/src/Dodge/RadarSweep.hs +++ b/src/Dodge/RadarSweep.hs @@ -13,7 +13,7 @@ import LensHelp aRadarPulse :: ObjectType -> Creature -> World -> World aRadarPulse ob cr = - cWorld . radarSweeps + cWorld . lWorld . radarSweeps .:~ RadarSweep { _rsTimer = 100 , _rsRad = 0 @@ -35,7 +35,7 @@ updateRadarSweep w pt blipsF = findBlips ob bf = makeBlip ob x = _rsTimer pt - putBlips = cWorld . radarBlips .++~ blips + putBlips = cWorld . lWorld . radarBlips .++~ blips blips = map bf circPoints circPoints = blipsF p r w r = fromIntegral (400 - x * 4) @@ -66,13 +66,13 @@ blipAt r col i p = } crBlips :: Point2 -> Float -> World -> [Point2] -crBlips p r = IM.elems . IM.filter f . fmap _crPos . IM.filter g . _creatures . _cWorld +crBlips p r = IM.elems . IM.filter f . fmap _crPos . IM.filter g . _creatures . _lWorld . _cWorld where f q = dist p q <= r && dist p q > r - 100 g cr = _crID cr /= 0 itemBlips :: Point2 -> Float -> World -> [Point2] -itemBlips p r = IM.elems . IM.filter f . fmap _flItPos . _floorItems . _cWorld +itemBlips p r = IM.elems . IM.filter f . fmap _flItPos . _floorItems . _lWorld . _cWorld where f q = dist p q <= r && dist p q > r - 4 diff --git a/src/Dodge/Reloading.hs b/src/Dodge/Reloading.hs index 9b8a1f201..2946b091c 100644 --- a/src/Dodge/Reloading.hs +++ b/src/Dodge/Reloading.hs @@ -40,13 +40,13 @@ tryNextLoadAction cr = case cr ^? crInv . ix (crSel cr) . itUse . heldConsumptio crToggleReloading :: Creature -> World -> World crToggleReloading cr w = case cr ^?! crInvSel . iselAction of - ReloadAction{} -> w & cWorld . creatures . ix (_crID cr) . crInvSel . iselAction .~ NoInvSelAction - _ -> w & cWorld . creatures . ix (_crID cr) %~ tryStartLoading + ReloadAction{} -> w & cWorld . lWorld . creatures . ix (_crID cr) . crInvSel . iselAction .~ NoInvSelAction + _ -> w & cWorld . lWorld . creatures . ix (_crID cr) %~ tryStartLoading crHoldReloading :: Creature -> World -> World crHoldReloading cr w = w - & cWorld . creatures . ix (_crID cr) . crInvSel . iselAction . actionHammer .~ HasHammer HammerDown + & cWorld . lWorld . creatures . ix (_crID cr) . crInvSel . iselAction . actionHammer .~ HasHammer HammerDown tryStartLoading :: Creature -> Creature tryStartLoading cr = case ic ^? laProgress . _Just . ix 0 of diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs index 21224bbea..c71b983aa 100644 --- a/src/Dodge/Render.hs +++ b/src/Dodge/Render.hs @@ -32,14 +32,14 @@ doDrawing pdata u = do sTicks <- SDL.ticks let w = _uvWorld u cfig = _uvConfig u - rot = w ^. cWorld . cwCam . cwcRot - camzoom = w ^. cWorld . cwCam . cwcZoom - trans = w ^. cWorld . cwCam . cwcCenter + rot = w ^. cWorld . lWorld . cwCam . cwcRot + camzoom = w ^. cWorld . lWorld . cwCam . cwcZoom + trans = w ^. cWorld . lWorld . cwCam . cwcCenter wins@(V2 winx winy) = V2 (_windowX cfig) (_windowY cfig) resFact = resFactorNum $ cfig ^. graphics_resolution_factor (wallPointsCol, windowPoints, wallSPics) = wallsToDraw w lightPoints = lightsToRender cfig w - viewFroms@(V2 vfx vfy) = w ^. cWorld . cwCam . cwcViewFrom + viewFroms@(V2 vfx vfy) = w ^. cWorld . lWorld . cwCam . cwcViewFrom viewFrom3d = Vector3 vfx vfy 20 shadV = _pictureShaders pdata lwShad = _lightingWallShadShader pdata @@ -63,7 +63,7 @@ doDrawing pdata u = do (shadVBOptr $ _textureArrayShader pdata) wallPointsCol windowPoints - (_floorTiles (_cWorld w)) + (w ^. cWorld . lWorld . floorTiles) ) ( pokeShape (_vboPtr $ _vaoVBO $ _shadVAO $ _shapeShader pdata) @@ -254,7 +254,7 @@ doDrawing pdata u = do depthFunc $= Just Always blendFunc $= (One, Zero) -- perform any radial distortion - case _distortions (_cWorld w) of + case w ^. cWorld . lWorld . distortions of [] -> do bindTO $ fst $ snd $ _fboBase pdata bindFramebuffer Framebuffer $= defaultFramebufferObject diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index 46d243e3d..35978107c 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -27,7 +27,7 @@ import Picture import SDL (MouseButton (..)) hudDrawings :: Universe -> Picture -hudDrawings uv = case _hudElement $ _hud (_cWorld w) of +hudDrawings uv = case w ^. cWorld . lWorld . hud . hudElement of DisplayCarte -> drawCarte cfig w DisplayInventory subinv -> drawInGameHUD uv @@ -55,7 +55,7 @@ inventoryDisplay cfig w = listPicturesAt 0 0 cfig invlist invlist = concatMap (itemText' cr) (IM.toList inv) ++ displayFreeSlots - ++ concatMap (closeObjectToTextPictures nfreeslots) (_closeObjects (_cWorld w)) + ++ concatMap (closeObjectToTextPictures nfreeslots) (w ^. cWorld . lWorld . closeObjects) -- ++ map floorItemsColor (concatMap (closeObjectToTextPictures nfreeslots) (_closeObjects w)) -- floorItemsColor = case _hudElement (_hud w) of -- DisplayInventory NoSubInventory -> id @@ -162,7 +162,7 @@ itmInfo mit = fromMaybe [] $ do displayTerminal :: Int -> Configuration -> World -> Picture displayTerminal tid cfig w = fromMaybe mempty $ do - tm <- w ^? cWorld . terminals . ix tid + tm <- w ^? cWorld . lWorld . terminals . ix tid return $ pictures [ invHead cfig (_tmTitle tm ++ ":T" ++ show tid) @@ -332,9 +332,9 @@ drawCarte cfig w = ++ mapOverlay cfig w ++ [mainListCursor white iPos cfig] where - iPos = _selLocation (_cWorld w) - locs = map (\(_, s) -> (s, white)) . IM.elems . _seenLocations $ _cWorld w - locPoss = map (cartePosToScreen cfig w . ($ w) . doWorldPos . fst) . IM.elems . _seenLocations $ _cWorld w + iPos = w ^. cWorld . lWorld . selLocation + locs = map (\(_, s) -> (s, white)) . IM.elems . _seenLocations . _lWorld $ _cWorld w + locPoss = map (cartePosToScreen cfig w . ($ w) . doWorldPos . fst) . IM.elems . _seenLocations . _lWorld $ _cWorld w locTexts = map fst locs displayListEndCoords :: Configuration -> [String] -> [Point2] @@ -348,7 +348,7 @@ displayListEndCoords cfig ss = map (doWindowScale cfig) $ zipWith h ss $ map f [ mapOverlay :: Configuration -> World -> [Picture] mapOverlay cfig w = (color (withAlpha 0.5 black) . polygon $ reverse $ rectNSWE 1 (-1) 1 (-1)) : - (mapMaybe (mapWall cfig w) . IM.elems $ _walls (_cWorld w)) + (mapMaybe (mapWall cfig w) . IM.elems $ w ^. cWorld . lWorld . walls) mapWall :: Configuration -> World -> Wall -> Maybe Picture mapWall cfig w wl = @@ -445,5 +445,4 @@ displayHP cid cfig w = . text . leftPad 5 ' ' . show - . _crHP - $ _creatures (_cWorld w) IM.! cid + $ w ^?! cWorld . lWorld . creatures . ix cid . crHP diff --git a/src/Dodge/Render/Lights.hs b/src/Dodge/Render/Lights.hs index b37ba97aa..7a0071fb5 100644 --- a/src/Dodge/Render/Lights.hs +++ b/src/Dodge/Render/Lights.hs @@ -10,13 +10,13 @@ import Control.Lens lightsToRender :: Configuration -> World -> [(Point3, Float, Point3)] lightsToRender cfig w = - mapMaybe getLS (IM.elems $ _lightSources (_cWorld w)) - ++ mapMaybe getTLS (_tempLightSources (_cWorld w)) + mapMaybe getLS (IM.elems $ w ^. cWorld . lWorld . lightSources) + ++ mapMaybe getTLS (w ^. cWorld . lWorld . tempLightSources) where getLS = getlsparam . _lsParam getTLS = getlsparam . _tlsParam - cbox = w ^. cWorld . cwCam . cwcBoundBox - cpos = w ^. cWorld . cwCam . cwcCenter + cbox = w ^. cWorld . lWorld . cwCam . cwcBoundBox + cpos = w ^. cWorld . lWorld . cwCam . cwcCenter getlsparam ls | not (pointInPolygon lpos cbox) && extraculltest = Nothing | otherwise = Just (_lsPos ls, rad ^ (2 :: Int), _lsCol ls) diff --git a/src/Dodge/Render/ShapePicture.hs b/src/Dodge/Render/ShapePicture.hs index 2e7e59cc2..f9b6bc799 100644 --- a/src/Dodge/Render/ShapePicture.hs +++ b/src/Dodge/Render/ShapePicture.hs @@ -58,7 +58,7 @@ worldSPic cfig w = <> singleSPic (anyTargeting cfig w) where foldup = foldMap' - filtOn f g = IM.filter (pointIsClose . f) (g (_cWorld w)) + filtOn f g = IM.filter (pointIsClose . f) (g (_lWorld (_cWorld w))) pointIsClose = cullPoint cfig w anyTargeting :: Configuration -> World -> SPic @@ -116,33 +116,35 @@ shiftDraw' fpos fdir fdraw x = cullPoint :: Configuration -> World -> Point2 -> Bool cullPoint cfig w p - | debugOn Close_shape_culling cfig = pointInPolygon p (w ^. cWorld . cwCam . cwcBoundBox) - | otherwise = dist (w ^. cWorld . cwCam . cwcCenter) p < (w ^. cWorld . cwCam . cwcViewDistance) + | debugOn Close_shape_culling cfig = pointInPolygon p (w ^. cWorld . lWorld . cwCam . cwcBoundBox) + | otherwise = dist (w ^. cWorld . lWorld . cwCam . cwcCenter) p < (w ^. cWorld . lWorld . cwCam . cwcViewDistance) extraPics :: Configuration -> World -> Picture extraPics cfig w = - pictures (_decorations (_cWorld w)) - <> concatMapPic drawTractorBeam (_tractorBeams (_cWorld w)) - <> concatMapPic drawLinearShockwave (_linearShockwaves (_cWorld w)) - <> concatMapPic drawShockwave (_shockwaves (_cWorld w)) - <> concatMapPic drawLaser (_lasersToDraw (_cWorld w)) - <> concatMapPic drawTeslaArc (_teslaArcs (_cWorld w)) + pictures (_decorations lw) + <> concatMapPic drawTractorBeam (_tractorBeams lw) + <> concatMapPic drawLinearShockwave (_linearShockwaves lw) + <> concatMapPic drawShockwave (_shockwaves lw) + <> concatMapPic drawLaser (_lasersToDraw lw) + <> concatMapPic drawTeslaArc (_teslaArcs lw) -- <> concatMapPic drawParticle (_particles w) - <> concatMapPic drawRadarSweep (_radarSweeps (_cWorld w)) - <> concatMapPic drawFlame (_flames (_cWorld w)) - <> concatMapPic drawEnergyBall (_energyBalls (_cWorld w)) - <> concatMapPic drawSpark (_sparks (_cWorld w)) - <> concatMapPic drawBul (_bullets (_cWorld w)) - <> concatMapPic drawBlip (_radarBlips (_cWorld w)) - <> concatMapPic drawFlare (_flares (_cWorld w)) - <> concatMapPic (dbArg (drawBeam . _bmDraw)) (_positronBeams $ _beams (_cWorld w)) - <> concatMapPic (dbArg (drawBeam . _bmDraw)) (_electronBeams $ _beams (_cWorld w)) - <> concatMapPic (dbArg (drawLightSource . _lsPict)) (_lightSources (_cWorld w)) + <> concatMapPic drawRadarSweep (_radarSweeps lw) + <> concatMapPic drawFlame (_flames lw) + <> concatMapPic drawEnergyBall (_energyBalls lw) + <> concatMapPic drawSpark (_sparks lw) + <> concatMapPic drawBul (_bullets lw) + <> concatMapPic drawBlip (_radarBlips lw) + <> concatMapPic drawFlare (_flares lw) + <> concatMapPic (dbArg (drawBeam . _bmDraw)) (_positronBeams $ _beams lw) + <> concatMapPic (dbArg (drawBeam . _bmDraw)) (_electronBeams $ _beams lw) + <> concatMapPic (dbArg (drawLightSource . _lsPict)) (_lightSources lw) <> testPic cfig w - <> concatMapPic clDraw (_clouds (_cWorld w)) - <> concatMapPic ppDraw (_pressPlates (_cWorld w)) + <> concatMapPic clDraw (_clouds lw) + <> concatMapPic ppDraw (_pressPlates lw) <> viewClipBounds cfig w <> debugDraw cfig w + where + lw = w ^. cWorld . lWorld debugDraw :: Configuration -> World -> Picture {-# INLINE debugDraw #-} @@ -195,7 +197,7 @@ drawCollisionTest cfig w = (a, b) = _lrLine w drawCreatureDisplayTexts :: World -> Picture -drawCreatureDisplayTexts w = foldMap (creatureDisplayText w) (_creatures (_cWorld w)) +drawCreatureDisplayTexts w = foldMap (creatureDisplayText w) (w ^. cWorld . lWorld . creatures) drawPathBetween :: World -> Picture drawPathBetween w = @@ -223,7 +225,7 @@ drawInspectWalls w = setLayer DebugLayer (color orange $ line [a,b]) <> foldMap (drawInspectWall w) ( filter (isJust . uncurry (intersectSegSeg a b) . _wlLine) $ - IM.elems $ _walls (_cWorld w) + IM.elems $ w ^. cWorld . lWorld . walls ) where (a, b) = _lLine w @@ -238,7 +240,7 @@ drawInspectWall w wl = drawDoorPaths :: World -> Int -> Picture drawDoorPaths w drid = fromMaybe mempty $ do - paths <- w ^? cWorld . doors . ix drid . drObstructs + paths <- w ^? cWorld . lWorld . doors . ix drid . drObstructs return $ foldMap' (drawPathEdge . (^. penPathEdge)) paths drawPathEdge :: PathEdge -> Picture @@ -276,7 +278,7 @@ drawFarWallDetect w = $ getViewpoints p w -- $ runIdentity $ S.toList_ $ streamViewpoints p w where - p = w ^. cWorld . cwCam . cwcViewFrom + p = w ^. cWorld . lWorld . cwCam . cwcViewFrom drawDDATest :: World -> Picture drawDDATest w = @@ -287,7 +289,7 @@ drawDDATest w = -- <> color blue (runIdentity (S.foldMap_ drawCross qs')) <> setLayer DebugLayer (color yellow (line [cvf, mwp])) where - cvf = w ^. cWorld . cwCam . cwcViewFrom + cvf = w ^. cWorld . lWorld . cwCam . cwcViewFrom mwp = mouseWorldPos w --ps = ddaStreamX 50 cvf mwp ps = zoneOfSeg 50 cvf mwp @@ -314,7 +316,7 @@ drawWallSearchRays w = foldMap (f . fst) $ allVisibleWalls w setLayer DebugLayer $ color yellow $ uncurryV translate p (circle 5) - <> line [w ^. cWorld . cwCam . cwcViewFrom , p] + <> line [w ^. cWorld . lWorld . cwCam . cwcViewFrom , p] testPic :: Configuration -> World -> Picture testPic _ _ = mempty @@ -330,7 +332,7 @@ testPic _ _ = mempty drawBoundingBox :: World -> Picture drawBoundingBox w = setLayer DebugLayer $ color green $ line $ (x : xs) ++ [x] where - (x : xs) = w ^. cWorld . cwCam . cwcBoundBox + (x : xs) = w ^. cWorld . lWorld . cwCam . cwcBoundBox clDraw :: Cloud -> Picture clDraw c = translate3 (_clPos c) (drawCloud (_clPict c) c) @@ -358,7 +360,7 @@ soundPic cfig w s = fixedSizePicClampArrow 50 50 thePic p cfig w where p = _soundPos s thePic = - rotate (w ^. cWorld . cwCam . cwcRot) + rotate (w ^. cWorld . lWorld . cwCam . cwcRot) . scale theScale theScale . centerText . soundToOnomato @@ -378,7 +380,7 @@ drawMousePosition cfig w = mwp = mouseWorldPos w drawWlIDs :: Configuration -> World -> Picture -drawWlIDs cfig w = setLayer FixedCoordLayer $ foldMap f (_walls (_cWorld w)) +drawWlIDs cfig w = setLayer FixedCoordLayer $ foldMap f (w ^. cWorld . lWorld . walls) where f wl | dist (_crPos $ you w) (fst (_wlLine wl)) > 200 = mempty -- this should be improved with a better "on screen test" @@ -406,7 +408,7 @@ drawPathing cfig w = <> foldMap dispInc (graphToIncidence gr) where dispInc (p, n) = setDepth 2 . uncurryV translate p . scale 0.1 0.1 $ text $ show n - gr = _pathGraph (_cWorld w) + gr = w ^. cWorld . lWorld . pathGraph crDisplayInfo :: Configuration -> World -> Creature -> Maybe (Point2, [String]) crDisplayInfo cfig w cr @@ -437,7 +439,7 @@ drawCrInfo :: Configuration -> World -> Picture drawCrInfo cfig w = setLayer FixedCoordLayer $ renderInfoListsAt (2 * hw - 400) 0 cfig w $ - mapMaybe (crDisplayInfo cfig w) $ IM.elems $ _creatures (_cWorld w) + mapMaybe (crDisplayInfo cfig w) $ IM.elems $ w ^. cWorld . lWorld . creatures where hw = halfWidth cfig diff --git a/src/Dodge/Render/Walls.hs b/src/Dodge/Render/Walls.hs index d901e80d3..6abcd45cd 100644 --- a/src/Dodge/Render/Walls.hs +++ b/src/Dodge/Render/Walls.hs @@ -25,7 +25,7 @@ wallsToDraw w = <*> L.prefilter wlSeeThroughDraw (L.premap f L.list) <*> L.premap getWallSPic L.mconcat ) - (wlsFromIXs w $ zonesExtract (w ^. cWorld . wlZoning) $ zoneOfSight' wlZoneSize w) + (wlsFromIXs w $ zonesExtract (w ^. cWorld . lWorld . wlZoning) $ zoneOfSight' wlZoneSize w) --wallsToDraw -- :: World diff --git a/src/Dodge/Room/LongDoor.hs b/src/Dodge/Room/LongDoor.hs index 8c4ec8be8..736faf956 100644 --- a/src/Dodge/Room/LongDoor.hs +++ b/src/Dodge/Room/LongDoor.hs @@ -121,7 +121,7 @@ addButtonSlowDoor x h rm = do ptCont (PutWorldUpdate (const $ setmount dr plls plpr)) $ const mpl setmount pldr plls plpr = - cWorld . doors . ix (fromJust $ _plMID pldr) . drMounts + cWorld . lWorld . doors . ix (fromJust $ _plMID pldr) . drMounts .++~ [MountedLS (fromJust $ _plMID plls), MountedProp (fromJust $ _plMID plpr)] -- TODO make the height of this light source and of other mounted lights -- be taken from a single consistent source diff --git a/src/Dodge/Shockwave/Update.hs b/src/Dodge/Shockwave/Update.hs index bc8f19f23..0200608fc 100644 --- a/src/Dodge/Shockwave/Update.hs +++ b/src/Dodge/Shockwave/Update.hs @@ -28,7 +28,7 @@ moveShockwave w sw tFraction = fromIntegral t / fromIntegral (_swMaxTime sw) rad = r - (3 / 4) * r * tFraction doDams w' = - over (cWorld . creatures) (IM.map damCr) $ + over (cWorld . lWorld . creatures) (IM.map damCr) $ foldl' (flip $ damageWall (Damage EXPLOSIVE 10000 p p p NoDamageEffect)) w' @@ -62,7 +62,7 @@ moveInverseShockwave w sw r = _swRad sw t = _swTimer sw rad = r - 0.1 * r * fromIntegral (10 - t) - dams = over (cWorld . creatures) (IM.map damCr) -- . flip (foldr (damageBlocksBy 1)) hitBlocks + dams = over (cWorld . lWorld . creatures) (IM.map damCr) -- . flip (foldr (damageBlocksBy 1)) hitBlocks -- hitBlocks = wallsOnCirc' p rad $ wallsNearPoint' p w damCr cr | dist (_crPos cr) p >= rad + _crRad cr = cr diff --git a/src/Dodge/SoundLogic.hs b/src/Dodge/SoundLogic.hs index 6f155e1ca..d78840d10 100644 --- a/src/Dodge/SoundLogic.hs +++ b/src/Dodge/SoundLogic.hs @@ -212,9 +212,9 @@ soundAngle p w . radToDeg . normalizeAngle . (+ pi) - $ argV (vNormal (p -.- earPos)) - _cwcRot (_cwCam (_cWorld w)) + $ argV (vNormal (p -.- earPos)) - (w ^. cWorld . lWorld . cwCam . cwcRot) where - earPos = w ^. cWorld . cwCam . cwcViewFrom + earPos = w ^. cWorld . lWorld . cwCam . cwcViewFrom {- | Uses the first free origin from a list. Does nothing if all origins are already creating sounds. diff --git a/src/Dodge/Spark.hs b/src/Dodge/Spark.hs index c5d2b5c7c..8e302f3e2 100644 --- a/src/Dodge/Spark.hs +++ b/src/Dodge/Spark.hs @@ -56,7 +56,7 @@ randColDirSpark :: randColDirSpark randcol randdir pos w = w & randGen .~ g - & cWorld . sparks + & cWorld . lWorld . sparks .:~ Spark { _skVel = rotateV dir (V2 5 0) , _skColor = col @@ -82,7 +82,7 @@ randSpark :: randSpark dt randspeed randcol randdir pos w = w & randGen .~ g - & cWorld . sparks + & cWorld . lWorld . sparks .:~ Spark { _skVel = rotateV dir (V2 speed 0) , _skColor = col diff --git a/src/Dodge/Terminal.hs b/src/Dodge/Terminal.hs index 4bfcff120..26ef67173 100644 --- a/src/Dodge/Terminal.hs +++ b/src/Dodge/Terminal.hs @@ -186,7 +186,7 @@ getSensor f tm w = maybe [] (makeTermPara . map toUpper . show . f) - (w ^? cWorld . machines . ix (_tmMachineID tm) . mcType . _McSensor) + (w ^? cWorld . lWorld . machines . ix (_tmMachineID tm) . mcType . _McSensor) toggleCommand :: TerminalCommand toggleCommand = @@ -212,14 +212,14 @@ sensorCommand = disconnectTerminal :: Terminal -> World -> World disconnectTerminal tm w = w - & cWorld . terminals . ix (_tmID tm) . tmStatus .~ TerminalOff + & cWorld . lWorld . terminals . ix (_tmID tm) . tmStatus .~ TerminalOff & exitTerminalSubInv - & cWorld . terminals . ix (_tmID tm) . tmFutureLines + & cWorld . lWorld . terminals . ix (_tmID tm) . tmFutureLines .~ [TerminalLineTerminalEffect 0 TmTmClearDisplayedLines] exitTerminalSubInv :: World -> World -exitTerminalSubInv w = case w ^? cWorld . hud . hudElement . subInventory . termID of - Just _ -> w & cWorld . hud . hudElement . subInventory .~ NoSubInventory +exitTerminalSubInv w = case w ^? cWorld . lWorld . hud . hudElement . subInventory . termID of + Just _ -> w & cWorld . lWorld . hud . hudElement . subInventory .~ NoSubInventory _ -> w damageCodeCommand :: TerminalCommand @@ -233,7 +233,7 @@ damageCodeCommand = infoClearInput :: Terminal -> [TerminalLine] -> World -> World infoClearInput tm tls = - cWorld . terminals . ix (_tmID tm) + cWorld . lWorld . terminals . ix (_tmID tm) %~ ( (tmInput .~ TerminalInput T.empty True (0, 0)) . (tmFutureLines ++.~ tls) ) diff --git a/src/Dodge/Terminal/LeftButton.hs b/src/Dodge/Terminal/LeftButton.hs index 4ba9f0240..df9c5f3cf 100644 --- a/src/Dodge/Terminal/LeftButton.hs +++ b/src/Dodge/Terminal/LeftButton.hs @@ -9,7 +9,7 @@ import LensHelp doTerminalEffectLB :: Terminal -> World -> World doTerminalEffectLB tm w = guardDisconnected tm w $ fromMaybe w $ do - s <- fmap T.unpack $ w ^? cWorld . terminals . ix (_tmID tm) . tmInput . tiText + s <- fmap T.unpack $ w ^? cWorld . lWorld . terminals . ix (_tmID tm) . tmInput . tiText if null (words s) then Just $ defocusTerminalInput w else return $ terminalReturnEffect tm w @@ -17,20 +17,20 @@ doTerminalEffectLB tm w = guardDisconnected tm w $ terminalReturnEffect :: Terminal -> World -> World terminalReturnEffect tm w = guardDisconnected tm w $ fromMaybe w $ do - s <- fmap T.unpack $ w ^? cWorld . terminals . ix (_tmID tm) . tmInput . tiText + s <- fmap T.unpack $ w ^? cWorld . lWorld . terminals . ix (_tmID tm) . tmInput . tiText return $ runTerminalString s tm $ w - & cWorld . terminals . ix (_tmID tm) . tmFutureLines .~ [makeTermLine ('>' : s)] + & cWorld . lWorld . terminals . ix (_tmID tm) . tmFutureLines .~ [makeTermLine ('>' : s)] defocusTerminalInput :: World -> World defocusTerminalInput w = fromMaybe w $ do - tmid <- w ^? cWorld . hud . hudElement . subInventory . termID - return $ w & cWorld . terminals . ix tmid . tmInput . tiFocus %~ const False + tmid <- w ^? cWorld . lWorld . hud . hudElement . subInventory . termID + return $ w & cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus %~ const False runTerminalString :: String -> Terminal -> World -> World runTerminalString s tm w = - w & cWorld . terminals . ix (_tmID tm) + w & cWorld . lWorld . terminals . ix (_tmID tm) %~ ( (tmInput .~ TerminalInput T.empty True (0, 0)) . (tmFutureLines ++.~ commandFutureLines s tm w) . (tmCommandHistory %~ take 10 . (s :)) diff --git a/src/Dodge/Tesla/Arc.hs b/src/Dodge/Tesla/Arc.hs index 1092e1905..4e2861f56 100644 --- a/src/Dodge/Tesla/Arc.hs +++ b/src/Dodge/Tesla/Arc.hs @@ -43,10 +43,10 @@ moveTeslaArc w pt makesparks = makeaspark . makeaspark . makeaspark (lp, ld) = case last thearc of ArcStep lp' ld' NothingID -> (lp', ld') - ArcStep lp' ld' (CrID crid) -> case w ^? cWorld . creatures . ix crid of + ArcStep lp' ld' (CrID crid) -> case w ^? cWorld . lWorld . creatures . ix crid of Nothing -> (lp', ld') Just cr -> (lp' -.- (_crRad cr + 1) *.* unitVectorAtAngle ld', ld' + pi) - ArcStep lp' ld' (WlID wlid) -> case w ^? cWorld . walls . ix wlid of + ArcStep lp' ld' (WlID wlid) -> case w ^? cWorld . lWorld . walls . ix wlid of Nothing -> (lp', ld') Just _ -> (lp' -.- 2 *.* unitVectorAtAngle ld', ld' + pi) damthings (ArcStep p dir crwl) = damageCrWlID (thedamage p dir) crwl @@ -57,7 +57,7 @@ moveTeslaArc w pt shootTeslaArc' :: ItemParams -> Point2 -> Float -> World -> (World, ItemParams) shootTeslaArc' ip pos dir w = ( w & randGen .~ g - & cWorld . teslaArcs .:~ aTeslaArcAt col newarc + & cWorld . lWorld . teslaArcs .:~ aTeslaArcAt col newarc , ip & currentArc ?~ newarc ) where diff --git a/src/Dodge/Tesla/Arc/Default.hs b/src/Dodge/Tesla/Arc/Default.hs index ec5b9324c..0072ef38d 100644 --- a/src/Dodge/Tesla/Arc/Default.hs +++ b/src/Dodge/Tesla/Arc/Default.hs @@ -31,7 +31,7 @@ defaultArcStep itparams w (ArcStep p dir _) = do . sortOn (dist center . _crPos) . filter (\cr -> dist center (_crPos cr) < csize) . IM.elems - $ _creatures (_cWorld w) + $ w ^. cWorld . lWorld . creatures --_creatures (_cWorld w) mwl = listToMaybe . sortOn (dist p . fst) diff --git a/src/Dodge/TestString.hs b/src/Dodge/TestString.hs index 1a4fc1397..b78ce607c 100644 --- a/src/Dodge/TestString.hs +++ b/src/Dodge/TestString.hs @@ -1,20 +1,13 @@ module Dodge.TestString where -import Dodge.Data.Universe import Control.Lens +import Dodge.Data.Universe --import Data.Maybe import ShortShow testStringInit :: Universe -> [String] -testStringInit u = [show $ u ^. uvWorld . scrollAmount +testStringInit u = + [ show $ u ^. uvWorld . scrollAmount , show $ u ^. uvWorld . previousScrollAmount - , shortShow $ u ^?! uvWorld . cWorld . creatures . ix 0 . crPos + , shortShow $ u ^?! uvWorld . cWorld . lWorld . creatures . ix 0 . crPos ] --- [ show $ u ^? uvWorld . hammers . ix DoubleMouseHam --- , show $ u ^? uvWorld . cWorld . creatures . ix 0 . crLeftInvSel . _Just --- , fromMaybe "" $ do --- i <- u ^? uvWorld . cWorld . creatures . ix 0 . crLeftInvSel . _Just --- h <- u ^? uvWorld . cWorld . creatures . ix 0 . crInv . ix i . itUse . leftHammer --- return $ show h --- ] - diff --git a/src/Dodge/TractorBeam/Update.hs b/src/Dodge/TractorBeam/Update.hs index 4e735925e..11423af19 100644 --- a/src/Dodge/TractorBeam/Update.hs +++ b/src/Dodge/TractorBeam/Update.hs @@ -10,8 +10,8 @@ updateTractorBeam w pj | _tbTime pj <= 0 = (w, Nothing) | otherwise = ( w - & cWorld . creatures %~ IM.map (tractCr pullVel pos outpos) - & cWorld . floorItems %~ IM.map (tractFlIt pullVel pos outpos) + & cWorld . lWorld . creatures %~ IM.map (tractCr pullVel pos outpos) + & cWorld . lWorld . floorItems %~ IM.map (tractFlIt pullVel pos outpos) , Just (pj & tbTime -~ 1) ) where diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 1466dafc7..fc4c2d685 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -13,7 +13,6 @@ import Dodge.Update.Scroll import Control.Applicative import Data.List import qualified Data.Map.Strict as M -import qualified Data.Set as S import Data.Maybe import Dodge.Base import Dodge.Beam @@ -63,7 +62,6 @@ import LensHelp import SDL import Sound.Data import StrictHelp -import qualified Data.Text as T updateUniverse :: Universe -> Universe updateUniverse = updateUniverseLast . updateUniverseFirst @@ -80,7 +78,7 @@ updateUniverseFirst u u & uvWorld %~ ( --updateParticles - (cWorld . radarBlips .~ []) + (cWorld . lWorld . radarBlips .~ []) -- . updateIMl _props _pjUpdate . updateLightSources . updateClouds @@ -125,7 +123,7 @@ scrollTimeBack w = case w ^? cwTime . pastWorlds . _head of & timeFlow . futureWorlds .:~ _cWorld w & timeFlow . reverseAmount -~ 1 & cWorld .~ cw - & pointerToItemLocation (w ^?! cWorld . itemLocations . ix i) . itUse . leftConsumption . wpCharge .~ (x -1) + & pointerToItemLocation (w ^?! cWorld . lWorld . itemLocations . ix i) . itUse . leftConsumption . wpCharge .~ (x -1) _ -> w where i = w ^?! timeFlow . scrollItemLocation @@ -138,7 +136,7 @@ scrollTimeForward w = case w ^? timeFlow . futureWorlds . _head of & cwTime . pastWorlds .:~ _cWorld w & cWorld .~ cw & timeFlow . reverseAmount .~ ramount - & pointerToItemLocation (w ^?! cWorld . itemLocations . ix i) . itUse . leftConsumption . wpCharge .~ ramount + & pointerToItemLocation (w ^?! cWorld . lWorld . itemLocations . ix i) . itUse . leftConsumption . wpCharge .~ ramount where i = w ^?! timeFlow . scrollItemLocation ramount = (w ^?! timeFlow . reverseAmount) + 1 @@ -162,10 +160,10 @@ functionalUpdate w = . colCrsWalls . over uvWorld simpleCrSprings . over uvWorld zoneCreatures - . over uvWorld (updateIMl (_doors . _cWorld) (doDrWdWd . _drMech)) + . over uvWorld (updateIMl (_doors . _lWorld . _cWorld) (doDrWdWd . _drMech)) . over uvWorld doWorldEvents . over uvWorld updateDelayedEvents - . over uvWorld (updateIMl (_modifications . _cWorld) (doModificationEffect . _mdUpdate)) + . over uvWorld (updateIMl (_modifications . _lWorld . _cWorld) (doModificationEffect . _mdUpdate)) . over uvWorld updateSparks . over uvWorld updateRadarSweeps . over uvWorld updatePosEvents @@ -180,20 +178,20 @@ functionalUpdate w = . over uvWorld updateLasers . over uvWorld updateTeslaArcs . over uvWorld updateTractorBeams - . over uvWorld (updateIMl' (_linearShockwaves . _cWorld) updateLinearShockwave) - . over uvWorld (updateIMl' (_props . _cWorld) updateProp) - . over uvWorld (updateIMl' (_projectiles . _cWorld) updateProjectile) + . over uvWorld (updateIMl' (_linearShockwaves . _lWorld . _cWorld) updateLinearShockwave) + . over uvWorld (updateIMl' (_props . _lWorld . _cWorld) updateProp) + . over uvWorld (updateIMl' (_projectiles . _lWorld . _cWorld) updateProjectile) . over uvWorld updateLightSources . over uvWorld updateClouds . over uvWorld updateGusts . over uvWorld zoneClouds - . over uvWorld (updateMIM (cWorld . magnets) (doMagnetUpdate . _mgUpdate)) - . over uvWorld (updateIMl' (_terminals . _cWorld) tmUpdate) + . over uvWorld (updateMIM (cWorld . lWorld . magnets) (doMagnetUpdate . _mgUpdate)) + . over uvWorld (updateIMl' (_terminals . _lWorld . _cWorld) tmUpdate) -- . updateIMl _machines mcChooseUpdate - . over uvWorld (updateIMl' (_machines . _cWorld) updateMachine) - . over uvWorld (updateIMl' (_creatures . _cWorld) updateCreature) + . over uvWorld (updateIMl' (_machines . _lWorld . _cWorld) updateMachine) + . over uvWorld (updateIMl' (_creatures . _lWorld . _cWorld) updateCreature) -- creatures should be updated early so that crOldPos is set before any position change - . over (uvWorld . cWorld . creatures) (fmap setOldPos) + . over (uvWorld . cWorld . lWorld . creatures) (fmap setOldPos) . over uvWorld updateCreatureGroups . over uvWorld updateWallDamages . over uvWorld updateSeenWalls @@ -231,24 +229,23 @@ moveHammersUp = uvWorld . hammers %~ M.map moveHammerUp -- w' = w {_hammers = fmap moveHammerUp (_hammers w)} doWorldEvents :: World -> World -doWorldEvents w = foldl' (flip doWdWd) (w & cWorld . worldEvents .~ []) (_worldEvents (_cWorld w)) +doWorldEvents w = foldl' (flip doWdWd) (w & cWorld . lWorld . worldEvents .~ []) (w ^. cWorld . lWorld . worldEvents) updateLasers :: World -> World updateLasers w = w' - & cWorld . lasers .~ [] - & cWorld . lasersToDraw .~ ls + & cWorld . lWorld . lasers .~ [] + & cWorld . lWorld . lasersToDraw .~ ls where - (w', ls) = mapAccumR updateLaser w (_lasers (_cWorld w)) + (w', ls) = mapAccumR updateLaser w (w ^. cWorld . lWorld . lasers) zoneClouds :: World -> World zoneClouds w = w - & cWorld . clZoning .~ mempty - & cWorld . clZoning %~ \zn -> - foldl' (flip zoneCloud) zn (_clouds (_cWorld w)) + & cWorld . lWorld . clZoning .~ mempty + & cWorld . lWorld . clZoning %~ \zn -> + foldl' (flip zoneCloud) zn (w ^. cWorld . lWorld . clouds) ---runIdentity (S.fold_ (flip $ updateZoning (:)) (zn & znObjects .~ mempty) id (_clouds w)) updateWorldSelect :: World -> World updateWorldSelect w = f . g $ case (w ^? mouseButtons . ix ButtonLeft, w ^? mouseButtons . ix ButtonRight) of @@ -284,7 +281,7 @@ displayTerminalLineString tls = case tls of TerminalLineConst str col -> const (str, col) tmUpdate :: Terminal -> World -> World -tmUpdate tm w = case w ^? cWorld . terminals . ix (_tmID tm) . tmFutureLines . ix 0 of +tmUpdate tm w = case w ^? cWorld . lWorld . terminals . ix (_tmID tm) . tmFutureLines . ix 0 of Nothing -> w Just tl | _tlPause tl > 0 -> w & pointTermParams . tmFutureLines . ix 0 . tlPause -~ 1 Just (TerminalLineDisplay _ f) -> @@ -301,7 +298,7 @@ tmUpdate tm w = case w ^? cWorld . terminals . ix (_tmID tm) . tmFutureLines . i & pointTermParams . tmFutureLines %~ tail & pointTermParams %~ doTmTm eff where - pointTermParams = cWorld . terminals . ix (_tmID tm) + pointTermParams = cWorld . lWorld . terminals . ix (_tmID tm) setOldPos :: Creature -> Creature setOldPos cr = @@ -323,8 +320,8 @@ setOldPos cr = zoneCreatures :: World -> World zoneCreatures w = w - & cWorld . crZoning .~ mempty - & cWorld . crZoning %~ \zn -> foldl' (flip zoneCreature) zn (_creatures (_cWorld w)) + & cWorld . lWorld . crZoning .~ mempty + & cWorld . lWorld . crZoning %~ \zn -> foldl' (flip zoneCreature) zn (w ^. cWorld . lWorld . creatures) -- foldl' (flip $ updateZoning (\cr -> IM.insert (_crID cr) cr)) -- zn (_creatures w) @@ -336,7 +333,7 @@ updateCreatureSoundPositions w = $ _playingSounds w where insertSound w' k s = w' & toPlaySounds %~ M.insertWith (const id) k s - updateSound (CrMouth cid) s = case w ^? cWorld . creatures . ix cid . crPos of + updateSound (CrMouth cid) s = case w ^? cWorld . lWorld . creatures . ix cid . crPos of Just p -> Just s{_soundPos = p, _soundAngDist = Just (soundAngle p w, 0)} Nothing -> Just s{_soundTime = Just 0} updateSound _ _ = Nothing @@ -351,68 +348,68 @@ updateIMl' fim fup w = foldl' (flip fup) w (fim w) updateCreatureGroups :: World -> World updateCreatureGroups w = - w & cWorld . creatureGroups + w & cWorld . lWorld . creatureGroups %~ IM.mapMaybe (\cgp -> doCrGroupUpdate (_crGroupUpdate cgp) w cgp) updateDistortions :: World -> World -updateDistortions = cWorld . distortions %~ mapMaybe updateDistortion +updateDistortions = cWorld . lWorld . distortions %~ mapMaybe updateDistortion updateLightSources :: World -> World -updateLightSources = cWorld . tempLightSources %~ f +updateLightSources = cWorld . lWorld . tempLightSources %~ f where f = mapMaybe (\b -> updateTempLightSource (_tlsUpdate b) b) updateRadarBlips :: World -> World -updateRadarBlips = cWorld . radarBlips %~ mapMaybe updateRadarBlip +updateRadarBlips = cWorld . lWorld . radarBlips %~ mapMaybe updateRadarBlip updateFlares :: World -> World -updateFlares = cWorld . flares %~ mapMaybe updateFlare +updateFlares = cWorld . lWorld . flares %~ mapMaybe updateFlare updateTeslaArcs :: World -> World -updateTeslaArcs w = w' & cWorld . teslaArcs .~ catMaybes newtas +updateTeslaArcs w = w' & cWorld . lWorld . teslaArcs .~ catMaybes newtas where - (w', newtas) = mapAccumR moveTeslaArc w $ _teslaArcs (_cWorld w) + (w', newtas) = mapAccumR moveTeslaArc w $ w ^. cWorld . lWorld . teslaArcs updateTractorBeams :: World -> World -updateTractorBeams w = w' & cWorld . tractorBeams .~ catMaybes newtas +updateTractorBeams w = w' & cWorld . lWorld . tractorBeams .~ catMaybes newtas where - (w', newtas) = mapAccumR updateTractorBeam w $ _tractorBeams (_cWorld w) + (w', newtas) = mapAccumR updateTractorBeam w $ w ^. cWorld . lWorld . tractorBeams {- Apply internal particle updates, delete 'Nothing's. -} updateBullets :: World -> World -updateBullets w = updateInstantBullets $ set (cWorld . bullets) (catMaybes ps) w' +updateBullets w = updateInstantBullets $ set (cWorld . lWorld . bullets) (catMaybes ps) w' where - (w', ps) = mapAccumR updateBullet w $ _bullets (_cWorld w) + (w', ps) = mapAccumR updateBullet w $ w ^. cWorld . lWorld . bullets updateShockwaves :: World -> World -updateShockwaves w = w' & cWorld . shockwaves .~ catMaybes newflames +updateShockwaves w = w' & cWorld . lWorld . shockwaves .~ catMaybes newflames where - (w', newflames) = mapAccumR updateShockwave w $ _shockwaves (_cWorld w) + (w', newflames) = mapAccumR updateShockwave w $ w ^. cWorld . lWorld . shockwaves updateFlames :: World -> World -updateFlames w = w' & cWorld . flames .~ catMaybes newflames +updateFlames w = w' & cWorld . lWorld . flames .~ catMaybes newflames where - (w', newflames) = mapAccumR moveFlame w $ _flames (_cWorld w) + (w', newflames) = mapAccumR moveFlame w $ w ^. cWorld . lWorld . flames updateEnergyBalls :: World -> World -updateEnergyBalls w = w' & cWorld . energyBalls .~ catMaybes newebs +updateEnergyBalls w = w' & cWorld . lWorld . energyBalls .~ catMaybes newebs where - (w', newebs) = mapAccumR moveEnergyBall w $ _energyBalls (_cWorld w) + (w', newebs) = mapAccumR moveEnergyBall w $ w ^. cWorld . lWorld . energyBalls updateRadarSweeps :: World -> World -updateRadarSweeps w = w' & cWorld . radarSweeps .~ catMaybes newradarSweeps +updateRadarSweeps w = w' & cWorld . lWorld . radarSweeps .~ catMaybes newradarSweeps where - (w', newradarSweeps) = mapAccumR updateRadarSweep w $ _radarSweeps (_cWorld w) + (w', newradarSweeps) = mapAccumR updateRadarSweep w $ w ^. cWorld . lWorld . radarSweeps updateSparks :: World -> World -updateSparks w = w' & cWorld . sparks .~ catMaybes newsparks +updateSparks w = w' & cWorld . lWorld . sparks .~ catMaybes newsparks where - (w', newsparks) = mapAccumR moveSpark w $ _sparks (_cWorld w) + (w', newsparks) = mapAccumR moveSpark w $ w ^. cWorld . lWorld . sparks updatePosEvents :: World -> World -updatePosEvents w = w' & cWorld . posEvents .~ catMaybes newposEvents +updatePosEvents w = w' & cWorld . lWorld . posEvents .~ catMaybes newposEvents where - (w', newposEvents) = mapAccumR updatePosEvent w $ _posEvents (_cWorld w) + (w', newposEvents) = mapAccumR updatePosEvent w $ w ^. cWorld . lWorld . posEvents {- Apply internal particle updates, delete 'Nothing's. -} --updateParticles :: World -> World @@ -422,17 +419,17 @@ updatePosEvents w = w' & cWorld . posEvents .~ catMaybes newposEvents updateBeams :: World -> World updateBeams w = w - & cWorld . newBeams .~ WorldBeams [] [] [] [] - & cWorld . beams .~ thebeams + & cWorld . lWorld . newBeams .~ WorldBeams [] [] [] [] + & cWorld . lWorld . beams .~ thebeams & combineBeams thebeams where - thebeams = _newBeams (_cWorld w) + thebeams = w ^. cWorld . lWorld . newBeams combineBeams :: WorldBeams -> World -> World combineBeams wbeams w = w'' - & cWorld . beams . positronBeams .~ pbeams - & cWorld . beams . electronBeams .~ ebeams + & cWorld . lWorld . beams . positronBeams .~ pbeams + & cWorld . lWorld . beams . electronBeams .~ ebeams where (w', pbeams) = mapAccumR (combineBeamBeams (_electronBeams wbeams)) w $ _positronBeams wbeams (w'', ebeams) = mapAccumR (combineBeamBeams (_positronBeams wbeams)) w' $ _electronBeams wbeams @@ -494,11 +491,11 @@ intersectSegSegs' _ _ _ = Nothing -- (intersectSegSegss x y ass) --intersectSegsSegss _ _ = Nothing updateInstantBullets :: World -> World -updateInstantBullets w = case _instantBullets (_cWorld w) of +updateInstantBullets w = case w ^. cWorld . lWorld . instantBullets of [] -> w ps -> - let (w', ps') = mapAccumR updateBullet (w & cWorld . instantBullets .~ []) ps - in updateInstantBullets $ w' & cWorld . bullets .++~ catMaybes ps' + let (w', ps') = mapAccumR updateBullet (w & cWorld . lWorld . instantBullets .~ []) ps + in updateInstantBullets $ w' & cWorld . lWorld . bullets .++~ catMaybes ps' --updateInstantParticles :: World -> World --updateInstantParticles w = case _instantParticles w of @@ -522,7 +519,7 @@ updateMIM f up = f %~ IM.mapMaybe (dbArg up) -- (_,g') = genWord8 g ppEvents :: World -> World -ppEvents w = IM.foldl' (flip $ \pp -> doPressPlateEvent (_ppEvent pp) pp) w $ _pressPlates (_cWorld w) +ppEvents w = IM.foldl' (flip $ \pp -> doPressPlateEvent (_ppEvent pp) pp) w $ w ^. cWorld . lWorld . pressPlates updateSeenWalls :: World -> World updateSeenWalls w = foldl' markWallSeen w (map (_wlID . snd) $ allVisibleWalls w) @@ -533,7 +530,7 @@ updateSeenWalls w = foldl' markWallSeen w (map (_wlID . snd) $ allVisibleWalls w -- mw wl = wl {_wlSeen = True} markWallSeen :: World -> Int -> World -markWallSeen !w !i = w & cWorld . walls .~ IM.adjust markSeen i (_walls (_cWorld w)) +markWallSeen !w !i = w & cWorld . lWorld . walls .~ IM.adjust markSeen i (w ^. cWorld . lWorld . walls) markSeen :: Wall -> Wall {-# INLINE markSeen #-} @@ -552,7 +549,7 @@ checkEndGame uv = case w ^. cwTime . deathDelay of w = _uvWorld uv updateGusts :: World -> World -updateGusts w = w & cWorld . gusts %~ IM.mapMaybe (mvGust w) +updateGusts w = w & cWorld . lWorld . gusts %~ IM.mapMaybe (mvGust w) mvGust :: World -> Gust -> Maybe Gust mvGust _ gu @@ -564,10 +561,10 @@ mvGust _ gu & guTime -~ 1 updateClouds :: World -> World -updateClouds w = w' & cWorld . clouds .~ catMaybes mclouds +updateClouds w = w' & cWorld . lWorld . clouds .~ catMaybes mclouds where -- cls = _clouds w - (w', mclouds) = mapAccumR updateCloud w (_clouds (_cWorld w)) + (w', mclouds) = mapAccumR updateCloud w (w ^. cWorld . lWorld . clouds) cloudEffect :: Cloud -> World -> World cloudEffect cl = case _clType cl of @@ -609,7 +606,7 @@ clClSpringVel a v b radDist = (_clRad a + _clRad b) / 2 simpleCrSprings :: World -> World -simpleCrSprings w = IM.foldl' (flip crSpring) w $ _creatures (_cWorld w) +simpleCrSprings w = IM.foldl' (flip crSpring) w $ w ^. cWorld . lWorld . creatures -- note that this may in rare cases not push creatures away from each other crSpring :: Creature -> World -> World @@ -623,7 +620,7 @@ crCrSpring c1 c2 | vec == V2 0 0 = id | diff >= comRad = id | otherwise = - cWorld . creatures + cWorld . lWorld . creatures %~ ( over (ix id1 . crPos) (+.+ overlap1) . over (ix id2 . crPos) (-.- overlap2) ) @@ -639,9 +636,9 @@ crCrSpring c1 c2 updateDelayedEvents :: World -> World updateDelayedEvents w = - let (neww, newde) = mapAccumR f w (_delayedEvents (_cWorld w)) - in neww & cWorld . delayedEvents .~ catMaybes newde + let (neww, newde) = mapAccumR f w (w ^. cWorld . lWorld . delayedEvents) + in neww & cWorld . lWorld . delayedEvents .~ catMaybes newde where f w' (i, g) - | i <= 0 = (w' & cWorld . worldEvents .:~ g, Nothing) + | i <= 0 = (w' & cWorld . lWorld . worldEvents .:~ g, Nothing) | otherwise = (w', Just (i -1, g)) diff --git a/src/Dodge/Update/Camera.hs b/src/Dodge/Update/Camera.hs index 6136095fc..4387f7158 100644 --- a/src/Dodge/Update/Camera.hs +++ b/src/Dodge/Update/Camera.hs @@ -41,11 +41,11 @@ updateCamera uv = moveZoomCamera :: Universe -> Universe moveZoomCamera uv = uv - & uvWorld . cWorld . cwCam . cwcCenter .~ newcen - & uvWorld . cWorld . cwCam . cwcViewFrom .~ newvf - & uvWorld . cWorld . cwCam . cwcZoom .~ newzoom - & uvWorld . cWorld . cwCam . cwcDefaultZoom .~ newDefaultZoom - & uvWorld . cWorld . cwCam . cwcItemZoom .~ newItemZoom + & uvWorld . cWorld . lWorld . cwCam . cwcCenter .~ newcen + & uvWorld . cWorld . lWorld . cwCam . cwcViewFrom .~ newvf + & uvWorld . cWorld . lWorld . cwCam . cwcZoom .~ newzoom + & uvWorld . cWorld . lWorld . cwCam . cwcDefaultZoom .~ newDefaultZoom + & uvWorld . cWorld . lWorld . cwCam . cwcItemZoom .~ newItemZoom where cfig = _uvConfig uv w = _uvWorld uv @@ -60,23 +60,23 @@ moveZoomCamera uv = guard (SDL.ButtonRight `M.member` _mouseButtons w) yourItem w ^? _Just . itScope . scopePos newcen = cpos +.+ fromMaybe (V2 0 0) mscopeoffset +.+ offset - offset = rotateV (w ^. cWorld . cwCam . cwcRot) $ ((newzoom - newDefaultZoom) / (newDefaultZoom * newzoom)) *.* _mousePos w + offset = rotateV (w ^. cWorld . lWorld . cwCam . cwcRot) $ ((newzoom - newDefaultZoom) / (newDefaultZoom * newzoom)) *.* _mousePos w newzoom = case yourItem w ^? _Just . itScope of Just zs@ZoomScope{} -> _scopeZoom zs _ -> newDefaultZoom * newItemZoom idealDefaultZoom = clipZoom wallZoom newDefaultZoom = case yourItem w ^? _Just . itScope of Just zs@ZoomScope{} -> _scopeZoom zs - _ -> changeZoom (w ^. cWorld . cwCam . cwcDefaultZoom) idealDefaultZoom + _ -> changeZoom (w ^. cWorld . lWorld . cwCam . cwcDefaultZoom) idealDefaultZoom idealItemZoom = fromMaybe 1 $ do guard $ crIsAiming (you w) zoomFromItem' <$> (yourItem w ^? _Just . itUse . heldAim . aimZoom) - newItemZoom = changeZoom (w ^. cWorld . cwCam . cwcItemZoom) idealItemZoom + newItemZoom = changeZoom (w ^. cWorld . lWorld . cwCam . cwcItemZoom) idealItemZoom changeZoom curZoom idealZoom | curZoom > idealZoom + 0.01 = ((zoomOutSpeed -1) * curZoom + idealZoom) / zoomOutSpeed | curZoom < idealZoom - 0.01 = ((zoomInSpeed -1) * curZoom + idealZoom) / zoomInSpeed | otherwise = idealZoom - wallZoom = min4 (w ^. cWorld . cwCam . cwcBoundDist) + wallZoom = min4 (w ^. cWorld . lWorld . cwCam . cwcBoundDist) min4 (a, b, c, d) = minimum [hh / maxd a, hh / maxd (- b), hw / maxd c, hw / maxd (- d)] maxd = max distFromEqmnt distFromEqmnt = foldl' max 1 $ IM.mapMaybe (_eeViewDist . _equipEffect . _itUse) $ getCrEquipment $ you w @@ -91,7 +91,7 @@ updateScopeZoom :: World -> World updateScopeZoom w | SDL.ButtonRight `M.member` _mouseButtons w = case w - ^? cWorld . creatures . ix 0 . crInv . ix (crSel (_creatures (_cWorld w) IM.! 0)) + ^? cWorld . lWorld . creatures . ix 0 . crInv . ix (crSel (w ^?! cWorld . lWorld . creatures . ix 0)) . itScope . scopeZoomChange of Just x @@ -105,7 +105,7 @@ updateScopeZoom w _ -> w | otherwise = w - & cWorld . creatures . ix 0 . crInv . ix (crSel (_creatures (_cWorld w) IM.! 0)) + & cWorld . lWorld . creatures . ix 0 . crInv . ix (crSel (w ^?! cWorld . lWorld . creatures . ix 0)) . itScope %~ updateScope where @@ -125,11 +125,13 @@ zoomInLongGun w | otherwise = w & wpPointer . itScope . scopeZoomChange .~ 0 where decreaseScopeZoomChange = wpPointer . itScope . scopeZoomChange -~ 1 - wpPointer = cWorld . creatures . ix 0 . crInv . ix (crSel (_creatures (_cWorld w) IM.! 0)) - wp = _crInv (_creatures (_cWorld w) IM.! 0) IM.! crSel (_creatures (_cWorld w) IM.! 0) + wpPointer = cWorld . lWorld . creatures . ix 0 . crInv . ix (crSel (w ^?! cWorld . lWorld . creatures . ix 0)) + --wp = _crInv (_creatures (_cWorld w) IM.! 0) IM.! crSel (_creatures (_cWorld w) IM.! 0) + wp = ycr ^?! crInv . ix (crSel ycr) + ycr = you w Just currentZoom = wp ^? itScope . scopeZoom newzoom = (wp ^?! itScope . scopeZoom) / zoomSpeed - mousep = rotateV (w ^. cWorld . cwCam . cwcRot) $ _mousePos w + mousep = rotateV (w ^. cWorld . lWorld . cwCam . cwcRot) $ _mousePos w zoomOutLongGun :: World -> World zoomOutLongGun w @@ -143,8 +145,9 @@ zoomOutLongGun w where --mousep = rotateV (_cameraRot w) $ _mousePos w increaseScopeZoomChange = wpPointer . itScope . scopeZoomChange +~ 1 - wpPointer = cWorld . creatures . ix 0 . crInv . ix (crSel (_creatures (_cWorld w) IM.! 0)) - wp = _crInv (_creatures (_cWorld w) IM.! 0) IM.! crSel (_creatures (_cWorld w) IM.! 0) + wpPointer = cWorld . lWorld . creatures . ix 0 . crInv . ix (crSel (_creatures (_lWorld (_cWorld w)) IM.! 0)) + wp = ycr ^?! crInv . ix (crSel ycr) + ycr = you w Just currentZoom = wp ^? itScope . scopeZoom ifConfigWallRotate :: Configuration -> World -> World @@ -165,11 +168,11 @@ rotateToOverlappingWall w = p = _crPos (you w) doWallRotate :: Wall -> World -> World -doWallRotate wl' w = rotateUsing $ (argV . uncurry (-.-) $ _wlLine wl') - (w ^. cWorld . cwCam . cwcRot) +doWallRotate wl' w = rotateUsing $ (argV . uncurry (-.-) $ _wlLine wl') - (w ^. cWorld . lWorld . cwCam . cwcRot) where rotateUsing a - | b - b' > 0.01 = w & cWorld . cwCam . cwcRot +~ 0.01 - | b - b' < negate 0.01 = w & cWorld . cwCam . cwcRot -~ 0.01 + | b - b' > 0.01 = w & cWorld . lWorld . cwCam . cwcRot +~ 0.01 + | b - b' < negate 0.01 = w & cWorld . lWorld . cwCam . cwcRot -~ 0.01 | otherwise = w where --b = a * (2 / pi) @@ -179,8 +182,8 @@ doWallRotate wl' w = rotateUsing $ (argV . uncurry (-.-) $ _wlLine wl') - (w ^. rotateCameraBy :: Float -> World -> World rotateCameraBy x w = w - & cWorld . cwCam . cwcRot +~ x - & cWorld . creatures . ix 0 . crInv . ix (crSel (_creatures (_cWorld w) IM.! 0)) + & cWorld . lWorld . cwCam . cwcRot +~ x + & cWorld . lWorld . creatures . ix 0 . crInv . ix (crSel (_creatures (_lWorld (_cWorld w)) IM.! 0)) . itScope . scopePos %~ rotateV x @@ -197,7 +200,7 @@ rotateCamera cfig w -- TODO check where/how this is used notAtTerminal :: World -> Bool -notAtTerminal w = isNothing $ w ^? cWorld . hud . hudElement . subInventory . termID +notAtTerminal w = isNothing $ w ^? cWorld . lWorld . hud . hudElement . subInventory . termID --zoomCamBy :: Float -> World -> World --zoomCamBy x w = w {_cameraZoom = max (_cameraZoom w + x) 0.01} @@ -215,8 +218,8 @@ clipZoom = min 20 . max 0.2 setViewDistance :: Configuration -> World -> World setViewDistance cfig w = - w & cWorld . cwCam . cwcViewDistance - .~ sqrt (halfWidth cfig ** 2 + halfHeight cfig ** 2) / (w ^. cWorld . cwCam . cwcZoom) + w & cWorld . lWorld . cwCam . cwcViewDistance + .~ sqrt (halfWidth cfig ** 2 + halfHeight cfig ** 2) / (w ^. cWorld . lWorld . cwCam . cwcZoom) getViewpoints :: Point2 -> World -> [Point2] {-# INLINE getViewpoints #-} @@ -238,7 +241,7 @@ farWallDistDirection p w = boundPoints $ map f $ getViewpoints p w where - f q = (rotateV (negate (w ^. cWorld . cwCam . cwcRot)) . (-.- p)) (foldl' findPoint q (wls q)) + f q = (rotateV (negate (w ^. cWorld . lWorld . cwCam . cwcRot)) . (-.- p)) (foldl' findPoint q (wls q)) wls q = filter wlIsOpaque $ wlsNearSeg p q w findPoint q = fromMaybe q . uncurry (intersectSegSeg p q) . _wlLine diff --git a/src/Dodge/Update/Cloud.hs b/src/Dodge/Update/Cloud.hs index 582b84465..176b3af99 100644 --- a/src/Dodge/Update/Cloud.hs +++ b/src/Dodge/Update/Cloud.hs @@ -12,7 +12,7 @@ cloudPoisonDamage c w = w & dodamagesto (filter f $ crsNearPoint clpos w) dodamagesto :: [Creature] -> World -> World dodamagesto scrs mcrs = foldl' (flip doDam) mcrs scrs doDam cr = - cWorld . creatures . ix (_crID cr) . crState . csDamage + cWorld . lWorld . creatures . ix (_crID cr) . crState . csDamage .:~ Damage POISONDAM 1 clpos clpos clpos NoDamageEffect f cr = dist3 (addZ 20 $ _crPos cr) (_clPos c) < _crRad cr + _clRad c + 10 clpos = stripZ $ _clPos c diff --git a/src/Dodge/Update/Scroll.hs b/src/Dodge/Update/Scroll.hs index 430cf6897..8c30552e9 100644 --- a/src/Dodge/Update/Scroll.hs +++ b/src/Dodge/Update/Scroll.hs @@ -1,79 +1,37 @@ module Dodge.Update.Scroll where + +import qualified Data.Map.Strict as M +import Data.Maybe +import qualified Data.Set as S +import qualified Data.Text as T +import Dodge.Base +import Dodge.Combine +import Dodge.Data.Universe +import Dodge.Event.Keyboard +import Dodge.HeldScroll +import Dodge.InputFocus +import Dodge.Inventory +import Dodge.SoundLogic import Dodge.Terminal import Dodge.Tweak -import Dodge.Combine -import Dodge.Event.Keyboard -import Control.Applicative -import Data.List -import qualified Data.Map.Strict as M -import qualified Data.Set as S -import Data.Maybe -import Dodge.Base -import Dodge.Beam -import Dodge.InputFocus -import Dodge.Bullet -import Dodge.HeldScroll -import Dodge.CrGroupUpdate -import Dodge.Creature.Update -import Dodge.CullBox -import Dodge.Data.Universe -import Dodge.Distortion -import Dodge.DrWdWd -import Dodge.EnergyBall -import Dodge.Flame -import Dodge.Flare -import Dodge.Hammer -import Dodge.Inventory -import Dodge.Item.Location -import Dodge.Laser.Update -import Dodge.LightSource.Update -import Dodge.LinearShockwave.Update -import Dodge.Machine.Update -import Dodge.Magnet.Update -import Dodge.Menu -import Dodge.ModificationEffect -import Dodge.PosEvent -import Dodge.PressPlate -import Dodge.Projectile.Update -import Dodge.Prop.Update -import Dodge.RadarBlip -import Dodge.RadarSweep -import Dodge.Shockwave.Update -import Dodge.SoundLogic -import Dodge.Spark -import Dodge.Tesla.Arc -import Dodge.TmTm -import Dodge.TractorBeam.Update -import Dodge.Update.Camera -import Dodge.Update.Cloud -import Dodge.Update.WallDamage -import Dodge.WallCreatureCollisions -import Dodge.WorldEffect -import Dodge.Zoning.Cloud -import Dodge.Zoning.Creature -import Geometry import qualified IntMapHelp as IM import LensHelp ---import MaybeHelp import SDL -import Sound.Data -import StrictHelp -import qualified Data.Text as T updateWheelEvent :: Int -> World -> World -updateWheelEvent yi w = case w ^. cWorld . hud . hudElement of +updateWheelEvent yi w = case w ^. cWorld . lWorld . hud . hudElement of DisplayCarte - | rbDown -> w & cWorld . hud . carteZoom %~ min 0.75 . max 0.05 . ((1 + y * 0.1) *) - | otherwise -> w & cWorld . selLocation %~ (`mod` numLocs) . (+ yi) + | rbDown -> w & cWorld . lWorld . hud . carteZoom %~ min 0.75 . max 0.05 . ((1 + y * 0.1) *) + | otherwise -> w & cWorld . lWorld . selLocation %~ (`mod` numLocs) . (+ yi) DisplayInventory NoSubInventory -- functions that modify the inventory should be centralised so that -- this lock can be sensibly applied, perhaps - | _crInvLock (_creatures (_cWorld w) IM.! _yourID (_cWorld w)) -> w + | w ^?! cWorld . lWorld . creatures . ix (w ^. cWorld . lWorld . yourID) . crInvLock -> w | rbDown -> case (yourItem w ^? _Just . itUse . heldScroll, _rbOptions w) of (_, EquipOptions{}) -> scrollRBOption y w (Nothing, _) -> closeObjScrollDir y w (Just f, _) -> doHeldScroll f y (you w) w - | lbDown -> w & cWorld . cwCam . cwcZoom +~ y + | lbDown -> w & cWorld . lWorld . cwCam . cwcZoom +~ y | invKeyDown -> changeSwapInvSel yi w | otherwise -> stopSoundFrom (CrReloadSound 0) $ changeAugInvSel yi w DisplayInventory (TweakInventory mi) @@ -83,15 +41,15 @@ updateWheelEvent yi w = case w ^. cWorld . hud . hudElement of | otherwise -> w & moveTweakSel yi DisplayInventory CombineInventory{} -> w - & cWorld . hud . hudElement . subInventory . combineInvSel . _Just %~ ((`mod` numcombs) . subtract yi) + & cWorld . lWorld . hud . hudElement . subInventory . combineInvSel . _Just %~ ((`mod` numcombs) . subtract yi) DisplayInventory (DisplayTerminal tmid) | rbDown && inTermFocus w -> guardDisconnectedID tmid w $ w - & cWorld . terminals . ix tmid %~ updatetermsubsel + & cWorld . lWorld . terminals . ix tmid %~ updatetermsubsel | inTermFocus w -> w - & cWorld . terminals . ix tmid %~ updatetermsel + & cWorld . lWorld . terminals . ix tmid %~ updatetermsel _ -> w where updatetermsel tm = case tm ^? tmInput . tiSel of @@ -113,7 +71,7 @@ updateWheelEvent yi w = case w ^. cWorld . hud . hudElement of arg = getArguments' tc tm w' !! j numcombs = length $ combineItemListYou w y = fromIntegral yi - numLocs = (fst . IM.findMax $ _seenLocations (_cWorld w)) + 1 + numLocs = (fst . IM.findMax $ (w ^. cWorld . lWorld . seenLocations)) + 1 rbDown = ButtonRight `M.member` _mouseButtons w lbDown = ButtonLeft `M.member` _mouseButtons w invKeyDown = ScancodeCapsLock `S.member` _keys w @@ -126,7 +84,7 @@ scrollRBOption y w moveTweakSel :: Int -> World -> World moveTweakSel i w = case yourItem w ^? _Just . itTweaks . tweakParams of - Just l -> w & cWorld . hud . hudElement . subInventory . tweakInvSel . _Just %~ (`mod` length l) . subtract i + Just l -> w & cWorld . lWorld . hud . hudElement . subInventory . tweakInvSel . _Just %~ (`mod` length l) . subtract i _ -> w changeTweakParam :: Maybe Int -> Int -> World -> World @@ -135,10 +93,11 @@ changeTweakParam mi i w = fromMaybe w $ do params <- yourItem w ^? _Just . itTweaks . tweakParams . ix paramid let x = (_tweakVal params + i) `mod` _tweakMax params return $ - w & cWorld . creatures . ix (_yourID (_cWorld w)) . crInv . ix (crSel (you w)) + w & cWorld . lWorld . creatures . ix (w ^. cWorld . lWorld . yourID) . crInv . ix (crSel (you w)) %~ ( (itTweaks . tweakParams . ix paramid . tweakVal .~ x) . doTweak (_tweakType params) x ) + scrollCommands :: Terminal -> [TerminalCommand] scrollCommands = (nullCommand :) . _tmScrollCommands diff --git a/src/Dodge/Update/UsingInput.hs b/src/Dodge/Update/UsingInput.hs index cb134da3d..1e4b45861 100644 --- a/src/Dodge/Update/UsingInput.hs +++ b/src/Dodge/Update/UsingInput.hs @@ -18,7 +18,7 @@ import ListHelp import SDL updateUsingInput :: World -> World -updateUsingInput w = case _hudElement $ _hud (_cWorld w) of +updateUsingInput w = case w ^. cWorld . lWorld . hud . hudElement of DisplayInventory subinv -> pressedMBEffects subinv (_mouseButtons w) w DisplayCarte -> @@ -35,10 +35,10 @@ pressedMBEffects subinv pkeys w = case subinv of maybeexitcombine (maybe id doCombine mi w) & hammers . ix SubInvHam .~ HammerDown DisplayTerminal tmid | pkeys ^? ix ButtonLeft == Just False && inTermFocus w -> - doTerminalEffectLB (w ^?! cWorld . terminals . ix tmid) w + doTerminalEffectLB (w ^?! cWorld . lWorld . terminals . ix tmid) w & hammers . ix SubInvHam .~ HammerDown | pkeys ^? ix ButtonLeft == Just False -> - w & cWorld . terminals . ix tmid . tmInput . tiFocus %~ const True + w & cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus %~ const True & hammers . ix SubInvHam .~ HammerDown _ | ButtonLeft `M.member` pkeys -> @@ -47,7 +47,7 @@ pressedMBEffects subinv pkeys w = case subinv of where maybeexitcombine | ButtonRight `M.member` _mouseButtons w = id - | otherwise = cWorld . hud . hudElement .~ DisplayInventory NoSubInventory + | otherwise = cWorld . lWorld . hud . hudElement .~ DisplayInventory NoSubInventory pressedMBEffectsNoInventory :: M.Map MouseButton Bool -> World -> World pressedMBEffectsNoInventory pkeys w @@ -55,17 +55,17 @@ pressedMBEffectsNoInventory pkeys w useItem (you w) w & hammers . ix DoubleMouseHam .~ HammerDown | justPressedDown ButtonLeft && inTopInv && w ^?! hammers . ix DoubleMouseHam == HammerUp = - useLeftItem (_yourID (_cWorld w)) w + useLeftItem (w ^. cWorld . lWorld . yourID) w | isDown ButtonLeft && inTopInv = w & hammers . ix DoubleMouseHam .~ HammerDown | isDown ButtonRight && inTopInv = w | isDown ButtonMiddle = - w & cWorld . cwCam . cwcRot -~ rotation + w & cWorld . lWorld . cwCam . cwcRot -~ rotation & clickMousePos .~ _mousePos w | isDown ButtonLeft = w & hammers . ix DoubleMouseHam .~ HammerDown | otherwise = w where - inTopInv = case _hudElement (_hud (_cWorld w)) of + inTopInv = case w ^. cWorld . lWorld . hud . hudElement of DisplayInventory NoSubInventory -> True _ -> False justPressedDown but = (pkeys ^. at but) == Just False @@ -83,8 +83,8 @@ doCombine i w = case combineItemListYou w ^? ix i of . createPutItem it $ foldr (rmInvItem yid) w (sort is) where - yid = _yourID (_cWorld w) - selectinv (Just i', w') = w' & cWorld . creatures . ix yid . crInvSel .~ InvSel i' NoInvSelAction + yid = w ^. cWorld . lWorld . yourID + selectinv (Just i', w') = w' & cWorld . lWorld . creatures . ix yid . crInvSel .~ InvSel i' NoInvSelAction selectinv (Nothing, w') = w' updatePressedButtonsCarte :: M.Map MouseButton Bool -> World -> World @@ -92,15 +92,15 @@ updatePressedButtonsCarte pkeys w | isDown ButtonRight = w & clickMousePos .~ _mousePos w - & cWorld . hud . carteCenter %~ (-.- trans) + & cWorld . lWorld . hud . carteCenter %~ (-.- trans) | isDown ButtonLeft = w & clickMousePos .~ _mousePos w - & cWorld . hud . carteRot -~ rot - & cWorld . hud . carteZoom *~ czoom + & cWorld . lWorld . hud . carteRot -~ rot + & cWorld . lWorld . hud . carteZoom *~ czoom | otherwise = w where isDown but = but `M.member` pkeys rot = angleBetween (_mousePos w) (_clickMousePos w) czoom = magV (_mousePos w) / magV (_clickMousePos w) - trans = rotateV (_carteRot (_hud (_cWorld w))) $ 1 / _carteZoom (_hud (_cWorld w)) *.* (_mousePos w -.- _clickMousePos w) + trans = rotateV (w ^. cWorld . lWorld . hud . carteRot) $ 1 / (w ^. cWorld . lWorld . hud . carteZoom) *.* (_mousePos w -.- _clickMousePos w) diff --git a/src/Dodge/Update/WallDamage.hs b/src/Dodge/Update/WallDamage.hs index 02ece64c4..6e8e7a317 100644 --- a/src/Dodge/Update/WallDamage.hs +++ b/src/Dodge/Update/WallDamage.hs @@ -10,9 +10,9 @@ import Data.Foldable updateWallDamages :: World -> World updateWallDamages w = w - & cWorld . wallDamages .~ IM.empty - & flip (IM.foldlWithKey' f) (_wallDamages (_cWorld w)) + & cWorld . lWorld . wallDamages .~ IM.empty + & flip (IM.foldlWithKey' f) (w ^. cWorld . lWorld . wallDamages) where f w' k dams = fromMaybe w' $ do - wl <- w' ^? cWorld . walls . ix k + wl <- w' ^? cWorld . lWorld . walls . ix k return $ foldl' (flip (`damageWall` wl)) w' dams diff --git a/src/Dodge/Wall/Create.hs b/src/Dodge/Wall/Create.hs index 348b92799..6c5e9f23c 100644 --- a/src/Dodge/Wall/Create.hs +++ b/src/Dodge/Wall/Create.hs @@ -8,9 +8,9 @@ import qualified IntMapHelp as IM createWall :: Wall -> World -> (Int, World) createWall wl w = ( wlid - , w & cWorld . walls %~ IM.insert wlid newwl + , w & cWorld . lWorld . walls %~ IM.insert wlid newwl & insertWallInZones newwl ) where newwl = wl{_wlID = wlid} - wlid = IM.newKey $ _walls (_cWorld w) + wlid = IM.newKey $ w ^. cWorld . lWorld . walls --_walls (_cWorld w) diff --git a/src/Dodge/Wall/Damage.hs b/src/Dodge/Wall/Damage.hs index 738391db3..f5b64c6b5 100644 --- a/src/Dodge/Wall/Damage.hs +++ b/src/Dodge/Wall/Damage.hs @@ -14,9 +14,9 @@ import LensHelp -- maybeDestroyDoor should rather happen during the door mechanism update damageWall :: Damage -> Wall -> World -> World damageWall dt wl w = case _wlStructure wl of - MachinePart mcid -> w' & cWorld . machines . ix mcid . mcDamage .:~ dt - BlockPart blid -> w' & cWorld . blocks . ix blid . blHP -~ x & maybeDestroyBlock blid - DoorPart drid -> w' & cWorld . doors . ix drid . drHP -~ x & maybeDestroyDoor drid + MachinePart mcid -> w' & cWorld . lWorld . machines . ix mcid . mcDamage .:~ dt + BlockPart blid -> w' & cWorld . lWorld . blocks . ix blid . blHP -~ x & maybeDestroyBlock blid + DoorPart drid -> w' & cWorld . lWorld . doors . ix drid . drHP -~ x & maybeDestroyDoor drid _ -> w' where x = dt' ^. dmAmount @@ -24,16 +24,16 @@ damageWall dt wl w = case _wlStructure wl of -- block destruction is convoluted... maybeDestroyBlock :: Int -> World -> World -maybeDestroyBlock blid w = case w ^? cWorld . blocks . ix blid of +maybeDestroyBlock blid w = case w ^? cWorld . lWorld . blocks . ix blid of Just bl | _blHP bl < 1 -> destroyBlock bl w _ -> w maybeDestroyDoor :: Int -> World -> World -maybeDestroyDoor drid w = case w ^? cWorld . doors . ix drid of +maybeDestroyDoor drid w = case w ^? cWorld . lWorld . doors . ix drid of Just dr | _drHP dr < 1 -> destroyDoor dr w _ -> w damageBlocksBy :: Int -> Wall -> World -> World damageBlocksBy x wl = case wl ^? wlStructure . wsBlock of - Just blid -> cWorld . blocks . ix blid . blHP -~ x + Just blid -> cWorld . lWorld . blocks . ix blid . blHP -~ x Nothing -> id diff --git a/src/Dodge/Wall/DamageEffect.hs b/src/Dodge/Wall/DamageEffect.hs index 04ced2be4..df2b552c2 100644 --- a/src/Dodge/Wall/DamageEffect.hs +++ b/src/Dodge/Wall/DamageEffect.hs @@ -68,7 +68,7 @@ glassWallDamage dm wl w = where mbl = do blid <- wl ^? wlStructure . wsBlock - w ^? cWorld . blocks . ix blid + w ^? cWorld . lWorld . blocks . ix blid d :: Int d = max 1 $ maybe 1 (subtract 1 . _blHP) mbl a :: Int -> (World -> World) -> World -> (World, Damage) diff --git a/src/Dodge/Wall/Delete.hs b/src/Dodge/Wall/Delete.hs index adb02a691..90fe0e1b6 100644 --- a/src/Dodge/Wall/Delete.hs +++ b/src/Dodge/Wall/Delete.hs @@ -12,17 +12,18 @@ import qualified IntMapHelp as IM deleteWallID :: Int -> World -> World deleteWallID i w = - w & cWorld . walls %~ IM.delete i + w & cWorld . lWorld . walls %~ IM.delete i & deleteWallFromZones wl where - wl = _walls (_cWorld w) IM.! i + --wl = _walls (_cWorld w) IM.! i + wl = w ^?! cWorld . lWorld . walls . ix i deleteWall :: Wall -> World -> World deleteWall wl = - (cWorld . walls %~ IM.delete i) + (cWorld . lWorld . walls %~ IM.delete i) . deleteWallFromZones wl where i = _wlID wl deleteWallIDs :: IS.IntSet -> World -> World -deleteWallIDs is w = foldl' (flip deleteWall) w $ IM.restrictKeys (_walls (_cWorld w)) is +deleteWallIDs is w = foldl' (flip deleteWall) w $ IM.restrictKeys (w ^. cWorld . lWorld . walls) is diff --git a/src/Dodge/Wall/Move.hs b/src/Dodge/Wall/Move.hs index 2ab6d0081..b9542285c 100644 --- a/src/Dodge/Wall/Move.hs +++ b/src/Dodge/Wall/Move.hs @@ -15,21 +15,20 @@ import Dodge.Base import Dodge.Data.World import Dodge.Wall.Zone import Geometry -import qualified IntMapHelp as IM moveWallIDUnsafe :: Int -> (Point2, Point2) -> World -> World -moveWallIDUnsafe wlid wlline w = case w ^? cWorld . walls . ix wlid of +moveWallIDUnsafe wlid wlline w = case w ^? cWorld . lWorld . walls . ix wlid of Nothing -> error "tried moving nonexistant wall" Just wl -> moveWall wlid wl wlline w moveWallID :: Int -> (Point2, Point2) -> World -> World -moveWallID wlid wlline w = case w ^? cWorld . walls . ix wlid of +moveWallID wlid wlline w = case w ^? cWorld . lWorld . walls . ix wlid of Nothing -> w Just wl -> moveWall wlid wl wlline w moveWall :: Int -> Wall -> (Point2, Point2) -> World -> World moveWall wlid wl wlline w = - w & cWorld . walls . ix wlid .~ newwl + w & cWorld . lWorld . walls . ix wlid .~ newwl & deleteWallFromZones wl & insertWallInZones newwl where @@ -37,18 +36,19 @@ moveWall wlid wl wlline w = translateWallID :: Int -> Point2 -> World -> World translateWallID wlid p w = fromMaybe w $ do - oldwl <- w ^? cWorld . walls . ix wlid + oldwl <- w ^? cWorld . lWorld . walls . ix wlid let newwl = oldwl & wlLine . each +~ p return $ w - & cWorld . walls . ix wlid .~ newwl + & cWorld . lWorld . walls . ix wlid .~ newwl & deleteWallFromZones oldwl & insertWallInZones newwl moveWallIDToward :: Int -> Float -> (Point2, Point2) -> World -> World moveWallIDToward wlid speed ep w = moveWall wlid wl newwlline w where - wl = _walls (_cWorld w) IM.! wlid + --wl = _walls (_cWorld w) IM.! wlid + wl = w ^?! cWorld . lWorld . walls . ix wlid newwlline = mvPs speed ep (_wlLine wl) mvP :: Float -> Point2 -> Point2 -> Point2 diff --git a/src/Dodge/Wall/Zone.hs b/src/Dodge/Wall/Zone.hs index 766d3bcde..41ea3ffe0 100644 --- a/src/Dodge/Wall/Zone.hs +++ b/src/Dodge/Wall/Zone.hs @@ -7,7 +7,7 @@ import Dodge.Zoning.Wall -- need to verify that this not only inserts but also overwrites (updates) any -- already existing walls insertWallInZones :: Wall -> World -> World -insertWallInZones wl = cWorld . wlZoning %~ zoneWall wl +insertWallInZones wl = cWorld . lWorld . wlZoning %~ zoneWall wl --insertWallInZones wl = wlZoning %~ updateZoning (IM.insert (_wlID wl)) wl --insertWallInZones wl = wlZoning .updatets @@ -16,6 +16,6 @@ insertWallInZones wl = cWorld . wlZoning %~ zoneWall wl -- doinsert wlzns (V2 x y) = insertIMInZone x y (_wlID wl) wl wlzns deleteWallFromZones :: Wall -> World -> World -deleteWallFromZones wl = cWorld . wlZoning %~ deZoneWall wl +deleteWallFromZones wl = cWorld . lWorld . wlZoning %~ deZoneWall wl -- %~ flip (foldl' (flip $ \(a,b) updateeIMInZone a b (_wlID wl))) (zoneOfWall wl) diff --git a/src/Dodge/WallCreatureCollisions.hs b/src/Dodge/WallCreatureCollisions.hs index d24ff507b..7a1a5efd7 100644 --- a/src/Dodge/WallCreatureCollisions.hs +++ b/src/Dodge/WallCreatureCollisions.hs @@ -15,7 +15,7 @@ import Dodge.Zoning.Wall import Geometry colCrsWalls :: Universe -> Universe -colCrsWalls uv = uv & uvWorld . cWorld . creatures %~ fmap (noclipCheck (_uvConfig uv) (_uvWorld uv)) +colCrsWalls uv = uv & uvWorld . cWorld . lWorld . creatures %~ fmap (noclipCheck (_uvConfig uv) (_uvWorld uv)) noclipCheck :: Configuration -> World -> Creature -> Creature noclipCheck cfig w c diff --git a/src/Dodge/WdP2f.hs b/src/Dodge/WdP2f.hs index e289db961..14eb47e7a 100644 --- a/src/Dodge/WdP2f.hs +++ b/src/Dodge/WdP2f.hs @@ -9,5 +9,5 @@ doWdP2f :: WdP2f -> World -> (Point2, Float) doWdP2f x = case x of WdP2f0 -> const (0, 0) WdP2fDoorPosition drid -> \w -> - let Just (a, b) = w ^? cWorld . doors . ix drid . drPos + let Just (a, b) = w ^? cWorld . lWorld . doors . ix drid . drPos in (b, argV (a -.- b)) diff --git a/src/Dodge/WorldBool.hs b/src/Dodge/WorldBool.hs index 0acf4038a..3198bfd8d 100644 --- a/src/Dodge/WorldBool.hs +++ b/src/Dodge/WorldBool.hs @@ -10,11 +10,13 @@ import qualified IntMapHelp as IM doWdBl :: WdBl -> World -> Bool doWdBl wb w = case wb of WdBlConst bl -> bl - WdTrig i -> fromMaybe False $ w ^? cWorld . triggers . ix i + WdTrig i -> fromMaybe False $ w ^? cWorld . lWorld . triggers . ix i WdBlDoorMoving i -> fromMaybe False $ do - dr <- w ^? cWorld . doors . ix i + dr <- w ^? cWorld . lWorld . doors . ix i return (DoorHalfway == _drStatus dr) - WdBlCrFilterNearPoint r p t -> any (crNearPoint r p) (IM.filter (doCrBl t) (_creatures (_cWorld w))) - WdBlBtOn btid -> _btState (_buttons (_cWorld w) IM.! btid) == BtOn -- unsafe - WdBlBtNotOff btid -> _btState (_buttons (_cWorld w) IM.! btid) /= BtOff -- unsafe + WdBlCrFilterNearPoint r p t -> any (crNearPoint r p) (IM.filter (doCrBl t) (w ^. cWorld . lWorld . creatures)) + --WdBlBtOn btid -> _btState (_buttons (_cWorld w) IM.! btid) == BtOn -- unsafe + WdBlBtOn btid -> (w ^?! cWorld . lWorld . buttons . ix btid . btState) == BtOn -- unsafe + --WdBlBtNotOff btid -> _btState (_buttons (_cWorld w) IM.! btid) /= BtOff -- unsafe + WdBlBtNotOff btid -> (w ^?! cWorld . lWorld . buttons . ix btid . btState) /= BtOff -- unsafe WdBlNegate x -> not $ doWdBl x w diff --git a/src/Dodge/WorldEffect.hs b/src/Dodge/WorldEffect.hs index 5b8bdc26a..d435766a7 100644 --- a/src/Dodge/WorldEffect.hs +++ b/src/Dodge/WorldEffect.hs @@ -18,21 +18,21 @@ import System.Random doWdWd :: WdWd -> World -> World doWdWd we = case we of NoWorldEffect -> id - SetTrigger bool tid -> cWorld . triggers . ix tid .~ bool - SetLSCol col lsid -> cWorld . lightSources . ix lsid . lsParam . lsCol .~ col + SetTrigger bool tid -> cWorld . lWorld . triggers . ix tid .~ bool + SetLSCol col lsid -> cWorld . lWorld . lightSources . ix lsid . lsParam . lsCol .~ col AccessTerminal mtmid -> accessTerminal mtmid WorldEffects wes -> \w -> foldr doWdWd w wes UnlockInv cid -> unlockInv cid MakeStartCloudAt p -> makeStartCloudAt p TorqueCr x cid -> torqueCr x cid SoundStart so p sid mi -> soundStart so p sid mi - WdWdNegateTrig trid -> cWorld . triggers . ix trid %~ not + WdWdNegateTrig trid -> cWorld . lWorld . triggers . ix trid %~ not WdWdFromItixCrixWdWd itid crid f -> \w -> fromMaybe w $ do - cr <- w ^? cWorld . creatures . ix crid + cr <- w ^? cWorld . lWorld . creatures . ix crid it <- getItem itid w return $ doItCrWdWd f it cr w WdWdFromItCrixWdWd it crid f -> \w -> fromMaybe w $ do - cr <- w ^? cWorld . creatures . ix crid + cr <- w ^? cWorld . lWorld . creatures . ix crid return $ doItCrWdWd f it cr w doItCrWdWd :: ItCrWdWd -> Item -> Creature -> World -> World @@ -44,9 +44,9 @@ accessTerminal :: Maybe Int -> World -> World accessTerminal mtmid w = case mtmid of Nothing -> w Just tmid -> - w & cWorld . hud . hudElement .~ DisplayInventory (DisplayTerminal tmid) - & cWorld . terminals . ix tmid . tmInput . tiFocus .~ True - & cWorld . terminals . ix tmid %~ tryToBoot + w & cWorld . lWorld . hud . hudElement .~ DisplayInventory (DisplayTerminal tmid) + & cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus .~ True + & cWorld . lWorld . terminals . ix tmid %~ tryToBoot where tryToBoot tm = case _tmStatus tm of TerminalReady -> tm @@ -58,8 +58,8 @@ accessTerminal mtmid w = case mtmid of torqueCr :: Float -> Int -> World -> World torqueCr x cid w - | cid == 0 = set randGen g $ over (cWorld . cwCam . cwcRot) (+ rot) w - | otherwise = set randGen g $ over (cWorld . creatures . ix cid . crDir) (+ rot) w + | cid == 0 = set randGen g $ over (cWorld . lWorld . cwCam . cwcRot) (+ rot) w + | otherwise = set randGen g $ over (cWorld . lWorld . creatures . ix cid . crDir) (+ rot) w where (rot, g) = randomR (- x, x) $ _randGen w @@ -91,7 +91,7 @@ lineOutputTerminal tls = doDeathTriggers :: Terminal -> World -> World doDeathTriggers tm w = w - & cWorld . triggers %~ flip (foldl' $ flip doDeathToggle) xs + & cWorld . lWorld . triggers %~ flip (foldl' $ flip doDeathToggle) xs where xs = M.elems $ _tmToggles tm @@ -114,7 +114,7 @@ doTmWdWd tmwdwd = case tmwdwd of TmWdId -> const id TmWdWdDisconnectTerminal -> disconnectTerminal TmWdWdTermSound sid -> \tm w -> - let tpos = fromMaybe 0 $ w ^? cWorld . buttons . ix (_tmButtonID tm) . btPos + let tpos = fromMaybe 0 $ w ^? cWorld . lWorld . buttons . ix (_tmButtonID tm) . btPos in soundStart TerminalSound tpos sid Nothing w TmWdWdDoDeathTriggers -> doDeathTriggers TmWdWdfromWdWd f -> \_ -> doWdWd f diff --git a/src/Dodge/WorldEvent/Cloud.hs b/src/Dodge/WorldEvent/Cloud.hs index 57c6a16e7..fb346269b 100644 --- a/src/Dodge/WorldEvent/Cloud.hs +++ b/src/Dodge/WorldEvent/Cloud.hs @@ -27,7 +27,7 @@ makeCloudAt :: World -> World makeCloudAt drawFunc rad t alt p = - cWorld . clouds + cWorld . lWorld . clouds .:~ Cloud { --makeCloudAt drawFunc rad t alt p = clouds %~ S.cons Cloud _clPos = p diff --git a/src/Dodge/WorldEvent/Damage.hs b/src/Dodge/WorldEvent/Damage.hs index 93870e1d7..63959bcd8 100644 --- a/src/Dodge/WorldEvent/Damage.hs +++ b/src/Dodge/WorldEvent/Damage.hs @@ -15,6 +15,6 @@ damThingHitWith :: World -> World damThingHitWith partDT sp ep mayEiCrWl = case mayEiCrWl of - Just (hitp, Left cr) -> cWorld . creatures . ix (_crID cr) . crState . csDamage .:~ partDT sp hitp ep + Just (hitp, Left cr) -> cWorld . lWorld . creatures . ix (_crID cr) . crState . csDamage .:~ partDT sp hitp ep Just (hitp, Right wl) -> damageWall (partDT sp hitp ep) wl Nothing -> id diff --git a/src/Dodge/WorldEvent/Explosion.hs b/src/Dodge/WorldEvent/Explosion.hs index 74ff0a198..c63080ba5 100644 --- a/src/Dodge/WorldEvent/Explosion.hs +++ b/src/Dodge/WorldEvent/Explosion.hs @@ -66,7 +66,7 @@ makeFlameExplosionAt :: World makeFlameExplosionAt p w = soundMultiFrom [Explosion 0, Explosion 1] p bangS Nothing w - & cWorld . flames .++~ newFlames + & cWorld . lWorld . flames .++~ newFlames where newFlames = zipWith makeFlameWithVelAndTime velocities timers makeFlameWithVelAndTime vel time = aFlameParticle time p vel @@ -81,7 +81,7 @@ makeExplosionAt p w = w & soundMultiFrom [Explosion 0, Explosion 1] p bangS Nothing & addFlames - & cWorld . tempLightSources .:~ theTLS + & cWorld . lWorld . tempLightSources .:~ theTLS & makeShockwaveAt [] p 50 50 1 white where theTLS = tlsTimeRadColPos 20 150 (V3 1 0.5 0) (addZ 20 p) diff --git a/src/Dodge/WorldEvent/Flash.hs b/src/Dodge/WorldEvent/Flash.hs index 5cee1a5ba..924d11853 100644 --- a/src/Dodge/WorldEvent/Flash.hs +++ b/src/Dodge/WorldEvent/Flash.hs @@ -25,7 +25,7 @@ import System.Random muzFlareAt :: Color -> Point3 -> Float -> World -> World muzFlareAt col tranv dir w = - w & cWorld . flares + w & cWorld . lWorld . flares .:~ MuzFlare { _flarePoly = map @@ -43,7 +43,7 @@ muzFlareAt col tranv dir w = flareCircleAt :: Color -> Float -> Point3 -> World -> World flareCircleAt col alphax tranv = - cWorld . flares + cWorld . lWorld . flares .:~ CircFlare { _flareTime = 2 , _flareColor = col @@ -52,4 +52,4 @@ flareCircleAt col alphax tranv = } explosionFlashAt :: Point2 -> World -> World -explosionFlashAt p = cWorld . tempLightSources .:~ tlsTimeRadFunPos 20 150 (TLSFade 1 10) (addZ 20 p) +explosionFlashAt p = cWorld . lWorld . tempLightSources .:~ tlsTimeRadFunPos 20 150 (TLSFade 1 10) (addZ 20 p) diff --git a/src/Dodge/WorldEvent/Shockwave.hs b/src/Dodge/WorldEvent/Shockwave.hs index c9ec2e1bb..f17db6335 100644 --- a/src/Dodge/WorldEvent/Shockwave.hs +++ b/src/Dodge/WorldEvent/Shockwave.hs @@ -26,7 +26,7 @@ makeShockwaveAt :: World -> World makeShockwaveAt is p rad dam push col = - cWorld . shockwaves + cWorld . lWorld . shockwaves .:~ Shockwave { _swInvulnerableCrs = is , _swDirection = OutwardShockwave @@ -48,7 +48,7 @@ inverseShockwaveAt :: World -> World inverseShockwaveAt p rad dam push = - cWorld . shockwaves + cWorld . lWorld . shockwaves .:~ Shockwave { _swDirection = InwardShockwave , _swInvulnerableCrs = [] diff --git a/src/Dodge/WorldEvent/SpawnParticle.hs b/src/Dodge/WorldEvent/SpawnParticle.hs index 0a58c19d5..95bb4f5c7 100644 --- a/src/Dodge/WorldEvent/SpawnParticle.hs +++ b/src/Dodge/WorldEvent/SpawnParticle.hs @@ -11,22 +11,16 @@ import LensHelp import Picture import RandomHelp ---randParticleAt :: (Point2 -> State StdGen Particle) -> Point2 -> World -> World ---randParticleAt f p w = w --- & instantParticles .:~ thepart --- & randGen .~ g --- where --- (thepart,g) = runState (f p) (_randGen w) randEnergyBallAt :: (Point2 -> State StdGen EnergyBall) -> Point2 -> World -> World randEnergyBallAt f p w = w - & cWorld . energyBalls .:~ thepart + & cWorld . lWorld . energyBalls .:~ thepart & randGen .~ g where (thepart, g) = runState (f p) (_randGen w) makeStaticBall :: Point2 -> World -> World -makeStaticBall p = randEnergyBallAt aStaticBall p . (cWorld . posEvents .:~ thesparker) +makeStaticBall p = randEnergyBallAt aStaticBall p . (cWorld . lWorld . posEvents .:~ thesparker) where thesparker = PosEvent SparkSpawner 10 p @@ -92,7 +86,7 @@ makeGasCloud :: World makeGasCloud pos vel w = w - & cWorld . clouds .:~ theCloud + & cWorld . lWorld . clouds .:~ theCloud & randGen .~ g where theCloud = diff --git a/src/Dodge/WorldEvent/ThingsHit.hs b/src/Dodge/WorldEvent/ThingsHit.hs index 74d885ad9..e97880c5b 100644 --- a/src/Dodge/WorldEvent/ThingsHit.hs +++ b/src/Dodge/WorldEvent/ThingsHit.hs @@ -45,7 +45,7 @@ crsHit sp ep w | otherwise = sortOn (dist sp . fst) . overlapSegCrs sp ep - . mapMaybe (\cid -> w ^? cWorld . creatures . ix cid) + . mapMaybe (\cid -> w ^? cWorld . lWorld . creatures . ix cid) . IS.toList . crixsNearSeg sp ep $ w diff --git a/src/Dodge/Zoning/Cloud.hs b/src/Dodge/Zoning/Cloud.hs index e89777e0b..d17441e18 100644 --- a/src/Dodge/Zoning/Cloud.hs +++ b/src/Dodge/Zoning/Cloud.hs @@ -8,13 +8,13 @@ import Geometry import qualified IntMapHelp as IM clsNearPoint :: Point2 -> World -> [Cloud] -clsNearPoint p w = zoneExtract (zoneOfPoint clZoneSize p) (w ^. cWorld . clZoning) +clsNearPoint p w = zoneExtract (zoneOfPoint clZoneSize p) (w ^. cWorld . lWorld . clZoning) clsNearSeg :: Point2 -> Point2 -> World -> [Cloud] -clsNearSeg sp ep w = zonesExtract (w ^. cWorld . clZoning) (zoneOfSeg clZoneSize sp ep) +clsNearSeg sp ep w = zonesExtract (w ^. cWorld . lWorld . clZoning) (zoneOfSeg clZoneSize sp ep) clsNearRect :: Point2 -> Point2 -> World -> [Cloud] -clsNearRect sp ep w = zonesExtract (w ^. cWorld . clZoning) $ zoneOfRect' clZoneSize sp ep +clsNearRect sp ep w = zonesExtract (w ^. cWorld . lWorld . clZoning) $ zoneOfRect' clZoneSize sp ep clsNearCirc :: Point2 -> Float -> World -> [Cloud] clsNearCirc p r = clsNearRect (p +.+ V2 r r) (p -.- V2 r r) diff --git a/src/Dodge/Zoning/Creature.hs b/src/Dodge/Zoning/Creature.hs index caf08bc24..97b466c2e 100644 --- a/src/Dodge/Zoning/Creature.hs +++ b/src/Dodge/Zoning/Creature.hs @@ -10,28 +10,28 @@ import Geometry import qualified IntMapHelp as IM crIXsNearPoint :: Point2 -> World -> IS.IntSet -crIXsNearPoint p w = zoneExtract (zoneOfPoint crZoneSize p) (w ^. cWorld . crZoning) +crIXsNearPoint p w = zoneExtract (zoneOfPoint crZoneSize p) (w ^. cWorld . lWorld . crZoning) crsNearPoint :: Point2 -> World -> [Creature] -crsNearPoint p w = mapMaybe (\cid -> w ^? cWorld . creatures . ix cid) . IS.toList $ crIXsNearPoint p w +crsNearPoint p w = mapMaybe (\cid -> w ^? cWorld . lWorld . creatures . ix cid) . IS.toList $ crIXsNearPoint p w crsNearSeg :: Point2 -> Point2 -> World -> [Creature] crsNearSeg sp ep w = - mapMaybe (\cid -> w ^? cWorld . creatures . ix cid) + mapMaybe (\cid -> w ^? cWorld . lWorld . creatures . ix cid) . IS.toList $ crixsNearSeg sp ep w crixsNearSeg :: Point2 -> Point2 -> World -> IS.IntSet -crixsNearSeg sp ep w = zonesExtract (w ^. cWorld . crZoning) (zoneOfSeg crZoneSize sp ep) +crixsNearSeg sp ep w = zonesExtract (w ^. cWorld . lWorld . crZoning) (zoneOfSeg crZoneSize sp ep) crIXsNearCirc :: Point2 -> Float -> World -> IS.IntSet crIXsNearCirc p r = crsNearRect (p +.+ V2 r r) (p -.- V2 r r) crsNearCirc :: Point2 -> Float -> World -> [Creature] -crsNearCirc p r w = mapMaybe (\cid -> w ^? cWorld . creatures . ix cid) . IS.toList $ crIXsNearCirc p r w +crsNearCirc p r w = mapMaybe (\cid -> w ^? cWorld . lWorld . creatures . ix cid) . IS.toList $ crIXsNearCirc p r w crsNearRect :: Point2 -> Point2 -> World -> IS.IntSet -crsNearRect sp ep w = zonesExtract (w ^. cWorld . crZoning) $ zoneOfRect' crZoneSize sp ep +crsNearRect sp ep w = zonesExtract (w ^. cWorld . lWorld . crZoning) $ zoneOfRect' crZoneSize sp ep crZoneSize :: Float crZoneSize = 15 @@ -43,7 +43,7 @@ minCrIXOn :: Ord a => (Creature -> a) -> IS.IntSet -> World -> Maybe Creature minCrIXOn f is w = fst <$> IS.foldl' g Nothing is where g mcrx cid = minOn snd <$> getpair cid <*> mcrx - getpair cid = fmap h $ w ^? cWorld . creatures . ix cid + getpair cid = fmap h $ w ^? cWorld . lWorld . creatures . ix cid h cr = (cr, f cr) zoneCreature :: Creature -> IM.IntMap (IM.IntMap IS.IntSet) -> IM.IntMap (IM.IntMap IS.IntSet) diff --git a/src/Dodge/Zoning/Pathing.hs b/src/Dodge/Zoning/Pathing.hs index 47a843507..90375e78f 100644 --- a/src/Dodge/Zoning/Pathing.hs +++ b/src/Dodge/Zoning/Pathing.hs @@ -10,13 +10,13 @@ import Data.Set (Set) import qualified Data.Set as Set pnsNearPoint :: Point2 -> World -> [(Int, Point2)] -pnsNearPoint p w = zoneExtract (zoneOfPoint pnZoneSize p) (w ^. cWorld . pnZoning) +pnsNearPoint p w = zoneExtract (zoneOfPoint pnZoneSize p) (w ^. cWorld . lWorld . pnZoning) pnsNearSeg :: Point2 -> Point2 -> World -> [(Int, Point2)] -pnsNearSeg sp ep w = zonesExtract (w ^. cWorld . pnZoning) (zoneOfSeg pnZoneSize sp ep) +pnsNearSeg sp ep w = zonesExtract (w ^. cWorld . lWorld . pnZoning) (zoneOfSeg pnZoneSize sp ep) pnsNearRect :: Point2 -> Point2 -> World -> [(Int, Point2)] -pnsNearRect sp ep w = zonesExtract (w ^. cWorld . pnZoning) $ zoneOfRect' pnZoneSize sp ep +pnsNearRect sp ep w = zonesExtract (w ^. cWorld . lWorld . pnZoning) $ zoneOfRect' pnZoneSize sp ep pnsNearCirc :: Point2 -> Float -> World -> [(Int, Point2)] pnsNearCirc p r = pnsNearRect (p +.+ V2 r r) (p -.- V2 r r) @@ -31,13 +31,13 @@ zonePn :: (Int, Point2) -> IM.IntMap (IM.IntMap [(Int, Point2)]) -> IM.IntMap (I zonePn pn = zoneMonoid (zoneOfPn pn) [pn] pesNearPoint :: Point2 -> World -> Set PathEdgeNodes -pesNearPoint p w = zoneExtract (zoneOfPoint peZoneSize p) (w ^. cWorld . peZoning) +pesNearPoint p w = zoneExtract (zoneOfPoint peZoneSize p) (w ^. cWorld . lWorld . peZoning) pesNearSeg :: Point2 -> Point2 -> World -> Set PathEdgeNodes -pesNearSeg sp ep w = zonesExtract (w ^. cWorld . peZoning) (zoneOfSeg peZoneSize sp ep) +pesNearSeg sp ep w = zonesExtract (w ^. cWorld . lWorld . peZoning) (zoneOfSeg peZoneSize sp ep) pesNearRect :: Point2 -> Point2 -> World -> Set PathEdgeNodes -pesNearRect sp ep w = zonesExtract (w ^. cWorld . peZoning) $ zoneOfRect' peZoneSize sp ep +pesNearRect sp ep w = zonesExtract (w ^. cWorld . lWorld . peZoning) $ zoneOfRect' peZoneSize sp ep pesNearCirc :: Point2 -> Float -> World -> Set PathEdgeNodes pesNearCirc p r = pesNearRect (p +.+ V2 r r) (p -.- V2 r r) diff --git a/src/Dodge/Zoning/Wall.hs b/src/Dodge/Zoning/Wall.hs index 7ee693916..2ae7ae28a 100644 --- a/src/Dodge/Zoning/Wall.hs +++ b/src/Dodge/Zoning/Wall.hs @@ -10,21 +10,21 @@ import Geometry import qualified IntMapHelp as IM wlIXsNearPoint :: Point2 -> World -> IS.IntSet -wlIXsNearPoint p w = zoneExtract (zoneOfPoint wlZoneSize p) (w ^. cWorld . wlZoning) +wlIXsNearPoint p w = zoneExtract (zoneOfPoint wlZoneSize p) (w ^. cWorld . lWorld . wlZoning) wlIXsNearSeg :: Point2 -> Point2 -> World -> IS.IntSet {-# INLINE wlIXsNearSeg #-} -wlIXsNearSeg sp ep w = zonesExtract (w ^. cWorld . wlZoning) (zoneOfSeg wlZoneSize sp ep) +wlIXsNearSeg sp ep w = zonesExtract (w ^. cWorld . lWorld . wlZoning) (zoneOfSeg wlZoneSize sp ep) wlIXsNearRect :: Point2 -> Point2 -> World -> IS.IntSet -wlIXsNearRect sp ep w = zonesExtract (w ^. cWorld . wlZoning) $ zoneOfRect' wlZoneSize sp ep +wlIXsNearRect sp ep w = zonesExtract (w ^. cWorld . lWorld . wlZoning) $ zoneOfRect' wlZoneSize sp ep wlIXsNearCirc :: Point2 -> Float -> World -> IS.IntSet wlIXsNearCirc p r = wlIXsNearRect (p +.+ V2 r r) (p -.- V2 r r) wlsFromIXs :: World -> IS.IntSet -> [Wall] {-# INLINE wlsFromIXs #-} -wlsFromIXs w = mapMaybe (\wlid -> w ^? cWorld . walls . ix wlid) . IS.toList +wlsFromIXs w = mapMaybe (\wlid -> w ^? cWorld . lWorld . walls . ix wlid) . IS.toList wlsNearPoint :: Point2 -> World -> [Wall] wlsNearPoint p w = wlsFromIXs w $ wlIXsNearPoint p w diff --git a/src/Dodge/Zoning/World.hs b/src/Dodge/Zoning/World.hs index dd1821de8..13a1d1231 100644 --- a/src/Dodge/Zoning/World.hs +++ b/src/Dodge/Zoning/World.hs @@ -11,7 +11,7 @@ zoneOfSight' s w = , b <- [minimum ys .. maximum ys] ] where - (xs, ys) = unzip $ map sizeZoneOfPoint $ w ^. cWorld . cwCam . cwcBoundBox + (xs, ys) = unzip $ map sizeZoneOfPoint $ w ^. cWorld . lWorld . cwCam . cwcBoundBox sizeZoneOfPoint (V2 x y) = (f x, f y) where f = floor . (/ s)