Cleanup

src/Dodge/Event.hs

@@ -13,6 +13,7 @@ module Dodge.Event
     ( handleEvent
     ) where
 import Dodge.Terminal
+import Dodge.InputFocus
 import Dodge.Combine
 import Dodge.Event.Keyboard
 --import Dodge.Event.Menu
@@ -63,7 +64,7 @@ handleMouseMotionEvent mmev u = Just $ u & uvWorld . mousePos .~ V2
 handleMouseButtonEvent :: MouseButtonEventData -> Universe -> Maybe Universe
 handleMouseButtonEvent mbev = case mouseButtonEventMotion mbev of
     Released -> Just . updateButtons S.delete
-    Pressed  -> handlePressedMouseButton thebutton . updateButtons S.insert
+    Pressed  -> Just . over uvWorld (handlePressedMouseButton thebutton) . updateButtons S.insert
   where
     thebutton = mouseButtonEventButton mbev
     updateButtons f = uvWorld . mouseButtons %~ f thebutton
@@ -90,18 +91,20 @@ handleResizeEvent sev u = return . Just $ u
     V2 x' y' = windowSizeChangedEventSize sev
     divRes = resFactorNum $ u ^. config . graphics_resolution_factor
 
-handlePressedMouseButton :: MouseButton -> Universe -> Maybe Universe
-handlePressedMouseButton but w = case (_hudElement (_hud $ _uvWorld w), but) of
-    (DisplayCarte,_) -> Just $ w & uvWorld . clickMousePos .~ _mousePos (_uvWorld w)
-    (_,ButtonMiddle) -> Just $ w & uvWorld . clickMousePos .~ _mousePos (_uvWorld w)
-    ( DisplayInventory (DisplayTerminal tmid _) , ButtonLeft)
-                -> Just $ over uvWorld (doTerminalEffect (w ^?! uvWorld . terminals . ix tmid)) w
+handlePressedMouseButton :: MouseButton -> World -> World
+handlePressedMouseButton but w = case (_hudElement (_hud w), but) of
+    (DisplayCarte,_) -> w & clickMousePos .~ _mousePos w
+    (_,ButtonMiddle) -> w & clickMousePos .~ _mousePos w
+    ( DisplayInventory (DisplayTerminal tmid) , ButtonLeft)
+        | hasTerminalFocus w -> doTerminalEffectLB (w ^?! terminals . ix tmid) w
+        | otherwise -> w & terminals . ix tmid . tmInput . _Just . tiFocus %~ const True
     ( DisplayInventory (CombineInventory mi) , ButtonLeft)
-                -> Just $ fromMaybe (w & uvWorld . hud . hudElement .~ DisplayInventory NoSubInventory) 
-                    $ do -- ugly
-            i <- mi
-            return $ over uvWorld (doCombine i) w
-    _ -> Just w
+                -> maybe (hud . hudElement .~ DisplayInventory NoSubInventory) doCombine mi w
+--                -> fromMaybe (w & hud . hudElement .~ DisplayInventory NoSubInventory) 
+--                    $ do -- ugly
+--            i <- mi
+--            return $ doCombine i w
+    _ -> w
 
 -- note "sort" on the inventory indices; otherwise
 -- lower items may be shifted up and items below these removed instead
@@ -144,30 +147,30 @@ wheelEvent y w = case _hudElement $ _hud w of
         | otherwise ->  w & moveTweakSel yi
     DisplayInventory (CombineInventory _) -> w
         & hud . hudElement . subInventory . combineInvSel . _Just %~ ((`mod` numcombs) . subtract yi)
---    DisplayInventory (DisplayTerminal tmid True)
---        | rbDown -> w
---            & terminals . ix tmid %~ updatetermsubsel
---        | otherwise -> w
---            & terminals . ix tmid %~ updatetermsel
+    DisplayInventory (DisplayTerminal tmid)
+        | rbDown && hasTerminalFocus w -> w
+            & terminals . ix tmid %~ updatetermsubsel
+        | hasTerminalFocus w -> w
+            & terminals . ix tmid %~ updatetermsel
     _ -> w
   where
---    updatetermsel tp = case _tmSel tp of
---        Nothing -> tp & tmSel ?~ (0,0)
---            & tmInput . _Just %~ replacewith tp 0
---        Just (i,_) -> let newi = ((`mod` length (_tmScrollCommands tp)) . subtract yi) i
---            in tp & tmSel . _Just .~ (newi,0)
---                & tmInput . _Just %~ replacewith tp newi
---    updatetermsubsel tp = case _tmSel tp of
---        Nothing -> tp
---        Just (i,j) -> let newj = (j - yi) `mod` (1 + length (_tcArguments (_tmScrollCommands tp !! i) tp w))
---            in tp & tmSel . _Just .~ (i,newj)
---                & tmInput . _Just %~ replacewith' tp i newj w
---    replacewith tp newi _ = T.pack (_tcString (_tmScrollCommands tp !! newi))
---    replacewith' tp i j w' _ = T.pack $ _tcString tc ++ " " ++ arg-- ++ ((_tcArguments tp) w !! j)
---      where
---        arg :: String
---        arg = ("": _tcArguments tc w' )!! j
---        tc = _tmScrollCommands tp !! i
+    updatetermsel tp = case _tmSel tp of
+        Nothing -> tp & tmSel ?~ (0,0)
+            & tmInput . _Just . tiText %~ replacewith tp 0
+        Just (i,_) -> let newi = ((`mod` length (scrollCommands tp)) . subtract yi) i
+            in tp & tmSel . _Just .~ (newi,0)
+                & tmInput . _Just . tiText %~ replacewith tp newi
+    updatetermsubsel tp = case _tmSel tp of
+        Nothing -> tp
+        Just (i,j) -> let newj = (j - yi) `mod` (1 + length (_tcArguments (scrollCommands tp !! i) tp w))
+            in tp & tmSel . _Just .~ (i,newj)
+                & tmInput . _Just . tiText %~ replacewith' tp i newj w
+    replacewith tp newi _ = T.pack (_tcString (scrollCommands tp !! newi))
+    replacewith' tp i j w' _ = T.pack $ _tcString tc ++ " " ++ arg-- ++ ((_tcArguments tp) w !! j)
+      where
+        arg :: String
+        arg = ("": _tcArguments tc tp w' )!! j
+        tc = scrollCommands tp !! i
     numcombs = length $ combineItemListYou w
     yi = round $ signum y
     numLocs = (fst . IM.findMax $ _seenLocations w) + 1
@@ -175,6 +178,18 @@ wheelEvent y w = case _hudElement $ _hud w of
     lbDown = ButtonLeft `S.member` _mouseButtons w
     invKeyDown = ScancodeCapsLock `S.member` _keys w
 
+scrollCommands :: Terminal -> [TerminalCommand]
+scrollCommands = (nullCommand :) . _tmScrollCommands
+nullCommand :: TerminalCommand
+nullCommand = TerminalCommand
+    { _tcString = ""
+    , _tcAlias  = []
+    , _tcHelp   = ""
+    , _tcArgumentType = Nothing
+    , _tcArguments  = const (const [])
+    , _tcEffect = const $ \_ w -> Right $ w
+    }
+
 scrollRBOption :: Float -> World -> World
 scrollRBOption y w
     | y < 0 = w & rbOptions . opSel %~ (min (length (_opEquip (_rbOptions w))-1) . (+1))