justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Implement generalised storing of position for mouse presses

Browse Source
This commit is contained in:
justin
2023-03-26 23:00:07 +01:00
parent e5906eefa3
commit ee89ac9b00
10 changed files with 27 additions and 39 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Base/Collide.hs
+1 -2
View File
@@ -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
src/Dodge/Creature/YourControl.hs
+3 -2
View File
@@ -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
+1 -1
View File
@@ -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
-2
View File
@@ -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
+1 -3
View File
@@ -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
+6 -4
View File
@@ -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
src/Dodge/Render/ShapePicture.hs
+2 -2
View File
@@ -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
+2 -1
View File
@@ -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
+11 -9
View File
@@ -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 =
src/Dodge/Zoning/Common.hs
-13
View File
@@ -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)