Move towards serializing saves/loads faster

appDodge/Main.hs

@@ -1,38 +1,37 @@
-module Main 
+module Main (
-    ( main 
+    main,
 ) where
-import Dodge.Menu
-import Loop
-import Dodge.TestString
-import Dodge.Data
---import Dodge.StartNewGame
-import Dodge.Initialisation
-import Dodge.Concurrent
---import Dodge.LevelGen
-import Dodge.Update
-import Dodge.Event
-import Dodge.Render
-import Dodge.Config.Load
-import Dodge.Config.Update
-import Dodge.SoundLogic.LoadSound
-import Picture
-import Render
-import Preload.Render
-import Sound
-import Preload
-import Music
-import Data.Preload.Render
 
 import Control.Lens
 import Control.Monad
---import Control.Monad.Parallel
-import qualified Data.Text as T
-import qualified IntMapHelp               as IM
-import Graphics.Rendering.OpenGL hiding (color, rotate, scale, translate)
-import qualified SDL
-import qualified SDL.Mixer                 as Mix
 import Control.Parallel
 import qualified Data.Map.Strict as M
+import Data.Preload.Render
+import qualified Data.Text as T
+import Dodge.Concurrent
+import Dodge.Config.Load
+import Dodge.Config.Update
+import Dodge.Data
+import Dodge.Event
+import Dodge.Initialisation
+import Dodge.LoadSeed
+import Dodge.Menu
+import Dodge.Render
+import Dodge.SoundLogic.LoadSound
+import Dodge.TestString
+import Dodge.Update
+import Graphics.Rendering.OpenGL hiding (color, rotate, scale, translate)
+import qualified IntMapHelp as IM
+import Loop
+import Music
+import Picture
+import Preload
+import Preload.Render
+import Render
+import qualified SDL
+import qualified SDL.Mixer as Mix
+import Sound
+import System.Directory
 
 main :: IO ()
 main = do
@@ -54,8 +53,11 @@ main = do
 
 -- | Create an OpenGL SDL window configuration with a given x and y size.
 winConfig :: Int -> Int -> Maybe (Int, Int) -> SDL.WindowConfig
-winConfig x y winpos = SDL.defaultWindow 
+winConfig x y winpos =
-    { SDL.windowGraphicsContext = SDL.OpenGLContext $ SDL.defaultOpenGL 
+    SDL.defaultWindow
+        { SDL.windowGraphicsContext =
+            SDL.OpenGLContext $
+                SDL.defaultOpenGL
                     { SDL.glProfile = SDL.Core SDL.Normal 4 3
                     , SDL.glColorPrecision = SDL.V4 8 8 8 8
                     }
@@ -76,9 +78,12 @@ firstWorldLoad theConfig = do
     SDL.cursorVisible $= False
     pdata <- doPreload >>= applyWorldConfig theConfig
     --return $ startNewGame $ Universe
-    return $ Universe 
+    cancontinue <- doesFileExist "saveSlot/0"
-        --{_uvWorld = initialWorld
+    mseed <- loadSeed
-        {_uvWorld = splashScreen
+    return $
+        Universe
+            { --{_uvWorld = initialWorld
+              _uvWorld = splashScreen
             , _uvConfig = theConfig
             , _preloadData = pdata
             , _uvScreenLayers = [splashMenu]
@@ -86,6 +91,8 @@ firstWorldLoad theConfig = do
             , _uvTestString = testStringInit
             , _quickSave = Nothing
             , _uvConcEffects = NoConcEffect
+            , _uvCanContinue = cancontinue
+            , _uvMSeed = mseed
             }
 
 theUpdateStep :: Universe -> IO Universe
@@ -111,13 +118,17 @@ doSideEffects u = do
     u' <- _uvIOEffects u u
     endTicks <- SDL.ticks
     let lastFrameTicks = _frameTimer preData
-    when (debugOn Show_ms_frame $ _uvConfig u) $ void $ renderFoldable
+    when (debugOn Show_ms_frame $ _uvConfig u) $
+        void $
+            renderFoldable
                 (_pictureShaders $ _renderData preData)
                 ( setDepth (-1)
-            . translate (-0.5) (-0.8) . scale 0.0005 0.0005
+                    . translate (-0.5) (-0.8)
+                    . scale 0.0005 0.0005
                     $ fpsText (endTicks - lastFrameTicks)
                 )
-    return $ u' 
+    return $
+        u'
             & preloadData . frameTimer .~ endTicks
             & uvWorld . playingSounds .~ newPlayingSounds
             & uvWorld . toPlaySounds .~ M.empty
@@ -126,7 +137,8 @@ doSideEffects u = do
 fpsText :: (Show a, Ord a, Num a) => a -> Picture
 fpsText x = color col $ text $ "ms/frame " ++ show x
   where
-    col | x < 22 = blue
+    col
+        | x < 22 = blue
         | x < 30 = green
         | x < 40 = yellow
         | x < 50 = orange
@@ -138,7 +150,8 @@ doPreload = do
     lChunks <- loadSounds
     lMusic <- loadMusic
     Mix.playMusic Mix.Forever (lMusic IM.! 0)
-    return PreloadData 
+    return
+        PreloadData
             { _renderData = rData
             , _soundData = SoundData{_loadedChunks = lChunks}
             , _musicData = MusicData{_loadedMusic = lMusic}

package.yaml

@@ -51,6 +51,8 @@ dependencies:
 - linear
 - aeson
 - aeson-pretty
+- store
+- th-utilities
 - directory
 - extra
 - primitive

src/Dodge/Base/Collide.hs

@@ -178,7 +178,7 @@ allVisibleWalls :: World -> [(Point2, Wall)]
 {-# INLINE allVisibleWalls #-}
 allVisibleWalls w = concatMap (flip (visibleWalls vPos) w . (+.+ vPos)) $ nRays 20
   where
-    vPos = _cameraViewFrom $ _cWorld w
+    vPos = w ^. cWorld . cwCam . cwcViewFrom
 
 --allVisibleWalls :: World -> StreamOf (Point2,Wall)
 --{-# INLINE allVisibleWalls #-}

src/Dodge/Base/Coordinate.hs

@@ -3,14 +3,15 @@ module Dodge.Base.Coordinate where
 import Dodge.Base.WinScale
 import Dodge.Data.Universe
 import Geometry
+import Control.Lens
 
 -- | Transform coordinates from world position to screen coordinates.
 worldPosToScreenNorm :: Configuration -> World -> Point2 -> Point2
 worldPosToScreenNorm cfig w = doWindowScale cfig . doRotate . doZoom . doTranslate
   where
-    doTranslate p = p -.- _cameraCenter (_cWorld w)
+    doTranslate p = p -.- (w ^. cWorld . cwCam . cwcCenter)
-    doZoom p = _cameraZoom (_cWorld w) *.* p
+    doZoom p = (w ^. cWorld . cwCam . cwcZoom) *.* p
-    doRotate p = rotateV (negate $ _cameraRot (_cWorld w)) p
+    doRotate p = rotateV (negate (w ^. cWorld . cwCam . cwcRot)) p
 
 {- | Transform world coordinates to scaled screen coordinates.
  - These have to be scaled according to the size of the window to get actual screen positions.
@@ -18,9 +19,9 @@ worldPosToScreenNorm cfig w = doWindowScale cfig . doRotate . doZoom . doTransla
 -}
 worldPosToScreen :: World -> Point2 -> Point2
 worldPosToScreen w =
-    rotateV (negate $ _cameraRot (_cWorld w))
+    rotateV (negate $ w ^. cWorld . cwCam . cwcRot)
-        . (_cameraZoom (_cWorld w) *.*)
+        . ((w ^. cWorld . cwCam . cwcZoom) *.*)
-        . (-.- _cameraCenter (_cWorld w))
+        . (-.- (w ^. cWorld . cwCam . cwcCenter))
 
 {- | Transform coordinates from the map position to screen
 coordinates.
@@ -38,8 +39,8 @@ crToMousePosOffset cr w = (mouseWorldPos w -.- _crPos cr, 0)
 -- | The mouse position in world coordinates.
 mouseWorldPos :: World -> Point2
 mouseWorldPos w =
-    _cameraCenter (_cWorld w)
+    (w ^. cWorld . cwCam . cwcCenter)
-        +.+ (1 / _cameraZoom (_cWorld w)) *.* rotateV (_cameraRot (_cWorld w)) (_mousePos w)
+        +.+ (1 / (w ^. cWorld . cwCam . cwcZoom)) *.* rotateV (w ^. cWorld . cwCam . cwcRot) (_mousePos w)
 
 -- | The mouse position in map coordinates
 mouseCartePos :: World -> Point2

src/Dodge/Base/Window.hs

@@ -9,18 +9,17 @@ module Dodge.Base.Window (
 
 import Dodge.Data.Universe
 import Geometry
+import Control.Lens
 
 -- | A box covering the screen in world coordinates
 screenPolygon :: Configuration -> World -> [Point2]
 screenPolygon cfig w = map (scTran . scRot . scZoom) $ screenBox cfig
   where
-    --    [tr,tl,bl,br]
+    scRot = rotateV (w ^. cWorld . cwCam . cwcRot)
-
-    scRot = rotateV (_cameraRot (_cWorld w))
     scZoom p
-        | _cameraZoom (_cWorld w) /= 0 = (1 / _cameraZoom (_cWorld w)) *.* p
+        | (w ^. cWorld . cwCam . cwcZoom) /= 0 = (1 / (w ^. cWorld . cwCam . cwcZoom)) *.* p
         | otherwise = p
-    scTran p = p +.+ _cameraCenter (_cWorld w)
+    scTran p = p +.+ (w ^. cWorld . cwCam . cwcCenter)
 
 --    tr = scTran $ scRot $ scZoom (V2 ( halfWidth w) ( halfHeight w))
 --    tl = scTran $ scRot $ scZoom (V2 (-halfWidth w) ( halfHeight w))
@@ -41,9 +40,9 @@ screenPolygonBord xbord ybord cfig w = [tr, tl, bl, br]
     hw = halfWidth cfig - xbord
     hh = halfHeight cfig - ybord
     scZoom p
-        | _cameraZoom (_cWorld w) /= 0 = (1 / _cameraZoom (_cWorld w)) *.* p
+        | (w ^. cWorld . cwCam . cwcZoom) /= 0 = (1 / (w ^. cWorld . cwCam . cwcZoom)) *.* p
         | otherwise = p
-    theTransform = (+.+ _cameraCenter (_cWorld w)) . rotateV (_cameraRot (_cWorld w)) . scZoom
+    theTransform = (+.+ (w ^. cWorld . cwCam . cwcCenter)) . rotateV (w ^. cWorld . cwCam . cwcRot) . scZoom
     tr = theTransform (V2 hw hh)
     tl = theTransform (V2 (- hw) hh)
     br = theTransform (V2 hw (- hh))

src/Dodge/Creature/Picture/Awareness.hs

@@ -5,6 +5,7 @@ import Dodge.Clock
 import Dodge.Data.World
 import Geometry
 import Picture
+import Control.Lens
 
 creatureDisplayText :: World -> Creature -> Picture
 creatureDisplayText w cr =
@@ -26,8 +27,8 @@ creatureDisplayText w cr =
             w
             cr
   where
-    campos = _cameraViewFrom (_cWorld w)
+    campos = w ^. cWorld . cwCam . cwcViewFrom
-    theScale = 0.15 / _cameraZoom (_cWorld w)
+    theScale = 0.15 / (w ^. cWorld . cwCam . cwcZoom)
     cpos = _crPos cr
     v = cpos -.- campos
     (V2 x y) = campos +.+ v +.+ _crRad cr *.* normalizeV v

src/Dodge/Creature/YourControl.hs

@@ -56,12 +56,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 (_cWorld w) + argV movDir
+    dir = (w ^. cWorld . cwCam . cwcRot) + argV movDir
-    movAbs = rotateV (_cameraRot (_cWorld w)) $ normalizeV movDir
+    movAbs = rotateV (w ^. cWorld . cwCam . cwcRot) $ normalizeV movDir
     isAiming = _posture (_crStance cr) == Aiming
     mouseDir = case cr ^? crInv . ix (crSel cr) . itScope . scopePos of
         Just _ -> argV $ mouseWorldPos w -.- _crPos cr
-        _ -> argV (_mousePos w) + _cameraRot (_cWorld w)
+        _ -> argV (_mousePos w) + (w ^. cWorld . cwCam . cwcRot)
 
 wasdM :: SDL.Scancode -> Point2
 wasdM scancode = case scancode of

src/Dodge/CullBox.hs

@@ -12,7 +12,7 @@ import Geometry
 findBoundDists :: Configuration -> World -> (Float, Float, Float, Float)
 findBoundDists cfig w
     | debugOn Bound_box_screen cfig = (hh, - hh, hw, - hw)
-    | otherwise = fromMaybe (0, 0, 0, 0) $ farWallDistDirection (_cameraCenter (_cWorld w)) w
+    | otherwise = fromMaybe (0, 0, 0, 0) $ farWallDistDirection ((w ^. cWorld . cwCam . cwcCenter)) w
   where
     hw = halfWidth cfig
     hh = halfHeight cfig
@@ -20,8 +20,9 @@ findBoundDists cfig w
 updateBounds :: Universe -> Universe
 updateBounds uv =
     uv
-        & uvWorld . cWorld . boundDist .~ bdists
+        & uvWorld . cWorld . cwCam . cwcBoundDist .~ bdists
-        & uvWorld . cWorld . boundBox .~ map ((+.+ _cameraCenter (_cWorld w)) . rotateV (_cameraRot (_cWorld w))) (rectNSWE n s w' e)
+        & uvWorld . cWorld . cwCam . cwcBoundBox
+            .~ map ((+.+ w ^. cWorld . cwCam . cwcCenter) . rotateV (w ^. cWorld . cwCam . cwcRot)) (rectNSWE n s w' e)
   where
     w = _uvWorld uv
     cfig = _uvConfig uv

src/Dodge/Data/CWorld.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 module Dodge.Data.CWorld (
     module Dodge.Data.CWorld,
@@ -46,6 +47,8 @@ module Dodge.Data.CWorld (
     module Dodge.Data.WorldEffect,
 ) where
 
+import TH.Derive
+import Data.Store
 import Control.Lens
 import Data.Aeson
 import Data.Aeson.TH
@@ -99,16 +102,29 @@ import qualified IntMapHelp as IM
 import MaybeHelp
 import Picture.Data
 
+data CWCam = CWCam
+    { _cwcCenter :: Point2
+    , _cwcRot :: Float
+    , _cwcZoom :: Float -- smaller values zoom out
+    , _cwcItemZoom :: Float
+    , _cwcDefaultZoom :: Float
+    , _cwcViewFrom :: Point2
+    , _cwcViewDistance :: Float
+    , _cwcBoundBox :: [Point2]
+    , _cwcBoundDist :: (Float, Float, Float, Float) -- NSEW, S and W negative
+    }
+
 data CWorld = CWorld
-    { _cameraCenter :: Point2
+    --{ _cameraCenter :: Point2
-    , _cameraRot :: Float
+    --, _cameraRot :: Float
-    , _cameraZoom :: Float -- smaller values zoom out
+    --, _cameraZoom :: Float -- smaller values zoom out
-    , _itemZoom :: Float
+    --, _itemZoom :: Float
-    , _defaultZoom :: Float
+    --, _defaultZoom :: Float
-    , _cameraViewFrom :: Point2
+    --, _cameraViewFrom :: Point2
-    , _viewDistance :: Float
+    --, _viewDistance :: Float
-    , _boundBox :: [Point2]
+    --, _boundBox :: [Point2]
-    , _boundDist :: (Float, Float, Float, Float) -- NSEW, S and W negative
+    --, _boundDist :: (Float, Float, Float, Float) -- NSEW, S and W negative
+    { _cwCam :: CWCam
     , _creatures :: IM.IntMap Creature
     , _crZoning :: IM.IntMap (IM.IntMap IS.IntSet)
     , _creatureGroups :: IM.IntMap CrGroupParams
@@ -176,6 +192,14 @@ data CWorld = CWorld
     , _worldClock :: Int
     , _genParams :: GenParams
     , _deathDelay :: Maybe Int
+    , _cwSeed :: Int
+    }
+
+data CWGen = CWGen
+    { _cwgParams :: GenParams
+    , _cwgWorldBounds :: Bounds
+    , _cwgGameRooms :: [GameRoom] -- consider using an IntMap
+    , _cwgRoomClipping :: [ConvexPoly]
     }
 
 data WorldBeams = WorldBeams
@@ -188,5 +212,10 @@ data WorldBeams = WorldBeams
 
 deriveJSON defaultOptions ''CWorld
 deriveJSON defaultOptions ''WorldBeams
+deriveJSON defaultOptions ''CWCam
 makeLenses ''CWorld
 makeLenses ''WorldBeams
+makeLenses ''CWCam
+-- $($(derive [d|
+--     instance Deriving (Store CWorld)
+--     |]))

src/Dodge/Data/Universe.hs

@@ -27,6 +27,8 @@ data Universe = Universe
     , _uvConcEffects :: ConcEffect
     , _uvConfig :: Configuration
     , _uvTestString :: Universe -> [String]
+    , _uvCanContinue :: Bool
+    , _uvMSeed :: Maybe Int
     }
 
 data ConcEffect = NoConcEffect
@@ -62,10 +64,14 @@ data ScreenLayer
 --        { _scDisplay :: Universe -> Picture
 --        }
 
+data MenuOptionDisplay = MODString {_modString :: String}
+    | MODBlockedString {_modString :: String} 
+    | MODStringOption {_modString :: String,_modOption :: String}
+
 data MenuOption
     = Toggle
         { _moEff :: Universe -> IO (Maybe Universe)
-        , _moString :: Universe -> Either String (String, String)
+        , _moString :: Universe -> MenuOptionDisplay
         , _moKey :: Scancode
         }
     | Toggle2
@@ -73,7 +79,7 @@ data MenuOption
         , _moEff1 :: Universe -> IO (Maybe Universe)
         , _moKey2 :: Scancode
         , _moEff2 :: Universe -> IO (Maybe Universe)
-        , _moString :: Universe -> Either String (String, String)
+        , _moString :: Universe -> MenuOptionDisplay
         }
     | InvisibleToggle
         { _moKey :: Scancode
@@ -85,3 +91,4 @@ data IntID a = IntID Int a
 makeLenses ''Universe
 makeLenses ''ScreenLayer
 makeLenses ''ConcEffect
+makeLenses ''MenuOptionDisplay

src/Dodge/Debug/Picture.hs

@@ -1,5 +1,6 @@
 module Dodge.Debug.Picture where
 
+import Control.Lens
 import Data.Maybe
 import Dodge.Base.Wall
 import Dodge.Base.Window
@@ -19,11 +20,11 @@ printRotPoint r p =
 outsideScreenPolygon :: Configuration -> World -> [Point2]
 outsideScreenPolygon cfig w = [tr, tl, bl, br]
   where
-    scRot = rotateV (_cameraRot (_cWorld w))
+    scRot = rotateV (w ^. cWorld . cwCam . cwcRot)
     scZoom p
-        | _cameraZoom (_cWorld w) /= 0 = (1 / _cameraZoom (_cWorld w)) *.* p
+        | (w ^. cWorld . cwCam . cwcZoom) /= 0 = (1 / (w ^. cWorld . cwCam . cwcZoom)) *.* p
         | otherwise = error "Trying to set screen zoom to zero"
-    scTran p = p +.+ _cameraCenter (_cWorld w)
+    scTran p = p +.+ (w ^. cWorld . cwCam . cwcCenter)
     tr = f 3 3
     tl = f (-3) 3
     br = f 3 (-3)
@@ -39,10 +40,10 @@ lineOnScreenCone cfig w p1 p2 =
         || any (isJust . uncurry (intersectSegSeg p1 p2)) sps
   where
     sp' = screenPolygon cfig w
-    vp = _cameraViewFrom (_cWorld w)
+    vp = w ^. cWorld . cwCam . cwcViewFrom
     sp
         | pointInPolygon vp sp' = sp'
-        | otherwise = orderPolygon (_cameraViewFrom (_cWorld w) : sp')
+        | otherwise = orderPolygon ((w ^. cWorld . cwCam . cwcViewFrom) : sp')
     sps = zip sp (tail sp ++ [head sp])
 
 pointOnScreen :: Configuration -> World -> Point2 -> Bool
@@ -55,7 +56,7 @@ drawWallFace cfig w wall
   where
     (x, y) = _wlLine wall
     points = extendConeToScreenEdge cfig w sightFrom (x, y)
-    sightFrom = _cameraViewFrom (_cWorld w)
+    sightFrom = w ^. cWorld . cwCam . cwcViewFrom
 
 extendConeToScreenEdge :: Configuration -> World -> Point2 -> (Point2, Point2) -> [Point2]
 extendConeToScreenEdge cfig w c (x, y) = orderPolygon $ wallScreenIntersect ++ [x, y] ++ borderPs ++ cornerPs

src/Dodge/Default/World.hs

@@ -33,17 +33,25 @@ defaultWorld =
         , _rbOptions = NoRightButtonOptions
         }
 
+defaultCWCam :: CWCam
+defaultCWCam = CWCam
+        { _cwcCenter = V2 0 0
+        , _cwcRot = 0
+        , _cwcZoom = 1
+        , _cwcDefaultZoom = 1
+        , _cwcViewFrom = V2 0 0
+        , _cwcViewDistance = 1000
+        , _cwcItemZoom = 1
+        , _cwcBoundBox = square 100
+        , _cwcBoundDist = (100, -100, 100, -100)
+        }
+    
+
 defaultCWorld :: CWorld
 defaultCWorld =
     CWorld
-        { _cameraCenter = V2 0 0
+        { _cwCam = defaultCWCam
-        , _cameraRot = 0
-        , _cameraZoom = 1
         , _magnets = IM.empty
-        , _itemZoom = 1
-        , _defaultZoom = 1
-        , _cameraViewFrom = V2 0 0
-        , _viewDistance = 1000
         , _modifications = IM.empty
         , _creatures = IM.empty
         , _crZoning = mempty --Zoning IM.empty crZoneSize zoneOfCreature
@@ -57,9 +65,7 @@ defaultCWorld =
         , _projectiles = IM.empty
         , _instantBullets = []
         , _bullets = []
-        , --    , _instantParticles = []
+        , _flames = []
-          --    , _particles        = []
-          _flames = []
         , _radarSweeps = []
         , _sparks = []
         , _posEvents = []
@@ -121,11 +127,8 @@ defaultCWorld =
         , _maybeWorld = Nothing'
         , _rewindWorlds = []
         , _genParams = GenParams M.empty
-        , --    , _genPlacements = IM.empty
+        , _deathDelay = Nothing
-          --    , _genRooms = IM.empty
+        , _cwSeed = 0
-          _deathDelay = Nothing
-        , _boundBox = square 100
-        , _boundDist = (100, -100, 100, -100)
         }
 
 defaultWorldHammers :: M.Map WorldHammer HammerPosition

src/Dodge/Event.hs

@@ -108,7 +108,7 @@ wheelEvent y w = case _hudElement $ _hud (_cWorld w) of
             (_, EquipOptions{}) -> scrollRBOption y w
             (Nothing, _) -> closeObjScrollDir y w
             (Just f, _) -> w & cWorld . creatures . ix 0 . crInv . ix (crSel $ you w) %~ doHeldScroll f y (you w)
-        | lbDown -> w & cWorld . cameraZoom +~ y
+        | lbDown -> w & cWorld . cwCam . cwcZoom +~ y
         | invKeyDown -> changeSwapInvSel yi w
         | otherwise -> stopSoundFrom (CrReloadSound 0) $ changeAugInvSel yi w
     DisplayInventory (TweakInventory mi)

src/Dodge/Initialisation.hs

@@ -16,7 +16,7 @@ splashScreen =
 initialWorld :: World
 initialWorld =
     defaultWorld
-        & cWorld . cameraZoom .~ 10
+        & cWorld . cwCam . cwcZoom .~ 10
         & cWorld . creatures .~ IM.fromList [(0, startCr)]
         & cWorld . worldEvents .~ SoundStart BackgroundSound (V2 0 0) foamSprayFadeOutS Nothing :
         [MakeStartCloudAt (V3 x y 5) | x <- [-5, -4 .. 5], y <- [-5, -4 .. 5]]

src/Dodge/Item/Weapon/TriggerType.hs

@@ -579,7 +579,7 @@ torqueBefore torque feff item cr w
             w
                 & randGen .~ g
                 & cWorld . creatures . ix cid . crDir +~ rot
-                & cWorld . cameraRot +~ rot
+                & cWorld . cwCam . cwcRot +~ rot
     | otherwise = feff item cr $ set randGen g $ over (cWorld . creatures . ix cid . crDir) (+ rot) w
   where
     cid = _crID cr
@@ -600,7 +600,7 @@ torqueBeforeAtLeast minTorque exTorque feff item cr w
             w
                 & randGen .~ g
                 & cWorld . creatures . ix cid . crDir +~ rot'
-                & cWorld . cameraRot +~ rot'
+                & cWorld . cwCam . cwcRot +~ rot'
     | otherwise = feff item cr $ set randGen g $ over (cWorld . creatures . ix cid . crDir) (+ rot') w
   where
     cid = _crID cr
@@ -613,7 +613,7 @@ torqueBeforeAtLeast minTorque exTorque feff item cr w
 withTorqueAfter :: ChainEffect
 withTorqueAfter feff item cr w
     --    | cid == 0  = rotateScope $ set randGen g $ over cameraRot (+rot) $ feff item cr w
-    | cid == 0 = set randGen g $ over (cWorld . cameraRot) (+ rot) $ feff item cr w
+    | cid == 0 = set randGen g $ over (cWorld . cwCam . cwcRot) (+ rot) $ feff item cr w
     | otherwise = set randGen g $ over (cWorld . creatures . ix cid . crDir) (+ rot) $ feff item cr w
   where
     cid = _crID cr
@@ -651,7 +651,7 @@ sideEffectOnFrame i sf f it cr w =
 
 torqueSideEffect :: Float -> Item -> Creature -> World -> World
 torqueSideEffect torque _ cr w
-    | cid == 0 = set randGen g $ over (cWorld . cameraRot) (+ rot) w
+    | cid == 0 = set randGen g $ over (cWorld . cwCam . cwcRot) (+ rot) w
     | otherwise = set randGen g $ over (cWorld . creatures . ix cid . crDir) (+ rot) w
   where
     cid = _crID cr

src/Dodge/Layout.hs

@@ -56,7 +56,7 @@ generateLevelFromRoomList gr' w =
 
 
 randomCompass :: World -> World
-randomCompass w = w & cWorld . cameraRot .~ (takeOne [0, 0.5 * pi, pi, 1.5 * pi] & evalState $ _randGen w)
+randomCompass w = w & cWorld . cwCam . cwcRot .~ (takeOne [0, 0.5 * pi, pi, 1.5 * pi] & evalState $ _randGen w)
 
 putFloorTiles :: GenWorld -> GenWorld
 putFloorTiles gw = gw & gwWorld . cWorld . floorTiles .~ floorsFromGenWorld gw

src/Dodge/LevelGen.hs

@@ -28,6 +28,7 @@ generateWorldFromSeed i = do
         postGenerationProcessing $
             _gwWorld (generateLevelFromRoomList roomList initialWorld{_randGen = mkStdGen i})
                 & cWorld . roomClipping .~ bounds
+                & cWorld . cwSeed .~ i
 
 postGenerationProcessing :: World -> World
 postGenerationProcessing w = foldl' assignPushDoors w (_doors (_cWorld w))

src/Dodge/LoadSeed.hs

@@ -0,0 +1,16 @@
+module Dodge.LoadSeed
+    where
+import System.Directory
+import Text.Read
+
+loadSeed :: IO (Maybe Int)
+loadSeed = maybeReadFile "saveSlot/seed" >>= (return . (>>= readMaybe))
+    
+maybeReadFile :: String -> IO (Maybe String)
+maybeReadFile fpath = do
+    fexists <- doesFileExist fpath
+    if fexists
+        then do
+            str <- readFile fpath
+            return (Just str)
+        else return Nothing

src/Dodge/Menu.hs

@@ -21,6 +21,7 @@ import Padding
 import SDL
 import System.Clipboard
 import Text.Read
+import Data.Maybe
 
 splashMenu :: ScreenLayer
 splashMenu =
@@ -30,17 +31,21 @@ splashMenu =
 splashMenuOptions :: [MenuOption]
 splashMenuOptions =
     basicKeyOptions
-        [ Toggle (return . Just . loadSaveSlot (SaveSlotNum 0)) (opText "CONTINUE")
+        [ Toggle (return . Just . loadSaveSlot (SaveSlotNum 0)) displaycontinue
-        , Toggle (return . Just . startNewGameInSlot 0) (opText "NEW GAME")
+        , Toggle (return . Just . startNewGameInSlot 0) (opText "NEW WITH RANDOM SEED")
-        , Toggle (return . Just . reloadLevelStart) (opText "RESTART")
+        , Toggle (return . Just . reloadLevelStart) (displaywhenseed "NEW WITH LAST SEED")
-        , Toggle (pushScreen $ seedStartMenu "START FROM SEED") (opText "NEW FROM SEED")
+        , Toggle (pushScreen $ seedStartMenu "START FROM SEED") (opText "NEW WITH SPECIFIC SEED")
         , Toggle (pushScreen optionMenu) (opText "OPTIONS")
         , Toggle (pushScreen displayControls) (opText "VIEW CONTROLS")
-        , Toggle (return . Just) (opText "VIEW CURRENT SEED")
+        , Toggle (return . Just) (displaywhenseed "VIEW LAST SEED")
         , Toggle (return . const Nothing) (opText "QUIT")
         ]
   where
-    opText = const . Left
+    opText = const . MODString
+    displaycontinue u | _uvCanContinue u = MODString "CONTINUE"
+        | otherwise = MODBlockedString "CONTINUE"
+    displaywhenseed str u | isNothing (_uvMSeed u) = MODBlockedString str
+        | otherwise = MODString str
 
 pauseMenu :: ScreenLayer
 pauseMenu = slTitleOptionsEff "PAUSED" pauseMenuOptions (return . unpause)
@@ -60,7 +65,7 @@ pauseMenuOptions =
         ++ [ InvisibleToggle ScancodeEscape (return . const Nothing)
            ]
   where
-    opText = const . Left
+    opText = const . MODString
 
 saveQuit :: Universe -> IO (Maybe Universe)
 saveQuit u =
@@ -78,7 +83,7 @@ seedStartMenu str = slTitleOptionsEff str seedStartOptions popScreen
 
 seedStartOptions :: [MenuOption]
 seedStartOptions =
-    [ Toggle trySeedFromClipboard (const $ Left "PASTE NUMBER FROM CLIPBOARD") ScancodeA
+    [ Toggle trySeedFromClipboard (const $ MODString "PASTE NUMBER FROM CLIPBOARD") ScancodeA
     --    , Toggle ScancodeI (return . Just . loadSaveSlot LevelStartSlot) (const "INSERT NUMBER")
     ]
 
@@ -101,10 +106,10 @@ optionMenu = slTitleOptionsEff "OPTIONS" optionsOptions popScreen
 optionsOptions :: [MenuOption]
 optionsOptions =
     basicKeyOptions
-        [ makeSubmenuOption soundMenu $ Left "VOLUME"
+        [ makeSubmenuOption soundMenu $ MODString "VOLUME"
-        , makeSubmenuOption graphicsMenu $ Left "GRAPHICS"
+        , makeSubmenuOption graphicsMenu $ MODString "GRAPHICS"
-        , makeSubmenuOption gameplayMenu $ Left "GAMEPLAY"
+        , makeSubmenuOption gameplayMenu $ MODString "GAMEPLAY"
-        , makeSubmenuOption debugMenu $ Left "DEBUG OPTIONS"
+        , makeSubmenuOption debugMenu $ MODString "DEBUG OPTIONS"
         ]
 
 debugMenu :: ScreenLayer
@@ -124,7 +129,7 @@ debugMenuOptions =
     f bd =
         Toggle
             (return . Just . (uvConfig . debug_booleans . at bd %~ toggleJust))
-            (Right . g bd . (^? uvConfig . debug_booleans . ix bd))
+            (uncurry MODStringOption . g bd . (^? uvConfig . debug_booleans . ix bd))
     g bd Nothing = (show bd, "False")
     g bd _ = (show bd, "True")
 
@@ -176,7 +181,7 @@ soundMenuOptions =
             (change dec stype)
             scod2
             (change inc stype)
-            (\w -> Right (str, leftPad 2 '.' $ show (round $ 10 * voltype (_uvConfig w) :: Int)))
+            (\w -> MODStringOption str (leftPad 2 '.' $ show (round $ 10 * voltype (_uvConfig w) :: Int)))
     change g vt uv = sw uv >> return (Just $ uv & uvConfig . vt %~ g)
     dec x = max 0 (x - 0.1)
     inc x = min 1 (x + 0.1)

src/Dodge/Menu/OptionType.hs

@@ -8,12 +8,12 @@ import Dodge.Menu.PushPop
 makeBoolOption lns t =
     Toggle
         (return . Just . (uvConfig . lns #%~ not))
-        (\u -> Right (t, show (u ^# uvConfig . lns)))
+        (\u -> MODStringOption t (show (u ^# uvConfig . lns)))
 
 makeEnumOption lns str sideeff =
     Toggle
         (\u -> Just <$> sideeff (u & uvConfig . lns #%~ cycleEnum))
-        (\u -> Right (str, show (u ^# uvConfig . lns)))
+        (\u -> MODStringOption str (show (u ^# uvConfig . lns)))
 
 makeSubmenuOption submenu t = Toggle (pushScreen submenu) (const t)
 

src/Dodge/Picture/SizeInvariant.hs

@@ -1,5 +1,6 @@
 module Dodge.Picture.SizeInvariant where
 
+import Control.Lens
 import Data.Maybe
 import Dodge.Base.Window
 import Dodge.Data.Universe
@@ -18,9 +19,9 @@ fixedSizePicAt pic p w =
         . scale theScale theScale
         $ pic
   where
-    campos = _cameraViewFrom (_cWorld w)
+    campos = w ^. cWorld . cwCam . cwcViewFrom
     v = p -.- campos
-    theScale = 1 / _cameraZoom (_cWorld w)
+    theScale = 1 / (w ^. cWorld . cwCam . cwcZoom)
     (V2 x y) = campos +.+ v
 
 fixedSizePicClamp ::
@@ -40,11 +41,11 @@ fixedSizePicClamp xbord ybord pic p cfig w =
         . scale theScale theScale
         $ pic
   where
-    r = negate $ _cameraRot (_cWorld w)
+    r = negate $ w ^. cWorld . cwCam . cwcRot
-    z = _cameraZoom (_cWorld w)
+    z = w ^. cWorld . cwCam . cwcZoom
-    campos = _cameraViewFrom (_cWorld w)
+    campos = w ^. cWorld . cwCam . cwcViewFrom
     v = p -.- campos
-    theScale = 1 / _cameraZoom (_cWorld w)
+    theScale = 1 / (w ^. cWorld . cwCam . cwcZoom)
     (V2 x y) = campos +.+ rotateV (negate r) (V2 xr' yr')
     (V2 xr yr) = rotateV r v
     xr' = absClamp ((halfWidth cfig - fromIntegral xbord) / z) xr
@@ -74,8 +75,8 @@ fixedSizePicClampArrow xbord ybord pic p cfig w =
         Nothing -> blank
         Just bp -> thickLine 5 [bp, fromMaybe p windowPoint]
     (V2 x y) = fromMaybe p borderPoint
-    campos = _cameraCenter (_cWorld w)
+    campos = w ^. cWorld . cwCam . cwcCenter
-    theScale = 1 / _cameraZoom (_cWorld w)
+    theScale = 1 / (w ^. cWorld . cwCam . cwcZoom)
 
 absClamp ::
     -- | clamping value, assumed positive

src/Dodge/Projectile/Update.hs

@@ -99,7 +99,7 @@ setRemoteDir cid itid pj w = w & cWorld . projectiles . ix (_prjID pj) . prjAcc
         | SDL.ButtonRight `M.member` _mouseButtons w
             && w ^? cWorld . creatures . ix cid . crInvSel . iselPos
                 == w ^? cWorld . itemLocations . ix itid . ipInvID
-            = _cameraRot (_cWorld w) + argV (_mousePos w)
+            = (w ^. cWorld . cwCam . cwcRot) + argV (_mousePos w)
         | otherwise = _prjDir pj
 
 doThrust :: Proj -> World -> World

src/Dodge/Render.hs

@@ -32,14 +32,14 @@ doDrawing pdata u = do
     sTicks <- SDL.ticks
     let w = _uvWorld u
         cfig = _uvConfig u
-        rot = _cameraRot (_cWorld w)
+        rot = w ^. cWorld . cwCam . cwcRot
-        camzoom = _cameraZoom (_cWorld w)
+        camzoom = w ^. cWorld . cwCam . cwcZoom
-        trans = _cameraCenter (_cWorld w)
+        trans = w ^. cWorld . cwCam . cwcCenter
         wins@(V2 winx winy) = V2 (_windowX cfig) (_windowY cfig)
         resFact = resFactorNum $ cfig ^. graphics_resolution_factor
         (wallPointsCol, windowPoints, wallSPics) = wallsToDraw w
         lightPoints = lightsToRender cfig w
-        viewFroms@(V2 vfx vfy) = _cameraViewFrom (_cWorld w)
+        viewFroms@(V2 vfx vfy) = w ^. cWorld . cwCam . cwcViewFrom
         viewFrom3d = Vector3 vfx vfy 20
         shadV = _pictureShaders pdata
         lwShad = _lightingWallShadShader pdata

src/Dodge/Render/Lights.hs

@@ -6,6 +6,7 @@ import Data.Maybe
 import Dodge.Data.Universe
 import Geometry
 import qualified IntMapHelp as IM
+import Control.Lens
 
 lightsToRender :: Configuration -> World -> [(Point3, Float, Point3)]
 lightsToRender cfig w =
@@ -14,8 +15,8 @@ lightsToRender cfig w =
   where
     getLS = getlsparam . _lsParam
     getTLS = getlsparam . _tlsParam
-    cbox = _boundBox (_cWorld w)
+    cbox = w ^. cWorld . cwCam . cwcBoundBox
-    cpos = _cameraCenter (_cWorld w)
+    cpos = w ^. cWorld . cwCam . cwcCenter
     getlsparam ls
         | not (pointInPolygon lpos cbox) && extraculltest = Nothing
         | otherwise = Just (_lsPos ls, rad ^ (2 :: Int), _lsCol ls)

src/Dodge/Render/List.hs

@@ -59,6 +59,29 @@ listCursorNESW = listCursorChooseBorder [True, True, True, True]
 listCursorNSW :: Float -> Float -> Configuration -> Int -> Color -> Int -> Int -> Picture
 listCursorNSW = listCursorChooseBorder [True, False, True, True]
 
+fillScreenText :: Configuration -> String -> Picture
+fillScreenText cfig str =
+    winScale cfig
+        . scale wscale hscale
+        . centerText
+        $ str
+  where
+    wscale = hw*0.02/fromIntegral (length str)
+    hscale = hh*0.01
+    hw = halfWidth cfig
+    hh = halfHeight cfig
+
+
+fillWidthText :: Configuration -> String -> Picture
+fillWidthText cfig str =
+    winScale cfig
+        . scale thescale thescale
+        . centerText
+        $ str
+  where
+    thescale = hw*0.02/fromIntegral (length str)
+    hw = halfWidth cfig
+
 listTextPictureAt :: Float -> Float -> Configuration -> Int -> Picture -> Picture
 listTextPictureAt xoff yoff cfig yint =
     winScale cfig

src/Dodge/Render/MenuScreen.hs

@@ -64,7 +64,7 @@ drawOptions u title ops off footer =
         , drawFooterText cfig red footer
         ]
             ++ zipWith
-                (\s vpos -> placeString (- hw + 50) vpos 0.2 s)
+                (\s vpos -> placeColorString (- hw + 50) vpos 0.2 s)
                 ops''
                 [hh -100, hh -150 ..]
   where
@@ -77,7 +77,7 @@ drawOptions u title ops off footer =
         x | x < length ops -> take (availableMenuLines cfig) (drop off visibleops)
         _ -> visibleops
     ops'' = case availableMenuLines cfig of
-        x | x < length ops -> map (menuOptionToString u maxOptionLength) ops' ++ ["SPACE: MORE OPTIONS"]
+        x | x < length ops -> map (menuOptionToString u maxOptionLength) ops' ++ [(white,"SPACE: MORE OPTIONS")]
         _ -> map (menuOptionToString u maxOptionLength) ops'
     visibleops = filter notInvisible ops
     notInvisible InvisibleToggle{} = False
@@ -88,8 +88,8 @@ drawOptions u title ops off footer =
 
 optionValueOffset :: Universe -> MenuOption -> Int
 optionValueOffset u mo = case _moString mo u of
-    Left _ -> 0
+    MODStringOption s _ -> length s
-    Right (s, _) -> length s
+    _ -> 0
 
 darkenBackground :: Configuration -> Picture
 darkenBackground = color (withAlpha 0.5 black) . polygon . reverse . screenBox
@@ -111,18 +111,32 @@ placeString ::
     Picture
 placeString x y sc = color white . translate x y . scale sc sc . text
 
+placeColorString ::
+    -- | x distance from center
+    Float ->
+    -- | y distance from center
+    Float ->
+    -- | scale
+    Float ->
+    (Color,String) ->
+    Picture
+placeColorString x y sc (col,str) = color col . translate x y . scale sc sc . text $ str
+
 drawFooterText :: Configuration -> Color -> String -> Picture
 drawFooterText cfig col = color col . placeString (- hw + 30) (- hh + 10) 0.1
   where
     hh = halfHeight cfig
     hw = halfWidth cfig
 
-menuOptionToString :: Universe -> Int -> MenuOption -> String
+menuOptionToString :: Universe -> Int -> MenuOption -> (Color,String)
-menuOptionToString w padAmount mo = theKeys ++ optionText
+menuOptionToString w padAmount mo = (thecol,theKeys ++ optionText)
   where
+    thecol = case _moString mo w of
+        MODBlockedString {} -> greyN 0.5
+        _ -> white
     optionText = case _moString mo w of
-        Left s -> s
+        MODStringOption s t -> rightPad padAmount '.' s ++ t
-        Right (s, t) -> rightPad padAmount '.' s ++ t
+        x -> _modString x
     theKeys = case mo of
         Toggle{_moKey = k} -> stc k : ":"
         Toggle2{_moKey1 = k1, _moKey2 = k2} -> stc k1 : '/' : stc k2 : ":"

src/Dodge/Render/Outline.hs

@@ -0,0 +1,14 @@
+module Dodge.Render.Outline
+    where
+import Picture
+
+hackOutline :: Color -> Float -> Picture -> Picture
+hackOutline col x pic = pictures 
+    (map (color col)
+    [ translate x 0 pic
+    , translate (-x) 0 pic
+    , translate 0 x pic
+    , translate 0 (-x) pic
+    ]
+    ) <> pic
+

src/Dodge/Render/Picture.hs

@@ -2,6 +2,7 @@ module Dodge.Render.Picture (
     fixedCoordPictures,
 ) where
 
+import Control.Lens
 import Dodge.Base.WinScale
 import Dodge.Base.Window
 import Dodge.Data.Universe
@@ -10,7 +11,6 @@ import Dodge.Render.List
 import Dodge.Render.MenuScreen
 import Geometry
 import Picture
-import Control.Lens
 
 fixedCoordPictures :: Universe -> Picture
 fixedCoordPictures u =
@@ -27,16 +27,18 @@ fixedCoordPictures u =
 
 drawConcurrentMessage :: Universe -> Picture
 drawConcurrentMessage u = case u ^. uvConcEffects of
-    BlockingConcEffect str -> listPicturesAt
+    BlockingConcEffect str -> fillWidthText cfig str
-        (halfWidth cfig)
+    --listPicturesAt
-        (halfHeight cfig)
+    --(halfWidth cfig)
-        cfig
+    --(halfHeight cfig)
-        [text str]
+    --cfig
-    BackgroundConcEffect str -> listPicturesAt
+    --[centerText str]
+    BackgroundConcEffect str ->
+        listPicturesAt
             (halfWidth cfig)
             (_windowY cfig - 50)
             cfig
-        [text str]
+            [centerText str]
     _ -> mempty
   where
     cfig = _uvConfig u

src/Dodge/Render/ShapePicture.hs

@@ -118,8 +118,8 @@ shiftDraw' fpos fdir fdraw x =
 
 cullPoint :: Configuration -> World -> Point2 -> Bool
 cullPoint cfig w p
-    | debugOn Close_shape_culling cfig = pointInPolygon p (_boundBox (_cWorld w))
+    | debugOn Close_shape_culling cfig = pointInPolygon p (w ^. cWorld . cwCam . cwcBoundBox)
-    | otherwise = dist (_cameraCenter (_cWorld w)) p < _viewDistance (_cWorld w)
+    | otherwise = dist (w ^. cWorld . cwCam . cwcCenter) p < (w ^. cWorld . cwCam . cwcViewDistance)
 
 extraPics :: Configuration -> World -> Picture
 extraPics cfig w =
@@ -277,7 +277,7 @@ drawFarWallDetect w =
             )
         $ runIdentity $ S.toList_ $ streamViewpoints p w
   where
-    p = _cameraViewFrom (_cWorld w)
+    p = w ^. cWorld . cwCam . cwcViewFrom
 
 drawDDATest :: World -> Picture
 drawDDATest w =
@@ -288,7 +288,7 @@ drawDDATest w =
         --        <> color blue (runIdentity (S.foldMap_ drawCross qs'))
         <> setLayer DebugLayer (color yellow (line [cvf, mwp]))
   where
-    cvf = _cameraViewFrom (_cWorld w)
+    cvf = w ^. cWorld . cwCam . cwcViewFrom
     mwp = mouseWorldPos w
     --ps = ddaStreamX 50 cvf mwp
     ps = zoneOfSeg' 50 cvf mwp
@@ -315,15 +315,23 @@ drawWallSearchRays w = foldMap (f . fst) $ allVisibleWalls w
         setLayer DebugLayer $
             color yellow $
                 uncurryV translate p (circle 5)
-                    <> line [_cameraViewFrom (_cWorld w), p]
+                    <> line [w ^. cWorld . cwCam . cwcViewFrom , p]
 
 testPic :: Configuration -> World -> Picture
 testPic _ _ = mempty
+--testPic cfig _ = setLayer FixedCoordLayer $ listPicturesAt 100 100 cfig $ map centerText
+--    ["A"
+--    ,"AA"
+--    ,"AAA"
+--    ,"AAAA"
+--    ,"AAAAA"
+--    ,"AAAAAA"
+--    ]
 
 drawBoundingBox :: World -> Picture
 drawBoundingBox w = setLayer DebugLayer $ color green $ line $ (x : xs) ++ [x]
   where
-    (x : xs) = _boundBox (_cWorld w)
+    (x : xs) = w ^. cWorld . cwCam . cwcBoundBox
 
 clDraw :: Cloud -> Picture
 clDraw c = translate3 (_clPos c) (drawCloud (_clPict c) c)
@@ -351,7 +359,7 @@ soundPic cfig w s = fixedSizePicClampArrow 50 50 thePic p cfig w
   where
     p = _soundPos s
     thePic =
-        rotate (_cameraRot (_cWorld w))
+        rotate (w ^. cWorld . cwCam . cwcRot)
             . scale theScale theScale
             . centerText
             . soundToOnomato

src/Dodge/Save.hs

@@ -47,7 +47,7 @@ saveSlotPath QuicksaveSlot = "saveSlot/QuickSave"
 saveSlotPath (LevelStartSlot i) = "saveSlot/LevelStart" ++ show i
 
 saveWorldInSlot :: SaveSlot -> Universe -> Universe
-saveWorldInSlot slot u = tryConcEffect False "ASDF" (writeSaveSlot slot u) u
+saveWorldInSlot slot u = tryConcEffect False "SAVING" (writeSaveSlot slot u) u
     
 reloadLevelStart :: Universe -> Universe
 reloadLevelStart = loadSaveSlot (LevelStartSlot 0)

src/Dodge/SoundLogic.hs

@@ -212,9 +212,9 @@ soundAngle p w
             . radToDeg
             . normalizeAngle
             . (+ pi)
-            $ argV (vNormal (p -.- earPos)) - _cameraRot (_cWorld w)
+            $ argV (vNormal (p -.- earPos)) - _cwcRot (_cwCam (_cWorld w))
   where
-    earPos = _cameraViewFrom (_cWorld w)
+    earPos = w ^. cWorld . cwCam . cwcViewFrom
 
 {- | Uses the first free origin from a list.
 Does nothing if all origins are already creating sounds.

src/Dodge/StartNewGame.hs

@@ -22,6 +22,7 @@ startSeedGame _ i = tryConcEffect True "GENERATING" (startSeedGameConc i)
 startSeedGameConc :: Int -> IO (Universe -> Maybe Universe)
 startSeedGameConc seed = do
     w <- generateWorldFromSeed seed
+    writeFile "saveSlot/seed" $ show seed
     return $ Just
         . saveWorldInSlot (LevelStartSlot 0)
         . (uvScreenLayers .~ [])

src/Dodge/Update/Camera.hs

@@ -45,11 +45,11 @@ updateCamera uv =
 moveZoomCamera :: Universe -> Universe
 moveZoomCamera uv =
     uv
-        & uvWorld . cWorld . cameraCenter .~ newcen
+        & uvWorld . cWorld . cwCam . cwcCenter .~ newcen
-        & uvWorld . cWorld . cameraViewFrom .~ newvf
+        & uvWorld . cWorld . cwCam . cwcViewFrom .~ newvf
-        & uvWorld . cWorld . cameraZoom .~ newzoom
+        & uvWorld . cWorld . cwCam . cwcZoom .~ newzoom
-        & uvWorld . cWorld . defaultZoom .~ newDefaultZoom
+        & uvWorld . cWorld . cwCam . cwcDefaultZoom .~ newDefaultZoom
-        & uvWorld . cWorld . itemZoom .~ newItemZoom
+        & uvWorld . cWorld . cwCam . cwcItemZoom .~ newItemZoom
   where
     cfig = _uvConfig uv
     w = _uvWorld uv
@@ -64,7 +64,7 @@ moveZoomCamera uv =
         guard (SDL.ButtonRight `M.member` _mouseButtons w)
         yourItem w ^? _Just . itScope . scopePos
     newcen = cpos +.+ fromMaybe (V2 0 0) mscopeoffset +.+ offset
-    offset = rotateV (_cameraRot (_cWorld w)) $ ((newzoom - newDefaultZoom) / (newDefaultZoom * newzoom)) *.* _mousePos w
+    offset = rotateV (w ^. cWorld . cwCam . cwcRot) $ ((newzoom - newDefaultZoom) / (newDefaultZoom * newzoom)) *.* _mousePos w
     --newzoom = changeZoom (_cameraZoom w) idealZoom'
     newzoom = case yourItem w ^? _Just . itScope of
         Just zs@ZoomScope{} -> _scopeZoom zs
@@ -72,17 +72,17 @@ moveZoomCamera uv =
     idealDefaultZoom = clipZoom wallZoom
     newDefaultZoom = case yourItem w ^? _Just . itScope of
         Just zs@ZoomScope{} -> _scopeZoom zs
-        _ -> changeZoom (_defaultZoom (_cWorld w)) idealDefaultZoom
+        _ -> changeZoom (w ^. cWorld . cwCam . cwcDefaultZoom) idealDefaultZoom
     idealItemZoom = fromMaybe 1 $ do
         guard $ crIsAiming (you w)
         zoomFromItem' <$> (yourItem w ^? _Just . itUse . heldAim . aimZoom)
-    newItemZoom = changeZoom (_itemZoom (_cWorld w)) idealItemZoom
+    newItemZoom = changeZoom (w ^. cWorld . cwCam . cwcItemZoom) idealItemZoom
     changeZoom curZoom idealZoom
         | curZoom > idealZoom + 0.01 = ((zoomOutSpeed -1) * curZoom + idealZoom) / zoomOutSpeed
         | curZoom < idealZoom - 0.01 = ((zoomInSpeed -1) * curZoom + idealZoom) / zoomInSpeed
         | otherwise = idealZoom
     --wallZoom = farWallDist newvf cfig w
-    wallZoom = min4 (_boundDist (_cWorld w))
+    wallZoom = min4 (w ^. cWorld . cwCam . cwcBoundDist)
     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 (_eeViewDist . _equipEffect . _itUse) $ getCrEquipment $ you w
@@ -135,7 +135,7 @@ zoomInLongGun w
     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 (_cWorld w)) $ _mousePos w
+    mousep = rotateV (w ^. cWorld . cwCam . cwcRot) $ _mousePos w
 
 zoomOutLongGun :: World -> World
 zoomOutLongGun w
@@ -171,11 +171,11 @@ rotateToOverlappingWall w =
     p = _crPos (you w)
 
 doWallRotate :: Wall -> World -> World
-doWallRotate wl' w = rotateUsing $ (argV . uncurry (-.-) $ _wlLine wl') - _cameraRot (_cWorld w)
+doWallRotate wl' w = rotateUsing $ (argV . uncurry (-.-) $ _wlLine wl') - (w ^. cWorld . cwCam . cwcRot)
   where
     rotateUsing a
-        | b - b' > 0.01 = w & cWorld . cameraRot +~ 0.01
+        | b - b' > 0.01 = w & cWorld . cwCam . cwcRot +~ 0.01
-        | b - b' < negate 0.01 = w & cWorld . cameraRot -~ 0.01
+        | b - b' < negate 0.01 = w & cWorld . cwCam . cwcRot -~ 0.01
         | otherwise = w
       where
         --b = a * (2 / pi)
@@ -185,7 +185,7 @@ doWallRotate wl' w = rotateUsing $ (argV . uncurry (-.-) $ _wlLine wl') - _camer
 rotateCameraBy :: Float -> World -> World
 rotateCameraBy x w =
     w
-        & cWorld . cameraRot +~ x
+        & cWorld . cwCam . cwcRot +~ x
         & cWorld . creatures . ix 0 . crInv . ix (crSel (_creatures (_cWorld w) IM.! 0))
             . itScope
             . scopePos
@@ -221,8 +221,8 @@ clipZoom = min 20 . max 0.2
 
 setViewDistance :: Configuration -> World -> World
 setViewDistance cfig w =
-    w & cWorld . viewDistance
+    w & cWorld . cwCam . cwcViewDistance
-        .~ sqrt (halfWidth cfig ** 2 + halfHeight cfig ** 2) / _cameraZoom (_cWorld w)
+        .~ sqrt (halfWidth cfig ** 2 + halfHeight cfig ** 2) / (w ^. cWorld . cwCam . cwcZoom)
 
 --    .~ max (halfWidth cfig) (halfHeight cfig) / _cameraZoom w
 
@@ -245,7 +245,7 @@ farWallDistDirection p w =
     boundPoints $
         S.map f vps
   where
-    f q = (rotateV (negate $ _cameraRot (_cWorld w)) . (-.- p)) (foldl' findPoint q (wls q))
+    f q = (rotateV (negate $ (w ^. cWorld . cwCam . cwcRot)) . (-.- p)) (foldl' findPoint q (wls q))
     wls q = filter wlIsOpaque $ wlsNearSeg p q w
     findPoint q = fromMaybe q . uncurry (intersectSegSeg p q) . _wlLine
     vps = streamViewpoints p w

src/Dodge/Update/UsingInput.hs

@@ -60,7 +60,7 @@ updatePressedButtons' pkeys w
         w & hammers . ix DoubleMouseHam .~ HammerDown
     | isDown ButtonRight && inTopInv = w
     | isDown ButtonMiddle =
-        w & cWorld . cameraRot -~ rotation
+        w & cWorld . cwCam . cwcRot -~ rotation
             & cWorld . clickMousePos .~ _mousePos w
     | isDown ButtonLeft = w & hammers . ix DoubleMouseHam .~ HammerDown
     | otherwise = w

src/Dodge/WorldEffect.hs

@@ -58,7 +58,7 @@ accessTerminal mtmid w = case mtmid of
 
 torqueCr :: Float -> Int -> World -> World
 torqueCr x cid w
-    | cid == 0 = set randGen g $ over (cWorld . cameraRot) (+ rot) w
+    | cid == 0 = set randGen g $ over (cWorld . cwCam . cwcRot) (+ rot) w
     | otherwise = set randGen g $ over (cWorld . creatures . ix cid . crDir) (+ rot) w
   where
     (rot, g) = randomR (- x, x) $ _randGen w

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 $ _cWorld w -- ++ [_cameraViewFrom w]
+    (xs,ys) = unzip $ map (sizeZoneOfPoint x') $ w ^. cWorld . cwCam . cwcBoundBox
     sizeZoneOfPoint s (V2 x y) = (f x, f y)
       where
         f = floor . (/ s)

src/Dodge/Zoning/World.hs

@@ -2,6 +2,7 @@ module Dodge.Zoning.World where
 
 import Dodge.Data.World
 import Geometry.Data
+import Control.Lens
 
 zoneOfSight' :: Float -> World -> [Int2]
 zoneOfSight' s w =
@@ -10,7 +11,7 @@ zoneOfSight' s w =
     , b <- [minimum ys .. maximum ys]
     ]
   where
-    (xs, ys) = unzip $ map sizeZoneOfPoint $ _boundBox (_cWorld w) -- ++ [_cameraViewFrom w]
+    (xs, ys) = unzip $ map sizeZoneOfPoint $ w ^. cWorld . cwCam . cwcBoundBox
     sizeZoneOfPoint (V2 x y) = (f x, f y)
       where
         f = floor . (/ s)

src/Picture/Base.hs

@@ -1,56 +1,56 @@
-{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE BangPatterns #-}
-module Picture.Base
+{-# LANGUAGE TupleSections #-}
-    ( module Picture.Data
-    , module Color
-    , blank
-    , polygon
-    , polygonWire
-    , polygonZ
-    , polygonCol
-    , poly3
-    , poly3Col
-    , bezierQuad
-    , arc
-    , arcSolid
-    , thickArc
-    , thickCircle
-    , thickLine
-    , lineThick
-    , thickLineCol
-    , circleSolid
-    , circleSolidCol
-    , circle
-    , line
-    , lineCol
-    , text
-    , centerText
-    , stackText
-    , pictures
-    , concatMapPic
-    , appendPic
-    , tranRot
-    , translate
-    , translate3
-    , rotate
-    , scale
-    , color
-    , zeroZ
-    , setDepth
-    , addDepth
-    , setLayer
-    , mirroryz
-    , mirrorxz
-    , overPos
-    , picMap
-    )
-  where
-import Geometry
-import Picture.Data
-import Color
 
+module Picture.Base (
+    module Picture.Data,
+    module Color,
+    blank,
+    polygon,
+    polygonWire,
+    polygonZ,
+    polygonCol,
+    poly3,
+    poly3Col,
+    bezierQuad,
+    arc,
+    arcSolid,
+    thickArc,
+    thickCircle,
+    thickLine,
+    lineThick,
+    thickLineCol,
+    circleSolid,
+    circleSolidCol,
+    circle,
+    line,
+    lineCol,
+    text,
+    centerText,
+    stackText,
+    pictures,
+    concatMapPic,
+    appendPic,
+    tranRot,
+    translate,
+    translate3,
+    rotate,
+    scale,
+    color,
+    zeroZ,
+    setDepth,
+    addDepth,
+    setLayer,
+    mirroryz,
+    mirrorxz,
+    overPos,
+    picMap,
+) where
+
+import Color
 --import qualified Streaming.Prelude as S
 import Data.Foldable
+import Geometry
+import Picture.Data
 
 blank :: Picture
 {-# INLINE blank #-}
@@ -74,8 +74,6 @@ polygon = picFormat . map f . polyToTris
   where
     f (V2 x y) = Verx (V3 x y 0) black [] BottomLayer polyNum
 
-
-
 polygonZ :: [Point2] -> Float -> Picture
 {-# INLINE polygonZ #-}
 polygonZ ps z = picFormat . map (f . zeroZ) $ polyToTris ps
@@ -103,7 +101,8 @@ bezierQuad :: Color -> Color -> Float -> Float -> Point2 -> Point2 -> Point2 ->
 bezierQuad cola colc ra rc a b c
     | a == b && b == c = blank
     | a == b || b == c = bezierQuad cola colc ra rc a (0.5 *.* (a +.+ c)) c
-    | otherwise = bzhelp
+    | otherwise =
+        bzhelp
             [ (aIn, cola, V2 (fa aIn) (fc aIn), V2 1 0)
             , (aIn, cola, V2 (fa aIn) (fc aIn), V2 1 0)
             , (cIn, colc, V2 (fa cIn) (fc cIn), V2 0 1)
@@ -114,12 +113,14 @@ bezierQuad cola colc ra rc a b c
             ]
   where
     colb = mixColors 0.5 0.5 cola colc
-    b2a | isLHS a b c = a -.- b
+    b2a
+        | isLHS a b c = a -.- b
         | otherwise = b -.- a
     aRadVec = 0.5 * ra *.* normalizeV (vNormal b2a)
     aX = a -.- aRadVec
     aIn = a +.+ aRadVec
-    b2c | isLHS a b c = b -.- c
+    b2c
+        | isLHS a b c = b -.- c
         | otherwise = c -.- b
     cRadVec = 0.5 * rc *.* normalizeV (vNormal b2c)
     cX = c -.- cRadVec
@@ -146,8 +147,7 @@ extrapolate (V2 ox oy) (V2 ax ay) (V2 bx by) (V2 x y) =
         + y * (bx - ax)
         + (ax * by - bx * ay)
     )
-    / 
+        / ( ox * (ay - by)
-    (       ox * ( ay - by )
                 + ax * (by - oy)
                 + bx * (oy - ay)
           )
@@ -210,7 +210,7 @@ appendPic :: Picture -> Picture -> Picture
 appendPic = (<>)
 
 pictures :: Foldable t => t Picture -> Picture
-{-# INLINABLE pictures #-}
+{-# INLINEABLE pictures #-}
 pictures = fold
 
 makeArc :: Float -> Point2 -> [Point2]
@@ -226,7 +226,10 @@ circleSolid = circleSolidCol white white
 
 circleSolidCol :: Color -> Color -> Float -> Picture
 {-# INLINE circleSolidCol #-}
-circleSolidCol colC colE r = picFormat $ map f
+circleSolidCol colC colE r =
+    picFormat $
+        map
+            f
             [ (V3 (- r) r 0, colC)
             , (V3 (- r) (- r) 0, colE)
             , (V3 r (- r) 0, black)
@@ -240,7 +243,7 @@ circle rad = thickArc 0 (2*pi) rad 1
 
 centerText :: String -> Picture
 {-# INLINE centerText #-}
-centerText s = translate (50 * (negate . fromIntegral $ length s - 1)) 0 $ text s
+centerText s = translate (25 + 50 * (negate . fromIntegral $ length s - 1)) 0 $ text s
 
 stackText :: [String] -> Picture
 {-# INLINE stackText #-}
@@ -287,12 +290,14 @@ thickLineCol t = pictures . f
   where
     f ((x, c) : (y, c') : ys)
         | x == y = f ((x, c) : ys)
-      | otherwise   = polygonCol 
+        | otherwise =
+            polygonCol
                 [ (x +.+ n x y, c)
                 , (x -.- n x y, c)
                 , (y -.- n x y, c')
                 , (y +.+ n x y, c')
-        ] : f ((y,c'):ys)
+                ] :
+            f ((y, c') : ys)
     f _ = []
     n a b = (t * 0.5) *.* squashNormalizeV (vNormal (a -.- b))
 
@@ -300,26 +305,33 @@ thickCircle :: Float -> Float -> Picture
 {-# INLINE thickCircle #-}
 thickCircle = thickArc 0 (2 * pi)
 
-arcSolid
+arcSolid ::
-    :: Float -- ^ Start angle
+    -- | Start angle
-    -> Float -- ^ End angle
+    Float ->
-    -> Float -- ^ Radius
+    -- | End angle
-    -> Picture
+    Float ->
+    -- | Radius
+    Float ->
+    Picture
 {-# INLINE arcSolid #-}
 arcSolid startA endA rad = polygon $ V2 0 0 : makeArc rad (V2 startA endA)
 
-arc
+arc ::
-    :: Float -- ^ Start angle
+    -- | Start angle
-    -> Float -- ^ End angle
+    Float ->
-    -> Float -- ^ Radius
+    -- | End angle
-    -> Picture
+    Float ->
+    -- | Radius
+    Float ->
+    Picture
 arc startA endA rad = thickArc startA endA rad 1
 {-# INLINE arc #-}
 
 thickArc :: Float -> Float -> Float -> Float -> Picture
 {-# INLINE thickArc #-}
 thickArc startA endA rad wdth
-    | endA - startA > (pi/ 2) = pictures 
+    | endA - startA > (pi / 2) =
+        pictures
             [ thickArc (startA + pi / 2) endA rad wdth
             , thickArcHelp startA (startA + pi / 2) r w
             ]
@@ -330,7 +342,10 @@ thickArc startA endA rad wdth
 
 thickArcHelp :: Float -> Float -> Float -> Float -> Picture
 {-# INLINE thickArcHelp #-}
-thickArcHelp startA endA rad wdth = picFormat $ map f
+thickArcHelp startA endA rad wdth =
+    picFormat $
+        map
+            f
             [ (V3 0 0 0, black, V3 0 0 wdth)
             , (V3 xa ya 0, black, V3 1 0 wdth)
             , (V3 xb yb 0, black, V3 1 1 wdth)
@@ -345,7 +360,6 @@ thickArcHelp startA endA rad wdth = picFormat $ map f
     (V2 xc yc) = rotateV endA (V2 rad 0)
     f (pos, col, V3 a b c) = Verx pos col [a, b, c] BottomLayer arcNum
 
-
 -- Currently the lens version is much slower
 overPos :: (Point3 -> Point3) -> Verx -> Verx
 {-# INLINE overPos #-}