Add true quicksave and guickload
This commit is contained in:
@@ -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
|
||||
|
||||
@@ -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)
|
||||
|
||||
+10
-10
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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]
|
||||
|
||||
Reference in New Issue
Block a user