Make displayed terminal text screen dragable

src/Dodge/Data/Input.hs

@@ -25,13 +25,14 @@ data MouseContext
     | OverCombFilter
     | OverCombEscape
     | OverTerminal {_mcoTermID :: Int, _mcoTermStatus :: TerminalStatus}
+    | OverTerminalBar {_mcoBarOffset :: Point2}
     | OutsideTerminal
     | MouseGameRotate {_mcoRotateDist :: Float}  -- TODO warp mouse to this distance
     | OverDebug {_mcoDBBool :: DebugBool, _mcoDBInt :: Int}
     deriving (Show)
 
 data Input = Input
-    { _mousePos :: Point2 -- in pixels, from the center of the screen
+    { _mousePos :: Point2 -- in pixels, from the center of the screen, +ve up and right (I believe)
     , _mouseContext :: MouseContext
     , _mouseMoving :: Bool
     , _pressedKeys :: M.Map Scancode Int

src/Dodge/Data/World.hs

@@ -10,6 +10,7 @@ module Dodge.Data.World (
     module Dodge.Data.Input,
 ) where
 
+import Dodge.Data.SelectionList
 import Color.Data
 import qualified Data.IntMap.Strict as IM
 import NewInt
@@ -58,6 +59,7 @@ data World = World
     , _wCam :: Camera
     , _unpauseClock :: Int
     , _coordinates :: IM.IntMap Point2 -- temporary coordinates for world generation/placement
+    , _tmLDP :: LDParams
     }
 
 data TimeFlowStatus

src/Dodge/Default/World.hs

@@ -1,6 +1,7 @@
 module Dodge.Default.World (defaultWorld) where
 
 --import Data.Graph.Inductive.Graph hiding ((&))
+import Dodge.ListDisplayParams
 import qualified Data.Set as S
 import qualified Data.Map as M
 import Dodge.Data.World
@@ -58,6 +59,7 @@ defaultWorld =
         , _unpauseClock = 0
         , _coordinates = mempty
         , _wSoundFilter = FilterBySoundOrigin $ S.singleton SpawnSound
+        , _tmLDP = terminalLDP
         }
 
 defaultCWGen :: CWGen

src/Dodge/Render/HUD.hs

@@ -373,11 +373,9 @@ drawTerminalDisplay w cfig tid = fold $ do
             TerminalTextInput s -> (++ [(getPromptTM ++ s ++ [cFilledRect], white)])
             TerminalPressTo s -> (++ [(s, white)])
     return $
-        drawSelectionList terminalLDP cfig f
+        drawSelectionList (w ^. tmLDP) cfig f
             <> drawTerminalCursorLink w cfig tm
   where
-    --        <> tm ^. tmButtonID
-
     --        <> invHead cfig ("TERMINAL-" ++ show tid)
     --        <> color
     --            (withAlpha 0.5 green) -- consider integrating termScreenColor somehow

src/Dodge/Render/List.hs

@@ -49,8 +49,8 @@ ldpRect :: Config -> LDParams -> Maybe (Point2, Point2) -- (NW, SE)
 ldpRect cfig ldp = do
     (x, y) <- ldp ^? ldpBorder . _Just
     return $
-        ( V2 (-5) 5
+        ( V2 0 0
-        , V2 (10 * sf * fromIntegral x) (negate $ (20 * sf + ygap) * fromIntegral y + 5)
+        , V2 (10 * sf * fromIntegral x) (negate $ (20 * sf + ygap) * fromIntegral y)
         )
             & each +~ screenPosAbs cfig (ldp ^. ldpPos)
   where

src/Dodge/Render/Picture.hs

@@ -114,6 +114,7 @@ mouseCursorType u = case u ^. uvWorld . input . mouseContext of
     OverCombCombine{} -> drawGapPlus 5
     OverCombEscape -> rotate (pi / 4) $ drawPlus 5
     OverTerminal _ ts -> drawCursorByTerminalStatus ts
+    OverTerminalBar _ -> drawDragSelect 5
     OutsideTerminal -> rotate (pi / 4) $ drawPlus 5
     MouseGameRotate {} -> rotate a (drawVerticalDoubleArrow 5)
     OverDebug {} -> drawPlus 5 <> rotate (pi/4) (drawPlus 5)

src/Dodge/Room/Tutorial.hs

@@ -342,7 +342,7 @@ chasmSpitTerminal = do
                 [ treePost [triggerDoorRoom i1, deadEndPSType (PutCrit chaseCrit)]
                 --[ treePost [triggerDoorRoom i1, deadEndPSType (PutCrit hoverCrit)]
                 --[ treePost [triggerDoorRoom i1, deadEndRoom]
-                , treePost [triggerDoorRoom i1, deadEndPSType (PutCrit hoverCrit)]
+                , treePost [triggerDoorRoom i1, deadEndPSType (PutCrit chaseCrit)]
                 , return $ cleatOnward $ triggerDoorRoom i1
                 ]
   where

src/Dodge/TestString.hs

@@ -35,6 +35,9 @@ import RandomHelp
 import qualified SDL
 import ShortShow
 
+tocrs :: (IM.IntMap Creature
+          -> Const (Endo [String]) (IM.IntMap Creature))
+         -> Universe -> Const (Endo [String]) Universe
 tocrs = uvWorld . cWorld . lWorld . creatures
 
 testStringInit :: Universe -> [String]

src/Dodge/Update.hs

@@ -3,6 +3,7 @@
 
 module Dodge.Update (updateUniverse) where
 
+import Dodge.Data.ScreenPos
 import Bound
 import Color
 import Control.Applicative
@@ -412,6 +413,7 @@ updateMouseContextGame cfig u = \case
     x@OverInvDragSelect{} -> x
     MouseGameRotate x
         | ButtonRight `M.member` (w ^. input . mouseButtons) -> MouseGameRotate x
+    OverTerminalBar p | ButtonLeft `M.member` (w ^. input . mouseButtons) -> OverTerminalBar p
     _ -> fromMaybe aimcontext (overterm <|> overinv <|> overcomb)
   where
     w = u ^. uvWorld
@@ -443,10 +445,16 @@ updateMouseContextGame cfig u = \case
     overterm = do
         tmid <- w ^? hud . subInventory . termID
         tm <- w ^? cWorld . lWorld . terminals . ix tmid
-        return $
+        xy <- ldpRect cfig (w ^. tmLDP)
-            if isOverTerminalScreen cfig mpos
+        return $ tmScreenMousePos w xy mpos tmid (tm ^. tmStatus)
-                then OverTerminal tmid (tm ^. tmStatus)
+
-                else OutsideTerminal
+tmScreenMousePos :: World -> (Point2,Point2) -> Point2 -> Int -> TerminalStatus -> MouseContext
+tmScreenMousePos w (V2 xmin ymax, V2 xmax ymin) (V2 x y) tmid ts
+    | xtest && y <= ymax && y >= ymin = OverTerminal tmid ts
+    | xtest && y <= ymax + 20 && y >= ymax = OverTerminalBar (w ^. tmLDP . ldpPos . spPixelOff - V2 x y)
+    | otherwise = OutsideTerminal
+  where
+    xtest = x <= xmax && x >= xmin 
 
 getDebugMouseOver :: Universe -> MouseContext
 getDebugMouseOver u = fromMaybe MouseInGame $ do
@@ -468,11 +476,6 @@ getMenuMouseContext screen u = case screen ^. scOptions of
         t <- screen ^? scSelectionList . ix yi . siIsSelectable
         return $ if t then MouseMenuClick yi else NoMouseContext
 
-isOverTerminalScreen :: Config -> Point2 -> Bool
-isOverTerminalScreen cfig (V2 x y) = fromMaybe False $ do
-    (V2 xmin ymax, V2 xmax ymin) <- ldpRect cfig terminalLDP
-    return $ x <= xmax && x >= xmin && y <= ymax && y >= ymin
-
 updateWheelEvents :: World -> World
 updateWheelEvents w = case w ^. input . scrollAmount of
     0 -> w

src/Dodge/Update/Input/InGame.hs

@@ -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)