Make displayed terminal text screen dragable

This commit is contained in:
2026-04-05 23:45:38 +01:00
parent 017e92470e
commit ed28af8d11
11 changed files with 300 additions and 262 deletions
+21
View File
@@ -5,6 +5,8 @@ module Dodge.Update.Input.InGame (
updateMouseInGame,
) where
import Dodge.Data.ScreenPos
import Geometry.Data
import Dodge.Base.Coordinate
import Dodge.Button.Event
import Control.Applicative
@@ -124,8 +126,27 @@ updateMouseHeldInGame cfig w = case w ^. input . mouseContext of
guard (isGroupSelectableSection $ fst ysel)
return $ w & input . mouseContext .~ OverInvDragSelect (Just ysel) Nothing
OverInvDrag k mmouseover -> doDrag cfig 30 k mmouseover w
OverTerminalBar p -> w & tmLDP %~ setPixelOffsetBounded cfig (p + w ^. input . mousePos)
_ -> w
setPixelOffsetBounded :: Config -> Point2 -> LDParams -> LDParams
setPixelOffsetBounded cfig (V2 x y) ldp = ldp & ldpPos . spPixelOff .~ V2 x' y'
where
-- (V2 xmin ymax, V2 xmax ymin) = ldpRect cfig ldp
h = fromIntegral $ cfig ^. windowX
w = fromIntegral $ cfig ^. windowY
V2 ax ay = -V2 w h + ldp ^. ldpPos . spScreenOff * V2 w h
x' = min w $ max 1 x
y' = y
boundPixelOffset :: Config -> Point2 -> Point2 -> Point2 -> Point2
boundPixelOffset cfig nw se p = p
--leftHeldPosShift :: World -> Point2
--leftHeldPosShift w = fromMaybe 0 $ do
-- p <- w ^? input . heldPos . ix SDL.ButtonLeft
-- return $ w ^. input . mousePos - p
doDrag :: Config -> Int -> Int -> Maybe (Int, Int) -> World -> World
doDrag cfig n k mmouseover w = fromMaybe w $ do
guard (n /= 0)