Determine mouse position over terminal display

This commit is contained in:
2024-11-16 16:45:12 +00:00
parent 5efc9220e0
commit 86f185c71e
5 changed files with 36 additions and 14 deletions
+1 -5
View File
@@ -1,5 +1 @@
/home/justin/Haskell/loop/src/Dodge/Update.hs:416:9-12: warning: [-Wunused-matches] All good (594 modules, at 16:39:41)
Defined but not used: tmid
|
416 | tmid <- w ^? hud . hudElement . subInventory . termID
| ^^^^
+3
View File
@@ -6,6 +6,9 @@ module Dodge.Data.ScreenPos
import Geometry.Data import Geometry.Data
import Control.Lens import Control.Lens
-- from the center. positive x goes right, positive y goes up.
-- a spScreenOff of 1 is the full length of the screen
-- for eg see fromTopLeft
data ScreenPos = ScreenPos data ScreenPos = ScreenPos
{ _spScreenOff :: Point2 { _spScreenOff :: Point2
, _spPixelOff :: Point2 , _spPixelOff :: Point2
+1
View File
@@ -355,6 +355,7 @@ drawTerminalDisplay tid cfig w = fromMaybe mempty $ do
invHead cfig (_tmTitle tm ++ ":T" ++ show tid) invHead cfig (_tmTitle tm ++ ":T" ++ show tid)
<> drawSelectionList secondColumnParams cfig (thesellist tm) <> drawSelectionList secondColumnParams cfig (thesellist tm)
<> color (withAlpha 0.5 green) (drawSelectionListBackground secondColumnParams cfig 15) <> color (withAlpha 0.5 green) (drawSelectionListBackground secondColumnParams cfig 15)
-- when changing the 15, change isOverTerminalScreen
<> color (dark $ _tmExternalColor tm) (drawTitleBackground cfig) <> color (dark $ _tmExternalColor tm) (drawTitleBackground cfig)
where where
toselitm (str, col) = SelectionItem [str] 1 True col 0 () toselitm (str, col) = SelectionItem [str] 1 True col 0 ()
+1 -1
View File
@@ -56,7 +56,7 @@ drawSelectionListBackground ldp cfig l = translateScreenPos cfig (ldp ^. ldpPos)
polygon . reverse $ rectNSWE 5 s (-5) e polygon . reverse $ rectNSWE 5 s (-5) e
where where
s = - (5 + fromIntegral l * (20 * ldp ^. ldpScale + ldp ^. ldpVerticalGap)) s = - (5 + fromIntegral l * (20 * ldp ^. ldpScale + ldp ^. ldpVerticalGap))
e = 555 -- HACK e = 555 -- HACK isOverTerminalScreen
makeSelectionListPictures :: SelectionList a -> [Picture] makeSelectionListPictures :: SelectionList a -> [Picture]
makeSelectionListPictures = concatMap f . _slItems makeSelectionListPictures = concatMap f . _slItems
+27 -5
View File
@@ -6,8 +6,8 @@ Description : Simulation update
-} -}
module Dodge.Update (updateUniverse) where module Dodge.Update (updateUniverse) where
import Control.Applicative
import Color import Color
import Control.Applicative
import Control.Monad import Control.Monad
import Data.List import Data.List
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
@@ -40,6 +40,7 @@ import Dodge.Projectile.Update
import Dodge.Prop.Update import Dodge.Prop.Update
import Dodge.RadarBlip import Dodge.RadarBlip
import Dodge.RadarSweep import Dodge.RadarSweep
import Dodge.ScreenPos
import Dodge.ScrollValue import Dodge.ScrollValue
import Dodge.SelectionSections import Dodge.SelectionSections
import Dodge.Shockwave.Update import Dodge.Shockwave.Update
@@ -389,15 +390,18 @@ shiftInvItemsDown (_, i) x w = fromMaybe w $ do
updateMouseContext :: Configuration -> World -> World updateMouseContext :: Configuration -> World -> World
updateMouseContext cfig w = updateMouseContext cfig w =
w & input . mouseContext .~ fromMaybe aimcontext w & input . mouseContext
.~ fromMaybe
aimcontext
(overinv <|> overcomb <|> overterm) (overinv <|> overcomb <|> overterm)
where where
aimcontext aimcontext
| ButtonRight `M.member` (w ^. input . mouseButtons) = MouseAiming | ButtonRight `M.member` (w ^. input . mouseButtons) = MouseAiming
| otherwise = NoMouseContext | otherwise = NoMouseContext
mpos = w ^. input . mousePos
overinv = do overinv = do
sss <- w ^? hud . hudElement . diSections sss <- w ^? hud . hudElement . diSections
selpos <- inverseSelNumPos cfig (invDisplayParams w) sss (w ^. input . mousePos) selpos <- inverseSelNumPos cfig (invDisplayParams w) sss mpos
case w ^? hud . hudElement . subInventory . ciSelection of case w ^? hud . hudElement . subInventory . ciSelection of
Just _ -> return $ OverInvFilt selpos Just _ -> return $ OverInvFilt selpos
_ -> do _ -> do
@@ -414,8 +418,26 @@ updateMouseContext cfig w =
Just x -> OverCombSelect x Just x -> OverCombSelect x
overterm = do overterm = do
tmid <- w ^? hud . hudElement . subInventory . termID tmid <- w ^? hud . hudElement . subInventory . termID
guard True tm <- w ^? cWorld . lWorld . terminals . ix tmid
return OverTerminalReturn return $
if isOverTerminalScreen cfig tm mpos
then OverTerminalReturn
else OverTerminalEscape
isOverTerminalScreen :: Configuration -> Terminal -> Point2 -> Bool
isOverTerminalScreen cfig _ (V2 x y) =
x <= xmax
&& x >= xmin - 5
&& y <= ymax + 5
&& y >= ymin
where
ldp = secondColumnParams
V2 xmin ymax = screenPosAbs cfig (ldp ^. ldpPos)
s = (5 + 15 * (20 * ldp ^. ldpScale + ldp ^. ldpVerticalGap))
-- the 15 is the length of list in the terminal display, don't change
-- without changing drawTerminalDisplay
ymin = ymax - s
xmax = xmin + 555 -- HACK drawSelectionListBackground
updateWheelEvents :: World -> World updateWheelEvents :: World -> World
updateWheelEvents w updateWheelEvents w