diff --git a/appDodge/Main.hs b/appDodge/Main.hs index 9c4a65a7c..a140ffec3 100644 --- a/appDodge/Main.hs +++ b/appDodge/Main.hs @@ -93,21 +93,10 @@ firstWorldLoad theConfig = do , _uvMSeed = mseed , _uvLastFrameTicks = 0 , _uvFrameTicks = 0 + , _uvRAMSave = Nothing + , _uvDebugInfo = mempty } - return $ - Universe - { _uvWorld = splashScreen - , _uvConfig = theConfig - , _preloadData = pdata - , _uvScreenLayers = [splashMenu u] - , _uvIOEffects = return - , _uvTestString = testStringInit - , _uvSideEffects = mempty - , _uvCanContinue = cancontinue - , _uvMSeed = mseed - , _uvLastFrameTicks = 0 - , _uvFrameTicks = 0 - } + return $ u & uvScreenLayers .~ [splashMenu u] theUpdateStep :: SDL.Window -> Universe -> IO Universe theUpdateStep win = doSideEffects <=< updateRenderSplit win diff --git a/src/Dodge/Data/RightButtonOptions.hs b/src/Dodge/Data/RightButtonOptions.hs index eba83d4f7..3a26869cc 100644 --- a/src/Dodge/Data/RightButtonOptions.hs +++ b/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 -deriveJSON defaultOptions ''ActivateEquipment +makeLenses ''ModifyEquipmentActivation +deriveJSON defaultOptions ''ModifyEquipmentActivation deriveJSON defaultOptions ''AllocateEquipment deriveJSON defaultOptions ''RightButtonOptions diff --git a/src/Dodge/Data/Universe.hs b/src/Dodge/Data/Universe.hs index 2c9cc8477..027a7e7e2 100644 --- a/src/Dodge/Data/Universe.hs +++ b/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) diff --git a/src/Dodge/Save.hs b/src/Dodge/Save.hs index 5ed66711c..7e6121671 100644 --- a/src/Dodge/Save.hs +++ b/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 ---clearKeys = (keys .~ mempty) . (mouseButtons .~ mempty) - ---saveLevelStartSlot :: Universe -> Universe -----saveLevelStartSlot = id ---saveLevelStartSlot = saveWorldInSlot LevelStartSlot - ---saveLevelStartSlot = sideEffects %~ (fmap (undefined) . ) +doQuickload :: Universe -> Universe +doQuickload u = fromMaybe (loadSaveSlot QuicksaveSlot u) $ do + w <- u ^. uvRAMSave + return $ u & uvWorld .~ w diff --git a/src/Dodge/Update/Input/InGame.hs b/src/Dodge/Update/Input/InGame.hs index 45b990809..77b2af840 100644 --- a/src/Dodge/Update/Input/InGame.hs +++ b/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 diff --git a/src/Dodge/Zoning/Base.hs b/src/Dodge/Zoning/Base.hs index 8a8fde7de..7b427f8fc 100644 --- a/src/Dodge/Zoning/Base.hs +++ b/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]