Separate out concrete part of world

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)

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

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)

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

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

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)