Move configuration from world to universe

src/Dodge/Menu.hs

@@ -40,7 +40,7 @@ debugMenu :: ScreenLayer
 debugMenu  = OptionScreen
     { _scTitle = const "OPTIONS:GAMEPLAY"
     , _scOptions = debugMenuOptions
-    , _scDefaultEff = popScreen . over uvWorld writeConfig
+    , _scDefaultEff = popScreen . writeConfig
     , _scOptionFlag = NormalOptions
     }
 debugMenuOptions :: [MenuOption]
@@ -53,12 +53,12 @@ debugMenuOptions =
     ]
   where
     doption scode l t rec 
-        = Toggle scode (Just . (uvWorld . config . l %~ not)) (\w -> t ++ ":" ++ show (rec $ _config (_uvWorld w)))
+        = Toggle scode (Just . (config . l %~ not)) (\w -> t ++ ":" ++ show (rec $ _config w))
 gameplayMenu :: ScreenLayer
 gameplayMenu  = OptionScreen
     { _scTitle = const "OPTIONS:GAMEPLAY"
     , _scOptions = gameplayMenuOptions
-    , _scDefaultEff = popScreen . over uvWorld writeConfig
+    , _scDefaultEff = popScreen . writeConfig
     , _scOptionFlag = NormalOptions
     }
 gameplayMenuOptions :: [MenuOption]
@@ -67,33 +67,33 @@ gameplayMenuOptions =
     , option ScancodeS show_sound     "SHOW VISUAL SOUNDS" _show_sound
     ]
   where
-    option scode l t rec = Toggle scode (Just . (uvWorld . config . l %~ not)) 
-        (\w -> t ++ ":" ++ show (rec $ _config (_uvWorld w)))
+    option scode l t rec = Toggle scode (Just . (config . l %~ not)) 
+        (\w -> t ++ ":" ++ show (rec $ _config w))
 
 soundMenu :: ScreenLayer
 soundMenu = OptionScreen
     { _scTitle = const "OPTIONS:VOLUME"
     , _scOptions = soundMenuOptions
-    , _scDefaultEff = popScreen . over uvWorld writeConfig
+    , _scDefaultEff = popScreen . writeConfig
     , _scOptionFlag = NormalOptions
     }
 soundMenuOptions :: [MenuOption]
 soundMenuOptions =
     [ Toggle2 ScancodeY (master dec . sw)
-        ScancodeU (master inc . sw) (\w -> "MASTER VOLUME:" ++ mavol (_uvWorld w))
+        ScancodeU (master inc . sw) (\w -> "MASTER VOLUME:" ++ mavol w)
     , Toggle2 ScancodeH (soundEffs dec . sw)
-        ScancodeJ (soundEffs inc . sw) (\w -> "EFFECTS VOLUME:" ++ snvol (_uvWorld w))
+        ScancodeJ (soundEffs inc . sw) (\w -> "EFFECTS VOLUME:" ++ snvol w)
     , Toggle2 ScancodeN (music dec . sw)
-        ScancodeM (music inc . sw) (\w -> "MUSIC VOLUME:" ++ muvol (_uvWorld w))
+        ScancodeM (music inc . sw) (\w -> "MUSIC VOLUME:" ++ muvol w)
     ]
   where
     dec x = max 0 (x - 0.1)
     inc x = min 1 (x + 0.1)
     --sw w = w & sideEffects %~ (setVol (_config w) : )
-    sw w = w & uvWorld . sideEffects %~ setVolThen (_config (_uvWorld w))
-    master g    = Just . (uvWorld . config . volume_master %~ g)
-    soundEffs g = Just . (uvWorld . config . volume_sound %~ g)
-    music g     = Just . (uvWorld . config . volume_music %~ g)
+    sw w = w & uvWorld . sideEffects %~ setVolThen (_config w)
+    master g    = Just . (config . volume_master %~ g)
+    soundEffs g = Just . (config . volume_sound %~ g)
+    music g     = Just . (config . volume_music %~ g)
     cfig w = _config w
     mavol w = f $ _volume_master $ cfig w
     snvol w = f $ _volume_sound  $ cfig w
@@ -106,27 +106,27 @@ pushScreen ml w = Just $ w & menuLayers %~ (ml :)
 popScreen :: Universe -> Maybe Universe
 popScreen = Just . (menuLayers %~ tail)
 
-writeConfig :: World -> World
-writeConfig w = w & sideEffects %~ saveConfig (_config w)
+writeConfig :: Universe -> Universe
+writeConfig w = w & uvWorld . sideEffects %~ saveConfig (_config w)
 
 graphicsMenu :: ScreenLayer
 graphicsMenu = OptionScreen
     { _scTitle = const "OPTIONS:GRAPHICS"
     , _scOptions = graphicsMenuOptions
-    , _scDefaultEff = popScreen . over uvWorld writeConfig
+    , _scDefaultEff = popScreen . writeConfig
     , _scOptionFlag = NormalOptions
     }
 graphicsMenuOptions :: [MenuOption]
 graphicsMenuOptions =
-    [ Toggle ScancodeW (Just . (uvWorld . config . wall_textured %~ not))  wtextstring
+    [ Toggle ScancodeW (Just . (config . wall_textured %~ not))  wtextstring
     , Toggle ScancodeS upf resostring
-    , Toggle ScancodeD (Just . (uvWorld . config . cloud_shadows %~ not)) cshadstring
+    , Toggle ScancodeD (Just . (config . cloud_shadows %~ not)) cshadstring
     ]
   where
-    wtextstring w = "WALL TEXTURES:" ++ show (_wall_textured $ _config (_uvWorld w))
-    resostring w  = "RESOLUTION: 1/" ++ show (_resolution_factor $ _config (_uvWorld w))
-    upf w = Just $ over uvWorld updateFramebufferSize $ w & uvWorld . config . resolution_factor %~ cycleResolution
-    cshadstring w = "CLOUD SHADOWS:" ++ show (_cloud_shadows $ _config (_uvWorld w))
+    wtextstring w = "WALL TEXTURES:" ++ show (_wall_textured $ _config w)
+    resostring w  = "RESOLUTION: 1/" ++ show (_resolution_factor $ _config w)
+    upf w = Just $ updateFramebufferSize $ w & config . resolution_factor %~ cycleResolution
+    cshadstring w = "CLOUD SHADOWS:" ++ show (_cloud_shadows $ _config w)
 
 cycleResolution :: (Eq a, Num a, Num p) => a -> p
 cycleResolution 1 = 2
@@ -160,12 +160,14 @@ pauseMenuOptions =
 startNewGame :: Universe -> Maybe Universe
 startNewGame w = Just $ w
     & menuLayers .~ [WaitScreen (const "GENERATING...") 1]
-    & uvWorld . sideEffects .~  uvWorld (uvWorldSideEffects i (_uvWorld w))
+    & uvWorld . sideEffects .~ \u -> do 
+        w' <- generateWorldFromSeed i
+        return (u & uvWorld .~ w')
   where
     i = fst $ random (_randGen (_uvWorld w))
 
-uvWorldSideEffects :: Int -> World -> b -> IO World
-uvWorldSideEffects i w = const (generateWorldFromSeed i <&> config .~ _config w)
+--uvWorldSideEffects :: Int -> Universe -> b -> IO Universe
+--uvWorldSideEffects i w = const (generateWorldFromSeed i <&> config .~ _config w)
 
 
 -- | hacky
@@ -175,11 +177,12 @@ scodeToChar = toEnum . (+ 61) . fromIntegral . toNumber
 --charToScode :: Char -> Scancode
 --charToScode = Scancode . fromIntegral . (\x -> x - 61) . fromEnum
 
-updateFramebufferSize :: World -> World
-updateFramebufferSize w = w & sideEffects %~ sideEffectUpdatePreload divRes x y
+updateFramebufferSize :: Universe -> Universe
+updateFramebufferSize u = u & uvWorld . sideEffects %~ sideEffectUpdatePreload divRes x y
   where 
-    (x,y) = (round $ getWindowX w, round $ getWindowY w)
-    divRes = w ^. config . resolution_factor
+    (x,y) = (round $ getWindowX cfig, round $ getWindowY cfig)
+    cfig = _config u
+    divRes = u ^. config . resolution_factor
     
 --levelMenu :: Int -> ScreenLayer
 --levelMenu x = OptionScreen