Cleanup creature picture

src/Dodge/Event/Keyboard.hs

@@ -6,7 +6,7 @@ module Dodge.Event.Keyboard
     )
     where
 import Dodge.Data
-import Dodge.Data.Menu
+--import Dodge.Data.Menu
 import Dodge.Picture.Layer
 import Dodge.Base
 import Dodge.Creature.Action
@@ -18,6 +18,7 @@ import Dodge.Creature.Inanimate
 import qualified Data.IntMap.Strict as IM
 import Dodge.Event.Test
 import Dodge.Event.Menu
+import Dodge.Menu
 
 import SDL
 import Data.Maybe
@@ -39,7 +40,7 @@ handleKeyboardEvent kev w = case keyboardEventKeyMotion kev of
 
 handlePressedKey :: Bool -> Scancode -> World -> Maybe World
 handlePressedKey True _     w   = Just w
-handlePressedKey _    ScancodeSemicolon w | not (inTerminal w) = Just $ gotoTerminal w
+handlePressedKey _    ScancodeSemicolon w = Just $ gotoTerminal w
 handlePressedKey _    scode w
     | null (_menuLayers w)      = handlePressedKeyInGame scode w
     | otherwise                 = handlePressedKeyInMenu (head $ _menuLayers w) scode w
@@ -67,15 +68,10 @@ toggleInv x y
     | x == y = TopInventory
     | otherwise = x
 
-
-inTerminal :: World -> Bool
-inTerminal w = case _menuLayers w of
-    (Terminal _ : _) -> True
-    _ -> False
 gotoTerminal :: World -> World
 gotoTerminal w = case _menuLayers w of
-    (Terminal _ : _ ) ->  w
-    _ -> w & menuLayers %~ (Terminal [] :)
+    (InputScreen _ : _ ) ->  w
+    _ -> w & menuLayers %~ (InputScreen [] :)
 
 spaceAction :: World -> World
 spaceAction w = if _carteDisplay w
@@ -89,7 +85,7 @@ spaceAction w = if _carteDisplay w
     updateTopCloseObject i w' = w' & closeActiveObjects %~ ( Right (_buttons w' IM.! i) : ) . tail 
 
 pauseGame :: World -> World
-pauseGame w = w {_menuLayers = [PauseMenu]}
+pauseGame w = w {_menuLayers = [pauseMenu]}
 
 toggleMap :: World -> World
 toggleMap w = w & carteDisplay %~ not

src/Dodge/Event/Menu.hs

@@ -2,63 +2,39 @@ module Dodge.Event.Menu
     ( handlePressedKeyInMenu
     ) where
 import Dodge.Data
-import Dodge.Data.Menu
---import Dodge.Base.Window
---import Dodge.Floor
---import Dodge.Initialisation
-import Dodge.SoundLogic
---import Dodge.Config.Data
-import Dodge.Config.Update
---import Dodge.Layout
---import Preload.Update
 import Dodge.Debug.Terminal
 import Dodge.Menu
 
---import Data.Maybe
---import Data.Foldable
---import qualified Data.Set as S
+import Control.Monad
 import Control.Lens
 import SDL
---import SDL.Internal.Numbered
 
-handlePressedKeyInMenu :: MenuLayer -> Scancode -> World -> Maybe World
-handlePressedKeyInMenu mState scode w = case mState of
-    TerminalMessage 0 _ -> popMenu w
-    TerminalMessage _ m -> Just $ w & menuLayers %~ ((TerminalMessage 0 m : ) . tail)
-    Terminal s -> case scode of
-        ScancodeEscape  -> popMenu w
-        ScancodeReturn  -> popMenu $ applyTerminalString s w
-        ScancodeBackspace -> popMenu w >>= pushMenu (Terminal $ dropLast s)
-        _               -> popMenu w >>= pushMenu (Terminal $ s ++ [scodeToChar scode])
-    LevelMenu _     -> optionListToEffects levelMenuOptions startLevel scode w
-    PauseMenu       -> optionListToEffects pauseMenuOptions unpause scode w
-    GameOverMenu    -> optionListToEffects pauseMenuOptions pure scode w
-    OptionMenu      -> optionListToEffects optionsOptions popMenu scode w
-    SoundOptionMenu -> optionListToEffects 
-        soundMenuOptions 
-        ( popMenu . writeConfig ) 
-        scode 
-        w
-    GraphicsOptionMenu -> optionListToEffects graphicsMenuOptions (popMenu . writeConfig) scode w
-    ControlList -> Just $ w & menuLayers %~ tail
-    _ -> Just w
+handlePressedKeyInMenu :: ScreenLayer -> Scancode -> World -> Maybe World
+handlePressedKeyInMenu mState scode = case mState of
+    OptionScreen { _scOptions = mos, _scDefaultEff = defeff} 
+                        -> optionListToEffects mos defeff scode
+    DisplayScreen {}    -> popScreen
+    WaitScreen {}       -> Just
+    TerminalScreen 0 _  -> popScreen
+    TerminalScreen _ m  -> Just . ( menuLayers %~ ( (TerminalScreen 0 m : ) . tail) )
+    InputScreen s       -> case scode of
+        ScancodeEscape  -> popScreen
+        ScancodeReturn  -> popScreen . applyTerminalString s
+        ScancodeBackspace 
+            -> popScreen >=> pushScreen (InputScreen $ dropLast s)
+        _   -> popScreen >=> pushScreen (InputScreen $ s ++ [scodeToChar scode])
   where 
-    writeConfig = sideEffects %~ (saveConfig (_config w) :)
-    unpause w' = Just . resumeSound $ w' {_menuLayers = []}
-    startLevel = unpause . storeLevel
-    popMenu w'       = Just $ w' & menuLayers %~ tail
     dropLast (x:xs) = init (x:xs)
-    dropLast _ = []
-
+    dropLast _      = []
 optionListToEffects :: [MenuOption] -> (World -> Maybe World) -> Scancode -> World -> Maybe World
-optionListToEffects mos eff sc w = case lookup sc listEffects of
-    Nothing -> eff w
-    Just eff' -> eff' w
+optionListToEffects mos defaulteff sc w = case lookup sc listEffects of
+    Nothing -> defaulteff w
+    Just eff -> eff w
   where
     listEffects = concatMap menuOptionToEffects mos
 
 menuOptionToEffects :: MenuOption -> [(Scancode,World -> Maybe World)]
-menuOptionToEffects Toggle {_moKey = k, _moEff = eff} = [(k,eff)]
+menuOptionToEffects Toggle          {_moKey = k, _moEff = eff} = [(k,eff)]
 menuOptionToEffects InvisibleToggle {_moKey = k, _moEff = eff} = [(k,eff)]
 menuOptionToEffects Toggle2 
     { _moKey1 = k1
@@ -66,8 +42,3 @@ menuOptionToEffects Toggle2
     , _moKey2 = k2
     , _moEff2 = eff2 
     } = [(k1,eff1) , (k2,eff2)]
-
-storeLevel :: World -> World
-storeLevel w = case _storedLevel w of
-    Nothing -> w & storedLevel ?~ w
-    _       -> w