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

Implement floating camera

Browse Source
This commit is contained in:
justin
2023-03-26 16:44:19 +01:00
parent 082ce9c9a1
commit 73e742e1a2
12 changed files with 86 additions and 38 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Base/Coordinate.hs
+6
View File
@@ -2,6 +2,7 @@ module Dodge.Base.Coordinate (
mouseWorldPos,
cartePosToScreen,
worldPosToScreen,
screenToWorldPos,
) where
import Control.Lens
@@ -47,6 +48,11 @@ mouseWorldPos inp cam =
(cam ^. camCenter)
+.+ (1 / (cam ^. camZoom)) *.* rotateV (cam ^. camRot) (_mousePos inp)
screenToWorldPos :: Camera -> Point2 -> Point2
screenToWorldPos cam p =
(cam ^. camCenter)
+.+ (1 / (cam ^. camZoom)) *.* rotateV (cam ^. camRot) p
---- | The mouse position in map coordinates
--mouseCartePos :: World -> Point2
--mouseCartePos w = (thehud ^. carteCenter)
src/Dodge/Creature/Impulse/UseItem.hs
+1 -1
View File
@@ -55,7 +55,7 @@ itemEffect cr it w = case it ^. itUse of
tryReload :: Creature -> Item -> Input -> (World -> World) -> World -> World
tryReload cr it theinput f
| cid == 0 && itNeedsLoading it && _mouseButtons theinput M.!? SDL.ButtonLeft == Just False =
| cid == 0 && itNeedsLoading it && _mouseButtons theinput M.!? SDL.ButtonLeft == Just 1 =
cWorld . lWorld . creatures . ix cid %~ crToggleReloading
| otherwise =
(runIdentity . pointerToItemLocation (_itLocation it) (return . (itUse . heldHammer .~ HammerDown)))
src/Dodge/Creature/YourControl.hs
+2 -2
View File
@@ -104,7 +104,7 @@ wasdDir :: World -> Point2
wasdDir = foldl' (flip $ (+.+) . wasdM) (V2 0 0) . M.keys . _pressedKeys . _input
-- | Set posture according to mouse presses.
mouseActionsCr :: M.Map SDL.MouseButton Bool -> Creature -> Creature
mouseActionsCr :: M.Map SDL.MouseButton Int -> Creature -> Creature
mouseActionsCr pkeys cr
| rbPressed && noaction =
cr & crStance . posture .~ Aiming
@@ -115,7 +115,7 @@ mouseActionsCr pkeys cr
theaction <- cr ^? crManipulation . manObject . inInventory . iselAction
return $ theaction == NoInvSelAction
pressedMBEffectsTopInventory :: M.Map SDL.MouseButton Bool -> World -> World
pressedMBEffectsTopInventory :: M.Map SDL.MouseButton Int -> World -> World
pressedMBEffectsTopInventory pkeys w
| isDown SDL.ButtonLeft && isDown SDL.ButtonRight && inTopInv = useItem (you w) w
| isDown SDL.ButtonLeft && inTopInv = doTopInvLeftClick (you w) w
src/Dodge/Data/Input.hs
+5 -2
View File
@@ -20,7 +20,7 @@ data Input = Input
{ _mousePos :: Point2 -- in pixels, from the center of the screen
, _mouseMoving :: Bool
, _pressedKeys :: M.Map Scancode PressType
, _mouseButtons :: M.Map MouseButton Bool -- shortpress False, repeatpress True
, _mouseButtons :: M.Map MouseButton Int -- counts number of frames held down
, _scrollAmount :: Int
, _previousScrollAmount :: Int
, _lLine :: (Point2, Point2)
@@ -28,7 +28,10 @@ data Input = Input
, _lrLine :: (Point2, Point2)
, _lSelect :: Point2
, _rSelect :: Point2
, _clickMousePos :: 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
-- ideally, lags ONE FRAME BEHIND the stored mouse position
, _textInput :: [Either TermSignal Char]
, _scrollTestFloat :: Float
, _scrollTestInt :: Int
src/Dodge/Default/World.hs
+2
View File
@@ -14,6 +14,8 @@ defaultInput :: Input
defaultInput =
Input
{ _clickMousePos = V2 0 0
, _clickPos = mempty
, _heldPos = mempty
, _textInput = mempty
, _pressedKeys = mempty
, _mouseButtons = mempty
src/Dodge/Event/Input.hs
+5 -3
View File
@@ -12,6 +12,7 @@ import Dodge.Data.Config
import Dodge.Data.Input
import LensHelp
import SDL
--import qualified Data.Map.Strict as M
-- annoyingly, the text input event doesn't register backspace, so deletion has to be
-- dealt with separately
@@ -55,7 +56,8 @@ handleMouseWheelEvent mwev = scrollAmount +~ fromIntegral y
handleMouseButtonEvent :: MouseButtonEventData -> Input -> Input
handleMouseButtonEvent mbev = case mouseButtonEventMotion mbev of
Released -> pointtothebutton .~ Nothing
Pressed -> pointtothebutton ?~ False
Released -> mouseButtons . at thebutton .~ Nothing
Pressed -> mouseButtons . at thebutton ?~ 1 -- note that mouse button events are NOT repeating
where
pointtothebutton = mouseButtons . at (mouseButtonEventButton mbev)
-- pointtothebutton = mouseButtons . at thebutton
thebutton = mouseButtonEventButton mbev
src/Dodge/Menu.hs
+1
View File
@@ -231,6 +231,7 @@ listControls =
, ("x", "EXAMINE ITEMS")
, ("c|<esc>", "PAUSE AND DISPLAY MENU")
, ("q|e", "ROTATE CAMERA")
, ("<F1>", "USE NORMAL CAMERA")
, ("<F2>", "PAUSE AND FLOAT CAMERA")
, ("<F3>", "PAUSE AND PAN CAMERA")
, ("<F5>", "QUICKSAVE")
src/Dodge/TestString.hs
+17 -14
View File
@@ -1,3 +1,4 @@
{-# OPTIONS_GHC -Wno-unused-imports #-}
module Dodge.TestString where
import HelpNum
@@ -15,20 +16,22 @@ import Dodge.Data.Universe
--import qualified Data.Map.Strict as M
--import qualified IntMapHelp as IM
testStringInit :: Universe -> [String]
testStringInit u = [show $ length $ lightsToRender (u ^. uvConfig) (u ^. uvWorld . cWorld . cwCam)
(u ^. uvWorld . cWorld . lWorld)
, show a
, show $ u ^. uvWorld . input . mousePos
, show $ u ^. uvConfig . windowX
, show $ u ^. uvConfig . windowY
, show $ u ^. uvWorld . input . scrollTestInt
]
where
w = u ^. uvWorld
a = fromMaybe 0 $ do
cpos <- w ^? cWorld . lWorld . creatures . ix 0 . crPos
return . toClosestMultiple (pi/ 8) $ argV (mouseWorldPos (w ^. input) (w ^. cWorld . cwCam) -.- cpos)
- w ^. cWorld . cwCam . camRot
testStringInit u = [show $ u ^. uvWorld . input . mouseButtons
, show $ u ^. uvWorld . input . heldPos]
-- [show $ length $ lightsToRender (u ^. uvConfig) (u ^. uvWorld . cWorld . cwCam)
-- (u ^. uvWorld . cWorld . lWorld)
-- , show a
-- , show $ u ^. uvWorld . input . mousePos
-- , show $ u ^. uvConfig . windowX
-- , show $ u ^. uvConfig . windowY
-- , show $ u ^. uvWorld . input . scrollTestInt
-- ]
-- where
-- w = u ^. uvWorld
-- a = fromMaybe 0 $ do
-- cpos <- w ^? cWorld . lWorld . creatures . ix 0 . crPos
-- return . toClosestMultiple (pi/ 8) $ argV (mouseWorldPos (w ^. input) (w ^. cWorld . cwCam) -.- cpos)
-- - w ^. cWorld . cwCam . camRot
--[show $ u ^? uvWorld . hud . hudElement . diSections . sssExtra . sssSelPos . _Just]
-- [show $ fmap IM.keys $ u ^? uvWorld . hud . hudElement . subInventory . ciSections . sssSections]
src/Dodge/Update.hs
+15 -10
View File
@@ -105,11 +105,13 @@ gotoTerminal w = case _uvScreenLayers w of
_ -> w & uvScreenLayers .:~ InputScreen mempty "Enter command"
updateUniverseLast :: Universe -> Universe
updateUniverseLast =
over uvWorld (input . mouseButtons . each .~ True) -- to determine if the mouse button is held
. over uvWorld (input . pressedKeys . each %~ f)
. over uvWorld (input . mouseMoving .~ False)
updateUniverseLast u = u
& uvWorld . input . pressedKeys . each %~ f
& uvWorld . input . mouseMoving .~ False
& uvWorld . input . mouseButtons . each +~ 1
& uvWorld . input . heldPos %~ M.union (fmap (const mp) (u ^. uvWorld . input . mouseButtons))
where
mp = u ^. uvWorld . input . mousePos
f LongPress = LongPress
f _ = ShortPress
@@ -131,25 +133,28 @@ updateUniverseMid u = case _uvScreenLayers u of
timeFlowUpdate :: Universe -> Universe
timeFlowUpdate u = case u ^. uvWorld . timeFlow of
_ | debugcamera -> u
NormalTimeFlow -> functionalUpdate u
ScrollTimeFlow smoothing _ _ _ -> over uvWorld (doTimeScroll smoothing) u
RewindLeftClick 0 _ -> u & uvWorld . timeFlow .~ NormalTimeFlow
RewindLeftClick _ _ -> over uvWorld scrollTimeBack u -- & uvWorld . cWorld . timeFlow .~ NormalTimeFlow
DeathTime{} -> u
PausedTimeFlow _ itmloc -> over uvWorld (pauseTime itmloc) u
where
debugcamera = CamInGame /= (u ^. uvWorld . cWorld . cwCam . camControl)
pauseTime :: Int -> World -> World
pauseTime itmloc w
| justPressedButtonLeft || outofcharge = w & timeFlow .~ NormalTimeFlow
| otherwise = w & pointerToItemLocation (w ^?! cWorld . lWorld . itemLocations . ix itmloc) . itUse . leftConsumption . wpCharge -~ 1
where
justPressedButtonLeft = w ^? input . mouseButtons . ix ButtonLeft == Just False
justPressedButtonLeft = w ^? input . mouseButtons . ix ButtonLeft == Just 1
outofcharge = maybe True (== 0) charge
charge = w ^? pointerToItemLocation (w ^?! cWorld . lWorld . itemLocations . ix itmloc) . itUse . leftConsumption . wpCharge
doTimeScroll :: Int -> World -> World
doTimeScroll smoothing w = case w ^? input . mouseButtons . ix ButtonLeft of
Just False -> w & timeFlow .~ NormalTimeFlow
Just 1 -> w & timeFlow .~ NormalTimeFlow
_ -> doTimeScroll' smoothing w
doTimeScroll' :: Int -> World -> World
@@ -286,16 +291,16 @@ updateWorldSelect' w = over input (updateWorldSelect (w ^. cWorld . cwCam)) w
updateWorldSelect :: Camera -> Input -> Input
updateWorldSelect cam inp = f . g $ case (inp ^? mouseButtons . ix ButtonLeft, inp ^? mouseButtons . ix ButtonRight) of
(Just False, Nothing) ->
(Just 1, Nothing) ->
inp & lLine . _1 .~ mwp
& lrLine . _1 .~ mwp
(Just True, Nothing) ->
(Just _, Nothing) ->
inp & lLine . _2 .~ mwp
& lrLine . _1 .~ mwp
(Nothing, Just False) ->
(Nothing, Just 1) ->
inp & rLine . _1 .~ mwp
& lrLine . _2 .~ mwp
(Nothing, Just True) ->
(Nothing, Just _) ->
inp & rLine . _2 .~ mwp
& lrLine . _2 .~ mwp
_ -> inp
src/Dodge/Update/Camera.hs
+26 -1
View File
@@ -5,6 +5,8 @@ module Dodge.Update.Camera (
updateCamera,
) where
import SDL (MouseButton (..))
import Dodge.Base.Coordinate
import Dodge.InputFocus
import Bound
import Dodge.Viewpoints
@@ -28,9 +30,32 @@ update where your avatar's view is from. -}
updateCamera :: Configuration -> World -> World
updateCamera cfig w = case w ^. cWorld . cwCam . camControl of
CamInGame -> updateInGameCamera cfig w
CamFloat -> w
CamFloat -> updateFloatingCamera cfig w
CamPan -> w
updateFloatingCamera :: Configuration -> World -> World
updateFloatingCamera cfig w = w
& updateBounds cfig
& cWorld . cwCam %~ setViewDistance cfig
& cWorld . cwCam %~ translateFloatingCamera theinput
& cWorld . cwCam %~ zoomFloatingCamera theinput
where
theinput = w ^. input
translateFloatingCamera :: Input -> Camera -> Camera
translateFloatingCamera theinput cam = fromMaybe cam $ do
presstime <- theinput ^. mouseButtons . at ButtonLeft
guard $ presstime > 1
hpos <- theinput ^? heldPos . ix ButtonLeft
let thetran =
screenToWorldPos cam hpos
-.-
screenToWorldPos cam (theinput ^. mousePos)
return $ cam & camCenter +~ thetran
& camViewFrom +~ thetran
zoomFloatingCamera theinput cam = cam
updateInGameCamera :: Configuration -> World -> World
updateInGameCamera cfig w =
w
src/Dodge/Update/Input/InGame.hs
+4 -3
View File
@@ -61,12 +61,12 @@ updateUseInputInGame h u = case h of
where
w = u ^. uvWorld
pkeys = u ^. uvWorld . input . pressedKeys
lbinitialpress = u ^? uvWorld . input . mouseButtons . ix ButtonLeft == Just False
lbinitialpress = u ^? uvWorld . input . mouseButtons . ix ButtonLeft == Just 1
updatePressedButtonsCarte :: World -> World
updatePressedButtonsCarte w = updatePressedButtonsCarte' (_mouseButtons (_input w)) w
updatePressedButtonsCarte' :: M.Map MouseButton Bool -> World -> World
updatePressedButtonsCarte' :: M.Map MouseButton Int -> World -> World
updatePressedButtonsCarte' pkeys w
| isDown ButtonRight =
w
@@ -106,6 +106,7 @@ updateKeyInGame uv sc pt = case pt of
updateInitialPressInGame :: Universe -> Scancode -> Universe
updateInitialPressInGame uv sc = case sc of
ScancodeF1 -> useNormalCamera uv
ScancodeF2 -> pauseAndFloatCam uv
ScancodeF3 -> pauseAndPanCam uv
ScancodeF5 -> doQuicksave uv
@@ -149,7 +150,7 @@ doRegexInput u i sss
any
((== Just InitialPress) . (`M.lookup` pkeys))
[ScancodeReturn, ScancodeSlash]
endmouse = fromMaybe False $ u ^? uvWorld . input . mouseButtons . ix ButtonLeft
endmouse = maybe False (==1) $ u ^? uvWorld . input . mouseButtons . ix ButtonLeft
backspacetonothing =
sss ^? sssExtra . sssFilters . ix i . _Just == Just ""
&& ScancodeBackspace `M.lookup` pkeys == Just InitialPress
src/Dodge/Update/Input/ScreenLayer.hs
+2 -2
View File
@@ -60,12 +60,12 @@ mouseClickOptionsList :: ScreenLayer -> Universe -> Universe
mouseClickOptionsList screen u = fromMaybe u $ do
sl <- screen ^? scSelectionList
Just $ case u ^. uvWorld . input . mouseButtons . at ButtonLeft of
Just False -> fromMaybe u $ do
Just 1 -> fromMaybe u $ do
i <- sl ^. slSelPos
f <- sl ^? slItems . ix i . siPayload . _1
return $ f u
_ -> case u ^. uvWorld . input . mouseButtons . at ButtonRight of
Just False -> fromMaybe u $ do
Just 1 -> fromMaybe u $ do
i <- sl ^. slSelPos
f <- sl ^? slItems . ix i . siPayload . _2
return $ f u