From 1f52c4b5882bdba183fa96d39162769db7213af9 Mon Sep 17 00:00:00 2001 From: justin Date: Mon, 6 Apr 2026 00:52:09 +0100 Subject: [PATCH] Work on boundaries for dragging windows --- src/Dodge/Data/ScreenPos.hs | 2 +- src/Dodge/Data/SelectionList.hs | 3 ++- src/Dodge/ListDisplayParams.hs | 6 +++--- src/Dodge/Render/List.hs | 2 +- src/Dodge/Render/MenuScreen.hs | 2 +- src/Dodge/ScreenPos.hs | 5 +++-- src/Dodge/SelectionList.hs | 2 +- src/Dodge/Update/Input/InGame.hs | 13 ++++--------- src/Dodge/Update/Input/ScreenLayer.hs | 2 +- 9 files changed, 17 insertions(+), 20 deletions(-) diff --git a/src/Dodge/Data/ScreenPos.hs b/src/Dodge/Data/ScreenPos.hs index a26314c74..ba8b55e57 100644 --- a/src/Dodge/Data/ScreenPos.hs +++ b/src/Dodge/Data/ScreenPos.hs @@ -10,7 +10,7 @@ import Control.Lens -- a spScreenOff of 1 is the full length of the screen -- for eg see fromTopLeft data ScreenPos = ScreenPos - { _spScreenOff :: Point2 + { _spScreenOff :: Point2 -- from bottom left , _spPixelOff :: Point2 } makeLenses ''ScreenPos diff --git a/src/Dodge/Data/SelectionList.hs b/src/Dodge/Data/SelectionList.hs index 0b1b7517c..0749ed8e6 100644 --- a/src/Dodge/Data/SelectionList.hs +++ b/src/Dodge/Data/SelectionList.hs @@ -9,12 +9,13 @@ import Data.IntMap.Strict (IntMap) import Dodge.Data.CardinalPoint import Dodge.Data.ScreenPos import Picture.Data +import Linear data LDParams = LDP -- List display parameters { _ldpPos :: ScreenPos , _ldpScale :: Float , _ldpVerticalGap :: Float - , _ldpBorder :: Maybe (Int,Int) -- the Ints give height and width for a border + , _ldpSize :: Maybe (V2 Int) } data CursorDisplay diff --git a/src/Dodge/ListDisplayParams.hs b/src/Dodge/ListDisplayParams.hs index b23766596..85e3a2ad0 100644 --- a/src/Dodge/ListDisplayParams.hs +++ b/src/Dodge/ListDisplayParams.hs @@ -23,10 +23,10 @@ defaultLDP = , _ldpScale = 1 , _ldpPos = ScreenPos - { _spScreenOff = V2 (-0.5) 0.5 -- top left + { _spScreenOff = V2 0 1 -- top left , _spPixelOff = 0 } - , _ldpBorder = Nothing + , _ldpSize = Nothing } invDP :: LDParams @@ -46,7 +46,7 @@ secondColumnLDP :: LDParams secondColumnLDP = defaultLDP & ldpPos . spPixelOff .~ V2 subInvX (-20) terminalLDP :: LDParams -terminalLDP = secondColumnLDP & ldpBorder ?~ (49, 16) +terminalLDP = secondColumnLDP & ldpSize ?~ V2 50 16 subInvX :: Float subInvX = 10 * fromIntegral topInvW + 170 diff --git a/src/Dodge/Render/List.hs b/src/Dodge/Render/List.hs index 49fe4992b..6b26ad448 100644 --- a/src/Dodge/Render/List.hs +++ b/src/Dodge/Render/List.hs @@ -47,7 +47,7 @@ drawSelectionList ldps cfig sl = ldpRect :: Config -> LDParams -> Maybe (Point2, Point2) -- (NW, SE) ldpRect cfig ldp = do - (x, y) <- ldp ^? ldpBorder . _Just + V2 x y <- ldp ^? ldpSize . _Just return $ ( V2 0 0 , V2 (10 * sf * fromIntegral x) (negate $ (20 * sf + ygap) * fromIntegral y) diff --git a/src/Dodge/Render/MenuScreen.hs b/src/Dodge/Render/MenuScreen.hs index 2cf13eba6..808b4af1a 100644 --- a/src/Dodge/Render/MenuScreen.hs +++ b/src/Dodge/Render/MenuScreen.hs @@ -27,7 +27,7 @@ drawLoadingScreen s _ cfig = <> translateScreenPos cfig - (ScreenPos (V2 0 0.2) (V2 (-300) (10 * fromIntegral (length s)))) + (ScreenPos (V2 0.5 0.7) (V2 (-300) (10 * fromIntegral (length s)))) (drawList $ map text s) drawInputMenu :: String -> Config -> Picture diff --git a/src/Dodge/ScreenPos.hs b/src/Dodge/ScreenPos.hs index 8f6300f05..277af3855 100644 --- a/src/Dodge/ScreenPos.hs +++ b/src/Dodge/ScreenPos.hs @@ -7,13 +7,14 @@ import Geometry.Data import Picture.Base fromTopLeft :: Point2 -> ScreenPos -fromTopLeft (V2 x y) = ScreenPos (V2 (-0.5) 0.5) (V2 x (- y)) +fromTopLeft (V2 x y) = ScreenPos (V2 0 1) (V2 x (- y)) translateScreenPos :: Config -> ScreenPos -> Picture -> Picture translateScreenPos cfig = uncurryV translate . screenPosAbs cfig +-- returns distance from center in pixels screenPosAbs :: Config -> ScreenPos -> Point2 -screenPosAbs cfig sp = sp ^. spScreenOff * V2 w h + sp ^. spPixelOff +screenPosAbs cfig sp = (sp ^. spScreenOff - 0.5) * V2 w h + sp ^. spPixelOff where w = fromIntegral $ cfig ^. windowX h = fromIntegral $ cfig ^. windowY diff --git a/src/Dodge/SelectionList.hs b/src/Dodge/SelectionList.hs index ccd600cd5..d3429c692 100644 --- a/src/Dodge/SelectionList.hs +++ b/src/Dodge/SelectionList.hs @@ -14,5 +14,5 @@ getAvailableListLines ldps cfig = floor ((dToBot - vgap) / itmHeight) itmHeight = 20 * ldps ^. ldpScale + vgap winy = fromIntegral $ cfig ^. windowY dToBot = - winy / 2 + winy * (ldps ^. ldpPos . spScreenOff . _y) + winy * (ldps ^. ldpPos . spScreenOff . _y) + (ldps ^. ldpPos . spPixelOff . _y) diff --git a/src/Dodge/Update/Input/InGame.hs b/src/Dodge/Update/Input/InGame.hs index 2fdbd3479..5c2f35f6f 100644 --- a/src/Dodge/Update/Input/InGame.hs +++ b/src/Dodge/Update/Input/InGame.hs @@ -132,15 +132,10 @@ updateMouseHeldInGame cfig w = case w ^. input . mouseContext of 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 + h = fromIntegral $ cfig ^. windowY + w = fromIntegral $ cfig ^. windowX + x' = min (w - (1+10*ldp ^?! ldpSize . _Just . _x . to fromIntegral)) $ max 1 x + y' = max (1+20*(ldp^.ldpVerticalGap + ldp^?!ldpSize._Just._y.to fromIntegral)-h) y --leftHeldPosShift :: World -> Point2 --leftHeldPosShift w = fromMaybe 0 $ do diff --git a/src/Dodge/Update/Input/ScreenLayer.hs b/src/Dodge/Update/Input/ScreenLayer.hs index a65758cc9..2aa672c37 100644 --- a/src/Dodge/Update/Input/ScreenLayer.hs +++ b/src/Dodge/Update/Input/ScreenLayer.hs @@ -90,7 +90,7 @@ ldpSelection cfig ldp (V2 _ y) ygap = ldp ^. ldpVerticalGap yoff = ygap + 20 * ldp ^. ldpScale top :: Float - top = fromIntegral winy * (ldp ^. ldpPos . spScreenOff . _y) + ldp ^. ldpPos . spPixelOff . _y + top = fromIntegral winy * (ldp ^. ldpPos . spScreenOff . _y - 0.5) + ldp ^. ldpPos . spPixelOff . _y yupper = floor $ (top - (y + ygap)) / yoff ylower = ceiling ((top - y) / yoff) - 1