Fix reloading of start of level

This commit is contained in:
2021-09-13 00:34:14 +01:00
parent 49274064a0
commit d11d19c9e8
4 changed files with 27 additions and 36 deletions
+2 -28
View File
@@ -6,26 +6,20 @@ module Dodge.Event.Keyboard
) )
where where
import Dodge.Data import Dodge.Data
--import Dodge.Data.Menu import Dodge.Save
import Dodge.Picture.Layer
import Dodge.Base import Dodge.Base
import Dodge.Creature.Action import Dodge.Creature.Action
import Dodge.Config.KeyConfig import Dodge.Config.KeyConfig
--import Dodge.Room.Placement
import Dodge.LightSources
import Dodge.LevelGen
import Dodge.Creature.Inanimate
import qualified Data.IntMap.Strict as IM
import Dodge.Event.Test import Dodge.Event.Test
import Dodge.Event.Menu import Dodge.Event.Menu
import Dodge.Menu import Dodge.Menu
import qualified Data.IntMap.Strict as IM
import SDL import SDL
import Data.Maybe import Data.Maybe
import qualified Data.Set as S import qualified Data.Set as S
import Control.Lens import Control.Lens
import Picture
{- | Handles keyboard press and release. {- | Handles keyboard press and release.
On release, remove scancode from the 'Set' of pressed keys. On release, remove scancode from the 'Set' of pressed keys.
On press, adds the scancode, and perhaps applies a direct effect: On press, adds the scancode, and perhaps applies a direct effect:
@@ -47,12 +41,6 @@ handlePressedKey _ scode w
| null (_menuLayers w) = handlePressedKeyInGame scode w | null (_menuLayers w) = handlePressedKeyInGame scode w
| otherwise = handlePressedKeyInMenu (head $ _menuLayers w) scode w | otherwise = handlePressedKeyInMenu (head $ _menuLayers w) scode w
doQuicksave :: World -> World
doQuicksave w = w & quicksaveLevel ?~ clearKeys w
clearKeys :: World -> World
clearKeys = (keys .~ S.empty) . (mouseButtons .~ S.empty)
handlePressedKeyInGame :: Scancode -> World -> Maybe World handlePressedKeyInGame :: Scancode -> World -> Maybe World
handlePressedKeyInGame scode w handlePressedKeyInGame scode w
| scode == escapeKey (_keyConfig w) = Nothing | scode == escapeKey (_keyConfig w) = Nothing
@@ -64,8 +52,6 @@ handlePressedKeyInGame scode w
| scode == spaceActionKey (_keyConfig w) = Just $ spaceAction w | scode == spaceActionKey (_keyConfig w) = Just $ spaceAction w
| scode == rotateCameraPlusKey (_keyConfig w) = Just $ w & cameraRot +~ 0.01 | scode == rotateCameraPlusKey (_keyConfig w) = Just $ w & cameraRot +~ 0.01
| scode == rotateCameraMinusKey (_keyConfig w) = Just $ w & cameraRot -~ 0.01 | scode == rotateCameraMinusKey (_keyConfig w) = Just $ w & cameraRot -~ 0.01
| scode == ScancodeF5 = Just $ dropLight w
| scode == ScancodeF6 = Just $ dropLight' w
| scode == ScancodeX = Just $ w & inventoryMode %~ toggleInv TweakInventory | scode == ScancodeX = Just $ w & inventoryMode %~ toggleInv TweakInventory
| scode == ScancodeC = Just $ w & inventoryMode %~ toggleInv CombineInventory | scode == ScancodeC = Just $ w & inventoryMode %~ toggleInv CombineInventory
| scode == ScancodeI = Just $ w & inventoryMode %~ toggleInv InspectInventory | scode == ScancodeI = Just $ w & inventoryMode %~ toggleInv InspectInventory
@@ -100,15 +86,3 @@ toggleMap w = w & carteDisplay %~ not
escapeMap :: World -> World escapeMap :: World -> World
escapeMap w = w & carteDisplay .~ False escapeMap w = w & carteDisplay .~ False
dropLight :: World -> World
dropLight w = placeLS ls dec pos 0 w
where --(rot, g) = randomR (-pi,pi) $ _randGen w
(V2 x y) = _crPos (you w)
pos = V3 x y 0
ls = lightAt pos 0
dec = onLayer PtLayer $ color white $ circleSolid 8
dropLight' :: World -> World
dropLight' w = placeCr (lamp 30) pos 0 w
where
pos = _crPos(you w)
+2 -1
View File
@@ -1,5 +1,6 @@
module Dodge.Initialisation where module Dodge.Initialisation where
import Dodge.Default.World import Dodge.Default.World
import Dodge.Save
import Dodge.Data import Dodge.Data
import Dodge.Data.SoundOrigin import Dodge.Data.SoundOrigin
import Dodge.Creature import Dodge.Creature
@@ -47,7 +48,7 @@ initialWorld = defaultWorld
, _mousePos = V2 0 0 , _mousePos = V2 0 0
, _testString = testStringInit , _testString = testStringInit
, _yourID = 0 , _yourID = 0
, _worldEvents = soundStart BackgroundSound (V2 0 0) foamSprayFadeOutS Nothing , _worldEvents = storeLevel . soundStart BackgroundSound (V2 0 0) foamSprayFadeOutS Nothing
. foldr ((.) . makeStartCloudAt) id [V3 x y 5 | x <- [-5,-3..5] , y <- [-5,-3..5]] . foldr ((.) . makeStartCloudAt) id [V3 x y 5 | x <- [-5,-3..5] , y <- [-5,-3..5]]
, _pressPlates = IM.empty , _pressPlates = IM.empty
, _buttons = IM.empty , _buttons = IM.empty
+2 -7
View File
@@ -1,6 +1,7 @@
module Dodge.Menu module Dodge.Menu
where where
import Dodge.Data import Dodge.Data
import Dodge.Save
import Dodge.Config.Data import Dodge.Config.Data
import Dodge.Config.Update import Dodge.Config.Update
import SDL import SDL
@@ -14,7 +15,6 @@ import Dodge.SoundLogic
import Picture import Picture
import Control.Lens import Control.Lens
import Data.Maybe
optionMenu :: ScreenLayer optionMenu :: ScreenLayer
optionMenu = OptionScreen optionMenu = OptionScreen
{ _scTitle = const "OPTIONS" { _scTitle = const "OPTIONS"
@@ -131,7 +131,7 @@ pauseMenu = OptionScreen
pauseMenuOptions :: [MenuOption] pauseMenuOptions :: [MenuOption]
pauseMenuOptions = pauseMenuOptions =
[ Toggle ScancodeN startNewGame (const "NEW LEVEL") [ Toggle ScancodeN startNewGame (const "NEW LEVEL")
, Toggle ScancodeR (\w -> return $ fromMaybe w $ _storedLevel w) (const "RESTART") , Toggle ScancodeR (Just . loadStoredLevel) (const "RESTART")
, Toggle ScancodeO (pushScreen optionMenu ) (const "OPTIONS") , Toggle ScancodeO (pushScreen optionMenu ) (const "OPTIONS")
, Toggle ScancodeC (pushScreen displayControls) (const "CONTROLS") , Toggle ScancodeC (pushScreen displayControls) (const "CONTROLS")
, InvisibleToggle ScancodeEscape (const Nothing) , InvisibleToggle ScancodeEscape (const Nothing)
@@ -174,11 +174,6 @@ levelMenu x = OptionScreen
unpause :: World -> Maybe World unpause :: World -> Maybe World
unpause w = Just . resumeSound $ w {_menuLayers = []} unpause w = Just . resumeSound $ w {_menuLayers = []}
storeLevel :: World -> World
storeLevel w = case _storedLevel w of
Nothing -> w & storedLevel ?~ w
_ -> w
displayControls :: ScreenLayer displayControls :: ScreenLayer
displayControls = DisplayScreen displayControls = DisplayScreen
{_scDisplay = \w -> pictures {_scDisplay = \w -> pictures
+21
View File
@@ -0,0 +1,21 @@
module Dodge.Save
where
import Dodge.Data
import Data.Maybe
import Control.Lens
import qualified Data.Set as S
storeLevel :: World -> World
storeLevel w = case _storedLevel w of
Nothing -> w & storedLevel ?~ clearKeys w
_ -> w
loadStoredLevel :: World -> World
loadStoredLevel w = fromMaybe w $ _storedLevel w
doQuicksave :: World -> World
doQuicksave w = w & quicksaveLevel ?~ clearKeys w
clearKeys :: World -> World
clearKeys = (keys .~ S.empty) . (mouseButtons .~ S.empty)