justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Commit towards merge

Browse Source
This commit is contained in:
justin
2022-03-20 17:18:12 +00:00
parent 6c3e335ded
commit 5e897c6a6c
10 changed files with 301 additions and 98 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Event/Keyboard.hs
+45 -32
View File
@@ -1,23 +1,35 @@
{- | Deals with keyboard events. -}
module Dodge.Event.Keyboard
( handleKeyboardEvent
, handleTextInputEvent
) where
import Dodge.Data
import Dodge.Combine
import Dodge.Save
import Dodge.Base
import Dodge.Reloading
import Dodge.Creature.Action
import Dodge.Event.Test
import Dodge.Event.Menu
import Dodge.Menu
import Dodge.Inventory
import qualified Data.IntMap.Strict as IM
import qualified Data.IntMap.Strict as IM
import Dodge.Base
import Dodge.Combine
import Dodge.Creature.Action
import Dodge.Data
import Dodge.Event.Menu
import Dodge.Event.Test
import Dodge.Inventory
import Dodge.Menu
import Dodge.Reloading
import Dodge.Save
import SDL
import Data.Maybe
import qualified Data.Set as S
import Control.Lens
import Control.Lens
import Data.Maybe
import qualified Data.Set as S
import SDL
import Data.Text (unpack)
handleTextInputEvent :: TextInputEventData -> Universe -> IO (Maybe Universe)
handleTextInputEvent tev = handleTextInput text
where
text = unpack $ textInputEventText tev
handleTextInput :: String -> Universe -> IO (Maybe Universe)
handleTextInput text w
| null (_menuLayers w) = return $ Just w
| otherwise = handleTextInMenu (head $ _menuLayers w) text w
{- | Handles keyboard press and release.
On release, remove scancode from the 'Set' of pressed keys.
@@ -26,20 +38,21 @@ see 'handlePressedKeyInGame'.
-}
handleKeyboardEvent :: KeyboardEventData -> Universe -> IO (Maybe Universe)
handleKeyboardEvent kev u = case keyboardEventKeyMotion kev of
Released -> return . Just $ u & uvWorld . keys %~ S.delete kcode
Pressed -> handlePressedKey (keyboardEventRepeat kev) kcode
(u & uvWorld . keys %~ S.insert kcode)
Released -> return . Just $ u & uvWorld . keys %~ S.delete scode
Pressed -> handlePressedKey (keyboardEventRepeat kev) scode
(u & uvWorld . keys %~ S.insert scode)
where
kcode = (keysymScancode . keyboardEventKeysym) kev
scode = (keysymScancode . keyboardEventKeysym) kev
handlePressedKey :: Bool -> Scancode -> Universe -> IO (Maybe Universe)
handlePressedKey True _ w = return $ Just w
handlePressedKey _ ScancodeF5 w = return . Just $ doQuicksave w
handlePressedKey _ ScancodeF9 w = return . Just $ loadSaveSlot QuicksaveSlot w
handlePressedKey _ ScancodeSemicolon w = return . Just $ gotoTerminal w
handlePressedKey _ scode w
handlePressedKey True _ w = return $ Just w
handlePressedKey _ ScancodeF5 w = return . Just $ doQuicksave w
handlePressedKey _ ScancodeF9 w = return . Just $ loadSaveSlot QuicksaveSlot w
handlePressedKey _ ScancodeSemicolon w = return . Just $ gotoTerminal w
handlePressedKey _ scode w
| null (_menuLayers w) = return $ uvWorld (handlePressedKeyInGame scode) w
| otherwise = handlePressedKeyInMenu (head $ _menuLayers w) scode w
-- | otherwise = return $ Just w
handlePressedKeyInGame :: Scancode -> World -> Maybe World
handlePressedKeyInGame scode w = case scode of
@@ -67,8 +80,8 @@ toggleInspectInv he = case he of
gotoTerminal :: Universe -> Universe
gotoTerminal w = case _menuLayers w of
(InputScreen _ : _ ) -> w
_ -> w & menuLayers %~ (InputScreen [] :)
(InputScreen _ _ : _ ) -> w
_ -> w & menuLayers %~ (InputScreen [] "Enter command" :)
spaceAction :: World -> World
spaceAction w = case _hudElement $ _hud w of
@@ -76,21 +89,21 @@ spaceAction w = case _hudElement $ _hud w of
DisplayInventory NoSubInventory -> case selectedCloseObject w of
Just (_,Left flit) -> pickUpItem 0 flit w
Just (_,Right but) -> _btEvent but but w
_ -> w
_ -> w
DisplayInventory DisplayTerminal {} -> w & hud . hudElement .~ DisplayInventory NoSubInventory
_ -> w & hud . hudElement .~ DisplayInventory NoSubInventory
where
theLoc = fst (_seenLocations w IM.! _selLocation w) w
-- updateTopCloseObject i w' = w' & closeObjects %~ ( Right (_buttons w' IM.! i) : ) . tail
-- updateTopCloseObject i w' = w' & closeObjects %~ ( Right (_buttons w' IM.! i) : ) . tail
pauseGame :: World -> World
pauseGame w = w & sideEffects %~ (. (menuLayers .~ [pauseMenu]))
toggleMap :: World -> World
toggleMap w = case _hudElement $ _hud w of
DisplayCarte -> w & hud . hudElement .~ DisplayInventory NoSubInventory
_ -> w & hud . hudElement .~ DisplayCarte
DisplayCarte -> w & hud . hudElement .~ DisplayInventory NoSubInventory
_ -> w & hud . hudElement .~ DisplayCarte
escapeMap :: World -> World
escapeMap w = case _hudElement $ _hud w of
DisplayCarte -> w & hud . hudElement .~ DisplayInventory NoSubInventory
_ -> w
DisplayCarte -> w & hud . hudElement .~ DisplayInventory NoSubInventory
_ -> w
src/Dodge/Event/Menu.hs
+32 -12
View File
@@ -1,6 +1,7 @@
module Dodge.Event.Menu
( handlePressedKeyInMenu
)
, handleTextInMenu
)
where
import Dodge.Data
import Dodge.Debug.Terminal
@@ -11,25 +12,44 @@ import Data.Maybe
import Control.Monad
--import Control.Lens
import SDL
import Control.Lens ((%~))
import qualified Debug.Trace
handleTextInMenu :: ScreenLayer -> [Char] -> Universe -> IO (Maybe Universe)
handleTextInMenu mState text = case mState of
InputScreen s help-> return . (popScreen' >=> pushScreen' (InputScreen new_text help))
where
new_text
-- Text events occur after key events so ignore the first
-- (key that opened the terminal menu)
| s == "" = ">"
| otherwise = s ++ text
_ -> return . Just
handlePressedKeyInMenu :: ScreenLayer -> Scancode -> Universe -> IO (Maybe Universe)
handlePressedKeyInMenu mState scode = case mState of
OptionScreen { _scOptions = mos, _scDefaultEff = defeff}
OptionScreen { _scOptions = mos, _scDefaultEff = defeff}
-> optionListToEffects mos defeff scode
DisplayScreen {} -> popScreen
ColumnsScreen {} -> popScreen
WaitScreen {} -> return . Just
InputScreen s -> case scode of
InputScreen s help -> case scode of
ScancodeEscape -> popScreen
ScancodeReturn -> popScreen . applyTerminalString s
ScancodeBackspace
-> return . (popScreen' >=> pushScreen' (InputScreen $ dropLast s))
_ -> return . (popScreen' >=> pushScreen' (InputScreen $ s ++ [scodeToChar scode]))
where
-- Remove the menu layer (we readd it in applyTerminalString if the commmand fails)
ScancodeReturn -> return. Just . applyTerminalString (tail s) . (menuLayers %~ tail)
ScancodeTab -> autoCompleteTerminal s help
ScancodeBackspace
-> return . (popScreen' >=> pushScreen' (InputScreen (dropLast s) "Enter command"))
-- Ignore (text input now handled by handleText)
_ -> return . (popScreen' >=> pushScreen' (InputScreen s help))
where
dropLast [x] = ['>']
dropLast (x:xs) = init (x:xs)
dropLast _ = []
dropLast _ = ['>']
optionListToEffects :: [MenuOption] -> (Universe -> IO (Maybe Universe)) -> Scancode
optionListToEffects :: [MenuOption] -> (Universe -> IO (Maybe Universe)) -> Scancode
-> Universe -> IO (Maybe Universe)
optionListToEffects mos defaulteff sc = fromMaybe defaulteff .
lookup sc $ concatMap menuOptionToEffects mos
@@ -37,9 +57,9 @@ optionListToEffects mos defaulteff sc = fromMaybe defaulteff .
menuOptionToEffects :: MenuOption -> [(Scancode,Universe -> IO (Maybe Universe))]
menuOptionToEffects Toggle {_moKey = k, _moEff = eff} = [(k,eff)]
menuOptionToEffects InvisibleToggle {_moKey = k, _moEff = eff} = [(k,eff)]
menuOptionToEffects Toggle2
menuOptionToEffects Toggle2
{ _moKey1 = k1
, _moEff1 = eff1
, _moKey2 = k2
, _moEff2 = eff2
, _moEff2 = eff2
} = [(k1,eff1) , (k2,eff2)]