|
|
|
@@ -6,12 +6,19 @@ import Dodge.Data
|
|
|
|
|
import Dodge.Base
|
|
|
|
|
import Dodge.CreatureAction
|
|
|
|
|
import Dodge.LoadConfig
|
|
|
|
|
import Dodge.Room.Placement
|
|
|
|
|
import Dodge.LightSources
|
|
|
|
|
import Dodge.LevelGen
|
|
|
|
|
import Dodge.Creature.Inanimate
|
|
|
|
|
import qualified Data.IntMap.Strict as IM
|
|
|
|
|
|
|
|
|
|
import SDL
|
|
|
|
|
import Data.Maybe
|
|
|
|
|
import qualified Data.Set as S
|
|
|
|
|
import Control.Lens
|
|
|
|
|
|
|
|
|
|
import Picture
|
|
|
|
|
|
|
|
|
|
handleKeyboardEvent :: KeyboardEventData -> World -> Maybe World
|
|
|
|
|
handleKeyboardEvent kev w = case keyboardEventKeyMotion kev of
|
|
|
|
|
Released -> Just $ w & keys %~ S.delete kcode
|
|
|
|
@@ -35,11 +42,13 @@ handlePressedKey _ scancode w
|
|
|
|
|
-- Rotation seems to be duplicated here and in Camera.hs ? why
|
|
|
|
|
| scancode == rotateCameraPlusKey (_keyConfig w) = Just $ w {_cameraRot = _cameraRot w + 0.01}
|
|
|
|
|
| scancode == rotateCameraMinusKey (_keyConfig w) = Just $ w {_cameraRot = _cameraRot w - 0.01}
|
|
|
|
|
| scancode == ScancodeF7 = Just $ w {_varMovementSpeedModifier = _varMovementSpeedModifier w - 1}
|
|
|
|
|
| scancode == ScancodeF8 = Just $ w {_varMovementSpeedModifier = _varMovementSpeedModifier w + 1}
|
|
|
|
|
| scancode == ScancodeF11 = Just $ w {_debugMode = not $ _debugMode w}
|
|
|
|
|
| _debugMode w && scancode == ScancodeF7 = Just $ w {_varMovementSpeedModifier = _varMovementSpeedModifier w - 1}
|
|
|
|
|
| _debugMode w && scancode == ScancodeF8 = Just $ w {_varMovementSpeedModifier = _varMovementSpeedModifier w + 1}
|
|
|
|
|
| _debugMode w && scancode == ScancodeF5 = Just $ dropLight w
|
|
|
|
|
| _debugMode w && scancode == ScancodeF6 = Just $ dropLight' w
|
|
|
|
|
handlePressedKey _ _ w = Just w
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
spaceAction :: World -> World
|
|
|
|
|
spaceAction w = case listToMaybe $ _closeActiveObjects w of
|
|
|
|
|
Just (Left flit) -> pickUpItem' flit w
|
|
|
|
@@ -54,3 +63,24 @@ pauseGame w = w {_menuState = PauseMenu}
|
|
|
|
|
|
|
|
|
|
toggleMap w = w & carteDisplay %~ not
|
|
|
|
|
escapeMap w = w & carteDisplay .~ False
|
|
|
|
|
|
|
|
|
|
dropLight :: World -> World
|
|
|
|
|
dropLight w = placeLS ls dec pos 0
|
|
|
|
|
-- $ over creatures IM.insert i (lamp)
|
|
|
|
|
$ w
|
|
|
|
|
--case yourItem w of
|
|
|
|
|
--NoItem -> w
|
|
|
|
|
--it -> rmInvItem (_yourID w) $ over floorItems (IM.insert flid theflit)
|
|
|
|
|
-- gg $ updateLocation
|
|
|
|
|
-- $ soundOnce putDownSound
|
|
|
|
|
-- $ set randGen g w
|
|
|
|
|
where --(rot, g) = randomR (-pi,pi) $ _randGen w
|
|
|
|
|
i = newCrKey w -- to give different lights different keys
|
|
|
|
|
pos = _crPos(you w)
|
|
|
|
|
ls = lightAt pos 0
|
|
|
|
|
dec = onLayer PtLayer $ color white $ circleSolid 8
|
|
|
|
|
|
|
|
|
|
dropLight' :: World -> World
|
|
|
|
|
dropLight' w = placeCr lamp pos 0 w
|
|
|
|
|
where
|
|
|
|
|
pos = _crPos(you w)
|