Add true quicksave and guickload

appDodge/Main.hs

@@ -93,21 +93,10 @@ firstWorldLoad theConfig = do
                 , _uvMSeed = mseed
                 , _uvLastFrameTicks = 0
                 , _uvFrameTicks = 0
+                , _uvRAMSave = Nothing
+                , _uvDebugInfo = mempty
                 }
-    return $
+    return $ u & uvScreenLayers .~ [splashMenu u]
-        Universe
-            { _uvWorld = splashScreen
-            , _uvConfig = theConfig
-            , _preloadData = pdata
-            , _uvScreenLayers = [splashMenu u]
-            , _uvIOEffects = return
-            , _uvTestString = testStringInit
-            , _uvSideEffects = mempty
-            , _uvCanContinue = cancontinue
-            , _uvMSeed = mseed
-            , _uvLastFrameTicks = 0
-            , _uvFrameTicks = 0
-            }
 
 theUpdateStep :: SDL.Window -> Universe -> IO Universe
 theUpdateStep win = doSideEffects <=< updateRenderSplit win

src/Dodge/Data/RightButtonOptions.hs

@@ -17,11 +17,11 @@ data RightButtonOptions
         , _opSel :: Int
         , _opItemID :: Int
         , _opAllocateEquipment :: AllocateEquipment
-        , _opActivateEquipment :: ActivateEquipment
+        , _opActivateEquipment :: ModifyEquipmentActivation
         }
     --deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
-data ActivateEquipment
+data ModifyEquipmentActivation
     = ActivateEquipment {_activateEquipment :: Int}
     | DeactivateEquipment {_deactivateEquipment :: Int}
     | ActivateDeactivateEquipment {_activateEquipment :: Int, _deactivateEquipment :: Int}
@@ -53,7 +53,7 @@ data AllocateEquipment
 
 makeLenses ''RightButtonOptions
 makeLenses ''AllocateEquipment
-makeLenses ''ActivateEquipment
+makeLenses ''ModifyEquipmentActivation
-deriveJSON defaultOptions ''ActivateEquipment
+deriveJSON defaultOptions ''ModifyEquipmentActivation
 deriveJSON defaultOptions ''AllocateEquipment
 deriveJSON defaultOptions ''RightButtonOptions

src/Dodge/Data/Universe.hs

@@ -23,6 +23,7 @@ import Dodge.Data.Config
 import Dodge.Data.World
 import Loop.Data
 import Picture.Data
+import Linear
 --import SDL (Scancode)
 
 data Universe = Universe
@@ -37,8 +38,20 @@ data Universe = Universe
     , _uvMSeed :: Maybe Int
     , _uvLastFrameTicks :: Word32
     , _uvFrameTicks :: Word32
+    , _uvRAMSave :: Maybe World
+    , _uvDebugInfo :: [DebugInfo]
     }
 
+data DebugInfo
+    = DebugWorldPos 
+        { _debugWorldPos :: V3 Float
+        , _debugMessage :: [String]
+        }
+    | DebugScreenPos
+        { _debugScreenPos :: V2 Float
+        , _debugMessage :: [String]
+        }
+
 data SideEffect
     = NewSideEffect
         { _ceSideEffect :: IO (Universe -> Maybe Universe)

src/Dodge/Save.hs

@@ -2,6 +2,7 @@ module Dodge.Save (
     saveWorldInSlot,
     loadSaveSlot,
     doQuicksave,
+    doQuickload,
 --    saveLevelStartSlot,
     writeSaveSlot,
     readSaveSlot,
@@ -9,6 +10,7 @@ module Dodge.Save (
 ) where
 
 
+import Data.Maybe
 import Dodge.WorldLoad
 import Dodge.Path.Translate
 import Data.Graph.Inductive (labEdges, labNodes)
@@ -70,16 +72,14 @@ reloadLevelStart :: Universe -> Universe
 reloadLevelStart = loadSaveSlot (LevelStartSlot 0)
 
 loadSaveSlot :: SaveSlot -> Universe -> Universe
-loadSaveSlot slot = blockingLoad "LOADING SAVE" $ readSaveSlot slot
+loadSaveSlot slot = blockingLoad ("DESERIALISING "++ show slot) $ readSaveSlot slot
 
 doQuicksave :: Universe -> Universe
-doQuicksave = saveWorldInSlot QuicksaveSlot
+doQuicksave u = u
+    & uvRAMSave ?~ _uvWorld u
+    & saveWorldInSlot QuicksaveSlot
 
---clearKeys :: World -> World
+doQuickload :: Universe -> Universe
---clearKeys = (keys .~ mempty) . (mouseButtons .~ mempty)
+doQuickload u = fromMaybe (loadSaveSlot QuicksaveSlot u) $ do
-
+    w <- u ^. uvRAMSave
---saveLevelStartSlot :: Universe -> Universe
+    return $ u & uvWorld .~ w
-----saveLevelStartSlot = id
---saveLevelStartSlot = saveWorldInSlot LevelStartSlot
-
---saveLevelStartSlot = sideEffects %~ (fmap  (undefined) . )

src/Dodge/Update/Input/InGame.hs

@@ -109,7 +109,7 @@ updateKeyInGame uv sc pt = case pt of
 updateInitialPressInGame :: Universe -> Scancode -> Universe
 updateInitialPressInGame uv sc = case sc of
     ScancodeF5 -> doQuicksave uv
-    ScancodeF9 -> loadSaveSlot QuicksaveSlot uv
+    ScancodeF9 -> doQuickload uv
     ScancodeEscape -> pauseGame uv
     ScancodeSpace -> over uvWorld spaceAction uv
     ScancodeP -> pauseGame uv

src/Dodge/Zoning/Base.hs

@@ -21,6 +21,7 @@ import Geometry.Zone
 import qualified IntMapHelp as IM
 
 zoneOfCirc :: Float -> Point2 -> Float -> [Int2]
+{-# INLINE zoneOfCirc #-}
 zoneOfCirc zsize p r = zoneOfRect zsize (p +.+ V2 r r) (p -.- V2 r r)
 
 zoneOfRect :: Float -> Point2 -> Point2 -> [Int2]