Fix reloading of start of level
This commit is contained in:
@@ -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)
|
|
||||||
|
|||||||
@@ -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
@@ -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
|
||||||
|
|||||||
@@ -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)
|
||||||
Reference in New Issue
Block a user