Cleanup

src/Dodge/Update/Input/ScreenLayer.hs

@@ -2,12 +2,10 @@ module Dodge.Update.Input.ScreenLayer (
     updateUseInputOnScreen,
 ) where
 
-import Linear
-import Dodge.Data.ScreenPos
 import Control.Monad
 import qualified Data.Map.Strict as M
 import Data.Maybe
-import Dodge.Base.Window
+import Dodge.Data.ScreenPos
 import Dodge.Data.Universe
 import Dodge.Debug.Terminal
 import Dodge.Menu.Option
@@ -15,25 +13,26 @@ import Dodge.SelectionList
 import Dodge.Update.Input.Text
 import Geometry
 import LensHelp
+import Linear
 import SDL
 
 updateUseInputOnScreen :: ScreenLayer -> Universe -> Universe
 updateUseInputOnScreen sl = case sl of
-    InputScreen thetext _ -> doInputScreenInput thetext
-    screen -> optionScreenUpdate screen
+    InputScreen{} -> doInputScreenInput (sl ^. scInput)
+    _ -> optionScreenUpdate sl
 
 doInputScreenInput :: String -> Universe -> Universe
 doInputScreenInput s u =
     u & doTextInputOver (uvScreenLayers . _head . scInput)
         & checkEndStatus
   where
-    pkeys = u ^. uvWorld . input . pressedKeys
+    ispressed = (`M.member` (u ^. uvWorld . input . pressedKeys))
     checkEndStatus
-        | ScancodeReturn `M.member` pkeys =
+        | ispressed ScancodeReturn =
             (uvScreenLayers %~ tail)
                 . applyTerminalString (words s)
                 . (uvWorld . worldEventFlags . at InventoryChange ?~ ())
-        | ScancodeEscape `M.member` pkeys = uvScreenLayers %~ tail
+        | ispressed ScancodeEscape = uvScreenLayers %~ tail
         | otherwise = id
 
 optionScreenUpdate ::
@@ -53,10 +52,16 @@ optionScreenUpdate screen u =
     mop = _scPositionedMenuOption screen
     ldps = _scListDisplayParams screen
 
-optionScreenDefaultEffect :: PositionedMenuOption -> Universe -> Universe
-optionScreenDefaultEffect f u = case u ^. uvWorld . input . pressedKeys . at ScancodeEscape of
-    Just InitialPress -> fromMaybe id (f ^? pmoMenuOption . moEff) u
-    _ -> u
+optionScreenDefaultEffect :: EscapeMenuOption -> Universe -> Universe
+optionScreenDefaultEffect f u =
+    fromMaybe
+        id
+        ( do
+            ptype <- u ^. uvWorld . input . pressedKeys . at ScancodeEscape
+            guard $ ptype == InitialPress
+            f ^? emoMenuOption . moEff
+        )
+        u
 
 -- ouch this is not good
 mouseClickOptionsList :: ScreenLayer -> Universe -> Universe
@@ -81,36 +86,40 @@ mouseOverSelectionList ::
     Universe
 mouseOverSelectionList ldps screen u = fromMaybe u $ do
     yi <- ldpVerticalSelection (u ^. uvConfig) ldps (u ^. uvWorld . input . mousePos)
-    guard $ (mmoving || (_scDisplayTime screen <= 1))
-        && isselectable yi
-        && yi >= 0
-        && yi < ymax
---      && x > xl && x < xr
+    guard $
+        (mmoving || (_scDisplayTime screen <= 1))
+            && isselectable yi
+            && yi >= 0
+            && yi < ymax
+    --      && x > xl && x < xr
     return $ u & uvScreenLayers . _head . scSelectionList . slSelPos ?~ yi
---    | x > xl && x < xr
---        && ylower == yupper
---        && (mmoving || (_scDisplayTime screen <= 1)) -- slight hack
---        && isselectable =
---        u & uvScreenLayers . _head . scSelectionList . slSelPos ?~ yupper
---    | otherwise = u
   where
+    --    | x > xl && x < xr
+    --        && ylower == yupper
+    --        && (mmoving || (_scDisplayTime screen <= 1)) -- slight hack
+    --        && isselectable =
+    --        u & uvScreenLayers . _head . scSelectionList . slSelPos ?~ yupper
+    --    | otherwise = u
+
     sl = _scSelectionList screen
     isselectable yi =
         fromMaybe False $
             u ^? uvScreenLayers . _head . scSelectionList . slItems . ix yi . siIsSelectable
     ymax = maybe 0 length $ sl ^? slItems
     mmoving = u ^. uvWorld . input . mouseMoving
+
 --    ylower = ceiling $ (hh - (75 + y + _ldpPosY ldps)) / 50
 --    yupper = floor $ (hh - (15 + y + _ldpPosY ldps)) / 50
 --    xl = _ldpPosX ldps - hw
 --    xr = xl + _ldpScale ldps * 26 * 9
-    V2 _ y = u ^. uvWorld . input . mousePos
-    cfig = u ^. uvConfig
-    hh = halfHeight cfig
-    hw = halfWidth cfig
+--    V2 _ y = u ^. uvWorld . input . mousePos
+--    cfig = u ^. uvConfig
+--    hh = halfHeight cfig
+--    hw = halfWidth cfig
 
 ldpVerticalSelection :: Configuration -> ListDisplayParams -> Point2 -> Maybe Int
-ldpVerticalSelection cfig ldp (V2 _ y) | yupper == ylower = Just yupper
+ldpVerticalSelection cfig ldp (V2 _ y)
+    | yupper == ylower = Just yupper
     | otherwise = Nothing
   where
     winy = cfig ^. windowY