Commit towards merge

src/Dodge/Event/Keyboard.hs

@@ -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