diff --git a/src/Dodge/Base/Collide.hs b/src/Dodge/Base/Collide.hs index cb9418a4f..9e8f03b28 100644 --- a/src/Dodge/Base/Collide.hs +++ b/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 $ wlsNearPoint ep w + hitWl = collideCircWalls sp ep rad $ wlsNearSeg sp ep w -- this should probably be wallsOnLine or something diff --git a/src/Dodge/Creature/YourControl.hs b/src/Dodge/Creature/YourControl.hs index 20ab06d45..7e5556c29 100644 --- a/src/Dodge/Creature/YourControl.hs +++ b/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) diff --git a/src/Dodge/Data/Config.hs b/src/Dodge/Data/Config.hs index 759c7cab0..69a3db537 100644 --- a/src/Dodge/Data/Config.hs +++ b/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 diff --git a/src/Dodge/Data/Input.hs b/src/Dodge/Data/Input.hs index b20c1fbbc..efd93457c 100644 --- a/src/Dodge/Data/Input.hs +++ b/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 diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index 5e6d0fa12..4ca2a3006 100644 --- a/src/Dodge/Default/World.hs +++ b/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) diff --git a/src/Dodge/Event/Input.hs b/src/Dodge/Event/Input.hs index 31f305ba0..a9d1ab41b 100644 --- a/src/Dodge/Event/Input.hs +++ b/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 - Released -> mouseButtons . at thebutton .~ Nothing - Pressed -> mouseButtons . at thebutton ?~ 1 -- note that mouse button events are NOT repeating +handleMouseButtonEvent mbev theinput = case mouseButtonEventMotion mbev of + Released -> theinput & mouseButtons . at thebutton .~ Nothing + 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 diff --git a/src/Dodge/Render/ShapePicture.hs b/src/Dodge/Render/ShapePicture.hs index ddbc41528..b13862daf 100644 --- a/src/Dodge/Render/ShapePicture.hs +++ b/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 diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 4b9322132..d12dd2290 100644 --- a/src/Dodge/Update.hs +++ b/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 diff --git a/src/Dodge/Update/Input/InGame.hs b/src/Dodge/Update/Input/InGame.hs index 3a595163a..c38659e78 100644 --- a/src/Dodge/Update/Input/InGame.hs +++ b/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 - & input . clickMousePos .~ _mousePos (_input w) - & hud . carteCenter %~ (-.- trans) + 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)) - czoom = magV (_mousePos (_input w)) / magV (_clickMousePos (_input w)) - trans = - rotateV (w ^. hud . carteRot) $ - 1 / (w ^. hud . carteZoom) *.* (_mousePos (_input w) -.- _clickMousePos (_input w)) + mbutpos but = theinput ^. heldPos . at but + rot = fromMaybe 0 $ angleBetween (_mousePos (_input w)) <$> mbutpos SDL.ButtonLeft + czoom = fromMaybe 1 $ do + p <- mbutpos SDL.ButtonLeft + 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 = diff --git a/src/Dodge/Zoning/Common.hs b/src/Dodge/Zoning/Common.hs index 24803aab7..f09480827 100644 --- a/src/Dodge/Zoning/Common.hs +++ b/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)