Implement generalised storing of position for mouse presses

src/Dodge/Base/Collide.hs

@@ -249,7 +249,6 @@ anythingHitCirc rad sp ep w = hitCr || isJust (sequence hitWl)
             (\cr -> null $ intersectCircSeg (_crPos cr) (rad + _crRad cr) sp ep)
             (w ^? cWorld . lWorld . creatures . ix cid)
             || bl
-
+    hitWl = collideCircWalls sp ep rad $ wlsNearSeg sp ep w
-    hitWl = collideCircWalls sp ep rad $ wlsNearPoint ep w
 
 -- this should probably be wallsOnLine or something

src/Dodge/Creature/YourControl.hs

@@ -121,11 +121,12 @@ pressedMBEffectsTopInventory pkeys w
     | isDown SDL.ButtonLeft && inTopInv = doTopInvLeftClick (you w) w
     | isDown SDL.ButtonMiddle =
         w & wCam . camRot -~ rotation
-            & input . clickMousePos .~ _mousePos (_input w)
     | otherwise = w
   where
     inTopInv = case w ^. hud . hudElement of
         DisplayInventory {_subInventory = NoSubInventory} -> True
         _ -> False
     isDown but = but `M.member` pkeys
-    rotation = angleBetween (_mousePos (_input w)) (_clickMousePos (_input w))
+    theinput = w ^. input
+    rotation = fromMaybe 0 
+        $ angleBetween (theinput ^. mousePos) <$> (theinput ^. heldPos . at SDL.ButtonMiddle)

src/Dodge/Data/Config.hs

@@ -65,7 +65,7 @@ windowYFloat = fromIntegral . _windowY
 
 data DebugBool
     = Show_ms_frame
-    | Show_debug
+    | Enable_debug
     | Show_sound
     | Noclip
     | Cr_status

src/Dodge/Data/Input.hs

@@ -22,14 +22,12 @@ data Input = Input
     , _pressedKeys :: M.Map Scancode PressType
     , _mouseButtons :: M.Map MouseButton Int -- counts number of frames held down
     , _scrollAmount :: Int
-    , _previousScrollAmount :: Int
     , _smoothScrollAmount :: Int
     , _lLine :: (Point2, Point2)
     , _rLine :: (Point2, Point2)
     , _lrLine :: (Point2, Point2)
     , _lSelect :: Point2
     , _rSelect :: Point2
-    , _clickMousePos :: Point2  -- is this in world or screen coords?
     , _clickPos :: M.Map MouseButton Point2 -- updates when mouse button is pressed
     , _heldPos :: M.Map MouseButton Point2 -- updates when mouse button is held
             -- lags ONE FRAME BEHIND the stored mouse position

src/Dodge/Default/World.hs

@@ -13,8 +13,7 @@ import System.Random
 defaultInput :: Input
 defaultInput =
     Input
-        { _clickMousePos = V2 0 0
+        { _clickPos = mempty
-        , _clickPos = mempty
         , _heldPos = mempty
         , _textInput = mempty
         , _pressedKeys = mempty
@@ -22,7 +21,6 @@ defaultInput =
         , _mousePos = V2 0 0
         , _mouseMoving = False
         , _scrollAmount = 0
-        , _previousScrollAmount = 0
         , _smoothScrollAmount = 0
         , _lrLine = (0, 0)
         , _lLine = (0, 0)

src/Dodge/Event/Input.hs

@@ -63,9 +63,11 @@ handleMouseWheelEvent mwev =
     V2 _ y = mouseWheelEventPos mwev
 
 handleMouseButtonEvent :: MouseButtonEventData -> Input -> Input
-handleMouseButtonEvent mbev = case mouseButtonEventMotion mbev of
+handleMouseButtonEvent mbev theinput = case mouseButtonEventMotion mbev of
-    Released -> mouseButtons . at thebutton .~ Nothing
+    Released -> theinput & mouseButtons . at thebutton .~ Nothing
-    Pressed -> mouseButtons . at thebutton ?~ 1 -- note that mouse button events are NOT repeating
+    Pressed -> theinput
+        & mouseButtons . at thebutton ?~ 1
+        & clickPos . at thebutton ?~ (theinput ^. mousePos)
+    -- note that mouse button down events are NOT repeating
   where
-    --    pointtothebutton = mouseButtons . at thebutton
     thebutton = mouseButtonEventButton mbev

src/Dodge/Render/ShapePicture.hs

@@ -167,7 +167,7 @@ extraPics cfig u =
 debugDraw :: Configuration -> World -> Picture
 {-# INLINE debugDraw #-}
 debugDraw cfig w
-    | Show_debug `Set.member` _debug_booleans cfig =
+    | Enable_debug `Set.member` _debug_booleans cfig =
         pic
             <> setLayer FixedCoordLayer (listPicturesAt (0.5 * halfWidth cfig) 0 cfig $ map text ts)
     | otherwise = mempty
@@ -178,7 +178,7 @@ debugDraw cfig w
 debugDraw' :: Configuration -> World -> DebugBool -> Picture
 {-# INLINE debugDraw' #-}
 debugDraw' cfig w bl = case bl of
-    Show_debug -> mempty
+    Enable_debug -> mempty
     Noclip -> mempty
     Remove_LOS -> mempty
     Cull_more_lights -> mempty

src/Dodge/Update.hs

@@ -8,6 +8,7 @@ module Dodge.Update (updateUniverse) where
 
 --import Dodge.InputFocus
 
+import Dodge.Debug
 import Dodge.SmoothScroll
 import Color
 import Control.Applicative
@@ -75,6 +76,7 @@ updateUniverse u =
         . maybeOpenTerminal
         . over (uvWorld . input . textInput) (const mempty)
         . updateUniverseMid
+        . debugEvents
         . updateUseInput -- this should be pushed inside when the universe is paused etc
         -- OR the keys should be tested "in game", so to speak
         . over uvWorld (updateCamera cfig)
@@ -268,7 +270,6 @@ updateWheelEvents w
 advanceScrollAmount :: Universe -> Universe
 advanceScrollAmount u =
     u
-        & uvWorld . input . previousScrollAmount .~ _scrollAmount (_input $ _uvWorld u)
         & uvWorld . input . scrollAmount .~ 0
         & uvWorld . input . smoothScrollAmount %~ advanceSmoothScroll
 

src/Dodge/Update/Input/InGame.hs

@@ -69,22 +69,24 @@ updatePressedButtonsCarte w = updatePressedButtonsCarte' (_mouseButtons (_input
 updatePressedButtonsCarte' :: M.Map MouseButton Int -> World -> World
 updatePressedButtonsCarte' pkeys w
     | isDown ButtonRight =
-        w
+        w & hud . carteCenter %~ (-.- trans)
-            & input . clickMousePos .~ _mousePos (_input w)
-            & hud . carteCenter %~ (-.- trans)
     | isDown ButtonLeft =
         w
-            & input . clickMousePos .~ _mousePos (_input w)
             & hud . carteRot -~ rot
             & hud . carteZoom *~ czoom
     | otherwise = w
   where
     isDown but = but `M.member` pkeys
-    rot = angleBetween (_mousePos (_input w)) (_clickMousePos (_input w))
+    mbutpos but = theinput ^. heldPos . at but
-    czoom = magV (_mousePos (_input w)) / magV (_clickMousePos (_input w))
+    rot = fromMaybe 0 $ angleBetween (_mousePos (_input w)) <$> mbutpos SDL.ButtonLeft
-    trans =
+    czoom = fromMaybe 1 $ do
-        rotateV (w ^. hud . carteRot) $
+        p <- mbutpos SDL.ButtonLeft
-            1 / (w ^. hud . carteZoom) *.* (_mousePos (_input w) -.- _clickMousePos (_input w))
+        return $ magV (_mousePos theinput) / magV p
+    theinput = w ^. input
+    trans = fromMaybe 0 $ do
+        p <- mbutpos SDL.ButtonRight
+        return . rotateV (w ^. hud . carteRot) $
+            1 / (w ^. hud . carteZoom) *.* (_mousePos (_input w) -.- p)
 
 updateKeysInTerminal :: Int -> Universe -> Universe
 updateKeysInTerminal tmid u =

src/Dodge/Zoning/Common.hs

@@ -1,31 +1,18 @@
 module Dodge.Zoning.Common where
 
 import Dodge.Data.World
-import Control.Lens
 import Dodge.Zoning.Base
 import Geometry
 import qualified IntMapHelp as IM
 
-nearPoint :: Monoid m => Float -> (LWorld -> IM.IntMap (IM.IntMap m)) -> Point2 -> World -> m
-{-# INLINE nearPoint #-}
-nearPoint size f p w = zoneExtract (zoneOfPoint size p) (f $ w ^. cWorld . lWorld)
-
 nearPoint' :: Monoid m => Float -> (World -> IM.IntMap (IM.IntMap m)) -> Point2 -> World -> m
 {-# INLINE nearPoint' #-}
 nearPoint' size f p w = zoneExtract (zoneOfPoint size p) (f w)
 
-nearSeg :: Monoid m => Float -> (LWorld -> IM.IntMap (IM.IntMap m)) -> Point2 -> Point2 -> World -> m
-{-# INLINE nearSeg #-}
-nearSeg size f sp ep w = zonesExtract (f $ w ^. cWorld . lWorld) (zoneOfSeg size sp ep)
-
 nearSeg' :: Monoid m => Float -> (World -> IM.IntMap (IM.IntMap m)) -> Point2 -> Point2 -> World -> m
 {-# INLINE nearSeg' #-}
 nearSeg' size f sp ep w = zonesExtract (f w) (zoneOfSeg size sp ep)
 
-nearRect :: Monoid m => Float -> (LWorld -> IM.IntMap (IM.IntMap m)) -> Point2 -> Point2 -> World -> m
-{-# INLINE nearRect #-}
-nearRect size f sp ep w = zonesExtract (f $ w ^. cWorld . lWorld) (zoneOfRect size sp ep)
-
 nearRect' :: Monoid m => Float -> (World -> IM.IntMap (IM.IntMap m)) -> Point2 -> Point2 -> World -> m
 {-# INLINE nearRect' #-}
 nearRect' size f sp ep w = zonesExtract (f w) (zoneOfRect size sp ep)