From b2efbd2b3e7b5fd4236b69f5330e8910d5a17f6d Mon Sep 17 00:00:00 2001 From: justin Date: Mon, 25 Jul 2022 12:10:50 +0100 Subject: [PATCH] Separate out concrete part of world --- appDodge/Main.hs | 2 +- src/Dodge/Barreloid.hs | 6 +- src/Dodge/Base/Collide.hs | 14 +- src/Dodge/Base/Coordinate.hs | 24 +-- src/Dodge/Base/Window.hs | 10 +- src/Dodge/Base/You.hs | 2 +- src/Dodge/Beam.hs | 8 +- src/Dodge/Block.hs | 28 +-- src/Dodge/Block/Debris.hs | 12 +- src/Dodge/Bullet.hs | 10 +- src/Dodge/Button/Event.hs | 8 +- src/Dodge/Clock.hs | 2 +- src/Dodge/Combine.hs | 6 +- src/Dodge/Creature/Action.hs | 30 ++-- src/Dodge/Creature/Boid.hs | 16 +- src/Dodge/Creature/Damage.hs | 10 +- src/Dodge/Creature/Impulse.hs | 8 +- src/Dodge/Creature/Impulse/UseItem.hs | 33 ++-- src/Dodge/Creature/Perception.hs | 4 +- src/Dodge/Creature/Picture/Awareness.hs | 4 +- src/Dodge/Creature/ReaderUpdate.hs | 2 +- src/Dodge/Creature/SetTarget.hs | 2 +- src/Dodge/Creature/State.hs | 32 ++-- src/Dodge/Creature/YourControl.hs | 16 +- src/Dodge/CreatureEffect.hs | 4 +- src/Dodge/CullBox.hs | 6 +- src/Dodge/Cuse.hs | 2 +- src/Dodge/Damage.hs | 6 +- src/Dodge/DamageCircle.hs | 4 +- src/Dodge/Data.hs | 12 +- src/Dodge/Debug/LinkDecoration.hs | 4 +- src/Dodge/Debug/Picture.hs | 12 +- src/Dodge/Debug/Terminal.hs | 24 +-- src/Dodge/Default/World.hs | 11 +- src/Dodge/DrWdWd.hs | 10 +- src/Dodge/EnergyBall.hs | 6 +- src/Dodge/Event.hs | 42 ++--- src/Dodge/Event/Keyboard.hs | 52 +++--- src/Dodge/Flame.hs | 10 +- src/Dodge/FloorItem.hs | 6 +- src/Dodge/HeldUse.hs | 8 +- src/Dodge/Humanoid.hs | 2 +- src/Dodge/Initialisation.hs | 25 +-- src/Dodge/InputFocus.hs | 6 +- src/Dodge/Inventory.hs | 127 +++++++------- src/Dodge/Inventory/Add.hs | 10 +- src/Dodge/Inventory/Lock.hs | 4 +- src/Dodge/ItEffect.hs | 14 +- src/Dodge/Item/Attachment.hs | 4 +- src/Dodge/Item/Consumable.hs | 6 +- src/Dodge/Item/Equipment.hs | 20 +-- src/Dodge/Item/Equipment/Booster.hs | 6 +- src/Dodge/Item/Location.hs | 16 +- src/Dodge/Item/Weapon/BatteryGuns.hs | 12 +- src/Dodge/Item/Weapon/ExtraEffect.hs | 16 +- src/Dodge/Item/Weapon/Launcher.hs | 8 +- src/Dodge/Item/Weapon/Remote.hs | 14 +- 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 | 10 +- src/Dodge/Layout.hs | 21 ++- src/Dodge/LevelGen.hs | 6 +- src/Dodge/LevelGen/LevelStructure.hs | 2 +- src/Dodge/LightSource.hs | 8 +- src/Dodge/LightSource/Torch.hs | 2 +- src/Dodge/LinearShockwave/Update.hs | 4 +- src/Dodge/Luse.hs | 10 +- src/Dodge/Machine.hs | 8 +- src/Dodge/Machine/Damage.hs | 2 +- src/Dodge/Machine/Destroy.hs | 6 +- src/Dodge/Machine/Update.hs | 42 ++--- src/Dodge/ModificationEffect.hs | 4 +- src/Dodge/Path.hs | 12 +- src/Dodge/Picture/SizeInvariant.hs | 16 +- .../Placement/Instance/LightSource/Flicker.hs | 8 +- src/Dodge/Placement/Instance/Sensor.hs | 2 +- src/Dodge/Placement/Instance/Terminal.hs | 8 +- src/Dodge/Placement/Instance/Turret.hs | 26 +-- src/Dodge/Placement/PlaceSpot.hs | 34 ++-- 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 | 38 ++-- 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 | 28 +-- src/Dodge/Render/Lights.hs | 8 +- src/Dodge/Render/Picture.hs | 2 +- src/Dodge/Render/ShapePicture.hs | 88 +++++----- src/Dodge/Render/Walls.hs | 2 +- src/Dodge/Room/LongDoor.hs | 2 +- src/Dodge/Save.hs | 2 +- src/Dodge/Shockwave/Update.hs | 4 +- src/Dodge/SoundLogic.hs | 4 +- src/Dodge/Spark.hs | 8 +- src/Dodge/Terminal.hs | 14 +- src/Dodge/Terminal/LeftButton.hs | 12 +- src/Dodge/Tesla/Arc.hs | 6 +- src/Dodge/Tesla/Arc/Default.hs | 2 +- src/Dodge/TractorBeam/Update.hs | 4 +- src/Dodge/Update.hs | 163 +++++++++--------- src/Dodge/Update/Camera.hs | 66 +++---- src/Dodge/Update/Cloud.hs | 2 +- src/Dodge/Update/UsingInput.hs | 68 ++++---- 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 | 8 +- src/Dodge/Wall/Move.hs | 12 +- src/Dodge/Wall/Zone.hs | 4 +- src/Dodge/WallCreatureCollisions.hs | 2 +- src/Dodge/WdP2f.hs | 2 +- src/Dodge/WorldBool.hs | 10 +- src/Dodge/WorldEffect.hs | 20 +-- 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 | 7 +- src/Dodge/WorldEvent/ThingsHit.hs | 2 +- src/Dodge/Zone.hs | 2 +- src/Dodge/Zoning/Cloud.hs | 6 +- src/Dodge/Zoning/Creature.hs | 12 +- src/Dodge/Zoning/Pathing.hs | 12 +- src/Dodge/Zoning/Wall.hs | 8 +- src/Dodge/Zoning/World.hs | 2 +- 134 files changed, 933 insertions(+), 930 deletions(-) diff --git a/appDodge/Main.hs b/appDodge/Main.hs index cb8c7d0ca..389fdce8a 100644 --- a/appDodge/Main.hs +++ b/appDodge/Main.hs @@ -97,7 +97,7 @@ updateRenderSplit u = do playSoundUnlessRewinding :: Universe -> IO (M.Map SoundOrigin Sound) playSoundUnlessRewinding u - | _timeFlow w == RewindingNow = return M.empty + | _timeFlow (_cWorld w) == RewindingNow = return M.empty | otherwise = playSoundAndUpdate (_soundData $ _preloadData u) (_playingSounds w) (_toPlaySounds w) where w = _uvWorld u diff --git a/src/Dodge/Barreloid.hs b/src/Dodge/Barreloid.hs index cb0c97084..e7f794a36 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 = foldr ($) (hiss w & creatures . at (_crID cr) .~ newCr) pierceSparks - | otherwise = makeExplosionAt (_crPos cr) $ stopSounds w & creatures . at (_crID cr) .~ Nothing + | _crHP cr > 0 = foldr ($) (hiss w & cWorld . creatures . at (_crID cr) .~ newCr) pierceSparks + | otherwise = makeExplosionAt (_crPos cr) $ stopSounds w & cWorld . creatures . at (_crID cr) .~ Nothing where g = _randGen w damages = _csDamage $ _crState cr @@ -40,7 +40,7 @@ updateExpBarrel cr w updateBarrel :: Creature -> World -> World updateBarrel cr | _crHP cr > 0 = doDamage cr - | otherwise = creatures . at (_crID cr) .~ Nothing + | otherwise = cWorld . creatures . at (_crID cr) .~ Nothing damToExpBarrel :: [Damage] -> Creature -> Creature damToExpBarrel ds cr = foldr damToExpBarrel' (foldr damToExpBarrel' cr pierceDam) otherDam diff --git a/src/Dodge/Base/Collide.hs b/src/Dodge/Base/Collide.hs index 522da625d..985e10ee8 100644 --- a/src/Dodge/Base/Collide.hs +++ b/src/Dodge/Base/Collide.hs @@ -161,7 +161,7 @@ allVisibleWalls :: World -> [(Point2,Wall)] {-# INLINE allVisibleWalls #-} allVisibleWalls w = concatMap (flip (visibleWalls vPos) w . (+.+ vPos)) $ nRays 20 where - vPos = _cameraViewFrom w + vPos = _cameraViewFrom $ _cWorld w --allVisibleWalls :: World -> StreamOf (Point2,Wall) --{-# INLINE allVisibleWalls #-} @@ -242,7 +242,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 ^? creatures . ix cid) || bl + f cid bl = maybe False (\cr -> dist p (_crPos cr) < r + _crRad cr) (w ^? cWorld . creatures . ix cid) || bl {- | More general collision tests follow -} @@ -274,22 +274,22 @@ canSee :: Int -> Int -> World -> Bool {-# INLINE canSee #-} canSee i j w = hasLOS p1 p2 w where - p1 = _crPos (_creatures w IM.! i) - p2 = _crPos (_creatures w IM.! j) + p1 = _crPos (_creatures (_cWorld w) IM.! i) + p2 = _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 w IM.! i) - jpos = _crPos (_creatures w IM.! j) + ipos = _crPos (_creatures (_cWorld w) IM.! i) + jpos = _crPos (_creatures (_cWorld w) IM.! j) anythingHitCirc :: Float -> Point2 -> Point2 -> World -> Bool anythingHitCirc rad sp ep w = hitCr || isJust (sequence hitWl) where hitCr = IS.foldr f False $ crsNearSeg sp ep w f cid bl = maybe False (\cr -> null $ intersectCircSeg (_crPos cr) (rad + _crRad cr) sp ep) - (w ^? creatures . ix cid) + (w ^? cWorld . 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 bf1889e26..7570ede14 100644 --- a/src/Dodge/Base/Coordinate.hs +++ b/src/Dodge/Base/Coordinate.hs @@ -7,31 +7,31 @@ import Geometry worldPosToScreenNorm :: Configuration -> World -> Point2 -> Point2 worldPosToScreenNorm cfig w = doWindowScale cfig . doRotate . doZoom . doTranslate where - doTranslate p = p -.- _cameraCenter w - doZoom p = _cameraZoom w *.* p - doRotate p = rotateV (negate $ _cameraRot w) p + doTranslate p = p -.- _cameraCenter (_cWorld w) + doZoom p = _cameraZoom (_cWorld w) *.* p + doRotate p = rotateV (negate $ _cameraRot (_cWorld w)) 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. - This allows for line thicknesses etc to correspond to pixel sizes.-} worldPosToScreen :: World -> Point2 -> Point2 worldPosToScreen w - = rotateV (negate $ _cameraRot w) - . (_cameraZoom w *.*) - . (-.- _cameraCenter w) + = rotateV (negate $ _cameraRot (_cWorld w)) + . (_cameraZoom (_cWorld w) *.*) + . (-.- _cameraCenter (_cWorld w)) {- | Transform coordinates from the map position to screen coordinates. -} cartePosToScreen :: Configuration -> World -> Point2 -> Point2 cartePosToScreen cfig w = doWindowScale cfig . doRotate . doZoom . doTranslate where - doTranslate p = p -.- _carteCenter (_hud w) - doZoom p = _carteZoom (_hud w) *.* p - doRotate p = rotateV (negate $ _carteRot (_hud w)) p + doTranslate p = p -.- _carteCenter (_hud (_cWorld w)) + doZoom p = _carteZoom (_hud (_cWorld w)) *.* p + doRotate p = rotateV (negate $ _carteRot (_hud (_cWorld w))) p crToMousePosOffset :: Creature -> World -> (Point2,Float) crToMousePosOffset cr w = (mouseWorldPos w -.- _crPos cr,0) {- | The mouse position in world coordinates. -} mouseWorldPos :: World -> Point2 -mouseWorldPos w = _cameraCenter w +.+ (1/_cameraZoom w) *.* rotateV (_cameraRot w) (_mousePos w) +mouseWorldPos w = _cameraCenter (_cWorld w) +.+ (1/_cameraZoom (_cWorld w)) *.* rotateV (_cameraRot (_cWorld w)) (_mousePos (_cWorld w)) {- | The mouse position in map coordinates -} mouseCartePos :: World -> Point2 -mouseCartePos w = _carteCenter (_hud w) +.+ (1/_carteZoom (_hud w)) - *.* rotateV (_carteRot (_hud w)) (_mousePos w) +mouseCartePos w = _carteCenter (_hud (_cWorld w)) +.+ (1/_carteZoom (_hud (_cWorld w))) + *.* rotateV (_carteRot (_hud (_cWorld w))) (_mousePos (_cWorld w)) diff --git a/src/Dodge/Base/Window.hs b/src/Dodge/Base/Window.hs index 3cb306edd..4669a1108 100644 --- a/src/Dodge/Base/Window.hs +++ b/src/Dodge/Base/Window.hs @@ -15,10 +15,10 @@ screenPolygon :: Configuration -> World -> [Point2] screenPolygon cfig w = map (scTran . scRot . scZoom) $ screenBox cfig -- [tr,tl,bl,br] where - scRot = rotateV (_cameraRot w) - scZoom p | _cameraZoom w /= 0 = (1/_cameraZoom w) *.* p + scRot = rotateV (_cameraRot (_cWorld w)) + scZoom p | _cameraZoom (_cWorld w) /= 0 = (1/_cameraZoom (_cWorld w)) *.* p | otherwise = p - scTran p = p +.+ _cameraCenter w + scTran p = p +.+ _cameraCenter (_cWorld w) -- 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)) @@ -35,9 +35,9 @@ screenPolygonBord xbord ybord cfig w = [tr,tl,bl,br] where hw = halfWidth cfig - xbord hh = halfHeight cfig - ybord - scZoom p | _cameraZoom w /= 0 = (1/_cameraZoom w) *.* p + scZoom p | _cameraZoom (_cWorld w) /= 0 = (1/_cameraZoom (_cWorld w)) *.* p | otherwise = p - theTransform = (+.+ _cameraCenter w) . rotateV (_cameraRot w) . scZoom + theTransform = (+.+ _cameraCenter (_cWorld w)) . rotateV (_cameraRot (_cWorld w)) . 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 91d4c854d..d3eceb184 100644 --- a/src/Dodge/Base/You.hs +++ b/src/Dodge/Base/You.hs @@ -5,7 +5,7 @@ import qualified IntMapHelp as IM --import Control.Lens you :: World -> Creature -you w = _creatures w IM.! _yourID w +you w = _creatures (_cWorld w) IM.! _yourID (_cWorld w) 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 10117c90d..983495f57 100644 --- a/src/Dodge/Beam.hs +++ b/src/Dodge/Beam.hs @@ -27,20 +27,20 @@ flameBeamCombine (p,(a,b,_),(x,y,_)) lasBeamCombine :: (Point2,(Point2,Point2,Beam),(Point2,Point2,Beam)) -> World -> World lasBeamCombine (p,(a,b,_),(x,y,_)) - = lasers .:~ lasRayAt yellow 11 1 p (argV (normalizeV (b-.-a)+.+normalizeV (y-.-x))) + = cWorld . 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,_)) - = (lasers .:~ lasRayAt yellow 11 1 p (dir+0.5*pi)) - . (lasers .:~ lasRayAt yellow 11 1 p (dir-0.5*pi)) + = (cWorld . lasers .:~ lasRayAt yellow 11 1 p (dir+0.5*pi)) + . (cWorld . lasers .:~ lasRayAt yellow 11 1 p (dir-0.5*pi)) where dir = argV (normalizeV (b-.-a)+.+normalizeV (y-.-x)) teslaBeamCombine :: (Point2,(Point2,Point2,Beam),(Point2,Point2,Beam)) -> World -> World teslaBeamCombine (p,(a,b,bm),(x,y,_)) w - = w' & pointToItem (_itemPositions w IM.! itid) . itParams . subParams ?~ ip + = w' & pointToItem (_itemPositions (_cWorld w) IM.! 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 513e58575..bdbc2640a 100644 --- a/src/Dodge/Block.hs +++ b/src/Dodge/Block.hs @@ -28,14 +28,14 @@ splinterBlock bl w = foldr unshadowBlock w (_blShadows bl) -- foldr shiftTowardC (weakenMatS bm) (_blPos bl) where bm = fromMaybe Stone $ do - wlids <- w ^? blocks . ix (_blID bl) . blWallIDs + wlids <- w ^? cWorld . blocks . ix (_blID bl) . blWallIDs (wlid,_) <- IS.minView wlids - w ^? walls . ix wlid . wlMaterial + w ^? cWorld . walls . ix wlid . wlMaterial unshadowBlock :: Int -> World -> World -unshadowBlock wlid w = case w ^? walls . ix wlid of +unshadowBlock wlid w = case w ^? cWorld . walls . ix wlid of Just wl -> w - & walls . ix wlid . wlUnshadowed .~ True + & cWorld . walls . ix wlid . wlUnshadowed .~ True & insertWallInZones (wl & wlUnshadowed .~ True) Nothing -> w @@ -50,13 +50,13 @@ destroyBlock bl w = w & makeBlockDebris bl & deleteWallIDs wlids & maybeClearPaths (_blObstructs bl) -- must happen after the walls are deleted - & blocks %~ IM.delete (_blID bl) + & cWorld . blocks %~ IM.delete (_blID bl) -- & matDesSound (_blMaterial bl) pos & flip (foldr (wlDustAt awl)) (map (pos +.+) ps) where wlids = _blWallIDs bl - awl = _walls w IM.! IS.findMin wlids - pos = fst . _wlLine $ _walls w IM.! IS.findMin wlids + awl = _walls (_cWorld w) IM.! IS.findMin wlids + pos = fst . _wlLine $ _walls (_cWorld w) IM.! IS.findMin wlids ps = replicateM 25 (randInCirc 20) & evalState $ _randGen w -- this does not handle eg doors blocking the path as well @@ -67,20 +67,20 @@ maybeClearPath :: World -> (Int,Int,PathEdge) -> World maybeClearPath w (x,y,pe) | not . null $ overlapSegWalls (_peStart pe) (_peEnd pe) $ wlsNearSeg (_peStart pe) (_peEnd pe) w = w - | otherwise = w & pathGraph %~ FGL.insEdge (x,y,pe & peObstacles .~ mempty) . FGL.delEdge (x,y) + | otherwise = w & cWorld . 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 - & doors %~ IM.delete (_drID dr) + & cWorld . doors %~ IM.delete (_drID dr) & flip (foldr (wlDustAt awl)) (map (pos +.+) ps) & stopPushing (_drPushes dr) & destroyMounts (_drMounts dr) where wlids = _drWallIDs dr - awl = _walls w IM.! IS.findMin wlids - pos = fst . _wlLine $ _walls w IM.! IS.findMin wlids + awl = _walls (_cWorld w) IM.! IS.findMin wlids + pos = fst . _wlLine $ _walls (_cWorld w) IM.! IS.findMin wlids ps = replicateM 25 (randInCirc 20) & evalState $ _randGen w destroyMounts :: [MountedObject] -> World -> World @@ -89,11 +89,11 @@ destroyMounts mos w = foldr destroyMount w mos destroyMount :: MountedObject -> World -> World destroyMount mo = case mo of MountedLS lsid -> destroyLS lsid - MountedProp prid -> props . at prid .~ Nothing + MountedProp prid -> cWorld . props . at prid .~ Nothing stopPushing :: Maybe Int -> World -> World stopPushing mdrid w = fromMaybe w $ do drid <- mdrid - dr <- w ^? doors . ix drid - return $ w & doors . ix drid . drMech .~ DrWdId + dr <- w ^? cWorld . doors . ix drid + return $ w & cWorld . doors . ix drid . drMech .~ DrWdId & stopPushing (_drPushes dr) diff --git a/src/Dodge/Block/Debris.hs b/src/Dodge/Block/Debris.hs index 6f06717d0..8176783de 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 ^? doors . ix (_drID dr) . drWallIDs + wlids <- w ^? cWorld . doors . ix (_drID dr) . drWallIDs (wlid,_) <- IS.minView wlids - wl <- w ^? walls . ix wlid + wl <- w ^? cWorld . walls . ix wlid return (_wlMaterial wl,_wlColor wl) makeBlockDebris :: Block -> World -> World @@ -32,9 +32,9 @@ makeBlockDebris bl w = foldr (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 ^? blocks . ix (_blID bl) . blWallIDs + wlids <- w ^? cWorld . blocks . ix (_blID bl) . blWallIDs (wlid,_) <- IS.minView wlids - wl <- w ^? walls . ix wlid + wl <- w ^? cWorld . walls . ix wlid return (_wlMaterial wl,_wlColor wl) makeDebrisToHeight :: Float -> Material -> Color -> Point2 -> World -> World @@ -46,7 +46,7 @@ makeDebris = makeDebrisDirected 1 2 (2*pi) 0 makeDebrisDirectedHeight :: Float -> Float -> Float -> Float -> Float -> Material -> Color -> Point2 -> World -> World makeDebrisDirectedHeight mindist maxdist arcrad dir maxh bm col p w = w - & flip (foldl' (flip $ plNew props prID)) thedebris + & flip (foldl' (flip $ plNew (cWorld . props) prID)) thedebris & randGen .~ newg & originsIDsAt [MaterialSound bm i | i <- [0,1,2]] (destroyMatS bm) p where @@ -75,7 +75,7 @@ makeDebrisDirected :: Float -> Point2 -> World -> World makeDebrisDirected mindist maxdist arcrad dir bm col p w = w - & flip (foldl' (flip $ plNew props prID)) thedebris + & flip (foldl' (flip $ plNew (cWorld . 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 99fd04dfd..784f39583 100644 --- a/src/Dodge/Bullet.hs +++ b/src/Dodge/Bullet.hs @@ -25,7 +25,7 @@ updateBullet w bu = case _buState bu of _ -> mvBullet 1 w bu useAmmoParams :: Item -> Creature -> World -> World -useAmmoParams it cr w = w & instantBullets .:~ (_amBullet bultype +useAmmoParams it cr w = w & cWorld . instantBullets .:~ (_amBullet bultype & buPos .~ sp & buTrajectory %~ settrajectory & buVel %~ (rotateV dir . (muzvel *.*)) @@ -60,7 +60,7 @@ mvBullet x w bt' partspawn <- bulletSpawn bt' return $ partspawn p w' hitstream = thingsHit p (p +.+ vel) w - bt = foldr (\mg b -> doMagnetBuBu (_mgField mg) mg b) bt' (_magnets w) + bt = foldr (\mg b -> doMagnetBuBu (_mgField mg) mg b) bt' (_magnets (_cWorld w)) & buState .~ NormalBulletState dodrag = case _buTrajectory bt of BasicBulletTrajectory -> buVel .*.*~ drag @@ -84,7 +84,7 @@ bulletSpawn :: Bullet -> Maybe (Point2 -> World -> World) bulletSpawn bu = case _buSpawn bu of BulSpark -> Nothing BulBall IncBall -> Just incBallAt - BulBall ConcBall -> Just $ \p -> shockwaves .:~ concBall p + BulBall ConcBall -> Just $ \p -> cWorld . shockwaves .:~ concBall p BulBall TeslaBall -> Just makeStaticBall hitEffFromBul :: Float -> Bullet @@ -112,8 +112,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 -> creatures . ix (_crID cr) . crState . csDamage .++~ dams - Right wl -> wallDamages %~ IM.insertWith (++) (_wlID wl) dams + Left cr -> cWorld . creatures . ix (_crID cr) . crState . csDamage .++~ dams + Right wl -> cWorld . 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 325732f98..d4b1171fa 100644 --- a/src/Dodge/Button/Event.hs +++ b/src/Dodge/Button/Event.hs @@ -9,8 +9,8 @@ doButtonEvent :: ButtonEvent -> Button -> World -> World doButtonEvent be = case be of ButtonDoNothing -> const id ButtonPress newstate newevent thesound f -> \b -> doWorldEffect f - . set (buttons . ix (_btID b) . btState) newstate - . set (buttons . ix (_btID b) . btEvent) newevent + . set (cWorld . buttons . ix (_btID b) . btState) newstate + . set (cWorld . 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 @@ -19,9 +19,9 @@ doButtonEvent be = case be of flipSwitch :: WdWd -> WdWd -> Button -> World -> World flipSwitch oneff offeff bt | _btState bt == BtOff = doWorldEffect oneff . dosound - . over (buttons . ix (_btID bt)) turnon + . over (cWorld . buttons . ix (_btID bt)) turnon | otherwise = doWorldEffect offeff . dosound - . over (buttons . ix (_btID bt)) turnoff + . over (cWorld . buttons . ix (_btID bt)) turnoff where turnon = (btState .~ BtOn ) . (btText .~ "SWITCH\\") turnoff = (btState .~ BtOff) . (btText .~ "SWITCH/") diff --git a/src/Dodge/Clock.hs b/src/Dodge/Clock.hs index b98e68e56..23efdefe8 100644 --- a/src/Dodge/Clock.hs +++ b/src/Dodge/Clock.hs @@ -9,5 +9,5 @@ clockCycle :: Int -> V.Vector a -> World -> a clockCycle tPeriod xs w = xs V.! i where l = V.length xs - t = _worldClock w `mod` (l * tPeriod) + t = _worldClock (_cWorld w) `mod` (l * tPeriod) i = t `div` tPeriod diff --git a/src/Dodge/Combine.hs b/src/Dodge/Combine.hs index e8413a555..c1962cb6f 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 w) of - DisplayInventory CombineInventory {} -> w & hud . hudElement .~ DisplayInventory NoSubInventory +toggleCombineInv w = case _hudElement (_hud (_cWorld w)) of + DisplayInventory CombineInventory {} -> w & cWorld . hud . hudElement .~ DisplayInventory NoSubInventory _ -> w & enterCombineInv enterCombineInv :: World -> World -enterCombineInv w = w & hud . hudElement .~ DisplayInventory (CombineInventory mi) +enterCombineInv w = w & cWorld . 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 0a8e12188..e3142826a 100644 --- a/src/Dodge/Creature/Action.hs +++ b/src/Dodge/Creature/Action.hs @@ -66,7 +66,7 @@ performAimAt cr w tcid p = ([TurnToward tpos aimSp], Just $ AimAt tcid tpos) aimSp = case cr ^? crMvType . mvAimSpeed of Just f -> doFloatFloat f $ safeAngleVV (unitVectorAtAngle cdir) (tpos - cpos) Nothing -> error "creature without aiming type" - tpos | canSee' = _crPos (_creatures w IM.! tcid) + tpos | canSee' = _crPos (_creatures (_cWorld w) IM.! tcid) | otherwise = p performPathTo :: Creature -> World -> Point2 -> OutAction @@ -159,8 +159,8 @@ blinkActionFail -> World blinkActionFail cr w = w & soundMultiFrom [TeleSound 0,TeleSound 1] p3 teleS Nothing - & distortions .:~ distortionBulge - & creatures . ix cid . crPos .~ p3 + & cWorld . distortions .:~ distortionBulge + & cWorld . creatures . ix cid . crPos .~ p3 & inverseShockwaveAt cpos 40 2 2 where distR = 120 @@ -176,8 +176,8 @@ blinkActionFail cr w = w blinkAction :: Creature -> World -> World blinkAction cr w = w & soundMultiFrom [TeleSound 0,TeleSound 1] p3 teleS Nothing - & distortions .++~ distortionBulge - & creatures . ix cid . crPos .~ p3 + & cWorld . distortions .++~ distortionBulge + & cWorld . creatures . ix cid . crPos .~ p3 & blinkShockwave cid p3 & inverseShockwaveAt cpos 40 2 2 where @@ -201,13 +201,13 @@ unsafeBlinkAction -> World unsafeBlinkAction cr w | success = soundMultiFrom [TeleSound 0,TeleSound 1] mwp teleS Nothing - . over distortions (distortionBulge ++) - . set (creatures . ix cid . crPos) mwp + . (cWorld . distortions .++~ distortionBulge) + . set (cWorld . creatures . ix cid . crPos) mwp . blinkShockwave cid mwp $ inverseShockwaveAt cpos 40 2 2 w | otherwise = w & blinkActionFail cr - & creatures . ix cid . crState . csDamage .:~ + & cWorld . creatures . ix cid . crState . csDamage .:~ Damage ENTERREMENT 10000 mwp mwp mwp NoDamageEffect where success = fromMaybe True $ do @@ -230,20 +230,20 @@ blinkShockwave blinkShockwave i p = makeShockwaveAt [i] p 60 1 2 cyan setMinInvSize :: Int -> Creature -> World -> World -setMinInvSize n cr = creatures . ix (_crID cr) . crInvCapacity .~ n +setMinInvSize n cr = cWorld . creatures . ix (_crID cr) . crInvCapacity .~ n -- maybe this should be removed... stripNoItems :: Creature -> World -> World stripNoItems cr = organiseInvKeys (_crID cr) . - ( creatures . ix (_crID cr) . crInv %~ IM.mapMaybe Just ) + ( cWorld . creatures . ix (_crID cr) . crInv %~ IM.mapMaybe Just ) organiseInvKeys :: Int -> World -> World -organiseInvKeys cid w = w & creatures . ix cid %~ +organiseInvKeys cid w = w & cWorld . creatures . ix cid %~ ( ( crInvSel . iselPos .~ newSelKey ) . ( crInv .~ newInv ) . ( crInvSel . iselAction .~ NoInvSelAction) ) where - cr = _creatures w IM.! cid + cr = _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 @@ -291,8 +291,8 @@ sizeSelf x cr w -- | _crPos cr1 == _crPos cr2 = Just $ w | not (crOnWall cr1 w) = Just $ w & soundMultiFrom [TeleSound 0,TeleSound 1] cpos teleS Nothing - & over distortions (distortionBulge :) - & creatures . ix cid %~ + & cWorld . distortions .:~ distortionBulge + & cWorld . creatures . ix cid %~ ( (crRad .~ 10 * x) . (crMvType . mvSpeed .~ yourDefaultSpeed * x) . (crStance . strideLength .~ ceiling (fromIntegral yourDefaultStrideLength * x)) @@ -309,7 +309,7 @@ sizeSelf x cr w cpos = _crPos cr pickUpItemID :: Int -> Int -> World -> World -pickUpItemID cid flid w = pickUpItem cid (_floorItems w IM.! flid) w +pickUpItemID cid flid w = pickUpItem cid (_floorItems (_cWorld w) IM.! flid) w {- | Pick up a specific item. -} pickUpItem :: Int -> FloorItem -> World -> World diff --git a/src/Dodge/Creature/Boid.hs b/src/Dodge/Creature/Boid.hs index 973a0b1b6..d0aafc863 100644 --- a/src/Dodge/Creature/Boid.hs +++ b/src/Dodge/Creature/Boid.hs @@ -175,7 +175,7 @@ swarmUsingCenter updT upd w cr = case _targetCr $ _crIntention cr of Just tcr -> updT tcr cenp cr where cid = _crID cr - cenp = _crGroupCenter $ _creatureGroups w IM.! _crGroupID (_crGroup $ _creatures w IM.! cid) + cenp = _crGroupCenter $ _creatureGroups (_cWorld w) IM.! _crGroupID (_crGroup $ _creatures (_cWorld w) IM.! cid) flockChaseTarget :: (Creature -> IM.IntMap Creature -> Creature -> Creature) -- ^ Update with target @@ -188,7 +188,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 w) is + crs = IM.restrictKeys (_creatures (_cWorld w)) is flockPointTarget :: (Creature -> IM.IntMap Creature -> Creature -> Point2) @@ -201,7 +201,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 w) is + crs = IM.restrictKeys (_creatures (_cWorld w)) is p = f crTarg crs cr flockToPointUsing @@ -213,7 +213,7 @@ 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 w IM.! _crGroupID (_crGroup cr) + cenp = _crGroupCenter $ _creatureGroups (_cWorld w) IM.! _crGroupID (_crGroup cr) ptarg = pf tcr cenp cr flockToPointUsing' :: (Creature -> Point2 -> Creature -> Point2) @@ -225,7 +225,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 w IM.! _crGroupID (_crGroup cr) + cenp = _crGroupCenter $ _creatureGroups (_cWorld w) IM.! _crGroupID (_crGroup cr) ptarg = pf tcr cenp cr flockFunc @@ -237,7 +237,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 w IM.! _crGroupID (_crGroup cr) + cenp = _crGroupCenter $ _creatureGroups (_cWorld w) IM.! _crGroupID (_crGroup cr) p = f crTarg cenp cr flockCenterFunc @@ -249,7 +249,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 w IM.! _crGroupID (_crGroup cr) + cenp = _crGroupCenter $ _creatureGroups (_cWorld w) IM.! _crGroupID (_crGroup cr) p = f crTarg cenp cr flockPointTargetR @@ -262,7 +262,7 @@ 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 w) is + crs = IM.restrictKeys (_creatures (_cWorld w)) is p = f crTarg crs cr meleeHeadingMove diff --git a/src/Dodge/Creature/Damage.hs b/src/Dodge/Creature/Damage.hs index 41f6f0763..f7222a580 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' - & creatures . ix (_crID cr) %~ doPoisonDam + & cWorld . creatures . ix (_crID cr) %~ doPoisonDam where (ps,ds') = partition isPoison ds isPoison Damage{_dmType=POISONDAM} = True @@ -31,15 +31,15 @@ defaultApplyDamage ds cr w = foldl' (applyIndividualDamage cr) w ds' applyDamageEffect :: Damage -> DamageEffect -> Creature -> World -> World applyDamageEffect dm de cr w = case de of PushDamage push pushexp pushRad -> w - & creatures . ix (_crID cr) . crPos .+.+~ pushAmount *.* squashNormalizeV (_crPos cr -.- fromDir) + & cWorld . 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 -> w - & creatures . ix (_crID cr) . crPos .+.+~ (pback/_crMass cr) *.* (_dmTo dm -.- fromDir) + & cWorld . creatures . ix (_crID cr) . crPos .+.+~ (pback/_crMass cr) *.* (_dmTo dm -.- fromDir) TorqueDamage rot -> w - & creatures . ix (_crID cr) . crDir +~ rot + & cWorld . creatures . ix (_crID cr) . crDir +~ rot NoDamageEffect -> w where fromDir = _dmFrom dm @@ -62,7 +62,7 @@ applyPiercingDamage cr dm p1 = p +.+ 2 *.* squashNormalizeV (p -.- _crPos cr) damageHP :: Creature -> Int -> World -> World -damageHP cr x = creatures . ix (_crID cr) %~ +damageHP cr x = cWorld . creatures . ix (_crID cr) %~ ( (crHP -~ x) . (crPastDamage +~ x) ) diff --git a/src/Dodge/Creature/Impulse.hs b/src/Dodge/Creature/Impulse.hs index 5f5f47b1d..ca319989f 100644 --- a/src/Dodge/Creature/Impulse.hs +++ b/src/Dodge/Creature/Impulse.hs @@ -24,14 +24,14 @@ impulsiveAIBeforeAfter :: (World -> Creature -> Creature) -> (World -> Creature -> Creature) -> Creature -> World -> World -impulsiveAIBeforeAfter startup endup cr w = w' & creatures . ix (_crID cr) .~ endup w' cr' +impulsiveAIBeforeAfter startup endup cr w = w' & cWorld . creatures . ix (_crID cr) .~ endup w' cr' where w' = g w (g,cr') = impulsiveAI startup cr w impulsiveAIBefore :: (World -> Creature -> Creature) -> Creature -> World -> World -impulsiveAIBefore f cr w = g w & creatures . ix (_crID cr) .~ cr' +impulsiveAIBefore f cr w = g w & cWorld . creatures . ix (_crID cr) .~ cr' where (g,cr') = impulsiveAI f cr w @@ -94,9 +94,9 @@ followImpulse cr w imp = case imp of cpos = _crPos cr cdir = _crDir cr cid = _crID cr - posFromID cid' = _crPos $ _creatures w IM.! cid' + posFromID cid' = _crPos $ _creatures (_cWorld w) IM.! cid' rr a = randomR (-a,a) $ _randGen w - hitCr i = (creatures . ix i . crState . csDamage + hitCr i = (cWorld . 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 ecce3500e..87c8482f2 100644 --- a/src/Dodge/Creature/Impulse/UseItem.hs +++ b/src/Dodge/Creature/Impulse/UseItem.hs @@ -20,11 +20,11 @@ import Data.Maybe useItem :: Creature -> World -> World useItem cr' w = fromMaybe (f w) $ do - cr <- w ^? creatures . ix (_crID cr') + cr <- w ^? cWorld . creatures . ix (_crID cr') it <- cr ^? crInv . ix (crSel cr) return $ itemEffect cr it w where - f = creatures . ix (_crID cr') . crHammerPosition .~ HammerDown + f = cWorld . creatures . ix (_crID cr') . crHammerPosition .~ HammerDown itemEffect :: Creature -> Item -> World -> World itemEffect cr it w = case it ^? itUse of @@ -40,13 +40,13 @@ itemEffect cr it w = case it ^? itUse of hammerTest f = case _crHammerPosition cr of HammerUp -> f w _ -> w & setuhamdown - setuhamdown = creatures . ix (_crID cr) . crHammerPosition .~ HammerDown - doequipmentchange = setuhamdown $ hammerTest (toggleEquipmentAt (_rbOptions w) (crSel cr) cr - . activateEquipmentAt (_rbOptions w) cr) + setuhamdown = cWorld . creatures . ix (_crID cr) . crHammerPosition .~ HammerDown + doequipmentchange = setuhamdown $ hammerTest (toggleEquipmentAt (_rbOptions (_cWorld w)) (crSel cr) cr + . activateEquipmentAt (_rbOptions (_cWorld w)) cr) tryReload :: Creature -> Item -> World -> (World -> World) -> World -> World tryReload cr it w f - | _crID cr == _yourID w && itNeedsLoading it && _mouseButtons w M.!? SDL.ButtonLeft == Just False + | _crID cr == _yourID (_cWorld w) && itNeedsLoading it && _mouseButtons (_cWorld w) M.!? SDL.ButtonLeft == Just False = crToggleReloading cr | otherwise = (runIdentity . pointToItem (_itPos it) (return . (itUse . useHammer .~ HammerDown))) @@ -58,7 +58,7 @@ itNeedsLoading it = _laLoaded ic == 0 || not (_laPrimed ic) ic = _itConsumption it activateEquipmentAt :: RightButtonOptions -> Creature -> World -> World -activateEquipmentAt rbo cr = creatures . ix (_crID cr) %~ case (rbo ^? opActivateEquipment . activateEquipment, rbo ^? opActivateEquipment . deactivateEquipment) of +activateEquipmentAt rbo cr = cWorld . creatures . ix (_crID cr) %~ case (rbo ^? opActivateEquipment . activateEquipment, rbo ^? opActivateEquipment . deactivateEquipment) of (Just i,_) -> crLeftInvSel ?~ i (_,Just _) -> crLeftInvSel .~ Nothing _ -> id @@ -67,31 +67,36 @@ toggleEquipmentAt :: RightButtonOptions -> Int -> Creature -> World -> World toggleEquipmentAt rbops invid cr w = case rbops ^? opAllocateEquipment of Just DoNotMoveEquipment -> w Just PutOnEquipment {_allocNewPos = newp} - -> w & crpoint . crEquipment . at newp ?~ invid + -> w + & crpoint . crEquipment . at newp ?~ invid & crpoint . crInvEquipped . at invid ?~ newp & onequip itm cr Just MoveEquipment {_allocNewPos=newp,_allocOldPos = oldp } - -> w & crpoint . crEquipment . at newp ?~ invid + -> w + & crpoint . crEquipment . at newp ?~ invid & crpoint . crEquipment . at oldp .~ Nothing & crpoint . crInvEquipped . at invid ?~ newp Just SwapEquipment {_allocNewPos=newp, _allocOldPos = oldp, _allocSwapID = sid } - -> w & crpoint . crEquipment . at newp ?~ invid + -> w + & crpoint . crEquipment . at newp ?~ invid & crpoint . crEquipment . at oldp ?~ sid & crpoint . crInvEquipped . at invid ?~ newp & crpoint . crInvEquipped . at sid ?~ oldp Just ReplaceEquipment {_allocNewPos = newp, _allocRemoveID = rid } - -> w & crpoint . crEquipment . at newp ?~ invid + -> w + & crpoint . crEquipment . at newp ?~ invid & crpoint . crInvEquipped . at invid ?~ newp & crpoint . crInvEquipped . at rid .~ Nothing & onremove (itmat rid) cr & onequip itm cr Just RemoveEquipment {_allocOldPos = oldp } - -> w & crpoint . crEquipment . at oldp .~ Nothing + -> w + & crpoint . crEquipment . at oldp .~ Nothing & crpoint . crInvEquipped . at invid .~ Nothing & onremove itm cr Nothing -> error "tried to toggle equipment whilst not prepared" where - crpoint = creatures . ix (_crID cr) + crpoint = cWorld . creatures . ix (_crID cr) itmat i = _crInv cr IM.! i itm = itmat (crSel cr) onequip itm' = useE ((_eqOnEquip . _eqEq . _itUse) itm') itm' @@ -110,7 +115,7 @@ useLeftItem cid w . useL f itm cr $ w where - cr = _creatures w IM.! cid + cr = _creatures (_cWorld w) IM.! cid itmShouldBeUsed = isJust (cr ^? crInv . ix (crSel cr) . itUse . cUse) || ( isJust (cr ^? crInv . ix (crSel cr) . itUse . eqEq . eqUse) && _crLeftInvSel cr /= Just (crSel cr) diff --git a/src/Dodge/Creature/Perception.hs b/src/Dodge/Creature/Perception.hs index f1da30d7b..cc61014c4 100644 --- a/src/Dodge/Creature/Perception.hs +++ b/src/Dodge/Creature/Perception.hs @@ -91,7 +91,7 @@ chaseCritAwarenessUpdate w cr = case _cpAttention $ _crPerception cr of in crActionPlan . apStrategy .~ StrategyActions WarningCry [ImpulsesList ([Bark soundid]: replicate numjits [RandomImpulse thejitter]++ [[ChangeStrategy $ CloseToMelee 0] ]) - , AimAt 0 (_crPos $ _creatures w IM.! 0) + , AimAt 0 (_crPos $ _creatures (_cWorld w) IM.! 0) ] | otherwise = id @@ -139,7 +139,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 w IM.! cid + tpos = _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 23c19df4f..6c414dfea 100644 --- a/src/Dodge/Creature/Picture/Awareness.hs +++ b/src/Dodge/Creature/Picture/Awareness.hs @@ -21,8 +21,8 @@ creatureDisplayText w cr = setLayer DebugLayer ] ) w cr where - campos = _cameraViewFrom w - theScale = 0.15 / _cameraZoom w + campos = _cameraViewFrom (_cWorld w) + theScale = 0.15 / _cameraZoom (_cWorld w) 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 dc719fb6a..b0acb40a5 100644 --- a/src/Dodge/Creature/ReaderUpdate.hs +++ b/src/Dodge/Creature/ReaderUpdate.hs @@ -172,7 +172,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 w IM.! 0 `seq` cr & crIntention . targetCr ?~ _creatures w IM.! 0 + Just (Cognizant _) -> _creatures (_cWorld w) IM.! 0 `seq` cr & crIntention . targetCr ?~ _creatures (_cWorld w) IM.! 0 _ -> cr & crIntention . targetCr .~ Nothing searchIfDamaged :: Creature -> Creature diff --git a/src/Dodge/Creature/SetTarget.hs b/src/Dodge/Creature/SetTarget.hs index 4f484da80..efb4d933d 100644 --- a/src/Dodge/Creature/SetTarget.hs +++ b/src/Dodge/Creature/SetTarget.hs @@ -10,6 +10,6 @@ targetYouWhenCognizant -> Creature -> Creature targetYouWhenCognizant w cr = case cr ^? crPerception . cpAwareness . ix 0 of - Just (Cognizant _) -> cr & crIntention . targetCr ?~ _creatures w IM.! 0 + Just (Cognizant _) -> cr & crIntention . targetCr ?~ _creatures (_cWorld w) IM.! 0 _ -> cr & crIntention . targetCr .~ Nothing diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index 849799d08..03117049d 100644 --- a/src/Dodge/Creature/State.hs +++ b/src/Dodge/Creature/State.hs @@ -32,7 +32,7 @@ foldCr :: [Creature -> World -> World] --foldCr xs cr w = foldr ($ cr) w xs foldCr xs cr w = foldr f w xs where - f g w' = case w' ^? creatures . ix (_crID cr) of + f g w' = case w' ^? cWorld . creatures . ix (_crID cr) of Just cr' -> g cr' w' Nothing -> w' @@ -66,15 +66,15 @@ checkDeath cr w & corpseOrGib cr where removecr - | _crID cr == 0 = (creatures . ix (_crID cr) . crType .~ NonDrawnCreature) - . (creatures . ix (_crID cr) . crHP .~ 0) + | _crID cr == 0 = (cWorld . creatures . ix (_crID cr) . crType .~ NonDrawnCreature) + . (cWorld . creatures . ix (_crID cr) . crHP .~ 0) -- hack to get around player creature being killed but left with more than 0 hp - | otherwise = creatures . at (_crID cr) .~ Nothing + | otherwise = cWorld . creatures . at (_crID cr) .~ Nothing corpseOrGib :: Creature -> World -> World corpseOrGib cr w = case maxDamageType (_csDamage (_crState cr)) of - Just (FLAMING,_) -> w & plNew corpses cpID (thecorpse & cpSPic %~ scorchSPic) - Just (ELECTRICAL,_) -> w & plNew corpses cpID thecorpse - Just (POISONDAM,_) -> w & plNew corpses cpID (thecorpse & cpSPic %~ poisonSPic) + 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) _ | _crPastDamage cr > 200 -> w & addCrGibs cr & bloodPuddleAt cpos & bloodPuddleAt cpos @@ -82,7 +82,7 @@ corpseOrGib cr w = case maxDamageType (_csDamage (_crState cr)) of _ -> w & bloodPuddleAt cpos & bloodPuddleAt cpos - & plNew corpses cpID thecorpse + & plNew (cWorld . corpses) cpID thecorpse where cpos = _crPos cr thecorpse = makeDefaultCorpse cr @@ -104,14 +104,14 @@ poisonSPic = over _1 $ bloodPuddleAt :: Point2 -> World -> World bloodPuddleAt p w = w - & snd . plNewID decorations + & snd . plNewID (cWorld . decorations) (color (dark $ dark red) . setDepth 01 . uncurryV translate (p +.+ q) $ circleSolid 10) & randGen .~ g where (q,g) = randInCirc 10 & runState $ _randGen w internalUpdate :: Creature -> World -> World -internalUpdate cr = creatures . ix (_crID cr) %~ +internalUpdate cr = cWorld . creatures . ix (_crID cr) %~ ( (crHammerPosition %~ moveHammerUp) . stepReloading . updateMovement @@ -127,7 +127,7 @@ dropByState cr w = foldr (dropItem cr) w $ case cr ^. crState . csDropsOnDeath o clearDamage :: Creature -> World -> World clearDamage cr w = w - & creatures . ix (_crID cr) . crState . csDamage .~ [] + & cWorld . creatures . ix (_crID cr) . crState . csDamage .~ [] doDamage :: Creature -> World -> World doDamage cr w = w @@ -140,13 +140,13 @@ doDamage cr w = w applyPastDamages :: Creature -> World -> World applyPastDamages cr w | _crPastDamage cr > 200 = let (p,g) = runState (randInCirc 3) (_randGen w) - in w & creatures . ix (_crID cr) %~ (crMvBy p . (crPastDamage -~ 100)) + in w & cWorld . creatures . ix (_crID cr) %~ (crMvBy p . (crPastDamage -~ 100)) & randGen .~ g | _crPastDamage cr > 20 = let (p,g) = runState (randInCirc 2) (_randGen w) - in w & creatures . ix (_crID cr) %~ (crMvBy p . (crPastDamage -~ 10)) + in w & cWorld . creatures . ix (_crID cr) %~ (crMvBy p . (crPastDamage -~ 10)) & randGen .~ g | _crPastDamage cr > 0 = let (p,g) = runState (randInCirc 1) (_randGen w) - in w & creatures . ix (_crID cr) %~ (crMvBy p . (crPastDamage -~ 1)) + in w & cWorld . creatures . ix (_crID cr) %~ (crMvBy p . (crPastDamage -~ 1)) & randGen .~ g | otherwise = w @@ -184,7 +184,7 @@ useEquipment cr i = useE (_eqUse (_eqEq $ _itUse itm)) itm cr itm = _crInv cr IM.! i -- a map updating all inventory items upInv :: Creature -> World -> World -upInv cr = creatures . ix (_crID cr) . crInv %~ IM.mapWithKey (itemUpdate cr) +upInv cr = cWorld . creatures . ix (_crID cr) . crInv %~ IM.mapWithKey (itemUpdate cr) -- a loop going over equipped items equipmentEffects :: Creature -> World -> World equipmentEffects cr = flip (foldr $ useEquipment cr) (IM.keys $ _crInvEquipped cr) @@ -226,7 +226,7 @@ doItemTargeting invid cr w = case cr ^? crInv . ix invid . itTargeting of Nothing -> w Just NoTargeting -> w Just t -> let (w',t') = updateTargeting (_tgUpdate t) (_crInv cr IM.! invid) cr w t - in w' & creatures . ix (_crID cr) . crInv . ix invid . itTargeting .~ t' + in w' & cWorld . 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 9fb2c137e..38e8fa482 100644 --- a/src/Dodge/Creature/YourControl.hs +++ b/src/Dodge/Creature/YourControl.hs @@ -18,12 +18,12 @@ yourControl :: Creature -> World -> World yourControl cr w | inTermFocus w = dimCreatureLight cr w & updateUsingInput | otherwise = dimCreatureLight cr w - & creatures . ix (_crID cr) %~ - (wasdWithAiming w (_mvSpeed $ _crMvType cr) . mouseActionsCr (_mouseButtons w)) + & cWorld . creatures . ix (_crID cr) %~ + (wasdWithAiming w (_mvSpeed $ _crMvType cr) . mouseActionsCr (_mouseButtons (_cWorld w))) & updateUsingInput dimCreatureLight :: Creature -> World -> World -dimCreatureLight cr = tempLightSources .:~ tlsTimeRadColPos 1 300 0.1 (addZ 100 $ _crPos cr) +dimCreatureLight cr = cWorld . 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 @@ -35,7 +35,7 @@ wasdWithAiming -> Creature wasdWithAiming w speed cr | isAiming = addAnyTwist $ set crDir mouseDir $ theMovement cr - | crIsReloading cr && SDL.ButtonRight `M.member` _mouseButtons w + | crIsReloading cr && SDL.ButtonRight `M.member` _mouseButtons (_cWorld w) = addAnyTwist $ set crDir (mouseDir + anytwist) $ theMovement cr | otherwise = theMovement $ theTurn $ removeTwist cr where @@ -52,12 +52,12 @@ wasdWithAiming w speed cr | otherwise = crMvAbsolute (speed *.* movAbs) . set crMvDir dir theTurn cr' = creatureTurnTowardDir (_crMvDir cr') 0.2 cr' movDir = wasdDir w - dir = _cameraRot w + argV movDir - movAbs = rotateV (_cameraRot w) $ normalizeV movDir + dir = _cameraRot (_cWorld w) + argV movDir + movAbs = rotateV (_cameraRot (_cWorld w)) $ 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) + _cameraRot w + _ -> argV (_mousePos (_cWorld w)) + _cameraRot (_cWorld w) wasdM :: SDL.Scancode -> Point2 wasdM scancode = case scancode of @@ -68,7 +68,7 @@ wasdM scancode = case scancode of _ -> V2 0 0 wasdDir :: World -> Point2 -wasdDir = foldr ((+.+) . wasdM) (V2 0 0) . _keys +wasdDir = foldr ((+.+) . wasdM) (V2 0 0) . _keys . _cWorld {- | Set posture according to mouse presses. -} mouseActionsCr :: M.Map SDL.MouseButton Bool -> Creature -> Creature diff --git a/src/Dodge/CreatureEffect.hs b/src/Dodge/CreatureEffect.hs index 10e9fbf43..aafb3ce98 100644 --- a/src/Dodge/CreatureEffect.hs +++ b/src/Dodge/CreatureEffect.hs @@ -92,7 +92,7 @@ chooseMovementSpreadGun cr w where d = dist cpos p cpos = _crPos cr - tcr = _creatures w IM.! 0 + tcr = _creatures (_cWorld w) IM.! 0 p = _crPos tcr chooseMovementLtAuto :: Creature -> World -> Action @@ -105,7 +105,7 @@ chooseMovementLtAuto cr w = DoImpulses [UseItem,TurnToward p' 0.05, Move (V2 0 3)] where cpos = _crPos cr - tcr = _creatures w IM.! 0 + tcr = _creatures (_cWorld w) IM.! 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 9dda65be3..74a6a8234 100644 --- a/src/Dodge/CullBox.hs +++ b/src/Dodge/CullBox.hs @@ -13,15 +13,15 @@ import Control.Lens 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 (_cameraCenter w) w + | otherwise = fromMaybe (0,0,0,0) $ farWallDistDirection (_cameraCenter (_cWorld w)) w where hw = halfWidth cfig hh = halfHeight cfig updateBounds :: Universe -> Universe updateBounds uv = uv - & uvWorld . boundDist .~ bdists - & uvWorld . boundBox .~ map ( (+.+ _cameraCenter w) . rotateV (_cameraRot w) ) (rectNSWE n s w' e) + & uvWorld . cWorld . boundDist .~ bdists + & uvWorld . cWorld . boundBox .~ map ( (+.+ _cameraCenter (_cWorld w)) . rotateV (_cameraRot (_cWorld w)) ) (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 5910499ec..e385b8887 100644 --- a/src/Dodge/Cuse.hs +++ b/src/Dodge/Cuse.hs @@ -6,4 +6,4 @@ import Control.Lens useC :: Cuse -> Item -> Creature -> World -> World useC cu = case cu of CDoNothing -> const $ const id - CHeal x -> const $ \cr -> creatures . ix (_crID cr) . crHP +~ x + CHeal x -> const $ \cr -> cWorld . creatures . ix (_crID cr) . crHP +~ x diff --git a/src/Dodge/Damage.hs b/src/Dodge/Damage.hs index 9aca2dfd2..575c4fbd3 100644 --- a/src/Dodge/Damage.hs +++ b/src/Dodge/Damage.hs @@ -9,11 +9,11 @@ import qualified Data.Map.Strict as M damageCrWlID :: Damage -> CrWlID -> World -> World damageCrWlID dam crwl = case crwl of NothingID -> id - CrID cid -> creatures . ix cid . crState . csDamage .:~ dam - WlID wlid -> wallDamages . ix wlid .:~ dam + CrID cid -> cWorld . creatures . ix cid . crState . csDamage .:~ dam + WlID wlid -> cWorld . wallDamages . ix wlid .:~ dam damageCrWall :: Damage -> Either Creature Wall -> World -> World -damageCrWall dt (Left cr) = creatures . ix (_crID cr) . crState . csDamage .:~ dt +damageCrWall dt (Left cr) = cWorld . creatures . ix (_crID cr) . crState . csDamage .:~ dt damageCrWall dt (Right wl) = damageWall dt wl damageDirection :: [Damage] -> Maybe Float diff --git a/src/Dodge/DamageCircle.hs b/src/Dodge/DamageCircle.hs index 98bf2b949..147ecd2e0 100644 --- a/src/Dodge/DamageCircle.hs +++ b/src/Dodge/DamageCircle.hs @@ -10,8 +10,8 @@ import Data.Foldable import qualified IntMapHelp as IM damageCircle :: Float -> Point2 -> DamageType -> Int -> World -> World damageCircle r sp dt da w = w - & wallDamages %~ addwalldamages - & creatures %~ addcreaturedamages + & cWorld . wallDamages %~ addwalldamages + & cWorld . 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.hs b/src/Dodge/Data.hs index 05a2dc456..a42aa5177 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -204,7 +204,13 @@ data GenWorld = GenWorld , _genPlacements :: IM.IntMap [(Placement,Int)] , _genRooms :: IM.IntMap Room } -data World = World +data World = World + { _cWorld :: CWorld + , _randGen :: StdGen + , _toPlaySounds :: M.Map SoundOrigin Sound + , _playingSounds :: M.Map SoundOrigin Sound + } +data CWorld = CWorld { _keys :: S.Set Scancode , _mouseButtons :: M.Map MouseButton Bool , _mousePos :: Point2 @@ -259,15 +265,12 @@ data World = World , _wlZoning :: IM.IntMap (IM.IntMap IS.IntSet) -- Zoning IM.IntMap Wall , _floorItems :: IM.IntMap FloorItem , _floorTiles :: [(Point3,Point3)] - , _randGen :: StdGen , _modifications :: IM.IntMap Modification , _yourID :: Int , _worldEvents :: [WdWd] , _delayedEvents :: [(Int,WdWd)] , _pressPlates :: IM.IntMap PressPlate , _buttons :: IM.IntMap Button - , _toPlaySounds :: M.Map SoundOrigin Sound - , _playingSounds :: M.Map SoundOrigin Sound , _decorations :: IM.IntMap Picture , _foregroundShapes :: IM.IntMap ForegroundShape , _corpses :: IM.IntMap Corpse @@ -501,6 +504,7 @@ makeLenses ''Equipment makeLenses ''ScreenLayer makeLenses ''WorldBeams makeLenses ''GenWorld +makeLenses ''CWorld ----- ROOM LENSES diff --git a/src/Dodge/Debug/LinkDecoration.hs b/src/Dodge/Debug/LinkDecoration.hs index 2877b4853..e4a1edec0 100644 --- a/src/Dodge/Debug/LinkDecoration.hs +++ b/src/Dodge/Debug/LinkDecoration.hs @@ -14,11 +14,11 @@ import Geometry.Vector import Control.Lens addRoomPolyDecorations :: [Room] -> World -> World -addRoomPolyDecorations rms w = w & decorations %~ +addRoomPolyDecorations rms w = w & cWorld . decorations %~ IM.insertWithNewKeys (map roomPolyDecorations rms) addRoomLinkDecorations :: [Room] -> World -> World -addRoomLinkDecorations rms w = w & decorations %~ +addRoomLinkDecorations rms w = w & cWorld . decorations %~ IM.insertWithNewKeys (map roomLinkDecorations rms) roomLinkDecorations :: Room -> Picture diff --git a/src/Dodge/Debug/Picture.hs b/src/Dodge/Debug/Picture.hs index 38112e338..c270ea844 100644 --- a/src/Dodge/Debug/Picture.hs +++ b/src/Dodge/Debug/Picture.hs @@ -19,10 +19,10 @@ printRotPoint r p = color white outsideScreenPolygon :: Configuration -> World -> [Point2] outsideScreenPolygon cfig w = [tr,tl,bl,br] where - scRot = rotateV (_cameraRot w) - scZoom p | _cameraZoom w /= 0 = (1/_cameraZoom w) *.* p + scRot = rotateV (_cameraRot (_cWorld w)) + scZoom p | _cameraZoom (_cWorld w) /= 0 = (1/_cameraZoom (_cWorld w)) *.* p | otherwise = error "Trying to set screen zoom to zero" - scTran p = p +.+ _cameraCenter w + scTran p = p +.+ _cameraCenter (_cWorld w) tr = f 3 3 tl = f (-3) 3 br = f 3 (-3) @@ -37,9 +37,9 @@ lineOnScreenCone cfig w p1 p2 = pointInPolygon p1 sp || any (isJust . uncurry (intersectSegSeg p1 p2)) sps where sp' = screenPolygon cfig w - vp = _cameraViewFrom w + vp = _cameraViewFrom (_cWorld w) sp | pointInPolygon vp sp' = sp' - | otherwise = orderPolygon (_cameraViewFrom w : sp') + | otherwise = orderPolygon (_cameraViewFrom (_cWorld w) : sp') sps = zip sp (tail sp ++ [head sp]) pointOnScreen :: Configuration -> World -> Point2 -> Bool @@ -52,7 +52,7 @@ drawWallFace cfig w wall where (x,y) = _wlLine wall points = extendConeToScreenEdge cfig w sightFrom (x,y) - sightFrom = _cameraViewFrom w + sightFrom = _cameraViewFrom (_cWorld w) 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 926da8e45..d3b64ce6e 100644 --- a/src/Dodge/Debug/Terminal.hs +++ b/src/Dodge/Debug/Terminal.hs @@ -31,16 +31,16 @@ applyTerminalString ss = case ss of applyTerminalCommand :: String -> Universe -> Universe applyTerminalCommand s = case s of "NOCLIP" -> uvConfig . debug_booleans . at Noclip %~ toggleJust - "LOADME" -> (uvWorld . creatures . ix 0 . crInv .~ stackedInventory) - . (uvWorld . creatures . ix 0 . crInvCapacity .~ 50) + "LOADME" -> (uvWorld . cWorld . creatures . ix 0 . crInv .~ stackedInventory) + . (uvWorld . cWorld . creatures . ix 0 . crInvCapacity .~ 50) "LM" -> applyTerminalCommand "LOADME" "LT" -> applyTerminalCommand "LOADTEST" - ['L',x] -> (uvWorld . creatures . ix 0 . crInv .~ IM.fromList (zip [0..] $ inventoryX x)) - . (uvWorld . creatures . ix 0 . crInvCapacity .~ 50) - "GODON" -> uvWorld . creatures . ix 0 . crMaterial .~ Crystal - "GODOFF" -> uvWorld . creatures . ix 0 . crMaterial .~ Flesh - "LOADTEST" -> (uvWorld . creatures . ix 0 . crInv .~ testInventory) - . (uvWorld . creatures . ix 0 . crInvCapacity .~ 50) + ['L',x] -> (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 + "LOADTEST" -> (uvWorld . cWorld . creatures . ix 0 . crInv .~ testInventory) + . (uvWorld . cWorld . creatures . ix 0 . crInvCapacity .~ 50) _ -> id --applyTerminalString' ('s': 'e': 't': '_': 'h': 'p': ' ': hp) -- | isNothing (readMaybe hp :: Maybe Int) = id @@ -85,10 +85,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 . creatures . ix 0 . crHP .~ round (fromJust val') - "invcap" -> uvWorld . creatures . ix 0 . crInvCapacity .~ round (fromJust val') - "mass" -> uvWorld . creatures . ix 0 . crMass .~ fromJust val' - "mvspeed" -> uvWorld . creatures . ix 0 . crMvType .mvSpeed .~ fromJust 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' _ -> 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 1f1c2e2f3..1dfd1f7de 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -11,6 +11,14 @@ import Data.Graph.Inductive.Graph hiding ((&)) --import Data.Graph.Inductive.NodeMap defaultWorld :: World defaultWorld = World + { _cWorld = defaultCWorld + , _toPlaySounds = M.empty + , _playingSounds = M.empty + , _randGen = mkStdGen 2 + } + +defaultCWorld :: CWorld +defaultCWorld = CWorld { _keys = S.empty , _magnets = IM.empty , _mouseButtons = mempty @@ -62,15 +70,12 @@ defaultWorld = World , _wlZoning = IM.empty --Zoning IM.empty wlZoneSize zoneOfWall , _floorItems = IM.empty , _floorTiles = [] - , _randGen = mkStdGen 2 , _mousePos = V2 0 0 , _yourID = 0 , _worldEvents = [] , _delayedEvents = [] , _pressPlates = IM.empty , _buttons = IM.empty - , _toPlaySounds = M.empty - , _playingSounds = M.empty , _corpses = IM.empty , _decorations = IM.empty --, _savedWorlds = M.empty diff --git a/src/Dodge/DrWdWd.hs b/src/Dodge/DrWdWd.hs index 59934446a..2cf2b3049 100644 --- a/src/Dodge/DrWdWd.hs +++ b/src/Dodge/DrWdWd.hs @@ -26,7 +26,7 @@ doorMechanism dr w = case mvDir of Just d -> w & flip (IS.foldl' (flip (`translateWallID` d))) (_drWallIDs dr) & moveUpdate - & doors . ix drid . drPos . each %~ (+.+ d) + & cWorld . doors . ix drid . drPos . each %~ (+.+ d) & maybeClearDoorPaths (_drObstacleType dr) (_drObstructs dr) Nothing -> w where @@ -46,9 +46,9 @@ doorMechanism dr w = case mvDir of dop = snd $ _drOpenPos dr dcp = snd $ _drClosePos dr setStatus - | dist dpos dop < 1 = doors . ix drid . drStatus .~ DoorOpen - | dist dpos dcp < 1 = doors . ix drid . drStatus .~ DoorClosed - | otherwise = doors . ix drid . drStatus .~ DoorHalfway + | 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 -- TODO use vector instead of list, perhaps also memoisation of rectanglePairs -- TODO update _drPos @@ -70,7 +70,7 @@ doorMechanismStepwise nsteps wlids pss dr w playSound = soundContinue (WallSound drid) (fst $ head pss) slideDoorS (Just 1) toOpen = doWdBl (_drTrigger dr) w setWalls n = playSound (foldl' (&) w (zipWith moveWallID wlids newps)) - & doors . ix drid . drStatus .~ DoorInt n + & cWorld . doors . ix drid . drStatus .~ DoorInt n where newps = uncurry (rectanglePairs 9) (pss !! n) -- it is not at all clear that the zoning selects the correct walls diff --git a/src/Dodge/EnergyBall.hs b/src/Dodge/EnergyBall.hs index 805bd91c2..da68b4229 100644 --- a/src/Dodge/EnergyBall.hs +++ b/src/Dodge/EnergyBall.hs @@ -17,7 +17,7 @@ makeFlamelet -> World makeFlamelet (V2 x y) z vel size time w = w & randGen .~ g - & energyBalls .:~ EnergyBall + & cWorld . energyBalls .:~ EnergyBall { _ebVel = vel , _ebColor = red , _ebPos = V2 x y @@ -39,7 +39,7 @@ moveEnergyBall w eb incBallAt :: Point2 -> World -> World -incBallAt p w = w & energyBalls .:~ theincball +incBallAt p w = w & cWorld . energyBalls .:~ theincball & randGen .~ g where (theincball,g) = runState thestate (_randGen w) @@ -58,6 +58,6 @@ incBallAt p w = w & energyBalls .:~ theincball ebFlicker :: EnergyBall -> World -> World ebFlicker pt - | _ebTimer pt `mod` 7 == 0 = tempLightSources + | _ebTimer pt `mod` 7 == 0 = cWorld . tempLightSources .:~ tlsTimeRadColPos 1 70 (0.5 *.*.* xyzV4 (_ebColor pt)) (addZ 20 $ _ebPos pt) | otherwise = id diff --git a/src/Dodge/Event.hs b/src/Dodge/Event.hs index a3dd762d6..790e09ec2 100644 --- a/src/Dodge/Event.hs +++ b/src/Dodge/Event.hs @@ -46,7 +46,7 @@ handleEvent e = case eventPayload e of _ -> return . Just handleMouseMotionEvent :: MouseMotionEventData -> Universe -> Maybe Universe -handleMouseMotionEvent mmev u = Just $ u & uvWorld . mousePos .~ V2 +handleMouseMotionEvent mmev u = Just $ u & uvWorld . cWorld . mousePos .~ V2 (fromIntegral x - 0.5*_windowX cfig) (0.5*_windowY cfig - fromIntegral y) where @@ -55,8 +55,8 @@ handleMouseMotionEvent mmev u = Just $ u & uvWorld . mousePos .~ V2 handleMouseButtonEvent :: MouseButtonEventData -> World -> World handleMouseButtonEvent mbev = case mouseButtonEventMotion mbev of - Released -> mouseButtons . at thebutton .~ Nothing - Pressed -> mouseButtons . at thebutton ?~ False + Released -> cWorld . mouseButtons . at thebutton .~ Nothing + Pressed -> cWorld . mouseButtons . at thebutton ?~ False where thebutton = mouseButtonEventButton mbev @@ -89,19 +89,19 @@ handleMouseWheelEvent mwev w = case _menuLayers w of _ -> Just w wheelEvent :: Float -> World -> World -wheelEvent y w = case _hudElement $ _hud w of +wheelEvent y w = case _hudElement $ _hud (_cWorld w) of DisplayCarte - | rbDown -> w & hud . carteZoom %~ min 0.75 . max 0.05 . ((1+y*0.1) * ) - | otherwise -> w & selLocation %~ (`mod` numLocs) . (+ yi) + | 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 w IM.! _yourID w) -> w - | rbDown -> case (yourItem w ^? _Just . itUse . heldScroll,_rbOptions w) of + | _crInvLock (_creatures (_cWorld w) IM.! _yourID (_cWorld w)) -> w + | rbDown -> case (yourItem w ^? _Just . itUse . heldScroll,_rbOptions (_cWorld w)) of (_,EquipOptions{}) -> scrollRBOption y w (Nothing,_) -> closeObjScrollDir y w - (Just f,_) -> w & creatures . ix 0 . crInv . ix (crSel $ you w) %~ doHeldScroll f y (you w) - | lbDown -> w & cameraZoom +~ y + (Just f,_) -> w & cWorld . creatures . ix 0 . crInv . ix (crSel $ you w) %~ doHeldScroll f y (you w) + | lbDown -> w & cWorld . cameraZoom +~ y | invKeyDown -> changeSwapInvSel yi w | otherwise -> stopSoundFrom (CrReloadSound 0) $ changeAugInvSel yi w DisplayInventory TweakInventory @@ -110,12 +110,12 @@ wheelEvent y w = case _hudElement $ _hud w of | rbDown -> w & changeTweakParam yi | otherwise -> w & moveTweakSel yi DisplayInventory (CombineInventory _) -> w - & hud . hudElement . subInventory . combineInvSel . _Just %~ ((`mod` numcombs) . subtract yi) + & cWorld . hud . hudElement . subInventory . combineInvSel . _Just %~ ((`mod` numcombs) . subtract yi) DisplayInventory (DisplayTerminal tmid) | rbDown && inTermFocus w -> guardDisconnectedID tmid w $ w - & terminals . ix tmid %~ updatetermsubsel + & cWorld . terminals . ix tmid %~ updatetermsubsel | inTermFocus w -> w - & terminals . ix tmid %~ updatetermsel + & cWorld . terminals . ix tmid %~ updatetermsel _ -> w where updatetermsel tm = case tm ^? tmInput . tiSel of @@ -134,10 +134,10 @@ wheelEvent y w = case _hudElement $ _hud w of arg = getArguments' tc tm w' !! j numcombs = length $ combineItemListYou w yi = round $ signum y - numLocs = (fst . IM.findMax $ _seenLocations w) + 1 - rbDown = ButtonRight `M.member` _mouseButtons w - lbDown = ButtonLeft `M.member` _mouseButtons w - invKeyDown = ScancodeCapsLock `S.member` _keys w + numLocs = (fst . IM.findMax $ _seenLocations (_cWorld w)) + 1 + rbDown = ButtonRight `M.member` _mouseButtons (_cWorld w) + lbDown = ButtonLeft `M.member` _mouseButtons (_cWorld w) + invKeyDown = ScancodeCapsLock `S.member` _keys (_cWorld w) getArguments' :: TerminalCommand -> Terminal -> World -> [String] getArguments' tc tm = ("" :) . getArguments tc tm @@ -159,18 +159,18 @@ nullCommand = TerminalCommand 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) + | y < 0 = w & cWorld . rbOptions . opSel %~ (min (length (_opEquip (_rbOptions (_cWorld w)))-1) . (+1)) + | y > 0 = w & cWorld . 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 & creatures . ix (_yourID w) . crInv . ix (crSel (you w)) + Just l -> w & cWorld . creatures . ix (_yourID (_cWorld w)) . crInv . ix (crSel (you w)) . itTweaks . tweakSel %~ (`mod` length l) . subtract i _ -> w changeTweakParam :: Int -> World -> World changeTweakParam i w = w - & creatures . ix (_yourID w) . crInv . ix (crSel (you w)) %~ + & cWorld . creatures . ix (_yourID (_cWorld w)) . crInv . ix (crSel (you w)) %~ ( (itTweaks . tweakParams . ix paramid . tweakVal .~ x) . doTweak (_tweakType params) x) where diff --git a/src/Dodge/Event/Keyboard.hs b/src/Dodge/Event/Keyboard.hs index e0ee9f71b..c590106dc 100644 --- a/src/Dodge/Event/Keyboard.hs +++ b/src/Dodge/Event/Keyboard.hs @@ -38,17 +38,17 @@ handleTextInput text u = u & menuLayers . ix 0 . scInput %~ updateText & updateTerminalText where - updateTerminalText = case u ^? uvWorld . hud . hudElement . subInventory of + updateTerminalText = case u ^? uvWorld . cWorld . hud . hudElement . subInventory of Just (DisplayTerminal tmid) | hasfocus tmid - -> uvWorld %~ \w -> guardDisconnectedID tmid w (w & terminals . ix tmid . tmInput . tiText %~ updateText) + -> uvWorld %~ \w -> guardDisconnectedID tmid w (w & cWorld . terminals . ix tmid . tmInput . tiText %~ updateText) _ -> id - hasfocus tmid = fromMaybe False $ u ^? uvWorld . terminals . ix tmid . tmInput . tiFocus + hasfocus tmid = fromMaybe False $ u ^? uvWorld . cWorld . 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 ^? terminals . ix tmid . tmStatus of +guardDisconnectedID tmid w w' = case w ^? cWorld . terminals . ix tmid . tmStatus of Just TerminalReady -> w' _ -> w @@ -60,23 +60,23 @@ see 'handlePressedKeyInGame'. -} handleKeyboardEvent :: KeyboardEventData -> Universe -> IO (Maybe Universe) handleKeyboardEvent kev u = case keyboardEventKeyMotion kev of - Released -> return . Just $ u & uvWorld . keys %~ S.delete scode + Released -> return . Just $ u & uvWorld . cWorld . keys %~ S.delete scode Pressed -> handlePressedKey (keyboardEventRepeat kev) scode - (u & uvWorld . keys %~ S.insert scode) + (u & uvWorld . cWorld . keys %~ S.insert scode) where scode = (keysymScancode . keyboardEventKeysym) kev handlePressedKey :: Bool -> Scancode -> Universe -> IO (Maybe Universe) handlePressedKey True ScancodeBackspace u - | _backspaceTimer (_uvWorld u) <= 0 = handlePressedKey False ScancodeBackspace u - <&> _Just . uvWorld . backspaceTimer .~ 0 - | otherwise = return $ Just $ u & uvWorld . backspaceTimer -~ 1 + | _backspaceTimer (_cWorld $ _uvWorld u) <= 0 = handlePressedKey False ScancodeBackspace u + <&> _Just . uvWorld . cWorld . backspaceTimer .~ 0 + | otherwise = return $ Just $ u & uvWorld . cWorld . backspaceTimer -~ 1 handlePressedKey True _ u = return $ Just u handlePressedKey _ scode u = case scode of ScancodeF5 -> return . Just $ doQuicksave u ScancodeF9 -> return . Just $ loadSaveSlot QuicksaveSlot u ScancodeSemicolon -> return . Just $ gotoTerminal u - _ | null (_menuLayers u) -> case u ^? uvWorld . hud . hudElement . subInventory of + _ | null (_menuLayers u) -> case u ^? uvWorld . cWorld . hud . hudElement . subInventory of Just (DisplayTerminal tmid) | inTermFocus (_uvWorld u) -> return $ uvWorld (Just . handlePressedKeyTerminal tmid scode) u _ -> return $ (Just . handlePressedKeyInGame scode) u @@ -91,9 +91,9 @@ handlePressedKeyInGame scode uv = case scode of ScancodeM -> over uvWorld toggleMap uv ScancodeR -> over uvWorld (crToggleReloading (you w)) uv ScancodeT -> over uvWorld testEvent uv - ScancodeX -> uv & uvWorld . hud . hudElement %~ toggleTweakInv + ScancodeX -> uv & uvWorld . cWorld . hud . hudElement %~ toggleTweakInv ScancodeC -> over uvWorld toggleCombineInv uv - ScancodeI -> uv & uvWorld . hud . hudElement %~ toggleInspectInv + ScancodeI -> uv & uvWorld . cWorld . hud . hudElement %~ toggleInspectInv _ -> uv where w = _uvWorld uv @@ -101,11 +101,11 @@ handlePressedKeyInGame scode uv = case scode of handlePressedKeyTerminal :: Int -> Scancode -> World -> World handlePressedKeyTerminal tmid scode w = case scode of - ScancodeEscape -> w & terminals . ix tmid . tmInput . tiFocus %~ const False - ScancodeReturn -> w & terminalReturnEffect (w ^?! terminals . ix tmid) + ScancodeEscape -> w & cWorld . terminals . ix tmid . tmInput . tiFocus %~ const False + ScancodeReturn -> w & terminalReturnEffect (w ^?! cWorld . terminals . ix tmid) ScancodeBackspace -> w - & terminals . ix tmid . tmInput . tiText %~ doBackspace - & backspaceTimer .~ 5 + & cWorld . terminals . ix tmid . tmInput . tiText %~ doBackspace + & cWorld . backspaceTimer .~ 5 _ -> w where doBackspace t = case T.unsnoc t of @@ -128,26 +128,26 @@ gotoTerminal w = case _menuLayers w of _ -> w & menuLayers .:~ InputScreen T.empty "Enter command" spaceAction :: World -> World -spaceAction w = case _hudElement $ _hud w of - DisplayCarte -> w & hud . carteCenter .~ theLoc +spaceAction w = case _hudElement $ _hud (_cWorld w) of + DisplayCarte -> w & cWorld . 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 & hud . hudElement .~ DisplayInventory NoSubInventory - _ -> w & hud . hudElement .~ DisplayInventory NoSubInventory + DisplayInventory DisplayTerminal {} -> w & cWorld . hud . hudElement .~ DisplayInventory NoSubInventory + _ -> w & cWorld . hud . hudElement .~ DisplayInventory NoSubInventory where - theLoc = doWorldPos (fst (_seenLocations w IM.! _selLocation w)) w + theLoc = doWorldPos (fst (_seenLocations (_cWorld w) IM.! _selLocation (_cWorld w))) w -- updateTopCloseObject i w' = w' & closeObjects %~ ( Right (_buttons w' IM.! i) : ) . tail pauseGame :: Universe -> Universe pauseGame = menuLayers .~ [pauseMenu] toggleMap :: World -> World -toggleMap w = case _hudElement $ _hud w of - DisplayCarte -> w & hud . hudElement .~ DisplayInventory NoSubInventory - _ -> w & hud . hudElement .~ DisplayCarte +toggleMap w = case _hudElement $ _hud (_cWorld w) of + DisplayCarte -> w & cWorld . hud . hudElement .~ DisplayInventory NoSubInventory + _ -> w & cWorld . hud . hudElement .~ DisplayCarte escapeMap :: World -> World -escapeMap w = case _hudElement $ _hud w of - DisplayCarte -> w & hud . hudElement .~ DisplayInventory NoSubInventory +escapeMap w = case _hudElement $ _hud (_cWorld w) of + DisplayCarte -> w & cWorld . hud . hudElement .~ DisplayInventory NoSubInventory _ -> w diff --git a/src/Dodge/Flame.hs b/src/Dodge/Flame.hs index 5e9ec4fd2..0f3b6b6e3 100644 --- a/src/Dodge/Flame.hs +++ b/src/Dodge/Flame.hs @@ -53,8 +53,8 @@ doDamagesFL :: (Flame -> Point2 -> [Damage]) -> World -> World doDamagesFL fdm (p,thhit) bt = case thhit of - Left cr -> creatures . ix (_crID cr) . crState . csDamage .++~ dams - Right wl -> wallDamages %~ IM.insertWith (++) (_wlID wl) dams + Left cr -> cWorld . creatures . ix (_crID cr) . crState . csDamage .++~ dams + Right wl -> cWorld . wallDamages %~ IM.insertWith (++) (_wlID wl) dams where dams = fdm bt p @@ -97,7 +97,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 w + damcrs = foldl' (flip $ \cr -> fst . hiteff [(p,Left cr)]) w $ IM.filter crt $ _creatures (_cWorld w) damwls w' = foldl' (flip $ \wl -> fst . hiteff [(p,Right wl)]) @@ -108,12 +108,12 @@ flDamageInArea crt wlt pt w = damwls damcrs flFlicker :: Flame -> World -> World flFlicker pt - | _flTimer pt `mod` 7 == 0 = tempLightSources + | _flTimer pt `mod` 7 == 0 = cWorld . 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 - & flames .:~ aFlameParticle t pos vel + & cWorld . 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 c9df6c3c3..9d08dfaf2 100644 --- a/src/Dodge/FloorItem.hs +++ b/src/Dodge/FloorItem.hs @@ -18,15 +18,15 @@ copyItemToFloor pos it = snd . copyItemToFloorID pos it {- | Copy an item to the floor, returns the floor item's id. -} copyItemToFloorID :: Point2 -> Item -> World -> (Int, World) copyItemToFloorID pos it w = (,) flid $ w' - & floorItems %~ IM.insert flid theflit + & cWorld . floorItems %~ IM.insert flid theflit & updateLocation where (p',w') = findWallFreeDropPoint (_dimRad $ _itDimension it) pos w rot = fst . randomR (-pi,pi) $ _randGen w updateLocation = case it ^? itID of - Just (Just i') -> itemPositions . ix i' .~ OnFloor flid + Just (Just i') -> cWorld . itemPositions . ix i' .~ OnFloor flid _ -> id - flid = IM.newKey $ _floorItems w + flid = IM.newKey $ _floorItems (_cWorld w) theflit = FlIt {_flIt = it & itConsumption . icAmount %~ const 1 ,_flItPos = p' diff --git a/src/Dodge/HeldUse.hs b/src/Dodge/HeldUse.hs index c71b17a8e..de8932838 100644 --- a/src/Dodge/HeldUse.hs +++ b/src/Dodge/HeldUse.hs @@ -360,10 +360,10 @@ overNozzles = overNozzles' . overNozzle overNozzles' :: (Item -> Creature -> World -> Nozzle -> (World,Nozzle)) -> Item -> Creature -> World -> World -overNozzles' eff it cr w = neww & creatures . ix cid . crInv . ix i . itParams . sprayNozzles .~ newNozzles +overNozzles' eff it cr w = neww & cWorld . creatures . ix cid . crInv . ix i . itParams . sprayNozzles .~ newNozzles where cid = _crID cr - i = crSel $ _creatures w IM.! cid + i = crSel $ _creatures (_cWorld w) IM.! cid (neww,newNozzles) = mapAccumR (eff it cr) w $ _sprayNozzles (_itParams it) overNozzle :: (Nozzle -> Item -> Creature -> World -> World) @@ -386,12 +386,12 @@ useGasParams nz it cr = createGas (_amCreateGas (_laAmmoType (_itConsumption it) pos = _crPos cr +.+ (_nzLength nz *.* unitVectorAtAngle (_crDir cr)) fireRemoteShell :: Item -> Creature -> World -> World -fireRemoteShell it cr w = set (creatures . ix cid . crInv . ix j . itUse . rUse) +fireRemoteShell it cr w = set (cWorld . creatures . ix cid . crInv . ix j . itUse . rUse) (HeldExplodeRemoteShell itid i) $ addRemRocket w' where (w',itid) = getHeldItemLoc cr w - i = IM.newKey $ _props w + i = IM.newKey $ _props (_cWorld w) cid = _crID cr addRemRocket = makeShell it cr [ PJSetScope itid diff --git a/src/Dodge/Humanoid.hs b/src/Dodge/Humanoid.hs index c5f493429..95e5b659e 100644 --- a/src/Dodge/Humanoid.hs +++ b/src/Dodge/Humanoid.hs @@ -170,7 +170,7 @@ chooseMovementPistol' cr w = takeOneWeighted [chargeProb,retreatProb,strafeProb, where g = _randGen w cpos = _crPos cr - ycr = _creatures w IM.! 0 + ycr = _creatures (_cWorld w) IM.! 0 ypos = _crPos ycr chargeProb | dist cpos ypos > 300 = 5 | dist cpos ypos > 150 = 1 diff --git a/src/Dodge/Initialisation.hs b/src/Dodge/Initialisation.hs index 4a701fb9c..d34950177 100644 --- a/src/Dodge/Initialisation.hs +++ b/src/Dodge/Initialisation.hs @@ -13,26 +13,13 @@ import System.Random import qualified Data.Set as S import qualified IntMapHelp as IM import qualified Data.Map as M +import Control.Lens initialWorld :: World initialWorld = defaultWorld - { _keys = S.empty - , _cameraCenter = V2 0 0 - , _cameraRot = 0 - , _cameraZoom = 10 - , _creatures = IM.fromList [(0,startCr)] - , _props = IM.empty - , _walls = IM.empty - , _floorItems = IM.empty - , _randGen = mkStdGen 2 - , _mousePos = V2 0 0 - , _yourID = 0 - , _worldEvents = SoundStart BackgroundSound (V2 0 0) foamSprayFadeOutS Nothing - : [MakeStartCloudAt (V3 x y 5) | x <- [-5,-4..5] , y <- [-5,-4..5]] - , _pressPlates = IM.empty - , _buttons = IM.empty - , _toPlaySounds = M.empty - , _decorations = IM.empty --- , _menuLayers = [TerminalScreen 300 rezText'] - } + & cWorld . cameraZoom .~ 10 + & cWorld . creatures .~ IM.fromList [(0,startCr)] + & cWorld . yourID .~ 0 + & cWorld . 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 484aa2a31..c295f74a0 100644 --- a/src/Dodge/InputFocus.hs +++ b/src/Dodge/InputFocus.hs @@ -6,7 +6,7 @@ import Data.Maybe inTermFocus :: World -> Bool inTermFocus w = fromMaybe False $ do - tmid <- w ^? hud . hudElement . subInventory . termID - hasfocus <- w ^? terminals . ix tmid . tmInput . tiFocus - connectionstatus <- w ^? terminals . ix tmid . tmStatus + tmid <- w ^? cWorld . hud . hudElement . subInventory . termID + hasfocus <- w ^? cWorld . terminals . ix tmid . tmInput . tiFocus + connectionstatus <- w ^? cWorld . terminals . ix tmid . tmStatus return $ hasfocus && connectionstatus == TerminalReady diff --git a/src/Dodge/Inventory.hs b/src/Dodge/Inventory.hs index 75d5b380b..f8de6415f 100644 --- a/src/Dodge/Inventory.hs +++ b/src/Dodge/Inventory.hs @@ -53,23 +53,24 @@ rmInvItem :: Int -- ^ Creature id -> Int -- ^ Inventory position -> World -> World -rmInvItem cid invid w = case w ^? creatures . ix cid . crInv . ix invid . itConsumption . icAmount of - Just x | x > 1 -> w & creatures . ix cid . crInv . ix invid . itConsumption . icAmount %~ subtract 1 - _ -> w & creatures . ix cid . crInv %~ f - & creatures . ix cid . crInvSel %~ stopCrInvSelAction - & creatures . ix cid . crInvSel . iselPos %~ g - & creatures . ix cid . crLeftInvSel %~ g' +rmInvItem cid invid w = case w ^? cWorld . creatures . ix cid . crInv . ix invid . itConsumption . icAmount of + Just x | x > 1 -> w & cWorld . creatures . ix cid . crInv . ix invid . itConsumption . icAmount %~ 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' & removeAnySlotEquipment & dounequipfunction & doanyitemeffect - & creatures . ix cid . crInvEquipped %~ IM.delete invid - & creatures . ix cid . crInvEquipped %~ IM.mapKeys g + & cWorld . creatures . ix cid . crInvEquipped %~ IM.delete invid + & cWorld . creatures . ix cid . crInvEquipped %~ IM.mapKeys g -- TODO check whether this can be mapKeysMonotonic where stopCrInvSelAction (InvSel i a) | i == invid = InvSel i NoInvSelAction | otherwise = InvSel i a - cr = _creatures w IM.! cid + cr = _creatures (_cWorld w) IM.! cid itm = _crInv cr IM.! invid dounequipfunction = fromMaybe id $ do rmf <- itm ^? itUse . eqEq . eqOnRemove @@ -77,10 +78,10 @@ rmInvItem cid invid w = case w ^? creatures . ix cid . crInv . ix invid . itCons doanyitemeffect = fromMaybe id $ do rmf <- itm ^? itEffect . ieDrop return $ doDropEffect rmf itm cr - removeAnySlotEquipment = case w ^? creatures . ix cid . crInvEquipped . ix invid of - Just epos -> creatures . ix cid . crEquipment . at epos .~ Nothing + removeAnySlotEquipment = case w ^? cWorld . creatures . ix cid . crInvEquipped . ix invid of + Just epos -> cWorld . creatures . ix cid . crEquipment . at epos .~ Nothing Nothing -> id - maxk = fmap fst $ IM.lookupMax $ _crInv $ _creatures w IM.! cid + maxk = fmap fst $ IM.lookupMax $ _crInv $ _creatures (_cWorld w) IM.! cid f inv = let (xs,ys) = IM.split invid inv in xs `IM.union` IM.mapKeys (subtract 1) ys g x | x > invid || Just x == maxk = max 0 $ x - 1 @@ -92,7 +93,7 @@ rmInvItem cid invid w = case w ^? creatures . ix cid . crInv . ix invid . itCons | otherwise = Just x rmSelectedInvItem :: Int -> World -> World -rmSelectedInvItem cid w = rmInvItem cid (crSel (_creatures w IM.! cid)) w +rmSelectedInvItem cid w = rmInvItem cid (crSel (_creatures (_cWorld w) IM.! cid)) w augmentedInvSizes :: World -> IM.IntMap Int augmentedInvSizes = bimapAugmentInv itSlotsTaken closeObjectSize @@ -100,7 +101,7 @@ augmentedInvSizes = bimapAugmentInv itSlotsTaken closeObjectSize bimapAugmentInv :: (Item -> a) -> (Either FloorItem Button -> a) -> World -> IM.IntMap a bimapAugmentInv f g w = IM.union (f <$> yourInv w) - (IM.fromAscList $ zip [length (yourInv w) ..] $ map g $ _closeObjects w) + (IM.fromAscList $ zip [length (yourInv w) ..] $ map g $ _closeObjects (_cWorld w)) invSelSize :: Int -> World -> Int invSelSize i w = fromMaybe 1 $ augmentedInvSizes w IM.!? i @@ -154,18 +155,18 @@ updateTerminal :: World -> World updateTerminal = checkTermDist checkTermDist :: World -> World -checkTermDist w = case w ^? hud . hudElement . subInventory . termID of - Just tmid -> fromMaybe (w & hud . hudElement .~ DisplayInventory NoSubInventory) $ do - btid <- w ^? terminals . ix tmid . tmButtonID - btpos <- w ^? buttons . ix btid . btPos +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 if dist btpos (_crPos $ you w) < 40 then Just w else Nothing Nothing -> w -- this looks ugly... updateCloseObjects :: World -> World updateCloseObjects w = w - & closeObjects .~ unionBy closeObjEq oldCloseFiltered currentClose - & creatures . ix (_yourID w) . crInvSel . iselPos %~ updateinvsel + & cWorld . closeObjects .~ unionBy closeObjEq oldCloseFiltered currentClose + & cWorld . creatures . ix (_yourID (_cWorld w)) . crInvSel . iselPos %~ updateinvsel where updateinvsel curinvsel | length (augmentedInvSizes w) <= curinvsel = max 0 $ length (augmentedInvSizes w) - 1 @@ -175,26 +176,26 @@ updateCloseObjects w = w activeButtons = map Right . filter ( (/=) BtNoLabel . _btState) . IM.elems - $ _buttons w - currentClose = filt $ map Left (IM.elems $ _floorItems w) ++ activeButtons - oldClose = filt $ mapMaybe updatebyid $ _closeObjects w + $ _buttons (_cWorld w) + currentClose = filt $ map Left (IM.elems $ _floorItems (_cWorld w)) ++ activeButtons + oldClose = filt $ mapMaybe updatebyid $ _closeObjects (_cWorld w) oldCloseFiltered = intersectBy closeObjEq oldClose currentClose - updatebyid (Left flid) = fmap Left $ w ^? floorItems . ix (_flItID flid) - updatebyid (Right btid) = fmap Right $ w ^? buttons . ix (_btID btid) + updatebyid (Left flid) = fmap Left $ w ^? cWorld . floorItems . ix (_flItID flid) + updatebyid (Right btid) = fmap Right $ w ^? cWorld . buttons . ix (_btID btid) updateRBList :: World -> World updateRBList w - | w ^? rbOptions . opCurInvPos == Just curinvid + | w ^? cWorld . rbOptions . opCurInvPos == Just curinvid = w & setEquipAllocation & setEquipActivation | otherwise = case cr ^? crInv . ix curinvid . itUse . eqEq . eqSite of Just esite -> w - & rbOptions .~ EquipOptions (equipSiteToPositions esite) + & cWorld . rbOptions .~ EquipOptions (equipSiteToPositions esite) (chooseEquipmentPosition cr (equipSiteToPositions esite)) curinvid DoNotMoveEquipment NoChangeActivateEquipment & setEquipAllocation & setEquipActivation - Nothing -> w & rbOptions .~ NoRightButtonOptions + Nothing -> w & cWorld . rbOptions .~ NoRightButtonOptions -- | otherwise = w & rbOptions .~ NoRightButtonOptions where curinvid = crSel cr @@ -211,53 +212,53 @@ chooseFreeSite cr = fromMaybe 0 . findIndex hasnoequipment hasnoequipment ep = isNothing $ cr ^? crEquipment . ix ep setEquipAllocation :: World -> World -setEquipAllocation w = case _rbOptions w of +setEquipAllocation w = case _rbOptions (_cWorld w) of EquipOptions {_opEquip = es,_opSel=i} -> case you w ^? crInvEquipped . ix (crSel (you w)) of Just epos | es !! i == epos - -> w & rbOptions . opAllocateEquipment .~ RemoveEquipment + -> w & cWorld . rbOptions . opAllocateEquipment .~ RemoveEquipment {_allocOldPos = epos} Just epos | isJust (you w ^? crEquipment . ix (es !! i)) - -> w & rbOptions . opAllocateEquipment .~ SwapEquipment + -> w & cWorld . rbOptions . opAllocateEquipment .~ SwapEquipment {_allocOldPos = epos ,_allocNewPos = es !! i ,_allocSwapID = _crEquipment (you w) M.! (es !! i) } - Just epos -> w & rbOptions . opAllocateEquipment .~ MoveEquipment + Just epos -> w & cWorld . rbOptions . opAllocateEquipment .~ MoveEquipment {_allocOldPos = epos ,_allocNewPos = es !! i } Nothing | isJust (you w ^? crEquipment . ix (es !! i)) - -> w & rbOptions . opAllocateEquipment .~ ReplaceEquipment + -> w & cWorld . rbOptions . opAllocateEquipment .~ ReplaceEquipment {_allocNewPos = es !! i ,_allocRemoveID = _crEquipment (you w) M.! (es !! i) } - Nothing -> w & rbOptions . opAllocateEquipment .~ PutOnEquipment + Nothing -> w & cWorld . rbOptions . opAllocateEquipment .~ PutOnEquipment {_allocNewPos = es !! i} _ -> w -- where -- curpos = invSelPos w setEquipActivation :: World -> World -setEquipActivation w = case w ^? rbOptions . opAllocateEquipment of +setEquipActivation w = case w ^? cWorld . rbOptions . opAllocateEquipment of Just DoNotMoveEquipment -> w Just RemoveEquipment { } -> case _crLeftInvSel (you w) of - Just i | i == invsel -> w & rbOptions . opActivateEquipment .~ DeactivateEquipment + Just i | i == invsel -> w & cWorld . rbOptions . opActivateEquipment .~ DeactivateEquipment {_deactivateEquipment = i} - _ -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment + _ -> w & cWorld . rbOptions . opActivateEquipment .~ NoChangeActivateEquipment Just rbos -> case _crLeftInvSel (you w) of - Just i | i == invsel -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment - Just i | invselcanactivate -> w & rbOptions . opActivateEquipment .~ ActivateDeactivateEquipment + Just i | i == invsel -> w & cWorld . rbOptions . opActivateEquipment .~ NoChangeActivateEquipment + Just i | invselcanactivate -> w & cWorld . rbOptions . opActivateEquipment .~ ActivateDeactivateEquipment {_activateEquipment = invsel,_deactivateEquipment = i} Just i | Just i == rbos ^? allocRemoveID - -> w & rbOptions . opActivateEquipment .~ DeactivateEquipment i - Just _ -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment - Nothing | invselcanactivate -> w & rbOptions . opActivateEquipment .~ ActivateEquipment + -> w & cWorld . rbOptions . opActivateEquipment .~ DeactivateEquipment i + Just _ -> w & cWorld . rbOptions . opActivateEquipment .~ NoChangeActivateEquipment + Nothing | invselcanactivate -> w & cWorld . rbOptions . opActivateEquipment .~ ActivateEquipment {_activateEquipment = invsel} - Nothing -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment - Nothing -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment + Nothing -> w & cWorld . rbOptions . opActivateEquipment .~ NoChangeActivateEquipment + Nothing -> w & cWorld . rbOptions . opActivateEquipment .~ NoChangeActivateEquipment where invsel = crSel (you w) invselcanactivate = isJust (you w ^? crInv . ix invsel . itUse . lUse) @@ -274,29 +275,32 @@ equipSiteToPositions es = case es of closeObjScrollDir :: Float -> World -> World closeObjScrollDir x - | x > 0 = over closeObjects rotU - | x < 0 = over closeObjects rotD + | x > 0 = over (cWorld . closeObjects) rotU + | x < 0 = over (cWorld . closeObjects) rotD | otherwise = id changeInvSel :: Int -> World -> World changeInvSel i w | n == 0 = w - | yourInvSel w < n = w & creatures . ix (_yourID w) . crInvSel . iselPos %~ (`mod` n) . subtract i - & creatures . ix (_yourID w) . crInvSel . iselAction .~ NoInvSelAction - | otherwise = w & creatures . ix (_yourID w) . crInvSel . iselPos %~ ((+n) . (`mod` numCO) . subtract (i+n)) - & creatures . ix (_yourID w) . crInvSel . iselAction .~ NoInvSelAction + | 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 + | 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 -- arguably this should jump the invpos into the inventory proper where - n = length $ _crInv $ _creatures w IM.! _yourID w - numCO = length $ _closeObjects w + n = length $ _crInv $ _creatures (_cWorld w) IM.! _yourID (_cWorld w) + numCO = length $ _closeObjects (_cWorld w) changeSwapInvSel :: Int -> World -> World changeSwapInvSel k w | n == 0 = w | yourInvSel w < n = w - & creatures . ix (_yourID w) %~ updatecreature - | otherwise = w & creatures . ix (_yourID w) . crInvSel . iselPos .~ ico' - & closeObjects %~ swapIndices (i - n) (ico' - n) + & cWorld . creatures . ix (_yourID (_cWorld w)) %~ updatecreature + | otherwise = w + & cWorld . creatures . ix (_yourID (_cWorld w)) . crInvSel . iselPos .~ ico' + & cWorld . closeObjects %~ swapIndices (i - n) (ico' - n) where updatecreature = ( crInv %~ IM.safeSwapKeys (i `mod` n) swapi ) . (crLeftInvSel . _Just %~ updateLeftInvSel) @@ -315,18 +319,19 @@ changeSwapInvSel k w i = crSel cr ico' = ( (i - (k+n)) `mod` numCO ) + n n = length $ _crInv cr - numCO = length $ _closeObjects w + numCO = length $ _closeObjects (_cWorld w) changeAugInvSel :: Int -> World -> World changeAugInvSel i w | n == 0 = w - | otherwise = w & creatures . ix (_yourID w) . crInvSel . iselPos %~ (`mod` n) . subtract i - & creatures . ix (_yourID w) . crInvSel . iselAction .~ NoInvSelAction + | otherwise = w + & cWorld . creatures . ix (_yourID (_cWorld w)) . crInvSel . iselPos %~ (`mod` n) . subtract i + & cWorld . creatures . ix (_yourID (_cWorld w)) . crInvSel . iselAction .~ NoInvSelAction where - n = length (yourInv w) + length (_closeObjects w) + n = length (yourInv w) + length (_closeObjects (_cWorld w)) bestCloseObjectIndex :: World -> Maybe Int -bestCloseObjectIndex w = findIndex f $ _closeObjects w +bestCloseObjectIndex w = findIndex f $ _closeObjects (_cWorld w) where f (Right _) = True f (Left flit) = itSlotsTaken (_flIt flit) <= _crInvCapacity ycr - crInvSize ycr @@ -342,4 +347,4 @@ selectedCloseObject w inv = _crInv cr selectNthCloseObject :: World -> Int -> Maybe (Int,Either FloorItem Button) -selectNthCloseObject w n = (length (yourInv w) + n,) <$> (_closeObjects w !? n) +selectNthCloseObject w n = (length (yourInv w) + n,) <$> (_closeObjects (_cWorld w) !? n) diff --git a/src/Dodge/Inventory/Add.hs b/src/Dodge/Inventory/Add.hs index 6b91e361b..e81c29d79 100644 --- a/src/Dodge/Inventory/Add.hs +++ b/src/Dodge/Inventory/Add.hs @@ -11,7 +11,7 @@ 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 w IM.! flid) w + (i,w') <- tryPutItemInInv cid (_floorItems (_cWorld w) IM.! flid) w return (Just i,w') putItemInInvSlot :: Int -> Item -> IM.IntMap Item -> IM.IntMap Item @@ -23,15 +23,15 @@ tryPutItemInInv cid flit w = case maybeInvSlot of Nothing -> Nothing Just i -> Just (i, w & updateItLocation i - & floorItems %~ IM.delete (_flItID flit) - & creatures . ix cid . crInv %~ putItemInInvSlot i it + & cWorld . floorItems %~ IM.delete (_flItID flit) + & cWorld . creatures . ix cid . crInv %~ putItemInInvSlot i it ) where it = _flIt flit maybeInvSlot = checkInvSlotsYou it w updateItLocation invid w' = case _itID it of Nothing -> w' - Just j -> w' & itemPositions . ix j .~ InInv cid invid + Just j -> w' & cWorld . itemPositions . ix j .~ InInv cid invid --{- | Pick up a specific item. -} --putItemInInv :: Int -> FloorItem -> World -> World @@ -48,5 +48,5 @@ tryPutItemInInv cid flit w = case maybeInvSlot of -- Nothing -> w' -- Just j -> w' & itemPositions . ix j .~ InInv cid invid createPutItem :: Item -> World -> (Maybe Int, World) -createPutItem it w = uncurry (putItemInInvID (_yourID w)) +createPutItem it w = uncurry (putItemInInvID (_yourID (_cWorld w))) $ copyItemToFloorID (_crPos $ you w) (applyModules it) w diff --git a/src/Dodge/Inventory/Lock.hs b/src/Dodge/Inventory/Lock.hs index c9b70faf8..d34344eb2 100644 --- a/src/Dodge/Inventory/Lock.hs +++ b/src/Dodge/Inventory/Lock.hs @@ -3,7 +3,7 @@ import Dodge.Data import Control.Lens lockInv :: Int -> World -> World -lockInv cid = creatures . ix cid . crInvLock %~ (|| True) +lockInv cid = cWorld . creatures . ix cid . crInvLock %~ (|| True) unlockInv :: Int -> World -> World -unlockInv cid = creatures . ix cid . crInvLock %~ (&& False) +unlockInv cid = cWorld . creatures . ix cid . crInvLock %~ (&& False) diff --git a/src/Dodge/ItEffect.hs b/src/Dodge/ItEffect.hs index 6e9dce832..09ee22f25 100644 --- a/src/Dodge/ItEffect.hs +++ b/src/Dodge/ItEffect.hs @@ -29,16 +29,16 @@ onOffEff f g it rewindEffect :: Item -> Creature -> World -> World rewindEffect itm cr w - | Just invid == _crLeftInvSel cr = w & rewindWorlds %~ (take maxcharge . (w' : )) - & ptrWpCharge .~ length (_rewindWorlds w) - | otherwise = w & rewindWorlds .~ [] + | Just invid == _crLeftInvSel cr = w & cWorld . rewindWorlds %~ (take maxcharge . (w' : )) + & ptrWpCharge .~ length (_rewindWorlds (_cWorld w)) + | otherwise = w & cWorld . rewindWorlds .~ [] & ptrWpCharge .~ 0 where invid = _ipInvID $ _itPos itm - ptrWpCharge = creatures . ix (_crID cr) . crInv . ix invid . itConsumption . wpCharge + ptrWpCharge = cWorld . creatures . ix (_crID cr) . crInv . ix invid . itConsumption . wpCharge maxcharge = _wpMaxCharge . _itConsumption $ itm - w' = w & rewindWorlds .~ [] - & timeFlow .~ NormalTimeFlow + w' = w & cWorld . rewindWorlds .~ [] + & cWorld . timeFlow .~ NormalTimeFlow resetAttachmentEffect :: Item -> Creature -> World -> World resetAttachmentEffect itm cr w @@ -47,7 +47,7 @@ resetAttachmentEffect itm cr w where iteff = _itEffect itm invid = _ipInvID $ _itPos itm - pointToIt = creatures . ix (_crID cr) . crInv . ix invid + pointToIt = cWorld . creatures . ix (_crID cr) . crInv . ix invid createHeldLight :: Item -> Creature -> World -> World createHeldLight itm cr = createTorchLightOffset cr itm 0 diff --git a/src/Dodge/Item/Attachment.hs b/src/Dodge/Item/Attachment.hs index 5fe484ba6..f36c96062 100644 --- a/src/Dodge/Item/Attachment.hs +++ b/src/Dodge/Item/Attachment.hs @@ -15,8 +15,8 @@ import qualified IntMapHelp as IM charFiringStratI :: [(Char, ChainEffect)] -- ^ Different firing effects for different characters -> ChainEffect -charFiringStratI strats eff item cr w = case w ^? creatures . ix cid . crInv - . ix (crSel $ _creatures w IM.! cid) . itAttachment . atCharMode of +charFiringStratI strats eff item cr w = case w ^? cWorld . creatures . ix cid . crInv + . ix (crSel $ _creatures (_cWorld w) IM.! cid) . itAttachment . atCharMode of Just (c :<| _) -> fromMaybe id (Prelude.lookup c strats) eff item cr w _ -> w where diff --git a/src/Dodge/Item/Consumable.hs b/src/Dodge/Item/Consumable.hs index a67701b16..bc47560e8 100644 --- a/src/Dodge/Item/Consumable.hs +++ b/src/Dodge/Item/Consumable.hs @@ -24,8 +24,8 @@ medkit i = defaultConsumable heal25 :: Int -> World -> Maybe World heal25 = heal 25 heal :: Int -> Int -> World -> Maybe World -heal hp n w | _crHP (_creatures w IM.! n) >= 10000 = Nothing +heal hp n w | _crHP (_creatures (_cWorld w) IM.! n) >= 10000 = Nothing | otherwise = Just $ soundStart (CrSound $ _crID cr) (_crPos cr) healS Nothing w - & creatures . ix n . crHP %~ min 10000 . (+ hp) + & cWorld . creatures . ix n . crHP %~ min 10000 . (+ hp) where - cr = _creatures w IM.! n + cr = _creatures (_cWorld w) IM.! n diff --git a/src/Dodge/Item/Equipment.hs b/src/Dodge/Item/Equipment.hs index 67a5e83e2..166d301a1 100644 --- a/src/Dodge/Item/Equipment.hs +++ b/src/Dodge/Item/Equipment.hs @@ -51,7 +51,7 @@ magShield = defaultEquipment & itUse . eqEq . eqSite .~ GoesOnWrist & itType . iyBase .~ EQUIP MAGSHIELD useMagShield :: Item -> Creature -> World -> World -useMagShield it cr w = w & magnets . at mgid ?~ themagnet +useMagShield it cr w = w & cWorld . magnets . at mgid ?~ themagnet where themagnet = Magnet {_mgID = mgid @@ -61,7 +61,7 @@ useMagShield it cr w = w & magnets . at mgid ?~ themagnet } mgid = case it ^? itAttachment . atMInt . _Just of Just mgid' -> mgid' - Nothing -> IM.newKey $ _magnets w + Nothing -> IM.newKey $ _magnets (_cWorld w) -- it = _crInv cr IM.! invid flameShield :: Item @@ -89,15 +89,15 @@ wristArmour = defaultEquipment onEquipWristShield :: Item -> Creature -> World -> World onEquipWristShield itm cr w = w - & creatures . ix (_crID cr) . crInv . ix (_ipInvID (_itPos itm)) . itUse . eqEq . eqParams .~ EquipID i - & walls . at i ?~ forceField {_wlID = i} + & cWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID (_itPos itm)) . itUse . eqEq . eqParams .~ EquipID i + & cWorld . walls . at i ?~ forceField {_wlID = i} & setWristShieldPos (itm & itUse . eqEq . eqParams .~ EquipID i) cr where - i = IM.newKey (_walls w) + i = IM.newKey (_walls (_cWorld w)) onRemoveWristShield :: Item -> Creature -> World -> World onRemoveWristShield itm cr w = w - & creatures . ix (_crID cr) . crInv . ix (_ipInvID (_itPos itm)) . itUse . eqEq . eqParams .~ NoEquipParams + & cWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID (_itPos itm)) . itUse . eqEq . eqParams .~ NoEquipParams & deleteWallID i where i = _eparamID $ _eqParams $ _eqEq $ _itUse itm @@ -168,7 +168,7 @@ shieldWall crid = defaultWall createShieldWall :: Item -> Creature -> World -> World createShieldWall it cr w = case _ieMID $ _itEffect it of Nothing -> let (wlid,w') = createWall ((shieldWall crid) {_wlLine = wlline,_wlID = wlid}) w - in w' & creatures . ix crid . crInv . ix invid . itEffect . ieMID ?~ wlid + in w' & cWorld . creatures . ix crid . crInv . ix invid . itEffect . ieMID ?~ wlid Just wid -> moveWallID wid wlline w where invid = fromJust $ _itID it @@ -185,7 +185,7 @@ removeShieldWall :: Item -> Creature -> World -> World removeShieldWall it cr w = case _ieMID $ _itEffect it of Nothing -> w Just wid -> w & deleteWallID wid - & creatures . ix crid . crInv . ix invid . itEffect . ieMID .~ Nothing + & cWorld . creatures . ix crid . crInv . ix invid . itEffect . ieMID .~ Nothing where crid = _crID cr invid = fromJust (_itID it) @@ -241,7 +241,7 @@ headLamp = defaultEquipment createHeadLamp :: Item -> Creature -> World -> World -createHeadLamp _ cr = tempLightSources .:~ tlsTimeRadColPos 1 200 0.7 +createHeadLamp _ cr = cWorld . tempLightSources .:~ tlsTimeRadColPos 1 200 0.7 ((_crPos cr `v2z` 0) +.+.+ rotate3 (_crDir cr) (translatePointToHead cr (V3 5 0 3))) powerLegs :: Item @@ -268,4 +268,4 @@ wristInvisibility = defaultEquipment & itType . iyBase .~ EQUIP (INVISIBILITYEQUIPMENT GoesOnWrist) overCID :: (Creature -> Creature) -> Item -> Creature -> World -> World -overCID f _ cr = creatures . ix (_crID cr) %~ f +overCID f _ cr = cWorld . creatures . ix (_crID cr) %~ f diff --git a/src/Dodge/Item/Equipment/Booster.hs b/src/Dodge/Item/Equipment/Booster.hs index a37f8f0f3..130e92dad 100644 --- a/src/Dodge/Item/Equipment/Booster.hs +++ b/src/Dodge/Item/Equipment/Booster.hs @@ -40,10 +40,10 @@ boostSelfL x itm cr w = case boostPoint x cr w of cid = _crID cr cpos = _crPos cr r = _crRad cr - pid = fromMaybe (IM.newKey $ _props w) + pid = fromMaybe (IM.newKey $ _props (_cWorld w)) (cr ^? crInv . ix invid . itAttachment . atInt) crEff p ammoEff = addBoostShockwave pid p (r *.* normalizeV (p -.- cpos)) w - & creatures . ix cid %~ + & cWorld . creatures . ix cid %~ (crPos .~ p) . (crInv . ix invid %~ ammoEff @@ -57,7 +57,7 @@ addBoostShockwave -> Point2 -> World -> World -addBoostShockwave pjid p v w = w & linearShockwaves %~ +addBoostShockwave pjid p v w = w & cWorld . linearShockwaves %~ IM.insertWith f pjid thePJ where thePJ = LinearShockwave diff --git a/src/Dodge/Item/Location.hs b/src/Dodge/Item/Location.hs index e3cce2f0e..2edb0e8d7 100644 --- a/src/Dodge/Item/Location.hs +++ b/src/Dodge/Item/Location.hs @@ -11,27 +11,27 @@ setHeldItemLoc cr = fst . getHeldItemLoc cr getHeldItemLoc :: Creature -> World -> (World,Int) getHeldItemLoc cr w = case maybeitid of Nothing -> - ( w & creatures . ix cid . crInv . ix j . itID ?~ newitid - & itemPositions %~ IM.insert newitid (InInv cid j) + ( w & cWorld . creatures . ix cid . crInv . ix j . itID ?~ newitid + & cWorld . itemPositions %~ IM.insert newitid (InInv cid j) , itid) _ -> (w, itid) where cid = _crID cr j = crSel cr - newitid = IM.newKey $ _itemPositions w + newitid = IM.newKey $ _itemPositions (_cWorld w) maybeitid = cr ^? crInv . ix j . itID . _Just itid = fromMaybe newitid maybeitid getItem :: Int -> World -> Maybe Item getItem itid w = do - itpos <- w ^? itemPositions . ix itid + itpos <- w ^? cWorld . itemPositions . ix itid case itpos of - OnFloor flitid -> w ^? floorItems . ix flitid . flIt - InInv cid invid -> w ^? creatures . ix cid . crInv . ix invid + OnFloor flitid -> w ^? cWorld . floorItems . ix flitid . flIt + InInv cid invid -> w ^? cWorld . creatures . ix cid . crInv . ix invid VoidItm -> Nothing pointToItem :: Applicative f => ItemPos -> (Item -> f Item) -> World -> f World -pointToItem (InInv cid invid) = creatures . ix cid . crInv . ix invid -pointToItem (OnFloor flid) = floorItems . ix flid . flIt +pointToItem (InInv cid invid) = cWorld . creatures . ix cid . crInv . ix invid +pointToItem (OnFloor flid) = cWorld . floorItems . ix flid . flIt pointToItem _ = const pure diff --git a/src/Dodge/Item/Weapon/BatteryGuns.hs b/src/Dodge/Item/Weapon/BatteryGuns.hs index 72b8d8d56..9ef1bb13e 100644 --- a/src/Dodge/Item/Weapon/BatteryGuns.hs +++ b/src/Dodge/Item/Weapon/BatteryGuns.hs @@ -276,14 +276,14 @@ tractorGunTweak = TweakParam -- | assumes that the item is held shootTeslaArc :: Item -> Creature -> World -> World shootTeslaArc it cr w = w' - & creatures . ix (_crID cr) . crInv . ix (crSel cr) . itParams .~ ip + & cWorld . 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 dir = _crDir cr shootLaser :: Item -> Creature -> World -> World -shootLaser it cr = lasers .:~ lasRayAt (_lasColor $ _itParams it) dam phasev pos dir +shootLaser it cr = cWorld . lasers .:~ lasRayAt (_lasColor $ _itParams it) dam phasev pos dir where pos = _crPos cr dir = _crDir cr @@ -294,7 +294,7 @@ shootLaser it cr = lasers .:~ lasRayAt (_lasColor $ _itParams it) dam phasev pos circleLaser :: Item -> Creature -> World -> World circleLaser it cr w | hasLOSIndirect cpos pos w = w - & lasers .:~ lasRayAt (_lasColor $ _itParams it) dam phasev pos dir + & cWorld . lasers .:~ lasRayAt (_lasColor $ _itParams it) dam phasev pos dir | otherwise = w where cpos = _crPos cr @@ -306,8 +306,8 @@ circleLaser it cr w shootDualLaser :: Item -> Creature -> World -> World shootDualLaser it cr w = w' - & newBeams . positronBeams .:~ dualRayAt (_lasBeam $ _itParams it) itid w (_lasColor $ _itParams it) dam phasev posl dirl - & newBeams . electronBeams .:~ basicBeamAt itid w (_lasColor2 $ _itParams it) dam phasev posr dirr + & 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 where (w',itid) = getHeldItemLoc cr w dir = _crDir cr @@ -346,7 +346,7 @@ dualRayAt bt itid w col dam phasev pos dir = basicBeamAt itid w col dam phasev p & bmType .~ bt aTractorBeam :: Item -> Creature -> World -> World -aTractorBeam _ cr w = w & tractorBeams .:~ tractorBeamAt spos outpos dir power +aTractorBeam _ cr w = w & cWorld . 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 0aaae4c3e..46d385060 100644 --- a/src/Dodge/Item/Weapon/ExtraEffect.hs +++ b/src/Dodge/Item/Weapon/ExtraEffect.hs @@ -38,11 +38,11 @@ import qualified SDL autoEffect :: (Item -> Creature -> World -> World) -> Int -> SoundID -> Item -> Creature -> World -> World autoEffect eff t sid itm cr w | _eparamInt (_eqParams (_eqEq $ _itUse itm)) < 1 = eff itm cr w - & creatures . ix (_crID cr) . crInv . ix (_ipInvID $ _itPos itm) + & cWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID $ _itPos itm) . itUse . eqEq . eqParams . eparamInt .~ t & soundStart OnceSound (_crPos cr) sid Nothing | otherwise = w - & creatures . ix (_crID cr) . crInv . ix (_ipInvID $ _itPos itm) + & cWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID $ _itPos itm) . itUse . eqEq . eqParams . eparamInt -~ 1 {- | Automatically send out radar pulses that detect walls. -} @@ -83,7 +83,7 @@ targetRBCreatureUp it cr w t & tgPos .~ Nothing & tgActive .~ False ) - | SDL.ButtonRight `M.member` _mouseButtons w && isJust (t ^? tgID . _Just) + | SDL.ButtonRight `M.member` _mouseButtons (_cWorld w) && isJust (t ^? tgID . _Just) && canSeeTarget = (w, t & updatePos & tgActive .~ True ) @@ -99,10 +99,10 @@ targetRBCreatureUp it cr w t mwp = mouseWorldPos w updatePos t' = t' & tgPos .~ posFromMaybeID (_tgID t') posFromMaybeID Nothing = Nothing - posFromMaybeID (Just i) = w ^? creatures . ix i . crPos + posFromMaybeID (Just i) = w ^? cWorld . creatures . ix i . crPos canSeeTarget = fromMaybe False $ do cid <- t ^? tgID . _Just - cpos <- w ^? creatures . ix cid . crPos + cpos <- w ^? cWorld . creatures . ix cid . crPos Just $ hasLOS cpos (_crPos cr) w targetUpdateWith :: (World -> Targeting -> Targeting) @@ -113,7 +113,7 @@ targetUpdateWith f it _ w t targetCursorUpdate :: World -> Targeting -> Targeting targetCursorUpdate w t - | SDL.ButtonRight `M.member` _mouseButtons w = t + | SDL.ButtonRight `M.member` _mouseButtons (_cWorld w) = t & tgPos . _Just .~ mouseWorldPos w & tgActive .~ True | otherwise = t & tgPos %~ const Nothing @@ -121,7 +121,7 @@ targetCursorUpdate w t targetRBPressUpdate :: World -> Targeting -> Targeting targetRBPressUpdate w t - | SDL.ButtonRight `M.member` _mouseButtons w = t + | SDL.ButtonRight `M.member` _mouseButtons (_cWorld w) = t & tgPos %~ maybe (Just $ mouseWorldPos w) Just & tgActive .~ True | otherwise = t & tgPos %~ const Nothing @@ -140,7 +140,7 @@ targetLaserUpdate _ cr w t (mp, _) = reflectLaserAlong 0.2 sp ep w sp = _crPos cr +.+ 15 *.* unitVectorAtAngle (_crDir cr) ep = sp +.+ 5000 *.* normalizeV (mouseWorldPos w -.- sp) - addLaserPic = lasers .:~ LaserStart + addLaserPic = cWorld . lasers .:~ LaserStart { _lpPhaseV = 1 , _lpDir = _crDir cr , _lpPos = sp diff --git a/src/Dodge/Item/Weapon/Launcher.hs b/src/Dodge/Item/Weapon/Launcher.hs index 38924c727..2453dba25 100644 --- a/src/Dodge/Item/Weapon/Launcher.hs +++ b/src/Dodge/Item/Weapon/Launcher.hs @@ -99,12 +99,12 @@ explodeRemoteRocket -> World -> World explodeRemoteRocket itid pjid w = w - & projectiles . ix pjid . prjUpdates .~ [PJRetireRemote itid 30 pjid] - & projectiles . ix pjid . prjDraw .~ DrawBlankProjectile + & cWorld . projectiles . ix pjid . prjUpdates .~ [PJRetireRemote itid 30 pjid] + & cWorld . projectiles . ix pjid . prjDraw .~ DrawBlankProjectile & itPoint . itUse . rUse .~ HeldDoNothing & usePayload (_prjPayload thepj) (_prjPos thepj) where - itPoint = pointToItem $ _itemPositions w IM.! itid - thepj = _projectiles w IM.! pjid + itPoint = pointToItem $ _itemPositions (_cWorld w) IM.! itid + thepj = _projectiles (_cWorld w) IM.! pjid diff --git a/src/Dodge/Item/Weapon/Remote.hs b/src/Dodge/Item/Weapon/Remote.hs index 71c959933..c3c704de1 100644 --- a/src/Dodge/Item/Weapon/Remote.hs +++ b/src/Dodge/Item/Weapon/Remote.hs @@ -12,17 +12,17 @@ import qualified IntMapHelp as IM import Control.Lens setRemoteBombScope :: Int -> Prop -> World -> World -setRemoteBombScope itid pj w' = case _itemPositions w' IM.! itid of +setRemoteBombScope itid pj w' = case _itemPositions (_cWorld w') IM.! itid of InInv cid invid - -> w' & creatures . ix cid . crInv . ix invid . itScope - . scopePos .~ (_prPos pj -.- _crPos (_creatures w' IM.! cid)) - & creatures . ix cid . crInv . ix invid . itUse . useAim . aimZoom + -> w' & cWorld . creatures . ix cid . crInv . ix invid . itScope + . scopePos .~ (_prPos pj -.- _crPos (_creatures (_cWorld w') IM.! cid)) + & cWorld . creatures . ix cid . crInv . ix invid . itUse . useAim . aimZoom .~ (defaultItZoom {_itZoomMax = 0.5, _itZoomMin = 0.5}) _ -> w' setRemoteScope :: Int -> Point2 -> World -> World -setRemoteScope itid pos w' = case w' ^? itemPositions . ix itid of +setRemoteScope itid pos w' = case w' ^? cWorld . itemPositions . ix itid of Just (InInv cid' invid ) - -> w' & creatures . ix cid' . crInv . ix invid . itScope - . scopePos .~ (pos -.- _crPos (_creatures w' IM.! cid')) + -> w' & cWorld . creatures . ix cid' . crInv . ix invid . itScope + . scopePos .~ (pos -.- _crPos (_creatures (_cWorld w') IM.! cid')) _ -> w' diff --git a/src/Dodge/Item/Weapon/Shell.hs b/src/Dodge/Item/Weapon/Shell.hs index 497b9e967..3915a6575 100644 --- a/src/Dodge/Item/Weapon/Shell.hs +++ b/src/Dodge/Item/Weapon/Shell.hs @@ -6,7 +6,7 @@ import Geometry.Vector import Control.Lens decTimMvVel :: Proj -> World -> World -decTimMvVel pj = projectiles . ix pjid %~ +decTimMvVel pj = cWorld . 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 ebbbe7754..6dc2b746d 100644 --- a/src/Dodge/Item/Weapon/Spawn.hs +++ b/src/Dodge/Item/Weapon/Spawn.hs @@ -24,9 +24,9 @@ spawnCrNextTo -> Creature -- ^ existing creature that will be spawned next to -> World -> World -spawnCrNextTo cr sCr w = w & creatures %~ IM.insert k newCr +spawnCrNextTo cr sCr w = w & cWorld . creatures %~ IM.insert k newCr where - k = IM.newKey $ _creatures w + k = IM.newKey $ _creatures (_cWorld w) newCr = cr & crID .~ k & crPos .~ _crPos sCr +.+ unitVectorAtAngle (_crDir sCr) diff --git a/src/Dodge/Item/Weapon/TriggerType.hs b/src/Dodge/Item/Weapon/TriggerType.hs index d2f5f4fd7..2dfe25267 100644 --- a/src/Dodge/Item/Weapon/TriggerType.hs +++ b/src/Dodge/Item/Weapon/TriggerType.hs @@ -95,7 +95,7 @@ type ChainEffect -> World lockInvFor :: Int -> ChainEffect -lockInvFor i f it cr = f it cr . (delayedEvents .:~ (i, UnlockInv (_crID cr))) +lockInvFor i f it cr = f it cr . (cWorld . delayedEvents .:~ (i, UnlockInv (_crID cr))) . lockInv (_crID cr) trigDoAlso' @@ -139,7 +139,7 @@ withThickSmokeI eff item cr w = eff item cr ammoCheckI :: ChainEffect ammoCheckI eff itm cr w | _laLoaded ic <= 0 || not (_laPrimed ic) = w - | otherwise = eff itm cr $ w & creatures . ix (_crID cr) %~ crCancelReloading + | otherwise = eff itm cr $ w & cWorld . creatures . ix (_crID cr) %~ crCancelReloading where ic = _itConsumption itm @@ -149,7 +149,7 @@ ammoHammerCheck :: ChainEffect ammoHammerCheck eff it cr w | _laLoaded ic <= 0 || not (_laPrimed ic) = w -- fromMaybe w (startReloadingWeapon cr w) | otherwise = case it ^? itUse . useHammer of - Just HammerUp -> eff it cr $ w & creatures . ix (_crID cr) %~ crCancelReloading + Just HammerUp -> eff it cr $ w & cWorld . creatures . ix (_crID cr) %~ crCancelReloading _ -> w where ic = _itConsumption it @@ -184,7 +184,7 @@ rateIncAB exeffFirst exeffCont eff item cr w startRate = _rateMaxMax . _useDelay $ _itUse item cid = _crID cr itRef = crSel cr - pointItem = creatures . ix cid . crInv . ix itRef + pointItem = cWorld . creatures . ix cid . crInv . ix itRef currentRate = _rateMax (_useDelay (_itUse item)) repeatFire = crWeaponReady cr && _rateTime (_useDelay (_itUse item)) == 1 firstFire = crWeaponReady cr && _rateTime (_useDelay (_itUse item)) == 0 @@ -203,7 +203,7 @@ withWarmUp soundID f item cr w where cid = _crID cr itRef = crSel cr - pointerToItem = creatures . ix cid . crInv . ix itRef + pointerToItem = cWorld . creatures . ix cid . crInv . ix itRef curWarmUp = _warmTime . _useDelay $ _itUse item maxWarmUp = _warmMax . _useDelay $ _itUse item withSoundItemChoiceStart @@ -259,12 +259,12 @@ withSoundForVol vol soundid playTime f item cr afterRecoil :: Float -- ^ Recoil amount -> ChainEffect -afterRecoil recoilAmount eff item cr = eff item (pushback cr) . over (creatures . ix cid) pushback +afterRecoil recoilAmount eff item cr = eff item (pushback cr) . over (cWorld . 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 (creatures . ix cid) pushback +withRecoil eff it cr = eff it cr . over (cWorld . creatures . ix cid) pushback where cid = _crID cr recoilAmount = fromMaybe 0 $ it ^? itParams . recoil @@ -275,7 +275,7 @@ withSidePushI :: Float -- ^ Maximal possible side push amount -> ChainEffect withSidePushI maxSide eff item cr w = eff item (push cr) $ w - & creatures . ix cid %~ push + & cWorld . creatures . ix cid %~ push & randGen .~ g where cid = _crID cr @@ -287,7 +287,7 @@ Applied after the underlying effect. -} withSidePushAfterI :: Float -- ^ Maximal possible side push amount -> ChainEffect -withSidePushAfterI maxSide eff item cr w = over (creatures . ix cid) push . eff item cr $ w +withSidePushAfterI maxSide eff item cr w = over (cWorld . creatures . ix cid) push . eff item cr $ w & randGen .~ g where cid = _crID cr @@ -295,14 +295,14 @@ withSidePushAfterI maxSide eff item cr w = over (creatures . ix cid) push . eff (pushAmount, g) = randomR (-maxSide,maxSide) $ _randGen w useAllAmmo :: ChainEffect useAllAmmo eff item cr = eff item cr - . (creatures . ix (_crID cr) . crInv . ix (crSel cr) . itConsumption . laLoaded .~ 0) + . (cWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) . itConsumption . laLoaded .~ 0) useAmmoUpTo :: Int -> ChainEffect useAmmoUpTo amAmount eff item cr = eff item cr - . (creatures . ix (_crID cr) . crInv . ix (crSel cr) . itConsumption . laLoaded + . (cWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) . itConsumption . laLoaded %~ (max 0 . subtract amAmount)) useAmmoAmount :: Int -> ChainEffect useAmmoAmount amAmount eff item cr = eff item cr - . (creatures . ix (_crID cr) . crInv . ix (crSel cr) . itConsumption . laLoaded -~ amAmount) + . (cWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) . itConsumption . laLoaded -~ amAmount) {- | Applies a world effect after an item use cooldown check. -} useTimeCheck :: ChainEffect @@ -311,7 +311,7 @@ useTimeCheck f item cr w = case item ^? itUse . useDelay . rateTime of _ -> w where cid = _crID cr - setUseTime = creatures . ix cid . crInv . ix (crSel cr) . itUse . useDelay . rateTime +~ userate + setUseTime = cWorld . creatures . ix cid . crInv . ix (crSel cr) . itUse . useDelay . rateTime +~ userate userate = fromMaybe 0 $ item ^? itUse . useDelay . rateMax {- | Applies a world effect after a hammer position check. -} hammerCheckI :: ChainEffect @@ -332,7 +332,7 @@ ammoUseCheck f item cr w where cid = _crID cr itRef = crSel cr - pointerToItem = creatures . ix cid . crInv . ix itRef + pointerToItem = cWorld . creatures . ix cid . crInv . ix itRef fireCondition = crWeaponReady cr && _rateTime (_useDelay (_itUse item)) == 0 && _laLoaded (_itConsumption item) > 0 @@ -364,7 +364,7 @@ shootL f item cr w where cid = _crID cr invid = _ipInvID $ _itPos item - pointerToItem = creatures . ix cid . crInv . ix invid + pointerToItem = cWorld . creatures . ix cid . crInv . ix invid fireCondition = _rateTime (_useDelay (_itUse item)) == 0 && _arLoaded (_itConsumption item) > 0 -- reloadCondition = _laLoaded (_itConsumption item) == 0 @@ -373,20 +373,20 @@ withItem g f it = g it f it -- not ideal withItemUpdate' :: (Item -> Item) -> ChainEffect -withItemUpdate' up f it cr = f (up it) cr . (creatures . ix (_crID cr) . crInv . ix (crSel cr) %~ up) +withItemUpdate' up f it cr = f (up it) cr . (cWorld . 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 . (creatures . ix (_crID cr) . crInv . ix (crSel cr) %~ up) +withItemUpdate up g f it cr = g it f it cr . (cWorld . 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 tempLightSources (theTLS :) + . over (cWorld . tempLightSources) (theTLS :) where theTLS = tlsTimeRadColPos time rad col (V3 x y 10) V2 x y = _crPos cr +.+ 15 *.* unitVectorAtAngle (_crDir cr) modClock :: Int -> ChainEffect -> ChainEffect modClock n chainEff eff it cr w - | _worldClock w `mod` n == 0 = chainEff eff it cr w + | _worldClock (_cWorld w) `mod` n == 0 = chainEff eff it cr w | otherwise = eff it cr w withMuzFlareI :: ChainEffect @@ -491,9 +491,9 @@ torqueBefore torqueBefore torque feff item cr w | cid == 0 = feff item (cr & crDir +~ rot) $ w & randGen .~ g - & creatures . ix cid . crDir +~ rot - & cameraRot +~ rot - | otherwise = feff item cr $ set randGen g $ over (creatures . ix cid . crDir) (+rot) w + & cWorld . creatures . ix cid . crDir +~ rot + & cWorld . cameraRot +~ rot + | otherwise = feff item cr $ set randGen g $ over (cWorld . creatures . ix cid . crDir) (+rot) w where cid = _crID cr (rot, g) = randomR (-torque,torque) $ _randGen w @@ -506,9 +506,9 @@ torqueBeforeAtLeast torqueBeforeAtLeast minTorque exTorque feff item cr w | cid == 0 = feff item (cr & crDir +~ rot') $ w & randGen .~ g - & creatures . ix cid . crDir +~ rot' - & cameraRot +~ rot' - | otherwise = feff item cr $ set randGen g $ over (creatures . ix cid . crDir) (+rot') w + & cWorld . creatures . ix cid . crDir +~ rot' + & cWorld . cameraRot +~ rot' + | otherwise = feff item cr $ set randGen g $ over (cWorld . creatures . ix cid . crDir) (+rot') w where cid = _crID cr (rot, g) = randomR (-exTorque,exTorque) $ _randGen w @@ -518,8 +518,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 cameraRot (+rot) $ feff item cr w - | otherwise = set randGen g $ over (creatures . ix cid . crDir) (+rot) $ feff item cr w + | cid == 0 = set randGen g $ over (cWorld . cameraRot) (+rot) $ feff item cr w + | otherwise = set randGen g $ over (cWorld . creatures . ix cid . crDir) (+rot) $ feff item cr w where cid = _crID cr (rot, g) = randomR (-torque,torque) $ _randGen w @@ -547,12 +547,12 @@ sideEffectOnFrame :: Int -> (Item -> Creature -> WdWd) -> ChainEffect sideEffectOnFrame i sf f it cr w = f it cr w - & delayedEvents .:~ (i, sf it cr) + & cWorld . delayedEvents .:~ (i, sf it cr) torqueSideEffect :: Float -> Item -> Creature -> World -> World torqueSideEffect torque _ cr w - | cid == 0 = set randGen g $ over cameraRot (+rot) w - | otherwise = set randGen g $ over (creatures . ix cid . crDir) (+rot) w + | cid == 0 = set randGen g $ over (cWorld . cameraRot) (+rot) w + | otherwise = set randGen g $ over (cWorld . creatures . ix cid . crDir) (+rot) w where cid = _crID cr (rot, g) = randomR (-torque,torque) $ _randGen w diff --git a/src/Dodge/Item/Weapon/Utility.hs b/src/Dodge/Item/Weapon/Utility.hs index 5a50c9c81..4617ffcaf 100644 --- a/src/Dodge/Item/Weapon/Utility.hs +++ b/src/Dodge/Item/Weapon/Utility.hs @@ -90,11 +90,11 @@ useForceFieldGun itm cr w = fromMaybe w $ do b = if dist a mwp < 100 then mwp else a +.+ 100 *.* normalizeV (mwp -.- a) wlline = (a,b) return $ w - & walls %~ IM.insertWith (\_ x -> x) i forceField {_wlID = i} - & creatures . ix (_crID cr) . crInv . ix (_ipInvID (_itPos itm)) . itParams . paramMID ?~ i + & cWorld . walls %~ IM.insertWith (\_ x -> x) i forceField {_wlID = i} + & cWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID (_itPos itm)) . itParams . paramMID ?~ i & moveWallIDUnsafe i wlline where - i = fromMaybe (IM.newKey (_walls w)) $ itm ^? itParams . paramMID . _Just + i = fromMaybe (IM.newKey (_walls (_cWorld w))) $ itm ^? itParams . paramMID . _Just -- grapGun = defaultGun -- { _itName = "grapGun" diff --git a/src/Dodge/Lampoid.hs b/src/Dodge/Lampoid.hs index 8e68412a6..4d892e84d 100644 --- a/src/Dodge/Lampoid.hs +++ b/src/Dodge/Lampoid.hs @@ -10,16 +10,16 @@ import LensHelp import qualified IntMapHelp as IM updateLampoid :: Creature -> World -> World updateLampoid cr w = case cr ^?! crType . lampLSID of - Nothing -> let i = IM.newKey (_lightSources w) - in w & lightSources %~ IM.insert i (lsColPosID lcol (addZ h cpos) i) + Nothing -> let i = IM.newKey (_lightSources (_cWorld w)) + in w & cWorld . lightSources %~ IM.insert i (lsColPosID lcol (addZ h cpos) i) Just i | _crHP cr < 0 -> w & explosionFlashAt cpos & originsIDsAt [MaterialSound Glass n | n <- [0,1,2]] (destroyMatS Glass) cpos - & lightSources . at i .~ Nothing - & creatures . at cid .~ Nothing + & cWorld . lightSources . at i .~ Nothing + & cWorld . creatures . at cid .~ Nothing | otherwise -> w - & lightSources . ix i . lsParam . lsPos .~ addZ h cpos + & cWorld . 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 caf705391..11b161cbd 100644 --- a/src/Dodge/Layout.hs +++ b/src/Dodge/Layout.hs @@ -41,12 +41,11 @@ generateLevelFromRoomList gr' w = over gwWorld initWallZoning . doIndividualPlacements . setFloors . worldToGenWorld rs' - $ w { _walls = wallsFromRooms rs - , _gameRooms = gameRoomsFromRooms (IM.elems rs') - , _pathGraph = path - } - & pnZoning .~ foldl' (flip zonePn) mempty (labNodes path) - & peZoning .~ foldl' (flip zonePe) mempty (labEdges path) + $ w & cWorld . walls .~ wallsFromRooms rs + & cWorld . gameRooms .~ gameRoomsFromRooms (IM.elems rs') + & cWorld . pathGraph .~ path + & cWorld . pnZoning .~ foldl' (flip zonePn) mempty (labNodes path) + & cWorld . peZoning .~ foldl' (flip zonePe) mempty (labEdges path) where (_,path) = pairsToGraph pairPath' pairPath = foldMap _rmPath rs @@ -55,10 +54,10 @@ generateLevelFromRoomList gr' w = over gwWorld initWallZoning rs'= mapM shuffleRoomPos gr' & evalState $ _randGen w randomCompass :: World -> World -randomCompass w = w & cameraRot .~ (takeOne [0,0.5*pi,pi,1.5*pi] & evalState $ _randGen w) +randomCompass w = w & cWorld . cameraRot .~ (takeOne [0,0.5*pi,pi,1.5*pi] & evalState $ _randGen w) putFloorTiles :: GenWorld -> GenWorld -putFloorTiles gw = gw & gwWorld . floorTiles .~ floorsFromGenWorld gw +putFloorTiles gw = gw & gwWorld . cWorld . floorTiles .~ floorsFromGenWorld gw setFloors :: GenWorld -> GenWorld setFloors = putFloorTiles . setTiles @@ -124,7 +123,7 @@ doRoomPlacements :: GenWorld -> Room -> (GenWorld, Room) doRoomPlacements w rm = foldl' (\wr -> fst . placeSpot wr) (w,rm) $ _rmPmnts rm setupWorldBounds :: World -> World -setupWorldBounds w = w & worldBounds %~ +setupWorldBounds w = w & cWorld . worldBounds %~ ( (bdMinX .~ f minx) . (bdMaxX .~ f maxx) . (bdMinY .~ f miny) @@ -132,7 +131,7 @@ setupWorldBounds w = w & worldBounds %~ ) where f = fromMaybe 0 - ps = IM.map (fst . _wlLine) $ _walls w + ps = IM.map (fst . _wlLine) $ _walls (_cWorld w) (minx,maxx,miny,maxy) = L.fold ((,,,) <$> L.premap fstV2 L.minimum <*> L.premap fstV2 L.maximum @@ -144,7 +143,7 @@ setupWorldBounds w = w & worldBounds %~ --polyhedrasToEdges = concatMap tflat4 . concatMap polyToEdges initWallZoning :: World -> World -initWallZoning w = foldl' (flip insertWallInZones) (w & wlZoning .~ IM.empty) (_walls w) +initWallZoning w = foldl' (flip insertWallInZones) (w & cWorld . wlZoning .~ IM.empty) (_walls (_cWorld w)) --makePath :: Tree Room -> [(Point2,Point2)] --makePath = concatMap _rmPath . flatten diff --git a/src/Dodge/LevelGen.hs b/src/Dodge/LevelGen.hs index ac938347c..ee6fd78f5 100644 --- a/src/Dodge/LevelGen.hs +++ b/src/Dodge/LevelGen.hs @@ -29,17 +29,17 @@ generateWorldFromSeed i = do return -- $ saveLevelStartSlot $ postGenerationProcessing $ _gwWorld (generateLevelFromRoomList roomList initialWorld{_randGen=mkStdGen i}) - & roomClipping .~ bounds + & cWorld . roomClipping .~ bounds postGenerationProcessing :: World -> World -postGenerationProcessing w = foldl' assignPushDoors w (_doors w) +postGenerationProcessing w = foldl' assignPushDoors w (_doors (_cWorld w)) generateGraphs :: IO () generateGraphs = TIO.writeFile "graph/itemCombinations.gv" combinationsDotGraph assignPushDoors :: World -> Door -> World assignPushDoors w dr = case dr ^?! drPushedBy of - PushedBy i -> w & doors . ix i . drPushes ?~ _drID dr + PushedBy i -> w & cWorld . doors . ix i . drPushes ?~ _drID dr _ -> w layoutLevelFromSeed :: Int -> Int -> IO (IM.IntMap Room,[ConvexPoly]) diff --git a/src/Dodge/LevelGen/LevelStructure.hs b/src/Dodge/LevelGen/LevelStructure.hs index f8afa7423..0257e956d 100644 --- a/src/Dodge/LevelGen/LevelStructure.hs +++ b/src/Dodge/LevelGen/LevelStructure.hs @@ -18,7 +18,7 @@ import qualified Data.Map.Strict as M worldToGenWorld :: IM.IntMap Room -> World -> GenWorld worldToGenWorld rms w = GenWorld - { _gwWorld = w & genParams .~ evalState generateGenParams (_randGen w) + { _gwWorld = w & cWorld . genParams .~ evalState generateGenParams (_randGen w) , _genRooms = rms , _genPlacements = mempty } diff --git a/src/Dodge/LightSource.hs b/src/Dodge/LightSource.hs index 68e9184e4..8808a1a04 100644 --- a/src/Dodge/LightSource.hs +++ b/src/Dodge/LightSource.hs @@ -84,19 +84,19 @@ tlsTimeRadColPos t rmax col (V3 x y z) = TLS } makeTlsTimeRadColPos :: Int -> Float -> Point3 -> Point3 -> World -> World -makeTlsTimeRadColPos i rad (V3 r g b) p = tempLightSources .:~ tlsTimeRadColPos i rad (V3 r g b) p +makeTlsTimeRadColPos i rad (V3 r g b) p = cWorld . tempLightSources .:~ tlsTimeRadColPos i rad (V3 r g b) p destroyLS :: Int -> World -> World destroyLS lsid w = w - & lightSources . at lsid .~ Nothing + & cWorld . lightSources . at lsid .~ Nothing & destroyLSFlashAt p3 & originsIDsAt [MaterialSound Glass n | n <- [0,1,2]] (destroyMatS Glass) (xyV3 p3) where - ls = w ^?! lightSources . ix lsid + ls = w ^?! cWorld . lightSources . ix lsid -- unsafe p3 = _lsPos $ _lsParam ls destroyLSFlashAt :: Point3 -> World -> World -destroyLSFlashAt (V3 x' y' z') = tempLightSources .:~ tlsTimeRadFunPos 20 150 +destroyLSFlashAt (V3 x' y' z') = cWorld . tempLightSources .:~ tlsTimeRadFunPos 20 150 (TLSFade 1 10) (addZ z' p) where diff --git a/src/Dodge/LightSource/Torch.hs b/src/Dodge/LightSource/Torch.hs index 1673f8191..28b60b06b 100644 --- a/src/Dodge/LightSource/Torch.hs +++ b/src/Dodge/LightSource/Torch.hs @@ -6,7 +6,7 @@ import Dodge.Item.Draw -- heldItemOffset needs to be moved somewhere more sensi import Dodge.LightSource -- this needs to be split! createTorchLightOffset :: Creature -> Item -> Point3 -> World -> World -createTorchLightOffset cr it off = tempLightSources .:~ tlsTimeRadColPos 1 250 0.7 +createTorchLightOffset cr it off = cWorld . tempLightSources .:~ tlsTimeRadColPos 1 250 0.7 (p +.+.+ rotate3 (_crDir cr) (heldItemOffset it cr (off +.+.+ V3 8 0 1.5))) where p = addZ 0 $ _crPos cr diff --git a/src/Dodge/LinearShockwave/Update.hs b/src/Dodge/LinearShockwave/Update.hs index da6e1fb4b..a20d244f1 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 & linearShockwaves %~ IM.delete lwid - | otherwise = w & linearShockwaves . ix lwid . lwTimer -~ 1 + | t < 1 = w & cWorld . linearShockwaves %~ IM.delete lwid + | otherwise = w & cWorld . 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 04fb82246..dfcc16d5f 100644 --- a/src/Dodge/Luse.hs +++ b/src/Dodge/Luse.hs @@ -16,18 +16,18 @@ useL lu = case lu of LBoost -> boostSelfL 10 useRewindGun :: Item -> Creature -> World -> World -useRewindGun _ _ w = case _rewindWorlds w of +useRewindGun _ _ w = case _rewindWorlds (_cWorld w) of [w'] -> rewindusing w' [w'] (w':ws) -> rewindusing w' ws _ -> w where rewindusing w' ws = w - & maybeWorld .~ Just' ( w' + & cWorld . maybeWorld .~ Just' ( w' -- & creatures . ix (_crID cr) .~ cr & upbuts - & rewindWorlds .~ ws + & cWorld . rewindWorlds .~ ws ) - upbuts = (keys .~ _keys w) . (mouseButtons .~ _mouseButtons w) + upbuts = (cWorld . keys .~ _keys (_cWorld w)) . (cWorld . mouseButtons .~ _mouseButtons (_cWorld w)) -- be careful changing this around; potential problems include updating the -- creature but using the old crInvSel value @@ -39,5 +39,5 @@ useShrinkGun it cr w = if _atBool $ _itAttachment it where invid = _ipInvID $ _itPos it tryResize x g = maybe w g $ sizeSelf x cr w - f isInUse cstatus = creatures . ix (_crID cr) . crInv . ix invid %~ + f isInUse cstatus = cWorld . creatures . ix (_crID cr) . crInv . ix invid %~ ( (itAttachment . atBool .~ isInUse) . (itCurseStatus .~ cstatus) ) diff --git a/src/Dodge/Machine.hs b/src/Dodge/Machine.hs index 7487a69fe..512738936 100644 --- a/src/Dodge/Machine.hs +++ b/src/Dodge/Machine.hs @@ -19,9 +19,9 @@ machineUpdateLiveDieEff -> Machine -> World -> World machineUpdateLiveDieEff livef dief mc | _mcHP mc < 1 = dief mc - . (machines %~ IM.delete mcid) + . (cWorld . machines %~ IM.delete mcid) . deleteWallIDs (_mcWallIDs mc) - | otherwise = livef mc . (machines . ix mcid %~ ( (mcDamage .~ []) . (mcHP -~ dams) )) + | otherwise = livef mc . (cWorld . machines . ix mcid %~ ( (mcDamage .~ []) . (mcHP -~ dams) )) where dams = sum $ map _dmAmount $ _mcDamage mc mcid = _mcID mc @@ -30,9 +30,9 @@ machineUpdateDeathEff :: (Machine -> World -> World) -> Machine -> World -> World machineUpdateDeathEff f mc | _mcHP mc < 1 = f mc - . (machines %~ IM.delete mcid) + . (cWorld . machines %~ IM.delete mcid) . deleteWallIDs (_mcWallIDs mc) - | otherwise = machines . ix mcid %~ ( (mcDamage .~ []) . (mcHP -~ dams) ) + | otherwise = cWorld . 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 0485aa2e3..77f44f535 100644 --- a/src/Dodge/Machine/Damage.hs +++ b/src/Dodge/Machine/Damage.hs @@ -3,7 +3,7 @@ import Dodge.Data import LensHelp basicMachineApplyDamage :: Machine -> World -> World -basicMachineApplyDamage mc = machines . ix mcid %~ ( (mcDamage .~ []) . (mcHP -~ dams) ) +basicMachineApplyDamage mc = cWorld . 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 597e3a521..7bdb02f1f 100644 --- a/src/Dodge/Machine/Destroy.hs +++ b/src/Dodge/Machine/Destroy.hs @@ -9,7 +9,7 @@ import Data.Maybe import qualified IntMapHelp as IM destroyMachine :: Machine -> World -> World -destroyMachine mc = (machines %~ IM.delete (_mcID mc)) +destroyMachine mc = (cWorld . machines %~ IM.delete (_mcID mc)) . deleteWallIDs (_mcWallIDs mc) . makeExplosionAt (_mcPos mc) . mcKillTerm mc @@ -18,11 +18,11 @@ destroyMachine mc = (machines %~ IM.delete (_mcID mc)) mcKillTerm :: Machine -> World -> World mcKillTerm mc w = fromMaybe w $ do tmid <- mc ^? mcMounts . ix ObTerminal - tm <- w ^? terminals . ix tmid + tm <- w ^? cWorld . terminals . ix tmid return $ w & doTmWdWd (_tmDeathEffect tm) tm mcKillBut :: Machine -> World -> World mcKillBut mc w = fromMaybe w $ do btid <- mc ^? mcMounts . ix ObButton - return $ w & buttons . at btid .~ Nothing + return $ w & cWorld . buttons . at btid .~ Nothing diff --git a/src/Dodge/Machine/Update.hs b/src/Dodge/Machine/Update.hs index 008b914ac..7d5c5c70a 100644 --- a/src/Dodge/Machine/Update.hs +++ b/src/Dodge/Machine/Update.hs @@ -34,7 +34,7 @@ mcTurretUpdate mc = case _mcType mc of -- this needs a major cleanup updateTurret :: Float -> Machine -> World -> World updateTurret rotSpeed mc w - | _mcHP mc < 1 = w & machines %~ IM.delete mcid + | _mcHP mc < 1 = w & cWorld . machines %~ IM.delete mcid & deleteWallIDs (_mcWallIDs mc) & makeExplosionAt mcpos & copyItemToFloor mcpos lasGun @@ -47,12 +47,12 @@ updateTurret rotSpeed mc w where deleteHomonculus = case _tuMCrID (_mcType mc) of Nothing -> id - Just cid -> creatures . at cid .~ Nothing - initHomonculus w' = case w' ^? machines . ix mcid . mcType . tuMCrID . _Just of - Nothing -> w' & machines . ix mcid . mcType . tuMCrID ?~ cid - & creatures . at cid ?~ thecreature + Just cid -> cWorld . creatures . at cid .~ Nothing + initHomonculus w' = case w' ^? cWorld . machines . ix mcid . mcType . tuMCrID . _Just of + Nothing -> w' & cWorld . machines . ix mcid . mcType . tuMCrID ?~ cid + & cWorld . creatures . at cid ?~ thecreature where - cid = IM.newKey (_creatures w') + cid = IM.newKey (_creatures (_cWorld w')) thecreature = defaultCreature & crID .~ cid & crInv . at 0 ?~ (_tuWeapon (_mcType mc) & itUse . useAim . aimHandlePos -~ 10 @@ -65,9 +65,9 @@ updateTurret rotSpeed mc w & crStance . posture .~ Aiming & crMaterial .~ Crystal Just cid -> w' - & creatures . ix cid . crPos .~ mcpos - & creatures . ix cid . crDir .~ mcdir - dodamage = machines . ix mcid %~ + & cWorld . creatures . ix cid . crPos .~ mcpos + & cWorld . creatures . ix cid . crDir .~ mcdir + dodamage = cWorld . machines . ix mcid %~ ( (mcDamage .~ [Damage ELECTRICAL (min 2500 $ max 0 (elecDam - 10)) 0 0 0 NoDamageEffect]) . (mcHP -~ dam) ) @@ -78,7 +78,7 @@ updateTurret rotSpeed mc w | _tuFireTime (_mcType mc) > 0 = fromMaybe id $ do cid <- _tuMCrID (_mcType mc) - return $ creatures . ix cid . crActionPlan . apImpulse .~ [UseItem] + return $ cWorld . creatures . ix cid . crActionPlan . apImpulse .~ [UseItem] | otherwise = id mcid = _mcID mc ypos = _crPos $ you w @@ -89,18 +89,18 @@ updateTurret rotSpeed mc w dam = sum $ map _dmAmount dams elecDam = sum $ map _dmAmount elecDams doTurn - | seesYou = machines . ix mcid . mcDir %~ turnTo rotSpeed mcpos ypos + | seesYou = cWorld . machines . ix mcid . mcDir %~ turnTo rotSpeed mcpos ypos | otherwise = id closeFireAngle = seesYou -- && angleVV (ypos -.- mcpos) (unitVectorAtAngle mcdir) < 1 updateFiringStatus - | closeFireAngle = machines . ix mcid . mcType . tuFireTime .~ 20 - | otherwise = machines . ix mcid . mcType . tuFireTime %~ (max 0 . subtract 1) + | closeFireAngle = cWorld . machines . ix mcid . mcType . tuFireTime .~ 20 + | otherwise = cWorld . machines . ix mcid . mcType . tuFireTime %~ (max 0 . subtract 1) mcSensorTriggerUpdate :: Machine -> World -> World mcSensorTriggerUpdate mc = fromMaybe id $ do trid <- mc ^? mcMounts . ix ObTrigger bval <- mcTriggerVal mc - return $ triggers . ix trid .~ bval + return $ cWorld . triggers . ix trid .~ bval mcTriggerVal :: Machine -> Maybe Bool mcTriggerVal mc = case mc ^. mcSensor of @@ -119,7 +119,7 @@ mcPlaySound mc w = case _mcCloseSound mc of mcApplyDamage :: [Damage] -> Machine -> World -> World mcApplyDamage ds mc = case _mcSensor mc of - NoSensor -> machines . ix (_mcID mc) %~ + NoSensor -> cWorld . machines . ix (_mcID mc) %~ ( (mcDamage .~ []) . (mcHP -~ sum (map _dmAmount ds)) ) _ -> id @@ -137,12 +137,12 @@ mcProximitySensorUpdate mc w = case , dist (_crPos ycr) (_mcPos mc) < _proxDist sens) of (_,True,_,_) -> w (_,False,True,True) -> w - & machines . ix (_mcID mc) . mcSensor . sensToggle .~ True + & cWorld . machines . ix (_mcID mc) . mcSensor . sensToggle .~ True & playsound dedaS - & machines . ix (_mcID mc) . mcSensor . proxStatus .~ IsClose + & cWorld . machines . ix (_mcID mc) . mcSensor . proxStatus .~ IsClose (NotClose,_,False,True) -> w & playsound dedumS - & machines . ix (_mcID mc) . mcSensor . proxStatus .~ IsClose - (_,_,_,False) -> w & machines . ix (_mcID mc) . mcSensor . proxStatus .~ NotClose + & cWorld . machines . ix (_mcID mc) . mcSensor . proxStatus .~ IsClose + (_,_,_,False) -> w & cWorld . machines . ix (_mcID mc) . mcSensor . proxStatus .~ NotClose _ -> w where playsound sid = soundContinue (MachineAltSound (_mcID mc)) (_mcPos mc) sid Nothing @@ -158,7 +158,7 @@ mcProxTest mc w = case mc ^? mcSensor . proxRequirement of cr = you w senseDamage :: DamageType -> Machine -> World -> World -senseDamage dt mc = (machines . ix mcid %~ upmc) +senseDamage dt mc = (cWorld . machines . ix mcid %~ upmc) . updatels where upmc = mcSensor . sensAmount %~ min 1000 . max 0 . (+ (newsense - 5)) @@ -167,7 +167,7 @@ senseDamage dt mc = (machines . ix mcid %~ upmc) ni = fromIntegral (_sensAmount $ _mcSensor mc) / 1000 updatels = fromMaybe id $ do lsid <- mc ^? mcMounts . ix ObLightSource - return $ lightSources . ix lsid . lsParam . lsCol .~ V3 ni ni ni + return $ cWorld . 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 87fd72abb..71152bf2e 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 ^?! triggers . ix (_mdExternalID2 md) + MdTrigIf ftrue ffalse -> \md w -> if w ^?! cWorld . 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 & lightSources . ix (_mdExternalID1 md) . lsParam . lsCol .~ col + MdSetLSCol col -> \md w -> w & cWorld . 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 a2f83752f..225f7d63b 100644 --- a/src/Dodge/Path.hs +++ b/src/Dodge/Path.hs @@ -34,13 +34,13 @@ import qualified Streaming.Prelude as S --import Data.Graph.Inductive.Graph hiding ((&)) getNodePos :: Int -> World -> Maybe Point2 -getNodePos i w = _pathGraph w `lab` i +getNodePos i w = _pathGraph (_cWorld w) `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 w)) + sp na nb (second _peDist (efilter (not . pathEdgeObstructed . (^. _3)) $ _pathGraph (_cWorld w))) pathEdgeObstructed :: PathEdge -> Bool pathEdgeObstructed pe = DoorObstacle `Set.member` obs || BlockObstacle `Set.member` obs @@ -53,15 +53,15 @@ walkableNodeNear :: World -> Point2 -> Maybe Int walkableNodeNear w p = fmap fst . find (flip (isWalkable p) w . snd) $ nodesNear where --nodesNear = runIdentity . S.toList_ $ nearPoint _pnZoning p w - nodesNear = zonesExtract (w ^. pnZoning) $ zonesAroundPoint pnZoneSize p + nodesNear = zonesExtract (w ^. cWorld . pnZoning) $ zonesAroundPoint pnZoneSize p makePathBetweenPs :: Point2 -> Point2 -> World -> Maybe [Point2] -makePathBetweenPs a b w = mapMaybe (lab $ _pathGraph w) <$> makePathBetween a b w +makePathBetweenPs a b w = mapMaybe (lab $ _pathGraph (_cWorld w)) <$> makePathBetween a b w bfsNodePoints :: Int -> World -> [Point2] bfsNodePoints n w = mapMaybe (lab g) $ bfs n g where - g = _pathGraph w + g = _pathGraph (_cWorld w) pointTowardsImpulse :: Point2 -> Point2 -> World -> Maybe Point2 @@ -137,7 +137,7 @@ addEdges nodemap gr = runIdentity . S.fold_ f (mempty,gr) id obstructPathsCrossing :: EdgeObstacle -> Point2 -> Point2 -> World -> ( World, [(Int,Int,PathEdge)]) obstructPathsCrossing obstacletype sp' ep w = - ( w & pathGraph %~ updateedges + ( w & cWorld . pathGraph %~ updateedges , es ) where diff --git a/src/Dodge/Picture/SizeInvariant.hs b/src/Dodge/Picture/SizeInvariant.hs index 864f2dc6c..888926434 100644 --- a/src/Dodge/Picture/SizeInvariant.hs +++ b/src/Dodge/Picture/SizeInvariant.hs @@ -20,9 +20,9 @@ fixedSizePicAt pic p w . scale theScale theScale $ pic where - campos = _cameraViewFrom w + campos = _cameraViewFrom (_cWorld w) v = p -.- campos - theScale = 1 / _cameraZoom w + theScale = 1 / _cameraZoom (_cWorld w) (V2 x y) = campos +.+ v fixedSizePicClamp @@ -40,11 +40,11 @@ fixedSizePicClamp xbord ybord pic p cfig w . scale theScale theScale $ pic where - r = negate $ _cameraRot w - z = _cameraZoom w - campos = _cameraViewFrom w + r = negate $ _cameraRot (_cWorld w) + z = _cameraZoom (_cWorld w) + campos = _cameraViewFrom (_cWorld w) v = p -.- campos - theScale = 1 / _cameraZoom w + theScale = 1 / _cameraZoom (_cWorld w) (V2 x y) = campos +.+ rotateV (negate r) (V2 xr' yr') (V2 xr yr) = rotateV r v xr' = absClamp ((halfWidth cfig - fromIntegral xbord) / z) xr @@ -71,8 +71,8 @@ fixedSizePicClampArrow xbord ybord pic p cfig w = pictures Nothing -> blank Just bp -> thickLine 5 [bp, fromMaybe p windowPoint] (V2 x y) = fromMaybe p borderPoint - campos = _cameraCenter w - theScale = 1 / _cameraZoom w + campos = _cameraCenter (_cWorld w) + theScale = 1 / _cameraZoom (_cWorld w) absClamp :: Float -- ^ clamping value, assumed positive diff --git a/src/Dodge/Placement/Instance/LightSource/Flicker.hs b/src/Dodge/Placement/Instance/LightSource/Flicker.hs index 04865b062..8674582ad 100644 --- a/src/Dodge/Placement/Instance/LightSource/Flicker.hs +++ b/src/Dodge/Placement/Instance/LightSource/Flicker.hs @@ -18,13 +18,13 @@ flickerMod pl = Just $ sps0 $ PutMod $ ModIDTimerPoint3Bool flickerUpdate :: Modification -> World -> World flickerUpdate md w - | _mdTimer md > 0 = w & modifications . ix mdid . mdTimer -~ 1 - | otherwise = w & lightSources . ix lsid . lsParam . lsCol .~ mdcol - & modifications . ix mdid + | _mdTimer md > 0 = w & cWorld . modifications . ix mdid . mdTimer -~ 1 + | otherwise = w & cWorld . lightSources . ix lsid . lsParam . lsCol .~ mdcol + & cWorld . modifications . ix mdid %~ ( (mdTimer .~ newtime) . (mdPoint3 .~ lscol) . (mdBool %~ not) ) where mdcol = _mdPoint3 md - lscol = _lsCol $ _lsParam $ _lightSources w IM.! lsid + lscol = w ^?! cWorld . 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/Sensor.hs b/src/Dodge/Placement/Instance/Sensor.hs index 9ac3aa177..04dfc8a57 100644 --- a/src/Dodge/Placement/Instance/Sensor.hs +++ b/src/Dodge/Placement/Instance/Sensor.hs @@ -29,7 +29,7 @@ damageSensor dt wdth mtrid ps = pContID ps (PutLS $ lsPosCol (V3 0 0 30) 0.1) & mcColor .~ yellow & mcMounts . at ObTrigger .~ mtrid & mcMounts . at ObLightSource ?~ lsid - & mcDraw .~ MachineDrawDamageSensor wdth (_sensorCoding (_genParams gw) M.! dt) + & mcDraw .~ MachineDrawDamageSensor wdth (_sensorCoding (_genParams (_cWorld gw)) M.! dt) & mcSensor .~ DamageSensor False 0 dt ) defaultSensorWall diff --git a/src/Dodge/Placement/Instance/Terminal.hs b/src/Dodge/Placement/Instance/Terminal.hs index 14aaf5653..ef25d725a 100644 --- a/src/Dodge/Placement/Instance/Terminal.hs +++ b/src/Dodge/Placement/Instance/Terminal.hs @@ -29,10 +29,10 @@ putTerminal mc tm $ \mcpl -> Just $ sps0 $ PutWorldUpdate $ const (setids tmpl btpl mcpl) where setids tmpl btpl mcpl w = w - & terminals . ix tmid . tmButtonID .~ btid - & terminals . ix tmid . tmMachineID .~ mcid - & machines . ix mcid . mcMounts . at ObTerminal ?~ tmid - & buttons . ix btid . btTermMID ?~ tmid + & 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 where tmid = fromJust (_plMID tmpl) btid = fromJust (_plMID btpl) diff --git a/src/Dodge/Placement/Instance/Turret.hs b/src/Dodge/Placement/Instance/Turret.hs index 35cd57109..de5fa620b 100644 --- a/src/Dodge/Placement/Instance/Turret.hs +++ b/src/Dodge/Placement/Instance/Turret.hs @@ -39,7 +39,7 @@ lasTurret = Turret -- this needs a major cleanup updateTurret :: Float -> Machine -> World -> World updateTurret rotSpeed mc w - | _mcHP mc < 1 = w & machines %~ IM.delete mcid + | _mcHP mc < 1 = w & cWorld . machines %~ IM.delete mcid & deleteWallIDs (_mcWallIDs mc) & makeExplosionAt mcpos & copyItemToFloor mcpos lasGun @@ -52,12 +52,12 @@ updateTurret rotSpeed mc w where deleteHomonculus = case _tuMCrID (_mcType mc) of Nothing -> id - Just cid -> creatures . at cid .~ Nothing - initHomonculus w' = case w' ^? machines . ix mcid . mcType . tuMCrID . _Just of - Nothing -> w' & machines . ix mcid . mcType . tuMCrID ?~ cid - & creatures . at cid ?~ thecreature + Just cid -> cWorld . creatures . at cid .~ Nothing + initHomonculus w' = case w' ^? cWorld . machines . ix mcid . mcType . tuMCrID . _Just of + Nothing -> w' & cWorld . machines . ix mcid . mcType . tuMCrID ?~ cid + & cWorld . creatures . at cid ?~ thecreature where - cid = IM.newKey (_creatures w') + cid = IM.newKey (_creatures (_cWorld w')) thecreature = defaultCreature & crID .~ cid & crInv . at 0 ?~ (_tuWeapon (_mcType mc) & itUse . useAim . aimHandlePos -~ 10 @@ -70,9 +70,9 @@ updateTurret rotSpeed mc w & crStance . posture .~ Aiming & crMaterial .~ Crystal Just cid -> w' - & creatures . ix cid . crPos .~ mcpos - & creatures . ix cid . crDir .~ mcdir - dodamage = machines . ix mcid %~ + & cWorld . creatures . ix cid . crPos .~ mcpos + & cWorld . creatures . ix cid . crDir .~ mcdir + dodamage = cWorld . machines . ix mcid %~ ( (mcDamage .~ [Damage ELECTRICAL (min 2500 $ max 0 (elecDam - 10)) 0 0 0 NoDamageEffect]) . (mcHP -~ dam) ) @@ -83,7 +83,7 @@ updateTurret rotSpeed mc w | _tuFireTime (_mcType mc) > 0 = fromMaybe id $ do cid <- _tuMCrID (_mcType mc) - return $ creatures . ix cid . crActionPlan . apImpulse .~ [UseItem] + return $ cWorld . creatures . ix cid . crActionPlan . apImpulse .~ [UseItem] | otherwise = id mcid = _mcID mc ypos = _crPos $ you w @@ -94,12 +94,12 @@ updateTurret rotSpeed mc w dam = sum $ map _dmAmount dams elecDam = sum $ map _dmAmount elecDams doTurn - | seesYou = machines . ix mcid . mcDir %~ turnTo rotSpeed mcpos ypos + | seesYou = cWorld . machines . ix mcid . mcDir %~ turnTo rotSpeed mcpos ypos | otherwise = id closeFireAngle = seesYou -- && angleVV (ypos -.- mcpos) (unitVectorAtAngle mcdir) < 1 updateFiringStatus - | closeFireAngle = machines . ix mcid . mcType . tuFireTime .~ 20 - | otherwise = machines . ix mcid . mcType . tuFireTime %~ (max 0 . subtract 1) + | closeFireAngle = cWorld . machines . ix mcid . mcType . tuFireTime .~ 20 + | otherwise = cWorld . machines . ix mcid . mcType . tuFireTime %~ (max 0 . subtract 1) drawTurret :: Machine -> SPic diff --git a/src/Dodge/Placement/PlaceSpot.hs b/src/Dodge/Placement/PlaceSpot.hs index b161bffc6..7cff41400 100644 --- a/src/Dodge/Placement/PlaceSpot.hs +++ b/src/Dodge/Placement/PlaceSpot.hs @@ -88,21 +88,21 @@ placeSpotID ps pt gw = let (i,w) = placeSpotID' ps pt (_gwWorld 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 triggers cnd w - PutMod mdi -> plNewUpID modifications mdID mdi w - PutProp prp -> plNewUpID props prID (mvProp p rot prp) w - PutButton bt -> plNewUpID buttons btID (mvButton p rot bt) w - PutTerminal tm -> plNewUpID terminals tmID tm w - PutFlIt itm -> plNewUpID floorItems flItID (createFlIt p rot itm) w - PutCrit cr -> plNewUpID creatures crID (mvCr p rot cr) w - PutForeground fs -> plNewUpID foregroundShapes fsID (mvFS p rot fs) w - PutDecoration pic -> plNewID decorations (shiftDec p rot pic) w + 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 PutMachine pps mc wl -> plMachine (map doShift pps) mc wl p rot w - PutLS ls -> plNewUpID lightSources lsID (mvLS p' rot ls) w - PutPPlate pp -> plNewUpID pressPlates ppID (mvPP p rot pp) w + PutLS ls -> plNewUpID (cWorld . lightSources) lsID (mvLS p' rot ls) w + PutPPlate pp -> plNewUpID (cWorld . 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 coordinates (doShift cp) w + PutCoord cp -> plNewID (cWorld . 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' -> plBlock (map doShift ps') (bl & blPos %~ doShift & blDir .~ rot) @@ -148,7 +148,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 walls wlID (wl & wlLine .~ l) +addPane wl w l = w & plNew (cWorld . walls) wlID (wl & wlLine .~ l) & fst . uncurry (obstructPathsCrossing WallObstacle) l -- where -- wlid = IM.newKey (_walls w) @@ -174,14 +174,14 @@ 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 & machines %~ addMc - & walls %~ placeMachineWalls wl col wallpoly mcid wlid + , gw & cWorld . machines %~ addMc + & cWorld . walls %~ placeMachineWalls wl col wallpoly mcid wlid ) where col = _mcColor mc w' = gw - mcid = IM.newKey $ _machines w' - wlid = IM.newKey $ _walls w' + mcid = IM.newKey $ _machines (_cWorld w') + wlid = IM.newKey $ _walls (_cWorld w') 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 97f35387a..5bded3b5c 100644 --- a/src/Dodge/Placement/PlaceSpot/Block.hs +++ b/src/Dodge/Placement/PlaceSpot/Block.hs @@ -23,7 +23,7 @@ plBlock -> (Int,World) plBlock [] _ _ _ = error "Trying to add a block with incomplete polygon" plBlock (p:ps) bl wl w = (,) blid $ w - & blocks . at blid ?~ bl + & cWorld . blocks . at blid ?~ bl { _blID = blid , _blWallIDs = IS.fromList is , _blShadows = [] @@ -31,9 +31,9 @@ plBlock (p:ps) bl wl w = (,) blid $ w } & insertWalls blid wls where - blid = IM.newKey $ _blocks w + blid = IM.newKey $ _blocks (_cWorld w) lns = zip (p:ps) (ps ++ [p]) - i = IM.newKey $ _walls w + i = IM.newKey $ _walls (_cWorld w) is = [i.. i + length lns-1] wls = zipWith (\j ln -> wl & wlLine .~ ln & wlID .~ j & wlStructure .~ BlockPart blid) @@ -62,11 +62,11 @@ plLineBlock basePane blwidth a b gw = ( 0 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 gw - blid = IM.newKey $ _blocks gw + wlid = IM.newKey $ _walls (_cWorld gw) + blid = IM.newKey $ _blocks (_cWorld gw) insertBlock (i,p) = insertWalls (i + blid) (makeWallAt p i) - . over blocks (IM.insert (i+blid) Block + . over (cWorld . blocks) (IM.insert (i+blid) Block { _blID = i + blid, _blWallIDs = IS.fromList $ ksAtI i , _blHP = 1000, _blShadows = shadowsAt i , _blDir = 0 -- THIS IS NOT SENSIBLE. TODO rethink block positioning @@ -96,10 +96,10 @@ plLineBlock basePane blwidth a b gw = ( 0 -- | Must be done after inserting the block insertWalls :: Int -> [Wall] -> World -> World -insertWalls blid wls w = w' & blocks . ix blid . blObstructs .~ concat paths +insertWalls blid wls w = w' & cWorld . blocks . ix blid . blObstructs .~ concat paths where (w',paths) = mapAccumR (flip insertWall) w wls insertWall :: Wall -> World -> (World,[(Int,Int,PathEdge)]) insertWall wl = uncurry (obstructPathsCrossing BlockObstacle) (_wlLine wl) - . (walls . at (_wlID wl) ?~ wl) + . (cWorld . walls . at (_wlID wl) ?~ wl) diff --git a/src/Dodge/Placement/PlaceSpot/TriggerDoor.hs b/src/Dodge/Placement/PlaceSpot/TriggerDoor.hs index 23c93689a..7326dfe88 100644 --- a/src/Dodge/Placement/PlaceSpot/TriggerDoor.hs +++ b/src/Dodge/Placement/PlaceSpot/TriggerDoor.hs @@ -27,9 +27,9 @@ plDoor :: Color -- Bumped out up and down by 9, not widened -> World -> (Int,World) -plDoor col eo cond pss gw = (drid, addWalls $ gw & doors %~ addDoor) -- carefull with the ordering of addWalls +plDoor col eo cond pss gw = (drid, addWalls $ gw & cWorld . doors %~ addDoor) -- carefull with the ordering of addWalls where - drid = IM.newKey $ _doors gw + drid = IM.newKey $ _doors (_cWorld gw) addDoor = IM.insert drid $ defaultDoor { _drID = drid , _drWallIDs = IS.fromList wlids @@ -42,18 +42,18 @@ plDoor col eo cond pss gw = (drid, addWalls $ gw & doors %~ addDoor) -- carefull , _drObstacleType = eo } nsteps = length pss - 1 - wlids = take 4 [IM.newKey $ _walls gw ..] + wlids = take 4 [IM.newKey $ _walls (_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' - & walls %~ IM.insert wlid wl + & cWorld . walls %~ IM.insert wlid wl { _wlLine = wlps , _wlID = wlid , _wlStructure = DoorPart drid } - & doors . ix drid . drObstructs .++~ es + & cWorld . doors . ix drid . drObstructs .++~ es where (w',es) = uncurry (obstructPathsCrossing eo) wlps w @@ -63,9 +63,9 @@ maybeClearDoorPaths eo es w = foldl' (maybeClearDoorPath eo) w es maybeClearDoorPath :: EdgeObstacle -> World -> (Int,Int,PathEdge) -> World maybeClearDoorPath eo w (x,y,pe) | not . null $ overlapSegWalls (_peStart pe) (_peEnd pe) $ wlsNearSeg (_peStart pe) (_peEnd pe) w - = w & pathGraph %~ FGL.insEdge (x,y,pe & peObstacles . at eo ?~ ()) . FGL.delEdge (x,y) + = w & cWorld . pathGraph %~ FGL.insEdge (x,y,pe & peObstacles . at eo ?~ ()) . FGL.delEdge (x,y) | otherwise - = w & pathGraph %~ FGL.insEdge (x,y,pe & peObstacles . at eo .~ Nothing) . FGL.delEdge (x,y) + = w & cWorld . pathGraph %~ FGL.insEdge (x,y,pe & peObstacles . at eo .~ Nothing) . FGL.delEdge (x,y) plSlideDoor :: Door @@ -77,9 +77,9 @@ plSlideDoor -> World -> (Int, World) plSlideDoor dr wl eo shiftOffset a b gw - = (drid, addDoorWalls $ gw & doors %~ addDoor) + = (drid, addDoorWalls $ gw & cWorld . doors %~ addDoor) where - drid = IM.newKey $ _doors gw + drid = IM.newKey $ _doors (_cWorld gw) addDoor = IM.insert drid $ dr { _drID = drid , _drWallIDs = IS.fromList wlids @@ -93,7 +93,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 gw ..] + wlids = take 4 [IM.newKey $ _walls (_cWorld gw) ..] -- old code that may help with pathing --import Dodge.LevelGen.Pathing --import Data.Graph.Inductive hiding ((&)) diff --git a/src/Dodge/Projectile/Create.hs b/src/Dodge/Projectile/Create.hs index a0ea253ab..91e453deb 100644 --- a/src/Dodge/Projectile/Create.hs +++ b/src/Dodge/Projectile/Create.hs @@ -22,7 +22,7 @@ fireShell it cr = makeShell it cr spinamount = _shellSpinAmount params thrustdelay = _shellThrustDelay params makeShell :: Item -> Creature -> [ProjectileUpdate] -> World -> World -makeShell it cr theupdate w = w & projectiles %~ IM.insert i Shell +makeShell it cr theupdate w = w & cWorld . projectiles %~ IM.insert i Shell { _prjPos = pos , _prjZ = 20 , _prjStartPos = pos @@ -38,7 +38,7 @@ makeShell it cr theupdate w = w & projectiles %~ IM.insert i Shell , _prjMITID = _itID it } where - i = IM.newKey $ _props w + i = IM.newKey $ _props (_cWorld w) dir = _crDir cr pos = _crPos cr +.+ rotateV dir (V2 (_crRad cr + 1) 0) am = _itConsumption it diff --git a/src/Dodge/Projectile/Update.hs b/src/Dodge/Projectile/Update.hs index 1e444269d..ffad5b0cc 100644 --- a/src/Dodge/Projectile/Update.hs +++ b/src/Dodge/Projectile/Update.hs @@ -46,7 +46,7 @@ updateRemoteShell pj w doExplode = w & usePayload (_prjPayload pj) oldPos & stopSoundFrom (ShellSound i) - & projectiles %~ IM.delete i + & cWorld . projectiles %~ IM.delete i i = _prjID pj oldPos = _prjPos pj vel = _prjVel pj @@ -58,15 +58,15 @@ explodeRemoteRocket' -> World -> World explodeRemoteRocket' mitid thepj w = w - & projectiles . ix pjid . prjDraw .~ DrawBlankProjectile + & cWorld . projectiles . ix pjid . prjDraw .~ DrawBlankProjectile & usePayload (_prjPayload thepj) (_prjPos thepj) & updateitem where - updateitem = fromMaybe (projectiles . at pjid .~ Nothing) $ do + updateitem = fromMaybe (cWorld . projectiles . at pjid .~ Nothing) $ do itid <- mitid - itpos <- w ^? itemPositions . ix itid + itpos <- w ^? cWorld . itemPositions . ix itid return $ (pointToItem itpos . itUse . rUse .~ HeldDoNothing) - . (projectiles . ix pjid . prjUpdates .~ [PJRetireRemote itid 30 pjid]) + . (cWorld . projectiles . ix pjid . prjUpdates .~ [PJRetireRemote itid 30 pjid]) pjid = _prjID thepj updateShell :: Proj -> World -> World @@ -82,7 +82,7 @@ updateShell pj w doExplode = w & usePayload (_prjPayload pj) oldPos & stopSoundFrom (ShellSound i) - & projectiles %~ IM.delete i + & cWorld . projectiles %~ IM.delete i i = _prjID pj oldPos = _prjPos pj vel = _prjVel pj @@ -108,7 +108,7 @@ upProjectile pu pj = case pu of | otherwise -> id PJSetScope itid -> setRemoteScope itid (_prjPos pj) PJRetireRemote itid 0 pjid -> retireRemoteProj'' itid pjid - PJRetireRemote _ _ pjid -> projectiles . ix pjid . prjUpdates . ix 0 . pjuTimer -~ 1 + PJRetireRemote _ _ pjid -> cWorld . projectiles . ix pjid . prjUpdates . ix 0 . pjuTimer -~ 1 where time = _prjTimer pj act st et = time <= st && time >= et @@ -116,26 +116,26 @@ upProjectile pu pj = case pu of retireRemoteProj'' :: Int -> Int -> World -> World retireRemoteProj'' itid pjid w = w - & pointToItem (_itemPositions w IM.! itid) %~ + & pointToItem (_itemPositions (_cWorld w) IM.! itid) %~ ( (itScope . scopePos .~ V2 0 0) . (itUse . rUse .~ HeldFireRemoteShell) ) - & props %~ IM.delete pjid + & cWorld . props %~ IM.delete pjid setRemoteDir :: Int -> Int -> Proj -> World -> World -setRemoteDir cid itid pj w = w & projectiles . ix i . prjDir .~ newdir +setRemoteDir cid itid pj w = w & cWorld . projectiles . ix i . prjDir .~ newdir where i = _prjID pj newdir - | SDL.ButtonRight `M.member` _mouseButtons w - && w ^? creatures . ix cid . crInvSel . iselPos == w ^? itemPositions . ix itid . ipInvID - = _cameraRot w + argV (_mousePos w) + | SDL.ButtonRight `M.member` _mouseButtons (_cWorld w) + && w ^? cWorld . creatures . ix cid . crInvSel . iselPos == w ^? cWorld . itemPositions . ix itid . ipInvID + = _cameraRot (_cWorld w) + argV (_mousePos (_cWorld w)) | otherwise = _prjDir pj doThrust' :: Proj -> World -> World doThrust' pj w = w & randGen .~ g - & projectiles . ix i . prjVel %~ (\v -> accel +.+ frict *.* v) + & cWorld . 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))) @@ -155,11 +155,11 @@ trySpinByCID' -> Proj -> World -> World -trySpinByCID' cid i pj w = w & projectiles . ix pjid . prjSpin .~ newSpin +trySpinByCID' cid i pj w = w & cWorld . projectiles . ix pjid . prjSpin .~ newSpin where pjid = _prjID pj dir = argV $ _prjVel pj - newSpin = case w ^? creatures . ix cid of + newSpin = case w ^? cWorld . creatures . ix cid of Just cr -> negate $ min 0.2 $ max (-0.2) $ normalizeAnglePi (dir - _crDir cr) / spinFactor _ -> 0 spinFactor = 5 * (6 - fromIntegral i) @@ -169,9 +169,9 @@ pjTrack' itid pj w = rotateToTarget pj w where rotateToTarget _ = fromMaybe id $ do tpos <- w ^? itPoint . itTargeting . tgPos . _Just - return $ projectiles . ix (_prjID pj) . prjSpin .~ turnToAmount 0.15 (_prjPos pj) tpos + return $ cWorld . projectiles . ix (_prjID pj) . prjSpin .~ turnToAmount 0.15 (_prjPos pj) tpos (argV $ _prjAcc pj) - itPoint = pointToItem $ _itemPositions w IM.! itid + itPoint = pointToItem $ _itemPositions (_cWorld w) IM.! itid reduceSpinBy' :: Float -> Proj -> World -> World -reduceSpinBy' x pj = projectiles . ix (_prjID pj) . prjSpin *~ x +reduceSpinBy' x pj = cWorld . projectiles . ix (_prjID pj) . prjSpin *~ x diff --git a/src/Dodge/Prop/Gib.hs b/src/Dodge/Prop/Gib.hs index 1d2a9d7ff..b8e01b03f 100644 --- a/src/Dodge/Prop/Gib.hs +++ b/src/Dodge/Prop/Gib.hs @@ -68,7 +68,7 @@ addGibsAtDir dir minh maxh col p w = foldl' (flip $ addGib4 p col) w (zip4 vels addGib4 :: Point2 -> Color -> (Point2, Float, Q.Quaternion Float, Float) -> World -> World -addGib4 p col (v,zs,q,h) = plNew props prID (aGib & prPos .~ p +.+ (5 *.* normalizeV v) +addGib4 p col (v,zs,q,h) = plNew (cWorld . props) prID (aGib & prPos .~ p +.+ (5 *.* normalizeV v) & prColor .~ col & prVel .~ v & prQuatSpin .~ Q.axisAngle (vNormal v `v2z` 0) (-0.1) @@ -79,7 +79,7 @@ addGib4 p col (v,zs,q,h) = plNew props prID (aGib & prPos .~ p +.+ (5 *.* normal addGibAt :: Float -> Color -> Point2 -> World -> World addGibAt h col p w = w - & plNew props prID gib + & plNew (cWorld . props) prID gib & randGen .~ newg where (gib,newg) = runState f $ _randGen w @@ -100,7 +100,7 @@ addGibAt h col p w = w addGibAtDir :: Float -> Float -> Color -> Point2 -> World -> World addGibAtDir dir h col p w = w - & plNew props prID gib + & plNew (cWorld . 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 ecd81bdb3..e2654ef73 100644 --- a/src/Dodge/Prop/Moving.hs +++ b/src/Dodge/Prop/Moving.hs @@ -9,12 +9,12 @@ import LensHelp fallSmallBounceDamage :: Prop -> World -> World fallSmallBounceDamage pr w = w & dodamage - & props . ix (_prID pr) %~ fallSmallBounce' w + & cWorld . props . ix (_prID pr) %~ fallSmallBounce' w where p = _prPos pr v = _prVel pr dodamage - | _prPosZ pr < 25 = creatures %~ fmap dodamage' + | _prPosZ pr < 25 = cWorld . creatures %~ fmap dodamage' | otherwise = id dodamage' cr | dist (_crPos cr) p < _crRad cr + 5 = cr & crState . csDamage @@ -23,7 +23,7 @@ fallSmallBounceDamage pr w = w fallSmallBounce :: Prop -> World -> World fallSmallBounce pr w = w - & props . ix (_prID pr) %~ fallSmallBounce' w + & cWorld . 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 8fe322ea7..98ca00e7b 100644 --- a/src/Dodge/Prop/Update.hs +++ b/src/Dodge/Prop/Update.hs @@ -17,7 +17,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 & lightSources . ix lsid %~ doPrWdLsLs x pr w + PropUpdateLS lsid x -> \w -> w & cWorld . 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] @@ -32,8 +32,8 @@ propUpdateIf wb x y pr w propUpdatePosition :: WdP2f -> Prop -> World -> World propUpdatePosition x pr w = w - & props . ix (_prID pr) . prPos .~ fst (doWdP2f x w) - & props . ix (_prID pr) . prRot .~ snd (doWdP2f x w) + & cWorld . props . ix (_prID pr) . prPos .~ fst (doWdP2f x w) + & cWorld . props . ix (_prID pr) . prRot .~ snd (doWdP2f x w) doPropUpdates :: Prop -> [PropUpdate] -> World -> World doPropUpdates pr pus w = foldl' f w pus @@ -45,9 +45,9 @@ propSetToggleAnd wb pu pr = setToggle (doWdBl wb) pr . updateProp (pr & prUpdate -- fugly setToggle :: (World -> Bool) -> Prop -> World -> World -setToggle cond pr w = w & props . ix (_prID pr) . prToggle .~ cond w +setToggle cond pr w = w & cWorld . props . ix (_prID pr) . prToggle .~ cond w rotateProp :: Float -> Prop -> World -> World rotateProp rotAmount pr w = w - & props . ix (_prID pr) . prRot +~ rotAmount + & cWorld . props . ix (_prID pr) . prRot +~ rotAmount diff --git a/src/Dodge/RadarSweep.hs b/src/Dodge/RadarSweep.hs index 6baa94a28..6f192f8e5 100644 --- a/src/Dodge/RadarSweep.hs +++ b/src/Dodge/RadarSweep.hs @@ -9,7 +9,7 @@ import Data.Maybe import qualified IntMapHelp as IM aRadarPulse :: Object -> Creature -> World -> World -aRadarPulse ob cr = radarSweeps .:~ RadarSweep +aRadarPulse ob cr = cWorld . radarSweeps .:~ RadarSweep { _rsTimer = 100 , _rsRad = 0 , _rsPos = _crPos cr @@ -29,7 +29,7 @@ updateRadarSweep w pt blipsF = findBlips ob bf = makeBlip ob x = _rsTimer pt - putBlips = radarBlips .++~ blips + putBlips = cWorld . radarBlips .++~ blips blips = map bf circPoints circPoints = blipsF p r w r = fromIntegral (400 - x*4) @@ -58,13 +58,13 @@ blipAt r col i p = RadarBlip } crBlips :: Point2 -> Float -> World -> [Point2] -crBlips p r = IM.elems . IM.filter f . fmap _crPos . IM.filter g . _creatures +crBlips p r = IM.elems . IM.filter f . fmap _crPos . IM.filter g . _creatures . _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 +itemBlips p r = IM.elems . IM.filter f . fmap _flItPos . _floorItems . _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 2f80b6348..712f77b3f 100644 --- a/src/Dodge/Reloading.hs +++ b/src/Dodge/Reloading.hs @@ -37,12 +37,12 @@ tryNextLoadAction cr = case cr ^? crInv . ix (crSel cr) . itConsumption . laProg crToggleReloading :: Creature -> World -> World crToggleReloading cr w = case cr ^?! crInvSel . iselAction of - ReloadAction {} -> w & creatures . ix (_crID cr) . crInvSel . iselAction .~ NoInvSelAction - _ -> w & creatures . ix (_crID cr) %~ tryStartLoading + ReloadAction {} -> w & cWorld . creatures . ix (_crID cr) . crInvSel . iselAction .~ NoInvSelAction + _ -> w & cWorld . creatures . ix (_crID cr) %~ tryStartLoading crHoldReloading :: Creature -> World -> World crHoldReloading cr w = w - & creatures . ix (_crID cr) . crInvSel . iselAction . actionHammer .~ HasHammer HammerDown + & cWorld . 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 1e5c47e59..02dc19846 100644 --- a/src/Dodge/Render.hs +++ b/src/Dodge/Render.hs @@ -34,14 +34,14 @@ doDrawing pdata u = do sTicks <- SDL.ticks let w = _uvWorld u cfig = _uvConfig u - rot = _cameraRot w - camzoom = _cameraZoom w - trans = _cameraCenter w + rot = _cameraRot (_cWorld w) + camzoom = _cameraZoom (_cWorld w) + trans = _cameraCenter (_cWorld w) 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) = _cameraViewFrom w + viewFroms@(V2 vfx vfy) = _cameraViewFrom (_cWorld w) viewFrom3d = Vector3 vfx vfy 20 shadV = _pictureShaders pdata lwShad = _lightingWallShadShader pdata @@ -64,7 +64,7 @@ doDrawing pdata u = do (shadVBOptr $ _textureArrayShader pdata) wallPointsCol windowPoints - (_floorTiles w) + (_floorTiles (_cWorld w)) ) ( pokeShape' (_vboPtr $ _vaoVBO $ _shadVAO $ _shapeShader pdata) @@ -248,7 +248,7 @@ doDrawing pdata u = do depthFunc $= Just Always blendFunc $= (One,Zero) -- perform any radial distortion - case _distortions w of + case _distortions (_cWorld w) 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 18efb1c0d..c3d93b83a 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -34,7 +34,7 @@ import qualified Data.Text as T --import Data.Bifunctor hudDrawings :: Universe -> Picture -hudDrawings uv = case _hudElement $ _hud w of +hudDrawings uv = case _hudElement $ _hud (_cWorld w) of DisplayCarte -> drawCarte cfig w DisplayInventory subinv -> drawInGameHUD uv <> subInventoryDisplay subinv cfig w @@ -59,7 +59,7 @@ inventoryDisplay cfig w = listPicturesAt 0 0 cfig invlist inv = _crInv cr invlist = concatMap (itemText' cr) (IM.toList inv) ++ displayFreeSlots - ++ concatMap (closeObjectToTextPictures nfreeslots) (_closeObjects w) + ++ concatMap (closeObjectToTextPictures nfreeslots) (_closeObjects (_cWorld w)) -- ++ map floorItemsColor (concatMap (closeObjectToTextPictures nfreeslots) (_closeObjects w)) -- floorItemsColor = case _hudElement (_hud w) of -- DisplayInventory NoSubInventory -> id @@ -131,7 +131,7 @@ subInventoryDisplay subinv cfig w = case subinv of selcursor' ct = fromMaybe mempty $ ct 0 0 cfig curpos itcol (determineInvSelCursorWidth w) cury <$ it selcursor = selcursor' selcursortype selcursortype - | ButtonRight `M.member` _mouseButtons w = listCursorNESW + | ButtonRight `M.member` _mouseButtons (_cWorld w) = listCursorNESW | otherwise = listCursorNSW curpos = invSelPos w cury = fromMaybe 1 $ augmentedInvSizes w IM.!? crSel (you w) @@ -140,8 +140,8 @@ subInventoryDisplay subinv cfig w = case subinv of _ -> mempty equipcursors = IM.foldMapWithKey (f yellow) (_crInvEquipped cr) f col invid epos = listTextPictureAt 144 0 cfig (selNumPos invid w) . color col $ text $ eqPosText epos - rboptions = if ButtonRight `M.member` _mouseButtons w - then drawRBOptions cfig w (_rbOptions w) + rboptions = if ButtonRight `M.member` _mouseButtons (_cWorld w) + then drawRBOptions cfig w (_rbOptions (_cWorld w)) else mempty itmInfo :: Maybe Item -> [String] @@ -151,7 +151,7 @@ itmInfo mit = fromMaybe [] $ do displayTerminal :: Int -> Configuration -> World -> Picture displayTerminal tid cfig w = fromMaybe mempty $ do - tm <- w ^? terminals . ix tid + tm <- w ^? cWorld . terminals . ix tid return $ pictures [ invHead cfig (_tmTitle tm ++ ":T" ++ show tid) , renderListAt subInvX 60 cfig @@ -187,7 +187,7 @@ drawRBOptions cfig w EquipOptions{_opEquip = es,_opSel=i, _opAllocateEquipment=a where midtext str = listTextPictureAt 252 0 cfig curpos (text str) extratext str = listTextPictureAt 432 0 cfig curpos (text (str ++ deactivatetext)) - deactivatetext = case w ^? rbOptions . opActivateEquipment . deactivateEquipment of + deactivatetext = case w ^? cWorld . rbOptions . opActivateEquipment . deactivateEquipment of Just k -> " DEACTIVATES " ++ show (_iyBase $ _itType (_crInv (you w) IM.! k)) Nothing -> "" curpos = invSelPos w @@ -255,9 +255,9 @@ topCursorTypeWidth ctype width cfig w i = ctype 0 0 cfig (selNumPos i w) (selNumCol i w) width (selNumSlots i w) determineInvSelCursorWidth :: World -> Int -determineInvSelCursorWidth w = case _rbOptions w of +determineInvSelCursorWidth w = case _rbOptions (_cWorld w) of NoRightButtonOptions -> topInvW - EquipOptions {} -> if ButtonRight `M.member` _mouseButtons w + EquipOptions {} -> if ButtonRight `M.member` _mouseButtons (_cWorld w) then 47 else topInvW @@ -309,9 +309,9 @@ drawCarte cfig w = pictures $ ++ mapOverlay cfig w ++ [mainListCursor white iPos cfig] where - iPos = _selLocation w - locs = map (\(_,s) -> (s,white)) . IM.elems . _seenLocations $ w - locPoss = map (cartePosToScreen cfig w . ($ w) . doWorldPos . fst) . IM.elems . _seenLocations $ w + 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) locTexts = map fst locs displayListEndCoords :: Configuration -> [String] -> [Point2] @@ -325,7 +325,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 w) + (mapMaybe (mapWall cfig w) . IM.elems $ _walls (_cWorld w)) mapWall :: Configuration -> World -> Wall -> Maybe Picture mapWall cfig w wl = @@ -419,4 +419,4 @@ displayHP cid cfig w = translate (halfWidth cfig-80) (halfHeight cfig-20) . leftPad 5 ' ' . show . _crHP - $ _creatures w IM.! cid + $ _creatures (_cWorld w) IM.! cid diff --git a/src/Dodge/Render/Lights.hs b/src/Dodge/Render/Lights.hs index 62f751aa6..800550465 100644 --- a/src/Dodge/Render/Lights.hs +++ b/src/Dodge/Render/Lights.hs @@ -9,13 +9,13 @@ import Data.Maybe import qualified IntMapHelp as IM lightsToRender :: Configuration -> World -> [(Point3,Float,Point3)] -lightsToRender cfig w = mapMaybe getLS (IM.elems $ _lightSources w) - ++ mapMaybe getTLS (_tempLightSources w) +lightsToRender cfig w = mapMaybe getLS (IM.elems $ _lightSources (_cWorld w)) + ++ mapMaybe getTLS (_tempLightSources (_cWorld w)) where getLS = getlsparam . _lsParam getTLS = getlsparam . _tlsParam - cbox = _boundBox w - cpos = _cameraCenter w + cbox = _boundBox (_cWorld w) + cpos = _cameraCenter (_cWorld w) getlsparam ls | not (pointInPolygon lpos cbox) && extraculltest = Nothing | otherwise = Just ( _lsPos ls, rad^(2::Int) , _lsCol ls) diff --git a/src/Dodge/Render/Picture.hs b/src/Dodge/Render/Picture.hs index c7a289066..2091dea4b 100644 --- a/src/Dodge/Render/Picture.hs +++ b/src/Dodge/Render/Picture.hs @@ -23,6 +23,6 @@ fixedCoordPictures u = case _menuLayers u of customMouseCursor :: Configuration -> World -> Picture customMouseCursor cfig w = winScale cfig - . uncurryV translate (_mousePos w) + . uncurryV translate (_mousePos (_cWorld w)) . color white $ pictures [ line [V2 (-5) 0,V2 5 0] , line [V2 0 (-5),V2 0 5] ] diff --git a/src/Dodge/Render/ShapePicture.hs b/src/Dodge/Render/ShapePicture.hs index df42180e0..11689ab05 100644 --- a/src/Dodge/Render/ShapePicture.hs +++ b/src/Dodge/Render/ShapePicture.hs @@ -78,7 +78,7 @@ worldSPic cfig w <> singleSPic (anyTargeting cfig w) where foldup = foldMap' - filtOn f g = IM.filter (pointIsClose . f) (g w) + filtOn f g = IM.filter (pointIsClose . f) (g (_cWorld w)) pointIsClose = cullPoint cfig w anyTargeting :: Configuration -> World -> SPic @@ -128,30 +128,30 @@ shiftDraw' fpos fdir fdraw x = uncurryV translateSPf (fpos x) cullPoint :: Configuration -> World -> Point2 -> Bool cullPoint cfig w p - | debugOn Close_shape_culling cfig = pointInPolygon p (_boundBox w) - | otherwise = dist (_cameraCenter w) p < _viewDistance w + | debugOn Close_shape_culling cfig = pointInPolygon p (_boundBox (_cWorld w)) + | otherwise = dist (_cameraCenter (_cWorld w)) p < _viewDistance (_cWorld w) extraPics :: Configuration -> World -> Picture -extraPics cfig w = pictures (_decorations w) - <> concatMapPic drawTractorBeam (_tractorBeams w) - <> concatMapPic drawLinearShockwave (_linearShockwaves w) - <> concatMapPic drawShockwave (_shockwaves w) - <> concatMapPic drawLaser (_lasersToDraw w) - <> concatMapPic drawTeslaArc (_teslaArcs w) +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)) -- <> concatMapPic drawParticle (_particles w) - <> concatMapPic drawRadarSweep (_radarSweeps w) - <> concatMapPic drawFlame (_flames w) - <> concatMapPic drawEnergyBall (_energyBalls w) - <> concatMapPic drawSpark (_sparks w) - <> concatMapPic drawBul (_bullets w) - <> concatMapPic drawBlip (_radarBlips w) - <> concatMapPic drawFlare (_flares w) - <> concatMapPic (dbArg (drawBeam . _bmDraw)) (_positronBeams $ _beams w) - <> concatMapPic (dbArg (drawBeam . _bmDraw)) (_electronBeams $ _beams w) - <> concatMapPic (dbArg (drawLightSource . _lsPict)) (_lightSources 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)) <> testPic cfig w - <> concatMapPic clDraw (_clouds w ) - <> concatMapPic ppDraw (_pressPlates w ) + <> concatMapPic clDraw (_clouds (_cWorld w) ) + <> concatMapPic ppDraw (_pressPlates (_cWorld w) ) <> viewClipBounds cfig w <> debugDraw cfig w @@ -196,7 +196,7 @@ debugDraw' cfig w bl = case bl of rdraw pic = (mempty,pic) drawCreatureDisplayTexts :: World -> Picture -drawCreatureDisplayTexts w = foldMap (creatureDisplayText w) (_creatures w) +drawCreatureDisplayTexts w = foldMap (creatureDisplayText w) (_creatures (_cWorld w)) drawPathBetween :: World -> Picture drawPathBetween w = setLayer DebugLayer @@ -207,22 +207,22 @@ drawPathBetween w = setLayer DebugLayer where nodepos = (`getNodePos` w) nodelist = makePathBetween sp ep w - sp = _lSelect w - ep = _rSelect w + sp = _lSelect (_cWorld w) + ep = _rSelect (_cWorld w) drawNodesNearSelect :: World -> Picture drawNodesNearSelect w = setLayer DebugLayer $ runIdentity (S.foldMap_ (drawZoneCol orange pnZoneSize) (zoneAroundPoint pnZoneSize sp)) <> color green (drawCross sp) where - sp = _lSelect w + sp = _lSelect (_cWorld w) drawInspectWalls :: World -> Picture drawInspectWalls w = foldMap (drawInspectWall w) $ filter (isJust . uncurry (intersectSegSeg a b) . _wlLine) - $ IM.elems $ _walls w + $ IM.elems $ _walls (_cWorld w) where - (a,b) = _lLine w + (a,b) = _lLine (_cWorld w) drawInspectWall :: World -> Wall -> Picture drawInspectWall w wl = setLayer DebugLayer @@ -233,7 +233,7 @@ drawInspectWall w wl = setLayer DebugLayer drawDoorPaths :: World -> Int -> Picture drawDoorPaths w drid = fromMaybe mempty $ do - paths <- w ^? doors . ix drid . drObstructs + paths <- w ^? cWorld . doors . ix drid . drObstructs return $ foldMap (drawPathEdge . (^. _3)) paths drawPathEdge :: PathEdge -> Picture @@ -252,8 +252,8 @@ drawWorldSelect w = setLayer DebugLayer $ color cyan (line [a,b]) <> color magenta (line [c,d]) where - (a,b) = _lLine w - (c,d) = _rLine w + (a,b) = _lLine (_cWorld w) + (c,d) = _rLine (_cWorld w) drawFarWallDetect :: World -> Picture drawFarWallDetect w = setLayer DebugLayer @@ -264,7 +264,7 @@ drawFarWallDetect w = setLayer DebugLayer ] ) $ runIdentity $ S.toList_ $ streamViewpoints p w where - p = _cameraViewFrom w + p = _cameraViewFrom (_cWorld w) drawDDATest :: World -> Picture drawDDATest w = runIdentity (S.foldMap_ (drawZoneCol orange 50) ps) @@ -273,12 +273,12 @@ drawDDATest w = runIdentity (S.foldMap_ (drawZoneCol orange 50) ps) <> color blue (runIdentity (S.foldMap_ drawCross qs')) <> setLayer DebugLayer (color yellow (line [cvf,mwp])) where - cvf = _cameraViewFrom w + cvf = _cameraViewFrom (_cWorld w) mwp = mouseWorldPos w ps = ddaStreamX 50 cvf mwp - ps' = ddaStreamY 50 (_cameraViewFrom w) (mouseWorldPos w) - qs = xIntercepts 50 (_cameraViewFrom w) (mouseWorldPos w) - qs' = yIntercepts 50 (_cameraViewFrom w) (mouseWorldPos w) + ps' = ddaStreamY 50 (_cameraViewFrom (_cWorld w)) (mouseWorldPos w) + qs = xIntercepts 50 (_cameraViewFrom (_cWorld w)) (mouseWorldPos w) + qs' = yIntercepts 50 (_cameraViewFrom (_cWorld w)) (mouseWorldPos w) drawCross :: Point2 -> Picture drawCross p = setLayer DebugLayer . color red . uncurryV translate p $ crossPic 5 @@ -299,7 +299,7 @@ drawWallSearchRays :: World -> Picture drawWallSearchRays w = foldMap (f . fst) $ allVisibleWalls w where f p = setLayer DebugLayer $ color yellow $ uncurryV translate p (circle 5) - <> line [_cameraViewFrom w, p] + <> line [_cameraViewFrom (_cWorld w), p] testPic :: Configuration -> World -> Picture testPic _ _ = mempty @@ -307,7 +307,7 @@ testPic _ _ = mempty drawBoundingBox :: World -> Picture drawBoundingBox w = setLayer DebugLayer $ color green $ line $ (x:xs) ++ [x] where - (x:xs) = _boundBox w + (x:xs) = _boundBox (_cWorld w) clDraw :: Cloud -> Picture clDraw c = translate3 (_clPos c) (drawCloud (_clPict c) c) @@ -329,7 +329,7 @@ soundPic cfig w s = fixedSizePicClampArrow 50 50 thePic p cfig w where p = _soundPos s thePic - = rotate (_cameraRot w) + = rotate (_cameraRot (_cWorld w)) . scale theScale theScale . centerText . soundToOnomato @@ -348,7 +348,7 @@ drawMousePosition cfig w = setLayer FixedCoordLayer . winScale cfig mwp = mouseWorldPos w drawWlIDs :: Configuration -> World -> Picture -drawWlIDs cfig w = setLayer FixedCoordLayer $ foldMap f (_walls w) +drawWlIDs cfig w = setLayer FixedCoordLayer $ foldMap f (_walls (_cWorld w)) where f wl | dist (_crPos $ you w) (fst (_wlLine wl)) > 200 = mempty -- this should be improved with a better "on screen test" @@ -374,7 +374,7 @@ drawPathing cfig w = setLayer DebugLayer <> foldMap dispInc (graphToIncidence gr) where dispInc (p,n) = setDepth 2 . uncurryV translate p . scale 0.1 0.1 $ text $ show n - gr = _pathGraph w + gr = _pathGraph (_cWorld w) crDisplayInfo :: Configuration -> World -> Creature -> Maybe (Point2,[String]) crDisplayInfo cfig w cr @@ -401,7 +401,7 @@ fpreShow str = fmap (((rightPad 7 '.'str ++ "...") ++) . show) drawCrInfo :: Configuration -> World -> Picture drawCrInfo cfig w = setLayer FixedCoordLayer $ renderInfoListsAt (2*hw - 400) 0 cfig w - $ mapMaybe (crDisplayInfo cfig w) $ IM.elems $ _creatures w + $ mapMaybe (crDisplayInfo cfig w) $ IM.elems $ _creatures (_cWorld w) where hw = halfWidth cfig @@ -410,14 +410,14 @@ viewBoundaries w = setLayer DebugLayer $ color green (foldMap (polygonWire . _gr <> color yellow (foldMap (\q -> line [p,q]) $ farWallPoints p w) where p = _crPos $ you w - grs = filter (pointInOrOnPolygon p . _grBound) (_gameRooms w) + grs = filter (pointInOrOnPolygon p . _grBound) (_gameRooms (_cWorld w)) viewClipBounds :: Configuration -> World -> Picture viewClipBounds cfig w | _debug_view_clip_bounds cfig == AllRoomClipBoundaries - = setLayer DebugLayer $ color green $ foldMap (polygonWire . _cpPoints) (_roomClipping w) + = setLayer DebugLayer $ color green $ foldMap (polygonWire . _cpPoints) (_roomClipping (_cWorld w)) | _debug_view_clip_bounds cfig == IntersectingRoomClipBoundaries - = setLayer DebugLayer $ f (_roomClipping w) + = setLayer DebugLayer $ f (_roomClipping (_cWorld w)) | otherwise = mempty where f (x:xs) = g x xs <> f xs diff --git a/src/Dodge/Render/Walls.hs b/src/Dodge/Render/Walls.hs index c45854bf3..c7cf2e299 100644 --- a/src/Dodge/Render/Walls.hs +++ b/src/Dodge/Render/Walls.hs @@ -23,7 +23,7 @@ wallsToDraw w <$> L.prefilter wlOpaqueDraw (L.premap f L.list) <*> L.prefilter wlSeeThroughDraw (L.premap f L.list) <*> L.premap getWallSPic L.mconcat - ) (wlsFromIXs w $ zonesExtract (w ^. wlZoning) $ zoneOfSight' wlZoneSize w) + ) (wlsFromIXs w $ zonesExtract (w ^. cWorld . wlZoning) $ zoneOfSight' wlZoneSize w) --wallsToDraw -- :: World -- -> ( [((Point2,Point2),Point4)] ,[((Point2,Point2),Point4)], SPic ) diff --git a/src/Dodge/Room/LongDoor.hs b/src/Dodge/Room/LongDoor.hs index 5ab865375..2e70551cc 100644 --- a/src/Dodge/Room/LongDoor.hs +++ b/src/Dodge/Room/LongDoor.hs @@ -105,7 +105,7 @@ addButtonSlowDoor x h rm = do (V3 15 xoff 89) (aShape (V2 15 0) (V3 15 xoff 90)) $ \plls plpr -> Just $ ptCont (PutWorldUpdate (const $ setmount dr plls plpr)) $ const mpl - setmount pldr plls plpr = doors . ix (fromJust $ _plMID pldr) . drMounts .++~ + setmount pldr plls plpr = cWorld . 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/Save.hs b/src/Dodge/Save.hs index 08ffceddf..50e287498 100644 --- a/src/Dodge/Save.hs +++ b/src/Dodge/Save.hs @@ -28,7 +28,7 @@ doQuicksave :: Universe -> Universe doQuicksave = saveWorldInSlot QuicksaveSlot clearKeys :: World -> World -clearKeys = (keys .~ mempty) . (mouseButtons .~ mempty) +clearKeys = (cWorld . keys .~ mempty) . (cWorld . mouseButtons .~ mempty) saveLevelStartSlot :: Universe -> Universe --saveLevelStartSlot = id diff --git a/src/Dodge/Shockwave/Update.hs b/src/Dodge/Shockwave/Update.hs index 813ee7e48..ef0ddb304 100644 --- a/src/Dodge/Shockwave/Update.hs +++ b/src/Dodge/Shockwave/Update.hs @@ -28,7 +28,7 @@ moveShockwave w sw t = _swTimer sw tFraction = fromIntegral t / fromIntegral (_swMaxTime sw) rad = r - (3/4) * r * tFraction - doDams w' = over creatures (IM.map damCr) + doDams w' = over (cWorld . creatures) (IM.map damCr) $ foldl' (flip $ damageWall (Damage EXPLOSIVE 10000 p p p NoDamageEffect)) w' @@ -56,7 +56,7 @@ moveInverseShockwave w sw r = _swRad sw t = _swTimer sw rad = r - 0.1 * r * fromIntegral (10 - t) - dams = over creatures (IM.map damCr) -- . flip (foldr (damageBlocksBy 1)) hitBlocks + dams = over (cWorld . 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 64678b083..d2f9e3a94 100644 --- a/src/Dodge/SoundLogic.hs +++ b/src/Dodge/SoundLogic.hs @@ -146,9 +146,9 @@ soundAngle p w . radToDeg . normalizeAngle . (+ pi) - $ argV (vNormal (p -.- earPos)) - _cameraRot w + $ argV (vNormal (p -.- earPos)) - _cameraRot (_cWorld w) where - earPos = _cameraViewFrom w + earPos = _cameraViewFrom (_cWorld w) {-| 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 2596544dc..5e8d92b82 100644 --- a/src/Dodge/Spark.hs +++ b/src/Dodge/Spark.hs @@ -35,8 +35,8 @@ sparkDam -> World -> World sparkDam sk sp ep mayEiCrWl = case mayEiCrWl of - (hitp,Left cr) -> creatures . ix (_crID cr) . crState . csDamage .:~ thedam hitp - (hitp,Right wl) -> wallDamages %~ IM.insertWith (++) (_wlID wl) [thedam hitp] + (hitp,Left cr) -> cWorld . creatures . ix (_crID cr) . crState . csDamage .:~ thedam hitp + (hitp,Right wl) -> cWorld . wallDamages %~ IM.insertWith (++) (_wlID wl) [thedam hitp] where thedam hitp = Damage (_skDamageType sk) 1 sp hitp ep NoDamageEffect @@ -53,7 +53,7 @@ randColDirSpark -> World -> World randColDirSpark randcol randdir pos w = w - & sparks .:~ spark + & cWorld . sparks .:~ spark & randGen .~ g where ((col,dir),g) = (`runState` _randGen w) $ do @@ -79,7 +79,7 @@ randSpark -> World randSpark dt randspeed randcol randdir pos w = w & randGen .~ g - & sparks .:~ Spark + & cWorld . sparks .:~ Spark { _skVel = rotateV dir (V2 speed 0) , _skColor = col , _skPos = pos diff --git a/src/Dodge/Terminal.hs b/src/Dodge/Terminal.hs index 3867ef801..2463fde79 100644 --- a/src/Dodge/Terminal.hs +++ b/src/Dodge/Terminal.hs @@ -152,7 +152,7 @@ guardDisconnected tm w w' = case _tmStatus tm of TerminalBusy -> w TerminalReady -> w' getDamageCoding :: World -> M.Map String [TerminalLine] -getDamageCoding = decodedtmap . _sensorCoding . _genParams +getDamageCoding = decodedtmap . _sensorCoding . _genParams . _cWorld sensorInfoMap :: Terminal -> World -> M.Map String [TerminalLine] sensorInfoMap tm w = M.fromList @@ -163,7 +163,7 @@ sensorInfoMap tm w = M.fromList ] getSensor :: Show a => (Sensor -> a) -> Terminal -> World -> [TerminalLine] getSensor f tm w = maybe [] (makeTermPara . map toUpper . show . f) - (w ^? machines . ix (_tmMachineID tm) . mcSensor) + (w ^? cWorld . machines . ix (_tmMachineID tm) . mcSensor) toggleCommand :: TerminalCommand toggleCommand = TerminalCommand @@ -185,14 +185,14 @@ sensorCommand = TerminalCommand disconnectTerminal :: Terminal -> World -> World disconnectTerminal tm w = w - & terminals . ix (_tmID tm) . tmStatus .~ TerminalOff + & cWorld . terminals . ix (_tmID tm) . tmStatus .~ TerminalOff & exitTerminalSubInv - & terminals . ix (_tmID tm) . tmFutureLines .~ + & cWorld . terminals . ix (_tmID tm) . tmFutureLines .~ [ TerminalLineTerminalEffect 0 TmTmClearDisplayedLines ] exitTerminalSubInv :: World -> World -exitTerminalSubInv w = case w ^? hud . hudElement . subInventory . termID of - Just _ -> w & hud . hudElement . subInventory .~ NoSubInventory +exitTerminalSubInv w = case w ^? cWorld . hud . hudElement . subInventory . termID of + Just _ -> w & cWorld . hud . hudElement . subInventory .~ NoSubInventory _ -> w damageCodeCommand :: TerminalCommand @@ -205,7 +205,7 @@ damageCodeCommand = TerminalCommand infoClearInput :: Terminal -> [TerminalLine] -> World -> World -infoClearInput tm tls = terminals . ix (_tmID tm) %~ +infoClearInput tm tls = cWorld . 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 cf83a6d29..ee7070352 100644 --- a/src/Dodge/Terminal/LeftButton.hs +++ b/src/Dodge/Terminal/LeftButton.hs @@ -9,24 +9,24 @@ import Data.Maybe doTerminalEffectLB :: Terminal -> World -> World doTerminalEffectLB tm w = guardDisconnected tm w $ fromMaybe w $ do - s <- fmap T.unpack $ w ^? terminals . ix (_tmID tm) . tmInput . tiText + s <- fmap T.unpack $ w ^? cWorld . terminals . ix (_tmID tm) . tmInput . tiText if null (words s) then Just $ defocusTerminalInput w else return $ terminalReturnEffect tm w terminalReturnEffect :: Terminal -> World -> World terminalReturnEffect tm w = guardDisconnected tm w $ fromMaybe w $ do - s <- fmap T.unpack $ w ^? terminals . ix (_tmID tm) . tmInput . tiText + s <- fmap T.unpack $ w ^? cWorld . terminals . ix (_tmID tm) . tmInput . tiText return $ runTerminalString s tm $ w - & terminals . ix (_tmID tm) . tmFutureLines .~ [makeTermLine ('>':s)] + & cWorld . terminals . ix (_tmID tm) . tmFutureLines .~ [makeTermLine ('>':s)] defocusTerminalInput :: World -> World defocusTerminalInput w = fromMaybe w $ do - tmid <- w ^? hud . hudElement . subInventory . termID - return $ w & terminals . ix tmid . tmInput . tiFocus %~ const False + tmid <- w ^? cWorld . hud . hudElement . subInventory . termID + return $ w & cWorld . terminals . ix tmid . tmInput . tiFocus %~ const False runTerminalString :: String -> Terminal -> World -> World -runTerminalString s tm w = w & terminals . ix (_tmID tm) %~ +runTerminalString s tm w = w & cWorld . 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 64225b494..df07dbb1c 100644 --- a/src/Dodge/Tesla/Arc.hs +++ b/src/Dodge/Tesla/Arc.hs @@ -56,10 +56,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 ^? creatures . ix crid of + ArcStep lp' ld' (CrID crid) -> case w ^? cWorld . creatures . ix crid of Nothing -> (lp',ld') Just cr -> (lp' -.- (_crRad cr + 1) *.* unitVectorAtAngle ld',ld'+pi) - ArcStep lp' ld' (WlID wlid) -> case w ^? walls . ix wlid of + ArcStep lp' ld' (WlID wlid) -> case w ^? cWorld . walls . ix wlid of Nothing -> (lp',ld') Just _ -> (lp' -.- 2 *.* unitVectorAtAngle ld',ld'+pi) --damthings (ArcStep _ _ NothingID) = id @@ -71,7 +71,7 @@ moveTeslaArc w pt shootTeslaArc' :: ItemParams -> Point2 -> Float -> World -> (World,ItemParams) shootTeslaArc' ip pos dir w = (w & randGen .~ g - & teslaArcs .:~ aTeslaArcAt col newarc + & cWorld . 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 c4f798591..cbf5dc58b 100644 --- a/src/Dodge/Tesla/Arc/Default.hs +++ b/src/Dodge/Tesla/Arc/Default.hs @@ -24,7 +24,7 @@ defaultArcStep itparams w (ArcStep p dir _) = do . sortOn (dist center . _crPos) . filter (\cr -> dist center (_crPos cr) < csize) . IM.elems - $ _creatures w + $ _creatures (_cWorld w) mwl = listToMaybe . sortOn (dist p . fst) . mapMaybe (\ q -> sequence $ collidePointWallsFilterStream (const True) p (center +.+ q) w) diff --git a/src/Dodge/TractorBeam/Update.hs b/src/Dodge/TractorBeam/Update.hs index 9e7618ff4..0499bfc35 100644 --- a/src/Dodge/TractorBeam/Update.hs +++ b/src/Dodge/TractorBeam/Update.hs @@ -9,8 +9,8 @@ updateTractorBeam :: World -> TractorBeam -> (World, Maybe TractorBeam) updateTractorBeam w pj | _tbTime pj <= 0 = (w, Nothing) | otherwise = (w - & creatures %~ IM.map (tractCr pullVel pos outpos) - & floorItems %~ IM.map (tractFlIt pullVel pos outpos) + & cWorld . creatures %~ IM.map (tractCr pullVel pos outpos) + & cWorld . floorItems %~ IM.map (tractFlIt pullVel pos outpos) , Just (pj & tbTime -~ 1)) where pullVel = _tbVel pj diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 4c687f365..6a38d9735 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -67,7 +67,7 @@ updateUniverse u = case _menuLayers u of | otherwise -> u & menuLayers %~ ( (WaitScreen s (i-1) :) . tail ) (OptionScreen {_scOptionFlag = GameOverOptions} : _) -> u & uvWorld %~ ( --updateParticles - (radarBlips .~ []) + (cWorld . radarBlips .~ []) -- . updateIMl _props _pjUpdate . updateLightSources . updateClouds ) @@ -78,11 +78,11 @@ updateUniverse u = case _menuLayers u of functionalUpdate :: Universe -> Universe functionalUpdate w = checkEndGame -- . updateRandGen - . over uvWorld (mouseButtons . each .~ True) -- to determine if the mouse button is held - . over uvWorld (worldClock +~ 1) + . over uvWorld (cWorld . mouseButtons . each .~ True) -- to determine if the mouse button is held + . over uvWorld (cWorld . worldClock +~ 1) . over uvWorld updateWorldSelect . over uvWorld doRewind - . over uvWorld (hammers . each %~ moveHammerUp) + . over uvWorld (cWorld . hammers . each %~ moveHammerUp) . over uvWorld updateDistortions . over uvWorld updateCreatureSoundPositions . over uvWorld ppEvents @@ -90,10 +90,10 @@ functionalUpdate w = checkEndGame . colCrsWalls . over uvWorld simpleCrSprings . over uvWorld zoneCreatures - . over uvWorld (updateIMl _doors (doDrWdWd . _drMech) ) + . over uvWorld (updateIMl (_doors . _cWorld) (doDrWdWd . _drMech) ) . over uvWorld doWorldEvents . over uvWorld updateDelayedEvents - . over uvWorld (updateIMl _modifications (doModificationEffect . _mdUpdate) ) + . over uvWorld (updateIMl (_modifications. _cWorld) (doModificationEffect . _mdUpdate) ) . over uvWorld updateSparks . over uvWorld updateRadarSweeps . over uvWorld updatePosEvents @@ -108,20 +108,20 @@ functionalUpdate w = checkEndGame . over uvWorld updateLasers . over uvWorld updateTeslaArcs . over uvWorld updateTractorBeams - . over uvWorld (updateIMl' _linearShockwaves updateLinearShockwave) - . over uvWorld (updateIMl' _props updateProp ) - . over uvWorld (updateIMl' _projectiles updateProjectile) + . over uvWorld (updateIMl' (_linearShockwaves . _cWorld) updateLinearShockwave) + . over uvWorld (updateIMl' (_props . _cWorld) updateProp ) + . over uvWorld (updateIMl' (_projectiles . _cWorld) updateProjectile) . over uvWorld updateLightSources . over uvWorld updateClouds . over uvWorld updateGusts . over uvWorld zoneClouds - . over uvWorld (updateMIM magnets (doMagnetUpdate . _mgUpdate) ) - . over uvWorld (updateIMl' _terminals tmUpdate ) + . over uvWorld (updateMIM (cWorld . magnets) (doMagnetUpdate . _mgUpdate) ) + . over uvWorld (updateIMl' (_terminals . _cWorld) tmUpdate ) -- . updateIMl _machines mcChooseUpdate - . over uvWorld (updateIMl' _machines updateMachine ) - . over uvWorld (updateIMl' _creatures updateCreature ) + . over uvWorld (updateIMl' (_machines . _cWorld) updateMachine ) + . over uvWorld (updateIMl' (_creatures . _cWorld) updateCreature ) -- creatures should be updated early so that crOldPos is set before any position change - . over (uvWorld . creatures) (fmap setOldPos) + . over (uvWorld . cWorld . creatures) (fmap setOldPos) . over uvWorld updateCreatureGroups . over uvWorld updateWallDamages . over uvWorld updateSeenWalls @@ -131,35 +131,35 @@ functionalUpdate w = checkEndGame $ over uvWorld updateCloseObjects w doWorldEvents :: World -> World -doWorldEvents w = foldr doWorldEffect (w & worldEvents .~ []) (_worldEvents w) +doWorldEvents w = foldr doWorldEffect (w & cWorld . worldEvents .~ []) (_worldEvents (_cWorld w)) updateLasers :: World -> World updateLasers w = w' - & lasers .~ [] - & lasersToDraw .~ ls + & cWorld . lasers .~ [] + & cWorld . lasersToDraw .~ ls where - (w',ls) = mapAccumR updateLaser w (_lasers w) + (w',ls) = mapAccumR updateLaser w (_lasers (_cWorld w)) zoneClouds :: World -> World zoneClouds w = w - & clZoning .~ mempty - & clZoning %~ \zn -> - foldl' (flip zoneCloud) zn (_clouds w) + & cWorld . clZoning .~ mempty + & cWorld . clZoning %~ \zn -> + foldl' (flip zoneCloud) zn (_clouds (_cWorld w)) --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 +updateWorldSelect w = f . g $ case (w ^? cWorld . mouseButtons . ix ButtonLeft, w ^? cWorld . mouseButtons . ix ButtonRight) of (Nothing ,Nothing) -> w - (Just False,Nothing) -> w & lLine . _1 .~ mwp - (Just True ,Nothing) -> w & lLine . _2 .~ mwp + (Just False,Nothing) -> w & cWorld . lLine . _1 .~ mwp + (Just True ,Nothing) -> w & cWorld . lLine . _2 .~ mwp (Nothing ,_) -> w - (Just False,_) -> w & rLine . _1 .~ mwp - (Just True ,_) -> w & rLine . _2 .~ mwp + (Just False,_) -> w & cWorld . rLine . _1 .~ mwp + (Just True ,_) -> w & cWorld . rLine . _2 .~ mwp where mwp = mouseWorldPos w - f | ButtonLeft `M.member` _mouseButtons w = lSelect .~ mwp + f | ButtonLeft `M.member` _mouseButtons (_cWorld w) = cWorld . lSelect .~ mwp | otherwise = id - g | ButtonRight `M.member` _mouseButtons w = rSelect .~ mwp + g | ButtonRight `M.member` _mouseButtons (_cWorld w) = cWorld . rSelect .~ mwp | otherwise = id --mcChooseUpdate :: Machine -> Machine -> World -> World @@ -172,7 +172,7 @@ displayTerminalLineString tls = case tls of TerminalLineConst str col -> const (str,col) tmUpdate :: Terminal -> World -> World -tmUpdate tm w = case w ^? terminals . ix (_tmID tm) . tmFutureLines . ix 0 of +tmUpdate tm w = case w ^? cWorld . 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) -> w & pointTermParams %~ @@ -186,7 +186,7 @@ tmUpdate tm w = case w ^? terminals . ix (_tmID tm) . tmFutureLines . ix 0 of & pointTermParams . tmFutureLines %~ tail & pointTermParams %~ doTmTm eff where - pointTermParams = terminals . ix (_tmID tm) + pointTermParams = cWorld . terminals . ix (_tmID tm) setOldPos :: Creature -> Creature setOldPos cr = cr @@ -198,14 +198,14 @@ setOldPos cr = cr --updateRandGen = randGen %~ (snd . (uniform :: StdGen -> (Int,StdGen))) doRewind :: World -> World -doRewind w = case _maybeWorld w of - Just' w' -> w' & timeFlow .~ RewindingLastFrame - Nothing' -> w & timeFlow .~ NormalTimeFlow +doRewind w = case _maybeWorld (_cWorld w) of + Just' w' -> w' & cWorld . timeFlow .~ RewindingLastFrame + Nothing' -> w & cWorld . timeFlow .~ NormalTimeFlow zoneCreatures :: World -> World zoneCreatures w = w - & crZoning .~ mempty - & crZoning %~ \zn -> foldl' (flip zoneCreature) zn (_creatures w) + & cWorld . crZoning .~ mempty + & cWorld . crZoning %~ \zn -> foldl' (flip zoneCreature) zn (_creatures (_cWorld w)) -- foldl' (flip $ updateZoning (\cr -> IM.insert (_crID cr) cr)) -- zn (_creatures w) @@ -215,7 +215,7 @@ updateCreatureSoundPositions w = M.foldlWithKey' insertSound w $ _playingSounds w where insertSound w' k s = w' & toPlaySounds %~ M.insertWith (const id) k s - updateSound (CrMouth cid) s = case w ^? creatures . ix cid . crPos of + updateSound (CrMouth cid) s = case w ^? cWorld . 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 @@ -229,67 +229,67 @@ updateIMl' :: (World -> IM.IntMap a) -> (a -> World -> World) -> World -> World updateIMl' fim fup w = foldl' (flip fup) w (fim w) updateCreatureGroups :: World -> World -updateCreatureGroups w = w & creatureGroups %~ +updateCreatureGroups w = w & cWorld . creatureGroups %~ IM.mapMaybe (\cgp -> doCrGroupUpdate (_crGroupUpdate cgp) w cgp) updateDistortions :: World -> World -updateDistortions = distortions %~ mapMaybe updateDistortion +updateDistortions = cWorld . distortions %~ mapMaybe updateDistortion updateLightSources :: World -> World -updateLightSources = tempLightSources %~ f +updateLightSources = cWorld . tempLightSources %~ f where f = mapMaybe (\b -> updateTempLightSource (_tlsUpdate b) b) updateRadarBlips :: World -> World -updateRadarBlips = radarBlips %~ mapMaybe updateRadarBlip +updateRadarBlips = cWorld . radarBlips %~ mapMaybe updateRadarBlip updateFlares :: World -> World -updateFlares = flares %~ mapMaybe updateFlare +updateFlares = cWorld . flares %~ mapMaybe updateFlare updateTeslaArcs :: World -> World -updateTeslaArcs w = w' & teslaArcs .~ catMaybes newtas +updateTeslaArcs w = w' & cWorld . teslaArcs .~ catMaybes newtas where - (w',newtas) = mapAccumR moveTeslaArc w $ _teslaArcs w + (w',newtas) = mapAccumR moveTeslaArc w $ _teslaArcs (_cWorld w) updateTractorBeams :: World -> World -updateTractorBeams w = w' & tractorBeams .~ catMaybes newtas +updateTractorBeams w = w' & cWorld . tractorBeams .~ catMaybes newtas where - (w',newtas) = mapAccumR updateTractorBeam w $ _tractorBeams w + (w',newtas) = mapAccumR updateTractorBeam w $ _tractorBeams (_cWorld w) {- Apply internal particle updates, delete 'Nothing's. -} updateBullets :: World -> World -updateBullets w = updateInstantBullets $ set bullets (catMaybes ps) w' +updateBullets w = updateInstantBullets $ set (cWorld . bullets) (catMaybes ps) w' where - (w',ps) = mapAccumR updateBullet w $ _bullets w + (w',ps) = mapAccumR updateBullet w $ _bullets (_cWorld w) updateShockwaves :: World -> World -updateShockwaves w = w' & shockwaves .~ catMaybes newflames +updateShockwaves w = w' & cWorld . shockwaves .~ catMaybes newflames where - (w',newflames) = mapAccumR updateShockwave w $ _shockwaves w + (w',newflames) = mapAccumR updateShockwave w $ _shockwaves (_cWorld w) updateFlames :: World -> World -updateFlames w = w' & flames .~ catMaybes newflames +updateFlames w = w' & cWorld . flames .~ catMaybes newflames where - (w',newflames) = mapAccumR moveFlame w $ _flames w + (w',newflames) = mapAccumR moveFlame w $ _flames (_cWorld w) updateEnergyBalls :: World -> World -updateEnergyBalls w = w' & energyBalls .~ catMaybes newebs +updateEnergyBalls w = w' & cWorld . energyBalls .~ catMaybes newebs where - (w',newebs) = mapAccumR moveEnergyBall w $ _energyBalls w + (w',newebs) = mapAccumR moveEnergyBall w $ _energyBalls (_cWorld w) updateRadarSweeps :: World -> World -updateRadarSweeps w = w' & radarSweeps .~ catMaybes newradarSweeps +updateRadarSweeps w = w' & cWorld . radarSweeps .~ catMaybes newradarSweeps where - (w',newradarSweeps) = mapAccumR updateRadarSweep w $ _radarSweeps w + (w',newradarSweeps) = mapAccumR updateRadarSweep w $ _radarSweeps (_cWorld w) updateSparks :: World -> World -updateSparks w = w' & sparks .~ catMaybes newsparks +updateSparks w = w' & cWorld . sparks .~ catMaybes newsparks where - (w',newsparks) = mapAccumR moveSpark w $ _sparks w + (w',newsparks) = mapAccumR moveSpark w $ _sparks (_cWorld w) updatePosEvents :: World -> World -updatePosEvents w = w' & posEvents .~ catMaybes newposEvents +updatePosEvents w = w' & cWorld . posEvents .~ catMaybes newposEvents where - (w',newposEvents) = mapAccumR updatePosEvent w $ _posEvents w + (w',newposEvents) = mapAccumR updatePosEvent w $ _posEvents (_cWorld w) {- Apply internal particle updates, delete 'Nothing's. -} @@ -299,16 +299,16 @@ updatePosEvents w = w' & posEvents .~ catMaybes newposEvents -- (w',ps) = mapAccumR (\a b -> _ptUpdate b a b) w $ _particles w updateBeams :: World -> World updateBeams w = w - & newBeams .~ WorldBeams [] [] [] [] - & beams .~ thebeams + & cWorld . newBeams .~ WorldBeams [] [] [] [] + & cWorld . beams .~ thebeams & combineBeams thebeams where - thebeams = _newBeams w + thebeams = _newBeams (_cWorld w) combineBeams :: WorldBeams -> World -> World combineBeams wbeams w = w'' - & beams . positronBeams .~ pbeams - & beams . electronBeams .~ ebeams + & cWorld . beams . positronBeams .~ pbeams + & cWorld . beams . electronBeams .~ ebeams where (w',pbeams) = mapAccumR (combineBeamBeams (_electronBeams wbeams)) w $ _positronBeams wbeams (w'',ebeams) = mapAccumR (combineBeamBeams (_positronBeams wbeams)) w' $ _electronBeams wbeams @@ -368,10 +368,10 @@ intersectSegSegs' _ _ _ = Nothing -- (intersectSegSegss x y ass) --intersectSegsSegss _ _ = Nothing updateInstantBullets :: World -> World -updateInstantBullets w = case _instantBullets w of +updateInstantBullets w = case _instantBullets (_cWorld w) of [] -> w - ps -> let (w',ps') = mapAccumR updateBullet (w {_instantBullets=[]}) ps - in updateInstantBullets $ w' & bullets .++~ catMaybes ps' + ps -> let (w',ps') = mapAccumR updateBullet (w & cWorld . instantBullets.~[]) ps + in updateInstantBullets $ w' & cWorld . bullets .++~ catMaybes ps' --updateInstantParticles :: World -> World --updateInstantParticles w = case _instantParticles w of @@ -395,7 +395,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 w +ppEvents w = IM.foldl' (flip $ \pp -> doPressPlateEvent (_ppEvent pp) pp) w $ _pressPlates (_cWorld w) updateSeenWalls :: World -> World updateSeenWalls w = foldl' markWallSeen w (map (_wlID . snd) $ allVisibleWalls w) @@ -405,24 +405,23 @@ updateSeenWalls w = foldl' markWallSeen w (map (_wlID . snd) $ allVisibleWalls w -- mw wl = wl {_wlSeen = True} markWallSeen :: World -> Int -> World -markWallSeen !w !i = w { _walls = IM.adjust markSeen i $ _walls w } +markWallSeen !w !i = w & cWorld . walls .~ IM.adjust markSeen i (_walls (_cWorld w)) markSeen :: Wall -> Wall markSeen wl = wl {_wlSeen = True} checkEndGame :: Universe -> Universe -checkEndGame uv = case _deathDelay w of +checkEndGame uv = case _deathDelay (_cWorld w) of Just x | x < 0 -> uv & menuLayers .~ [gameOverMenu] - & uvWorld . deathDelay .~ Nothing - Just _ -> uv & uvWorld . deathDelay . _Just -~ 1 - _ | _crHP (you w) < 1 -> uv & uvWorld . deathDelay ?~ 50 + & uvWorld . cWorld . deathDelay .~ Nothing + Just _ -> uv & uvWorld . cWorld . deathDelay . _Just -~ 1 + _ | _crHP (you w) < 1 -> uv & uvWorld . cWorld . deathDelay ?~ 50 _ -> uv where w = _uvWorld uv updateGusts :: World -> World -updateGusts w = w - & gusts %~ IM.mapMaybe (mvGust w) +updateGusts w = w & cWorld . gusts %~ IM.mapMaybe (mvGust w) mvGust :: World -> Gust -> Maybe Gust mvGust _ gu @@ -431,10 +430,10 @@ mvGust _ gu & guPos .+.+~ _guVel gu & guTime -~ 1 updateClouds :: World -> World -updateClouds w = w' & clouds .~ catMaybes mclouds +updateClouds w = w' & cWorld . clouds .~ catMaybes mclouds where -- cls = _clouds w - (w',mclouds) = mapAccumR updateCloud w (_clouds w) + (w',mclouds) = mapAccumR updateCloud w (_clouds (_cWorld w)) cloudEffect :: Cloud -> World -> World cloudEffect cl = case _clType cl of @@ -473,7 +472,7 @@ clClSpringVel a v b radDist = (_clRad a + _clRad b) / 2 simpleCrSprings :: World -> World -simpleCrSprings w = IM.foldl' (flip crSpring) w $ _creatures w +simpleCrSprings w = IM.foldl' (flip crSpring) w $ _creatures (_cWorld w) -- note that this may in rare cases not push creatures away from each other crSpring :: Creature -> World -> World @@ -486,7 +485,7 @@ crCrSpring c1 c2 | id1 == id2 = id | vec == V2 0 0 = id | diff >= comRad = id - | otherwise = creatures %~ + | otherwise = cWorld . creatures %~ ( over (ix id1 . crPos) (+.+ overlap1) . over (ix id2 . crPos) (-.- overlap2) ) @@ -501,9 +500,9 @@ crCrSpring c1 c2 massT = _crMass c1 + _crMass c2 updateDelayedEvents :: World -> World -updateDelayedEvents w = let (neww,newde) = mapAccumR f w (_delayedEvents w) - in neww & delayedEvents .~ catMaybes newde +updateDelayedEvents w = let (neww,newde) = mapAccumR f w (_delayedEvents (_cWorld w)) + in neww & cWorld . delayedEvents .~ catMaybes newde where f w' (i,g) - | i <= 0 = (w' & worldEvents .:~ g, Nothing) + | i <= 0 = (w' & cWorld . worldEvents .:~ g, Nothing) | otherwise = (w', Just (i-1,g)) diff --git a/src/Dodge/Update/Camera.hs b/src/Dodge/Update/Camera.hs index bbc7624cd..9987d7ece 100644 --- a/src/Dodge/Update/Camera.hs +++ b/src/Dodge/Update/Camera.hs @@ -42,11 +42,11 @@ updateCamera uv = uv moveZoomCamera :: Universe -> Universe moveZoomCamera uv = uv - & uvWorld . cameraCenter .~ newcen - & uvWorld . cameraViewFrom .~ newvf - & uvWorld . cameraZoom .~ newzoom - & uvWorld . defaultZoom .~ newDefaultZoom - & uvWorld . itemZoom .~ newItemZoom + & uvWorld . cWorld . cameraCenter .~ newcen + & uvWorld . cWorld . cameraViewFrom .~ newvf + & uvWorld . cWorld . cameraZoom .~ newzoom + & uvWorld . cWorld . defaultZoom .~ newDefaultZoom + & uvWorld . cWorld . itemZoom .~ newItemZoom where cfig = _uvConfig uv w = _uvWorld uv @@ -55,13 +55,13 @@ moveZoomCamera uv = uv vfoffset = do iscam <- yourItem w ^? _Just . itScope . scopeIsCamera guard iscam - guard (SDL.ButtonRight `M.member` _mouseButtons w) + guard (SDL.ButtonRight `M.member` _mouseButtons (_cWorld w)) yourItem w ^? _Just . itScope . scopePos mscopeoffset = do - guard (SDL.ButtonRight `M.member` _mouseButtons w) + guard (SDL.ButtonRight `M.member` _mouseButtons (_cWorld w)) yourItem w ^? _Just . itScope . scopePos newcen = cpos +.+ fromMaybe (V2 0 0) mscopeoffset +.+ offset - offset = rotateV (_cameraRot w) $ ((newzoom - newDefaultZoom)/(newDefaultZoom*newzoom)) *.* _mousePos w + offset = rotateV (_cameraRot (_cWorld w)) $ ((newzoom - newDefaultZoom)/(newDefaultZoom*newzoom)) *.* _mousePos (_cWorld w) --newzoom = changeZoom (_cameraZoom w) idealZoom' newzoom = case yourItem w ^? _Just . itScope of Just zs@ZoomScope {} -> _scopeZoom zs @@ -69,17 +69,17 @@ moveZoomCamera uv = uv idealDefaultZoom = clipZoom wallZoom newDefaultZoom = case yourItem w ^? _Just . itScope of Just zs@ZoomScope {} -> _scopeZoom zs - _ -> changeZoom (_defaultZoom w) idealDefaultZoom + _ -> changeZoom (_defaultZoom (_cWorld w)) idealDefaultZoom idealItemZoom = fromMaybe 1 $ do guard $ crIsAiming (you w) zoomFromItem' <$> (yourItem w ^? _Just . itUse . useAim . aimZoom) - newItemZoom = changeZoom (_itemZoom w) idealItemZoom + newItemZoom = changeZoom (_itemZoom (_cWorld w)) 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 = farWallDist newvf cfig w - wallZoom = min4 (_boundDist w) + wallZoom = min4 (_boundDist (_cWorld w)) min4 (a,b,c,d) = minimum [hh/maxd a,hh/maxd (-b),hw/maxd c,hw/maxd (-d)] maxd = max distFromEqmnt distFromEqmnt = foldr max 1 $ IM.mapMaybe (_eqViewDist . _eqEq. _itUse) $ getCrEquipment $ you w @@ -93,8 +93,8 @@ moveZoomCamera uv = uv updateScopeZoom :: World -> World updateScopeZoom w - | SDL.ButtonRight `M.member` _mouseButtons w - = case w ^? creatures . ix 0 . crInv . ix (crSel (_creatures w IM.! 0)) + | SDL.ButtonRight `M.member` _mouseButtons (_cWorld w) + = case w ^? cWorld . creatures . ix 0 . crInv . ix (crSel (_creatures (_cWorld w) IM.! 0)) . itScope . scopeZoomChange of Just x | x > 10 -> zoomInLongGun $ zoomInLongGun $ zoomInLongGun w @@ -105,7 +105,7 @@ updateScopeZoom w | x < 0 -> zoomOutLongGun w | otherwise -> w _ -> w - | otherwise = w & creatures . ix 0 . crInv . ix (crSel (_creatures w IM.! 0)) + | otherwise = w & cWorld . creatures . ix 0 . crInv . ix (crSel (_creatures (_cWorld w) IM.! 0)) . itScope %~ updateScope where updateScope (ZoomScope _ _ _ defz bl) = ZoomScope (V2 0 0) 0 defz defz bl @@ -123,11 +123,11 @@ zoomInLongGun w | otherwise = w & wpPointer . itScope . scopeZoomChange .~ 0 where decreaseScopeZoomChange = wpPointer . itScope . scopeZoomChange -~ 1 - wpPointer = creatures . ix 0 . crInv . ix (crSel (_creatures w IM.! 0)) - wp = _crInv (_creatures w IM.! 0) IM.! crSel (_creatures w IM.! 0) + 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) Just currentZoom = wp ^? itScope . scopeZoom newzoom = (wp ^?! itScope . scopeZoom) / zoomSpeed - mousep = rotateV (_cameraRot w) $ _mousePos w + mousep = rotateV (_cameraRot (_cWorld w)) $ _mousePos (_cWorld w) zoomOutLongGun :: World -> World zoomOutLongGun w @@ -140,13 +140,13 @@ zoomOutLongGun w where --mousep = rotateV (_cameraRot w) $ _mousePos w increaseScopeZoomChange = wpPointer . itScope . scopeZoomChange +~ 1 - wpPointer = creatures . ix 0 . crInv . ix (crSel (_creatures w IM.! 0)) - wp = _crInv (_creatures w IM.! 0) IM.! crSel (_creatures w IM.! 0) + 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) Just currentZoom = wp ^? itScope . scopeZoom ifConfigWallRotate :: Configuration -> World -> World ifConfigWallRotate cfig w - | _gameplay_rotate_to_wall cfig && not (SDL.ButtonRight `M.member` _mouseButtons w) + | _gameplay_rotate_to_wall cfig && not (SDL.ButtonRight `M.member` _mouseButtons (_cWorld w)) = rotateToOverlappingWall w | otherwise = w @@ -161,11 +161,11 @@ rotateToOverlappingWall w = maybe p = _crPos (you w) doWallRotate :: Wall -> World -> World -doWallRotate wl' w = rotateUsing $ (argV . uncurry (-.-) $ _wlLine wl') - _cameraRot w +doWallRotate wl' w = rotateUsing $ (argV . uncurry (-.-) $ _wlLine wl') - _cameraRot (_cWorld w) where rotateUsing a - | b - b' > 0.01 = w & cameraRot +~ 0.01 - | b - b' < negate 0.01 = w & cameraRot -~ 0.01 + | b - b' > 0.01 = w & cWorld . cameraRot +~ 0.01 + | b - b' < negate 0.01 = w & cWorld . cameraRot -~ 0.01 | otherwise = w where --b = a * (2 / pi) @@ -174,8 +174,8 @@ doWallRotate wl' w = rotateUsing $ (argV . uncurry (-.-) $ _wlLine wl') - _camer rotateCameraBy :: Float -> World -> World rotateCameraBy x w = w - & cameraRot +~ x - & creatures . ix 0 . crInv . ix (crSel (_creatures w IM.! 0)) + & cWorld . cameraRot +~ x + & cWorld . creatures . ix 0 . crInv . ix (crSel (_creatures (_cWorld w) IM.! 0)) . itScope . scopePos %~ rotateV x rotateCamera :: Configuration -> World -> World @@ -185,12 +185,12 @@ rotateCamera cfig w | keyr = rotateCameraBy (-0.025) w | otherwise = ifConfigWallRotate cfig w where - keyl = SDL.ScancodeQ `Set.member` _keys w && notAtTerminal w - keyr = SDL.ScancodeE `Set.member` _keys w && notAtTerminal w + keyl = SDL.ScancodeQ `Set.member` _keys (_cWorld w) && notAtTerminal w + keyr = SDL.ScancodeE `Set.member` _keys (_cWorld w) && notAtTerminal w -- TODO check where/how this is used notAtTerminal :: World -> Bool -notAtTerminal w = isNothing $ w ^? hud . hudElement . subInventory . termID +notAtTerminal w = isNothing $ w ^? cWorld . hud . hudElement . subInventory . termID --zoomCamBy :: Float -> World -> World --zoomCamBy x w = w {_cameraZoom = max (_cameraZoom w + x) 0.01} @@ -206,14 +206,14 @@ clipZoom clipZoom = min 20 . max 0.2 setViewDistance :: Configuration -> World -> World -setViewDistance cfig w = w & viewDistance - .~ sqrt (halfWidth cfig ** 2 + halfHeight cfig ** 2) / _cameraZoom w +setViewDistance cfig w = w & cWorld . viewDistance + .~ sqrt (halfWidth cfig ** 2 + halfHeight cfig ** 2) / _cameraZoom (_cWorld w) -- .~ max (halfWidth cfig) (halfHeight cfig) / _cameraZoom w streamViewpoints :: Monad m => Point2 -> World -> Stream (Of Point2) m () {-# INLINE streamViewpoints #-} streamViewpoints p w = flip S.for (gameRoomViewpoints p) - $ S.filter (pointInOrOnPolygon p . _grBound) $ S.each (_gameRooms w) + $ S.filter (pointInOrOnPolygon p . _grBound) $ S.each (_gameRooms (_cWorld w)) gameRoomViewpoints :: Monad m => Point2 -> GameRoom -> Stream (Of Point2) m () gameRoomViewpoints p gr = S.each (_grViewpoints gr) @@ -226,7 +226,7 @@ farWallDistDirection :: Point2 -> World -> Maybe (Float,Float,Float,Float) farWallDistDirection p w = boundPoints $ S.map f vps where - f q = (rotateV (negate $ _cameraRot w) . (-.- p)) (foldl' findPoint q (wls q)) + f q = (rotateV (negate $ _cameraRot (_cWorld w)) . (-.- p)) (foldl' findPoint q (wls q)) wls q = filter wlIsOpaque $ wlsNearSeg p q w findPoint q = fromMaybe q . uncurry (intersectSegSeg p q) . _wlLine vps = streamViewpoints p w @@ -244,7 +244,7 @@ extendedViewPoints p grs = map extend farWallPoints :: Point2 -> World -> [Point2] farWallPoints p w = concatMap _grViewpoints grs ++ extendedViewPoints p grs where - grs = filter (pointInOrOnPolygon p . _grBound) (_gameRooms w) + grs = filter (pointInOrOnPolygon p . _grBound) (_gameRooms (_cWorld w)) maxViewDistance :: Float maxViewDistance = 800 diff --git a/src/Dodge/Update/Cloud.hs b/src/Dodge/Update/Cloud.hs index 60937cd54..afca35086 100644 --- a/src/Dodge/Update/Cloud.hs +++ b/src/Dodge/Update/Cloud.hs @@ -9,7 +9,7 @@ cloudPoisonDamage c w = w & dodamagesto (filter f $ crsNearPoint clpos w) where dodamagesto :: [Creature] -> World -> World dodamagesto scrs mcrs = foldl' (flip doDam) mcrs scrs - doDam cr = creatures . ix (_crID cr) . crState . csDamage + doDam cr = cWorld . 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/UsingInput.hs b/src/Dodge/Update/UsingInput.hs index d96d16744..9477b95b5 100644 --- a/src/Dodge/Update/UsingInput.hs +++ b/src/Dodge/Update/UsingInput.hs @@ -19,57 +19,57 @@ import qualified Data.Map.Strict as M import Control.Lens updateUsingInput :: World -> World -updateUsingInput w = case _hudElement $ _hud w of +updateUsingInput w = case _hudElement $ _hud (_cWorld w) of DisplayInventory subinv - -> updatePressedButtons subinv (_mouseButtons w) w + -> updatePressedButtons subinv (_mouseButtons (_cWorld w)) w DisplayCarte - -> updatePressedButtonsCarte (_mouseButtons w) w + -> updatePressedButtonsCarte (_mouseButtons (_cWorld w)) w updatePressedButtons :: SubInventory -> M.Map MouseButton Bool -> World -> World updatePressedButtons subinv pkeys w = case subinv of NoSubInventory - | ButtonLeft `M.member` pkeys && w ^?! hammers . ix SubInvHam /= HammerUp - -> w & hammers . ix SubInvHam .~ HammerDown + | ButtonLeft `M.member` pkeys && w ^?! cWorld . hammers . ix SubInvHam /= HammerUp + -> w & cWorld . hammers . ix SubInvHam .~ HammerDown | otherwise -> updatePressedButtons' pkeys w CombineInventory mi | pkeys ^? ix ButtonLeft == Just False - -> maybeexitcombine (maybe id doCombine mi w) & hammers . ix SubInvHam .~ HammerDown + -> maybeexitcombine (maybe id doCombine mi w) & cWorld . hammers . ix SubInvHam .~ HammerDown DisplayTerminal tmid | pkeys ^? ix ButtonLeft == Just False && inTermFocus w - -> doTerminalEffectLB (w ^?! terminals . ix tmid) w - & hammers . ix SubInvHam .~ HammerDown + -> doTerminalEffectLB (w ^?! cWorld . terminals . ix tmid) w + & cWorld . hammers . ix SubInvHam .~ HammerDown | pkeys ^? ix ButtonLeft == Just False - -> w & terminals . ix tmid . tmInput . tiFocus %~ const True - & hammers . ix SubInvHam .~ HammerDown + -> w & cWorld . terminals . ix tmid . tmInput . tiFocus %~ const True + & cWorld . hammers . ix SubInvHam .~ HammerDown _ | ButtonLeft `M.member` pkeys - -> w & hammers . ix SubInvHam .~ HammerDown + -> w & cWorld . hammers . ix SubInvHam .~ HammerDown _ -> w where maybeexitcombine - | ButtonRight `M.member` _mouseButtons w = id - | otherwise = hud . hudElement .~ DisplayInventory NoSubInventory + | ButtonRight `M.member` _mouseButtons (_cWorld w) = id + | otherwise = cWorld . hud . hudElement .~ DisplayInventory NoSubInventory updatePressedButtons' :: M.Map MouseButton Bool -> World -> World updatePressedButtons' pkeys w | isDown ButtonLeft && isDown ButtonRight && inTopInv - = useItem (you w) w & hammers . ix DoubleMouseHam .~ HammerDown - | isDown ButtonLeft && (inTopInv || _timeFlow w == RewindingLastFrame) - && w ^?! hammers . ix DoubleMouseHam == HammerUp - = useLeftItem (_yourID w) w - | isDown ButtonLeft && (inTopInv || _timeFlow w == RewindingLastFrame) - = w & hammers . ix DoubleMouseHam .~ HammerDown + = useItem (you w) w & cWorld . hammers . ix DoubleMouseHam .~ HammerDown + | isDown ButtonLeft && (inTopInv || _timeFlow (_cWorld w) == RewindingLastFrame) + && w ^?! cWorld . hammers . ix DoubleMouseHam == HammerUp + = useLeftItem (_yourID (_cWorld w)) w + | isDown ButtonLeft && (inTopInv || _timeFlow (_cWorld w) == RewindingLastFrame) + = w & cWorld . hammers . ix DoubleMouseHam .~ HammerDown | isDown ButtonRight && inTopInv = w | isDown ButtonMiddle - = w & cameraRot -~ rotation - & clickMousePos .~ _mousePos w - | isDown ButtonLeft = w & hammers . ix DoubleMouseHam .~ HammerDown + = w & cWorld . cameraRot -~ rotation + & cWorld . clickMousePos .~ _mousePos (_cWorld w) + | isDown ButtonLeft = w & cWorld . hammers . ix DoubleMouseHam .~ HammerDown | otherwise = w where - inTopInv = case _hudElement (_hud w) of + inTopInv = case _hudElement (_hud (_cWorld w)) of DisplayInventory NoSubInventory -> True _ -> False isDown but = but `M.member` pkeys - rotation = angleBetween (_mousePos w) (_clickMousePos w) + rotation = angleBetween (_mousePos (_cWorld w)) (_clickMousePos (_cWorld w)) -- note "sort" on the inventory indices; otherwise @@ -82,23 +82,23 @@ doCombine i w = case combineItemListYou w ^? ix i of . createPutItem it $ foldr (rmInvItem yid) w (sort is) where - yid = _yourID w - selectinv (Just i', w') = w' & creatures . ix yid . crInvSel .~ InvSel i' NoInvSelAction + yid = _yourID (_cWorld w) + selectinv (Just i', w') = w' & cWorld . creatures . ix yid . crInvSel .~ InvSel i' NoInvSelAction selectinv (Nothing, w') = w' updatePressedButtonsCarte :: M.Map MouseButton Bool -> World -> World updatePressedButtonsCarte pkeys w | isDown ButtonRight = w - & clickMousePos .~ _mousePos w - & hud . carteCenter %~ (-.- trans) + & cWorld . clickMousePos .~ _mousePos (_cWorld w) + & cWorld . hud . carteCenter %~ (-.- trans) | isDown ButtonLeft = w - & clickMousePos .~ _mousePos w - & hud . carteRot -~ rot - & hud . carteZoom *~ czoom + & cWorld . clickMousePos .~ _mousePos (_cWorld w) + & cWorld . hud . carteRot -~ rot + & cWorld . 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 w)) $ 1 / _carteZoom (_hud w) *.* (_mousePos w -.- _clickMousePos w) + rot = angleBetween (_mousePos (_cWorld w)) (_clickMousePos (_cWorld w)) + czoom = magV (_mousePos (_cWorld w)) / magV (_clickMousePos (_cWorld w)) + trans = rotateV (_carteRot (_hud (_cWorld w))) $ 1 / _carteZoom (_hud (_cWorld w)) *.* (_mousePos (_cWorld w) -.- _clickMousePos (_cWorld w)) diff --git a/src/Dodge/Update/WallDamage.hs b/src/Dodge/Update/WallDamage.hs index 9ebb11d46..5383d2756 100644 --- a/src/Dodge/Update/WallDamage.hs +++ b/src/Dodge/Update/WallDamage.hs @@ -8,9 +8,9 @@ import Data.Maybe updateWallDamages :: World -> World updateWallDamages w = w - & wallDamages .~ IM.empty - & flip (IM.foldrWithKey f) (_wallDamages w) + & cWorld . wallDamages .~ IM.empty + & flip (IM.foldrWithKey f) (_wallDamages (_cWorld w)) where f k dams w' = fromMaybe w' $ do - wl <- w' ^? walls . ix k + wl <- w' ^? cWorld . walls . ix k return $ foldr (`damageWall` wl) w' dams diff --git a/src/Dodge/Wall/Create.hs b/src/Dodge/Wall/Create.hs index d40105b74..368194f4b 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 & walls %~ IM.insert wlid newwl + , w & cWorld . walls %~ IM.insert wlid newwl & insertWallInZones newwl ) where newwl = wl {_wlID = wlid} - wlid = IM.newKey $ _walls w + wlid = IM.newKey $ _walls (_cWorld w) diff --git a/src/Dodge/Wall/Damage.hs b/src/Dodge/Wall/Damage.hs index 604d2a2c5..28481fc8a 100644 --- a/src/Dodge/Wall/Damage.hs +++ b/src/Dodge/Wall/Damage.hs @@ -13,25 +13,25 @@ import Dodge.Wall.DamageEffect damageWall :: Damage -> Wall -> World -> World damageWall dt wl w = case _wlStructure wl of MachinePart mcid -> fst . defaultWallDamage dt wl $ w - & machines . ix mcid . mcDamage .:~ dt + & cWorld . machines . ix mcid . mcDamage .:~ dt BlockPart blid -> let (w',x) = defaultWallDamage dt wl w - in w' & blocks . ix blid . blHP -~ x & maybeDestroyBlock blid + in w' & cWorld . blocks . ix blid . blHP -~ x & maybeDestroyBlock blid DoorPart drid -> let (w',x) = defaultWallDamage dt wl w - in w' & doors . ix drid . drHP -~ x & maybeDestroyDoor drid + in w' & cWorld . doors . ix drid . drHP -~ x & maybeDestroyDoor drid _ -> fst $ defaultWallDamage dt wl w -- block destruction is convoluted... maybeDestroyBlock :: Int -> World -> World -maybeDestroyBlock blid w = case w ^? blocks . ix blid of +maybeDestroyBlock blid w = case w ^? cWorld . blocks . ix blid of Just bl | _blHP bl < 1 -> destroyBlock bl w _ -> w maybeDestroyDoor :: Int -> World -> World -maybeDestroyDoor drid w = case w ^? doors . ix drid of +maybeDestroyDoor drid w = case w ^? cWorld . 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 -> blocks . ix blid . blHP -~ x + Just blid -> cWorld . blocks . ix blid . blHP -~ x Nothing -> id diff --git a/src/Dodge/Wall/DamageEffect.hs b/src/Dodge/Wall/DamageEffect.hs index a5c85cbc2..2b8cf8f54 100644 --- a/src/Dodge/Wall/DamageEffect.hs +++ b/src/Dodge/Wall/DamageEffect.hs @@ -64,7 +64,7 @@ windowWallDamage dm wl w = w & case _dmType dm of where mbl = do blid <- wl ^? wlStructure . wsBlock - w ^? blocks . ix blid + w ^? cWorld . blocks . ix blid d :: Int d = max 1 $ maybe 1 (subtract 1 . _blHP) mbl a :: Int -> (World -> World) -> World -> (World,Int) diff --git a/src/Dodge/Wall/Delete.hs b/src/Dodge/Wall/Delete.hs index c43a879d9..e73899a8c 100644 --- a/src/Dodge/Wall/Delete.hs +++ b/src/Dodge/Wall/Delete.hs @@ -10,16 +10,16 @@ import qualified IntMapHelp as IM import qualified Data.IntSet as IS deleteWallID :: Int -> World -> World -deleteWallID i w = w & walls %~ IM.delete i +deleteWallID i w = w & cWorld . walls %~ IM.delete i & deleteWallFromZones wl where - wl = _walls w IM.! i + wl = _walls (_cWorld w) IM.! i deleteWall :: Wall -> World -> World -deleteWall wl = (walls %~ IM.delete i) +deleteWall wl = (cWorld . walls %~ IM.delete i) . deleteWallFromZones wl where i = _wlID wl deleteWallIDs :: IS.IntSet -> World -> World -deleteWallIDs is w = foldr deleteWall w $ IM.restrictKeys (_walls w) is +deleteWallIDs is w = foldr deleteWall w $ IM.restrictKeys (_walls (_cWorld w)) is diff --git a/src/Dodge/Wall/Move.hs b/src/Dodge/Wall/Move.hs index f1a92335c..f1d3dfff6 100644 --- a/src/Dodge/Wall/Move.hs +++ b/src/Dodge/Wall/Move.hs @@ -17,16 +17,16 @@ import Control.Lens import qualified IntMapHelp as IM moveWallIDUnsafe :: Int -> (Point2,Point2) -> World -> World -moveWallIDUnsafe wlid wlline w = case w ^? walls . ix wlid of +moveWallIDUnsafe wlid wlline w = case w ^? cWorld . 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 ^? walls . ix wlid of +moveWallID wlid wlline w = case w ^? cWorld . 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 & walls . ix wlid .~ newwl +moveWall wlid wl wlline w = w & cWorld . walls . ix wlid .~ newwl & deleteWallFromZones wl & insertWallInZones newwl where @@ -34,17 +34,17 @@ moveWall wlid wl wlline w = w & walls . ix wlid .~ newwl translateWallID :: Int -> Point2 -> World -> World translateWallID wlid p w = fromMaybe w $ do - oldwl <- w ^? walls . ix wlid + oldwl <- w ^? cWorld . walls . ix wlid let newwl = oldwl & wlLine . each +~ p return $ w - & walls . ix wlid .~ newwl + & cWorld . 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 w IM.! wlid + wl = _walls (_cWorld w) IM.! 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 d2a8f1a3d..8787c3b95 100644 --- a/src/Dodge/Wall/Zone.hs +++ b/src/Dodge/Wall/Zone.hs @@ -9,7 +9,7 @@ import Control.Lens -- need to verify that this not only inserts but also overwrites (updates) any -- already existing walls insertWallInZones :: Wall -> World -> World -insertWallInZones wl = wlZoning %~ zoneWall wl +insertWallInZones wl = cWorld . wlZoning %~ zoneWall wl --insertWallInZones wl = wlZoning %~ updateZoning (IM.insert (_wlID wl)) wl --insertWallInZones wl = wlZoning .updatets @@ -18,5 +18,5 @@ insertWallInZones wl = wlZoning %~ zoneWall wl -- doinsert wlzns (V2 x y) = insertIMInZone x y (_wlID wl) wl wlzns deleteWallFromZones :: Wall -> World -> World -deleteWallFromZones wl = wlZoning %~ deZoneWall wl +deleteWallFromZones wl = cWorld . 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 84e8aee91..ab0f8a626 100644 --- a/src/Dodge/WallCreatureCollisions.hs +++ b/src/Dodge/WallCreatureCollisions.hs @@ -16,7 +16,7 @@ import Data.Function import Control.Lens colCrsWalls :: Universe -> Universe -colCrsWalls uv = uv & uvWorld . creatures %~ fmap (noclipCheck (_uvConfig uv) (_uvWorld uv)) +colCrsWalls uv = uv & uvWorld . cWorld . 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 dcf97361c..4746191be 100644 --- a/src/Dodge/WdP2f.hs +++ b/src/Dodge/WdP2f.hs @@ -8,5 +8,5 @@ import Control.Lens doWdP2f :: WdP2f -> World -> (Point2,Float) doWdP2f x = case x of WdP2f0 -> const (0,0) - WdP2fDoorPosition drid -> \w -> let Just (a,b) = w ^? doors . ix drid . drPos + WdP2fDoorPosition drid -> \w -> let Just (a,b) = w ^? cWorld . doors . ix drid . drPos in (b, argV (a-.-b)) diff --git a/src/Dodge/WorldBool.hs b/src/Dodge/WorldBool.hs index de818ad72..cfea0ab86 100644 --- a/src/Dodge/WorldBool.hs +++ b/src/Dodge/WorldBool.hs @@ -11,12 +11,12 @@ import qualified IntMapHelp as IM doWdBl :: WdBl -> World -> Bool doWdBl wb w = case wb of WdBlConst bl -> bl - WdTrig i -> fromMaybe False $ w ^? triggers . ix i + WdTrig i -> fromMaybe False $ w ^? cWorld . triggers . ix i WdBlDoorMoving i -> fromMaybe False $ do - dr <- w ^? doors . ix i + dr <- w ^? cWorld . doors . ix i return (DoorHalfway == _drStatus dr) - WdBlCrFilterNearPoint r p t -> any (crNearPoint r p) (IM.filter (doCrBl t) (_creatures w)) - WdBlBtOn btid -> _btState (_buttons w IM.! btid) == BtOn -- unsafe - WdBlBtNotOff btid -> _btState (_buttons w IM.! btid) /= BtOff -- unsafe + 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 WdBlNegate x -> not $ doWdBl x w diff --git a/src/Dodge/WorldEffect.hs b/src/Dodge/WorldEffect.hs index b41f5a89e..d838ea8c8 100644 --- a/src/Dodge/WorldEffect.hs +++ b/src/Dodge/WorldEffect.hs @@ -17,22 +17,22 @@ import System.Random doWorldEffect :: WdWd -> World -> World doWorldEffect we = case we of NoWorldEffect -> id - SetTrigger bool tid -> triggers . ix tid .~ bool - SetLSCol col lsid -> lightSources . ix lsid . lsParam . lsCol .~ col + SetTrigger bool tid -> cWorld . triggers . ix tid .~ bool + SetLSCol col lsid -> cWorld . lightSources . ix lsid . lsParam . lsCol .~ col AccessTerminal mtmid -> accessTerminal mtmid WorldEffects wes -> \w -> foldr doWorldEffect 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 -> triggers . ix trid %~ not + WdWdNegateTrig trid -> cWorld . triggers . ix trid %~ not accessTerminal :: Maybe Int -> World -> World accessTerminal mtmid w = case mtmid of Nothing -> w - Just tmid -> w & hud . hudElement .~ DisplayInventory (DisplayTerminal tmid) - & terminals . ix tmid . tmInput . tiFocus .~ True - & terminals . ix tmid %~ tryToBoot + Just tmid -> w & cWorld . hud . hudElement .~ DisplayInventory (DisplayTerminal tmid) + & cWorld . terminals . ix tmid . tmInput . tiFocus .~ True + & cWorld . terminals . ix tmid %~ tryToBoot where tryToBoot tm = case _tmStatus tm of TerminalReady -> tm @@ -43,8 +43,8 @@ accessTerminal mtmid w = case mtmid of torqueCr :: Float -> Int -> World -> World torqueCr x cid w - | cid == 0 = set randGen g $ over cameraRot (+rot) w - | otherwise = set randGen g $ over (creatures . ix cid . crDir) (+rot) w + | cid == 0 = set randGen g $ over (cWorld . cameraRot) (+rot) w + | otherwise = set randGen g $ over (cWorld . creatures . ix cid . crDir) (+rot) w where (rot, g) = randomR (-x,x) $ _randGen w @@ -78,7 +78,7 @@ lineOutputTerminal tls = defaultTerminal doDeathTriggers :: Terminal -> World -> World doDeathTriggers tm w = w - & triggers %~ flip (foldl' $ flip doDeathToggle) xs + & cWorld . triggers %~ flip (foldl' $ flip doDeathToggle) xs where xs = M.elems $ _tmToggles tm doDeathToggle :: TerminalToggle -> IM.IntMap Bool -> IM.IntMap Bool @@ -102,7 +102,7 @@ doTmWdWd :: TmWdWd -> Terminal -> World -> World doTmWdWd tmwdwd = case tmwdwd of TmWdId -> const id TmWdWdDisconnectTerminal -> disconnectTerminal - TmWdWdTermSound sid -> \tm w -> let tpos = fromMaybe 0 $ w ^? buttons . ix (_tmButtonID tm) . btPos + TmWdWdTermSound sid -> \tm w -> let tpos = fromMaybe 0 $ w ^? cWorld . buttons . ix (_tmButtonID tm) . btPos in soundStart TerminalSound tpos sid Nothing w TmWdWdDoDeathTriggers -> doDeathTriggers TmWdWdfromWdWd f -> \_ -> doWorldEffect f diff --git a/src/Dodge/WorldEvent/Cloud.hs b/src/Dodge/WorldEvent/Cloud.hs index bab9e2097..e70389a8e 100644 --- a/src/Dodge/WorldEvent/Cloud.hs +++ b/src/Dodge/WorldEvent/Cloud.hs @@ -25,7 +25,7 @@ makeCloudAt -> Point3 -- start position -> World -> World -makeCloudAt drawFunc rad t alt p = clouds .:~ Cloud +makeCloudAt drawFunc rad t alt p = cWorld . clouds .:~ Cloud --makeCloudAt drawFunc rad t alt p = clouds %~ S.cons Cloud { _clPos = p , _clVel = V3 0 0 0 diff --git a/src/Dodge/WorldEvent/Damage.hs b/src/Dodge/WorldEvent/Damage.hs index 6bbd0c4ef..9aa38f868 100644 --- a/src/Dodge/WorldEvent/Damage.hs +++ b/src/Dodge/WorldEvent/Damage.hs @@ -14,6 +14,6 @@ damThingHitWith -> World -> World damThingHitWith partDT sp ep mayEiCrWl = case mayEiCrWl of - Just (hitp,Left cr) -> creatures . ix (_crID cr) . crState . csDamage .:~ partDT sp hitp ep + Just (hitp,Left cr) -> cWorld . 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 53c3900a0..27383e68b 100644 --- a/src/Dodge/WorldEvent/Explosion.hs +++ b/src/Dodge/WorldEvent/Explosion.hs @@ -58,7 +58,7 @@ makeFlameExplosionAt -> World makeFlameExplosionAt p w = soundMultiFrom [Explosion 0,Explosion 1] p bangS Nothing w - & flames .++~ newFlames + & cWorld . flames .++~ newFlames where newFlames = zipWith makeFlameWithVelAndTime velocities timers makeFlameWithVelAndTime vel time = aFlameParticle time p vel @@ -71,7 +71,7 @@ makeExplosionAt :: Point2 -> World -> World makeExplosionAt p w = w & soundMultiFrom [Explosion 0,Explosion 1] p bangS Nothing & addFlames - & tempLightSources .:~ theTLS + & cWorld . 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 1da4b377f..d30e294c5 100644 --- a/src/Dodge/WorldEvent/Flash.hs +++ b/src/Dodge/WorldEvent/Flash.hs @@ -23,7 +23,7 @@ import LensHelp import System.Random muzFlareAt :: Color -> Point3 -> Float -> World -> World -muzFlareAt col tranv dir w = w & flares .:~ MuzFlare +muzFlareAt col tranv dir w = w & cWorld . flares .:~ MuzFlare { _flarePoly = map (rotateV dir) [ V2 0 0 , V2 a (-b) @@ -37,7 +37,7 @@ muzFlareAt col tranv dir w = w & flares .:~ MuzFlare (a:b:c:d:_) = randomRs (2,20) (_randGen w) flareCircleAt :: Color -> Float -> Point3 -> World -> World -flareCircleAt col alphax tranv = flares .:~ CircFlare +flareCircleAt col alphax tranv = cWorld . flares .:~ CircFlare { _flareTime = 2 , _flareColor = col , _flareAlpha = alphax @@ -46,4 +46,4 @@ flareCircleAt col alphax tranv = flares .:~ CircFlare explosionFlashAt :: Point2 -> World -> World -explosionFlashAt p = tempLightSources .:~ tlsTimeRadFunPos 20 150 (TLSFade 1 10) (addZ 20 p) +explosionFlashAt p = cWorld . 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 0efcc91d0..83f32b796 100644 --- a/src/Dodge/WorldEvent/Shockwave.hs +++ b/src/Dodge/WorldEvent/Shockwave.hs @@ -17,7 +17,7 @@ makeShockwaveAt -> Color -- ^ Color of shockwave. -> World -- ^ Start world. -> World -makeShockwaveAt is p rad dam push col = shockwaves .:~ Shockwave +makeShockwaveAt is p rad dam push col = cWorld . shockwaves .:~ Shockwave { _swInvulnerableCrs = is , _swDirection = OutwardShockwave , _swColor = col @@ -37,7 +37,7 @@ inverseShockwaveAt -> Float -- Push amount -> World -> World -inverseShockwaveAt p rad dam push = shockwaves .:~ Shockwave +inverseShockwaveAt p rad dam push = cWorld . shockwaves .:~ Shockwave { _swDirection = InwardShockwave , _swInvulnerableCrs = [] , _swColor = cyan diff --git a/src/Dodge/WorldEvent/SpawnParticle.hs b/src/Dodge/WorldEvent/SpawnParticle.hs index e08c9b3d8..40ef229e9 100644 --- a/src/Dodge/WorldEvent/SpawnParticle.hs +++ b/src/Dodge/WorldEvent/SpawnParticle.hs @@ -19,13 +19,13 @@ import LensHelp -- (thepart,g) = runState (f p) (_randGen w) randEnergyBallAt :: (Point2 -> State StdGen EnergyBall) -> Point2 -> World -> World randEnergyBallAt f p w = w - & energyBalls .:~ thepart + & cWorld . energyBalls .:~ thepart & randGen .~ g where (thepart,g) = runState (f p) (_randGen w) makeStaticBall :: Point2 -> World -> World -makeStaticBall p = randEnergyBallAt aStaticBall p . (posEvents .:~ thesparker) +makeStaticBall p = randEnergyBallAt aStaticBall p . (cWorld . posEvents .:~ thesparker) where thesparker = PosEvent SparkSpawner 10 p @@ -84,8 +84,7 @@ makeGasCloud -> World -> World makeGasCloud pos vel w = w - & clouds .:~ theCloud --- & clouds %~ S.cons theCloud + & cWorld . clouds .:~ theCloud & randGen .~ g where theCloud = Cloud diff --git a/src/Dodge/WorldEvent/ThingsHit.hs b/src/Dodge/WorldEvent/ThingsHit.hs index a08e5cd0a..9c23e2037 100644 --- a/src/Dodge/WorldEvent/ThingsHit.hs +++ b/src/Dodge/WorldEvent/ThingsHit.hs @@ -48,7 +48,7 @@ crsHit sp ep w | sp == ep = mempty | otherwise = sortOn (dist sp . fst) . overlap1SegCrs sp ep - . mapMaybe (\cid -> w ^? creatures . ix cid) + . mapMaybe (\cid -> w ^? cWorld . creatures . ix cid) . IS.toList . crsNearSeg sp ep $ w diff --git a/src/Dodge/Zone.hs b/src/Dodge/Zone.hs index e310bbc1d..df471420e 100644 --- a/src/Dodge/Zone.hs +++ b/src/Dodge/Zone.hs @@ -56,7 +56,7 @@ zoneOfSight x' w = S.each ] where --(xs,ys) = unzip $ map zoneOfPoint $ screenPolygon cfig w -- ++ [_cameraViewFrom w] - (xs,ys) = unzip $ map (sizeZoneOfPoint x') $ _boundBox w -- ++ [_cameraViewFrom w] + (xs,ys) = unzip $ map (sizeZoneOfPoint x') $ _boundBox $ _cWorld w -- ++ [_cameraViewFrom w] sizeZoneOfPoint s (V2 x y) = (f x, f y) where f = floor . (/ s) diff --git a/src/Dodge/Zoning/Cloud.hs b/src/Dodge/Zoning/Cloud.hs index c81c293de..de9b1bb10 100644 --- a/src/Dodge/Zoning/Cloud.hs +++ b/src/Dodge/Zoning/Cloud.hs @@ -10,13 +10,13 @@ import Control.Lens import qualified IntMapHelp as IM clsNearPoint :: Point2 -> World -> [Cloud] -clsNearPoint p w = zoneExtract (zoneOfPoint' clZoneSize p) (w ^. clZoning) +clsNearPoint p w = zoneExtract (zoneOfPoint' clZoneSize p) (w ^. cWorld . clZoning) clsNearSeg :: Point2 -> Point2 -> World -> [Cloud] -clsNearSeg sp ep w = zonesExtract (w ^. clZoning) (zoneOfSeg' clZoneSize sp ep) +clsNearSeg sp ep w = zonesExtract (w ^. cWorld . clZoning) (zoneOfSeg' clZoneSize sp ep) clsNearRect :: Point2 -> Point2 -> World -> [Cloud] -clsNearRect sp ep w = zonesExtract (w ^. clZoning) $ zoneOfRect' clZoneSize sp ep +clsNearRect sp ep w = zonesExtract (w ^. cWorld . 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 b1aafa38c..ac4a9c6f5 100644 --- a/src/Dodge/Zoning/Creature.hs +++ b/src/Dodge/Zoning/Creature.hs @@ -12,22 +12,22 @@ import qualified Data.IntSet as IS import Control.Lens crIXsNearPoint :: Point2 -> World -> IS.IntSet -crIXsNearPoint p w = zoneExtract (zoneOfPoint' crZoneSize p) (w ^. crZoning) +crIXsNearPoint p w = zoneExtract (zoneOfPoint' crZoneSize p) (w ^. cWorld . crZoning) crsNearPoint :: Point2 -> World -> [Creature] -crsNearPoint p w = mapMaybe (\cid -> w ^? creatures . ix cid) . IS.toList $ crIXsNearPoint p w +crsNearPoint p w = mapMaybe (\cid -> w ^? cWorld . creatures . ix cid) . IS.toList $ crIXsNearPoint p w crsNearSeg :: Point2 -> Point2 -> World -> IS.IntSet -crsNearSeg sp ep w = zonesExtract (w ^. crZoning) (zoneOfSeg' crZoneSize sp ep) +crsNearSeg sp ep w = zonesExtract (w ^. cWorld . 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 ^? creatures . ix cid) . IS.toList $ crIXsNearCirc p r w +crsNearCirc p r w = mapMaybe (\cid -> w ^? cWorld . creatures . ix cid) . IS.toList $ crIXsNearCirc p r w crsNearRect :: Point2 -> Point2 -> World -> IS.IntSet -crsNearRect sp ep w = zonesExtract (w ^. crZoning) $ zoneOfRect' crZoneSize sp ep +crsNearRect sp ep w = zonesExtract (w ^. cWorld . crZoning) $ zoneOfRect' crZoneSize sp ep crZoneSize :: Float crZoneSize = 15 @@ -39,7 +39,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 ^? creatures . ix cid + getpair cid = fmap h $ w ^? cWorld . 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 134017d79..f04a2a1c9 100644 --- a/src/Dodge/Zoning/Pathing.hs +++ b/src/Dodge/Zoning/Pathing.hs @@ -10,13 +10,13 @@ import Control.Lens import qualified IntMapHelp as IM pnsNearPoint :: Point2 -> World -> [(Int,Point2)] -pnsNearPoint p w = zoneExtract (zoneOfPoint' pnZoneSize p) (w ^. pnZoning) +pnsNearPoint p w = zoneExtract (zoneOfPoint' pnZoneSize p) (w ^. cWorld . pnZoning) pnsNearSeg :: Point2 -> Point2 -> World -> [(Int,Point2)] -pnsNearSeg sp ep w = zonesExtract (w ^. pnZoning) (zoneOfSeg' pnZoneSize sp ep) +pnsNearSeg sp ep w = zonesExtract (w ^. cWorld . pnZoning) (zoneOfSeg' pnZoneSize sp ep) pnsNearRect :: Point2 -> Point2 -> World -> [(Int,Point2)] -pnsNearRect sp ep w = zonesExtract (w ^. pnZoning) $ zoneOfRect' pnZoneSize sp ep +pnsNearRect sp ep w = zonesExtract (w ^. cWorld . pnZoning) $ zoneOfRect' pnZoneSize sp ep pnsNearCirc :: Point2 -> Float -> World -> [(Int,Point2)] pnsNearCirc p r = pnsNearRect (p +.+ V2 r r) (p -.- V2 r r) @@ -33,13 +33,13 @@ zonePn pn = zoneMonoid (zoneOfPn pn) [pn] pesNearPoint :: Point2 -> World -> [(Int,Int,PathEdge)] -pesNearPoint p w = zoneExtract (zoneOfPoint' peZoneSize p) (w ^. peZoning) +pesNearPoint p w = zoneExtract (zoneOfPoint' peZoneSize p) (w ^. cWorld . peZoning) pesNearSeg :: Point2 -> Point2 -> World -> [(Int,Int,PathEdge)] -pesNearSeg sp ep w = zonesExtract (w ^. peZoning) (zoneOfSeg' peZoneSize sp ep) +pesNearSeg sp ep w = zonesExtract (w ^. cWorld . peZoning) (zoneOfSeg' peZoneSize sp ep) pesNearRect :: Point2 -> Point2 -> World -> [(Int,Int,PathEdge)] -pesNearRect sp ep w = zonesExtract (w ^. peZoning) $ zoneOfRect' peZoneSize sp ep +pesNearRect sp ep w = zonesExtract (w ^. cWorld . peZoning) $ zoneOfRect' peZoneSize sp ep pesNearCirc :: Point2 -> Float -> World -> [(Int,Int,PathEdge)] 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 1e2c304a7..a16c40c87 100644 --- a/src/Dodge/Zoning/Wall.hs +++ b/src/Dodge/Zoning/Wall.hs @@ -10,19 +10,19 @@ import qualified Data.IntSet as IS import Control.Lens wlIXsNearPoint :: Point2 -> World -> IS.IntSet -wlIXsNearPoint p w = zoneExtract (zoneOfPoint' wlZoneSize p) (w ^. wlZoning) +wlIXsNearPoint p w = zoneExtract (zoneOfPoint' wlZoneSize p) (w ^. cWorld . wlZoning) wlIXsNearSeg :: Point2 -> Point2 -> World -> IS.IntSet -wlIXsNearSeg sp ep w = zonesExtract (w ^. wlZoning) (zoneOfSeg' wlZoneSize sp ep) +wlIXsNearSeg sp ep w = zonesExtract (w ^. cWorld . wlZoning) (zoneOfSeg' wlZoneSize sp ep) wlIXsNearRect :: Point2 -> Point2 -> World -> IS.IntSet -wlIXsNearRect sp ep w = zonesExtract (w ^. wlZoning) $ zoneOfRect' wlZoneSize sp ep +wlIXsNearRect sp ep w = zonesExtract (w ^. cWorld . 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] -wlsFromIXs w = mapMaybe (\wlid -> w ^? walls . ix wlid) . IS.toList +wlsFromIXs w = mapMaybe (\wlid -> w ^? cWorld . 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 94f7ba659..824394e90 100644 --- a/src/Dodge/Zoning/World.hs +++ b/src/Dodge/Zoning/World.hs @@ -10,7 +10,7 @@ zoneOfSight' s w = ] where --(xs,ys) = unzip $ map zoneOfPoint $ screenPolygon cfig w -- ++ [_cameraViewFrom w] - (xs,ys) = unzip $ map sizeZoneOfPoint $ _boundBox w -- ++ [_cameraViewFrom w] + (xs,ys) = unzip $ map sizeZoneOfPoint $ _boundBox (_cWorld w) -- ++ [_cameraViewFrom w] sizeZoneOfPoint (V2 x y) = (f x, f y) where f = floor . (/ s)