diff --git a/src/Dodge/Base/Collide.hs b/src/Dodge/Base/Collide.hs index c60f12090..acf416418 100644 --- a/src/Dodge/Base/Collide.hs +++ b/src/Dodge/Base/Collide.hs @@ -132,7 +132,7 @@ allVisibleWalls :: World -> [(Point2, Wall)] {-# INLINE allVisibleWalls #-} allVisibleWalls w = concatMap (flip (visibleWalls vPos) w . (+.+ vPos)) $ nRays 15 where - vPos = w ^. cWorld . cwCamPos . camViewFrom + vPos = w ^. cWorld . cwCam . camViewFrom overlapCircWalls :: Point2 -> diff --git a/src/Dodge/Base/Coordinate.hs b/src/Dodge/Base/Coordinate.hs index 7e3ffcddb..b1b422105 100644 --- a/src/Dodge/Base/Coordinate.hs +++ b/src/Dodge/Base/Coordinate.hs @@ -5,7 +5,7 @@ module Dodge.Base.Coordinate ( ) where import Control.Lens -import Dodge.Data.CamPos +import Dodge.Data.Camera import Dodge.Data.HUD import Dodge.Data.Input import Geometry @@ -22,7 +22,7 @@ import Geometry - These have to be scaled according to the size of the window to get actual screen positions. - This allows for line thicknesses etc to correspond to pixel sizes. -} -worldPosToScreen :: CamPos -> Point2 -> Point2 +worldPosToScreen :: Camera -> Point2 -> Point2 worldPosToScreen cam = rotateV (negate $ cam ^. camRot) . ((cam ^. camZoom) *.*) @@ -42,7 +42,7 @@ cartePosToScreen thehud = doRotate . doZoom . doTranslate --crToMousePosOffset cr w = (mouseWorldPos w -.- _crPos cr, 0) -- | The mouse position in world coordinates. -mouseWorldPos :: Input -> CamPos -> Point2 +mouseWorldPos :: Input -> Camera -> Point2 mouseWorldPos inp cam = (cam ^. camCenter) +.+ (1 / (cam ^. camZoom)) *.* rotateV (cam ^. camRot) (_mousePos inp) diff --git a/src/Dodge/Base/Window.hs b/src/Dodge/Base/Window.hs index bba653eb5..c365ac4a4 100644 --- a/src/Dodge/Base/Window.hs +++ b/src/Dodge/Base/Window.hs @@ -7,13 +7,13 @@ module Dodge.Base.Window ( screenBox, ) where -import Dodge.Data.CamPos +import Dodge.Data.Camera import Dodge.Data.Config import Geometry import Control.Lens -- | A box covering the screen in world coordinates -screenPolygon :: Configuration -> CamPos -> [Point2] +screenPolygon :: Configuration -> Camera -> [Point2] screenPolygon cfig w = map (scTran . scRot . scZoom) $ screenBox cfig where scRot = rotateV (w ^. camRot) @@ -29,7 +29,7 @@ screenPolygonBord :: -- | Y border Float -> Configuration -> - CamPos -> + Camera -> [Point2] screenPolygonBord xbord ybord cfig w = [tr, tl, bl, br] where diff --git a/src/Dodge/Bullet.hs b/src/Dodge/Bullet.hs index 175ce9bc6..7a67fab04 100644 --- a/src/Dodge/Bullet.hs +++ b/src/Dodge/Bullet.hs @@ -82,7 +82,7 @@ useAmmoParams it cr w = return $ FlechetteTrajectory tpos BezierTrajectory{} -> fromMaybe BasicBulletTrajectory $ do tpos <- cr ^? crTargeting . ctPos . _Just - return $ BezierTrajectory sp tpos (mouseWorldPos (w ^. input) (w ^. cWorld . cwCamPos)) + return $ BezierTrajectory sp tpos (mouseWorldPos (w ^. input) (w ^. cWorld . cwCam)) bounceDir :: (Point2, Either Creature Wall) -> Maybe Point2 bounceDir (_, Right wl) | _wlBouncy wl = Just $ uncurry (-.-) (_wlLine wl) diff --git a/src/Dodge/Creature/Action/Blink.hs b/src/Dodge/Creature/Action/Blink.hs index 5b6b2328b..f8cdf4b8d 100644 --- a/src/Dodge/Creature/Action/Blink.hs +++ b/src/Dodge/Creature/Action/Blink.hs @@ -26,7 +26,7 @@ blinkActionMousePos cr w = & inverseShockwaveAt cpos 40 2 2 where cid = _crID cr - p1 = mouseWorldPos (w ^. input) (w ^. cWorld . cwCamPos) + p1 = mouseWorldPos (w ^. input) (w ^. cWorld . cwCam) cpos = _crPos cr --p2 = bouncePoint (const True) 1 cpos p1 w p2 = pushIntoMaybe $ collideCircWalls cpos p1 r (wlsNearSeg cpos p1 w) @@ -70,7 +70,7 @@ unsafeBlinkAction cr w wl <- snd $ collidePointWallsFilter (const True) mwp cpos w return (isLHS mwp `uncurry` _wlLine wl) cid = _crID cr - mwp = mouseWorldPos (w ^. input) (w ^. cWorld . cwCamPos) + mwp = mouseWorldPos (w ^. input) (w ^. cWorld . cwCam) cpos = _crPos cr blinkShockwave :: @@ -96,7 +96,7 @@ blinkActionFail cr w = distR = 120 distortionBulge = RadialDistortion cpos (cpos +.+ V2 distR 0) (cpos +.+ V2 0 distR) 1.9 cid = _crID cr - p1 = mouseWorldPos (w ^. input) (w ^. cWorld . cwCamPos) + p1 = mouseWorldPos (w ^. input) (w ^. cWorld . cwCam) cpos = _crPos cr p2 = bouncePoint (const True) 1 cpos p1 w r = 1.5 * _crRad cr diff --git a/src/Dodge/Creature/Picture/Awareness.hs b/src/Dodge/Creature/Picture/Awareness.hs index b1d293d95..3d0be819f 100644 --- a/src/Dodge/Creature/Picture/Awareness.hs +++ b/src/Dodge/Creature/Picture/Awareness.hs @@ -28,8 +28,8 @@ creatureDisplayText w cr = cr where lw = w ^. cWorld . lWorld - campos = w ^. cWorld . cwCamPos . camViewFrom - theScale = 0.15 / (w ^. cWorld . cwCamPos . camZoom) + campos = w ^. cWorld . cwCam . camViewFrom + theScale = 0.15 / (w ^. cWorld . cwCam . camZoom) cpos = _crPos cr v = cpos -.- campos (V2 x y) = campos +.+ v +.+ _crRad cr *.* normalizeV v diff --git a/src/Dodge/Creature/YourControl.hs b/src/Dodge/Creature/YourControl.hs index 23e5daee9..a4b525f5e 100644 --- a/src/Dodge/Creature/YourControl.hs +++ b/src/Dodge/Creature/YourControl.hs @@ -75,15 +75,15 @@ wasdWithAiming w speed cr | otherwise = crMvForward speed theTurn cr' = creatureTurnTowardDir (_crMvAim cr') 0.2 cr' movDir = wasdDir w - dir = fmap ((w ^. cWorld . cwCamPos . camRot) +) (safeArgV movDir) - movAbs = rotateV (w ^. cWorld . cwCamPos . camRot) $ normalizeV movDir + dir = fmap ((w ^. cWorld . cwCam . camRot) +) (safeArgV movDir) + movAbs = rotateV (w ^. cWorld . cwCam . camRot) $ normalizeV movDir isAiming = _posture (_crStance cr) == Aiming mouseDir = fromMaybe - (argV (_mousePos (_input w)) + (w ^. cWorld . cwCamPos . camRot) ) + (argV (_mousePos (_input w)) + (w ^. cWorld . cwCam . camRot) ) $ do itRef <- cr ^? crManipulation . manObject . inInventory . ispItem _ <- cr ^? crInv . ix itRef . itScope . scopePos - return . argV $ mouseWorldPos (w ^. input) (w ^. cWorld . cwCamPos) -.- _crPos cr + return . argV $ mouseWorldPos (w ^. input) (w ^. cWorld . cwCam) -.- _crPos cr aimTurn :: Float -> Creature -> Creature aimTurn a cr = creatureTurnTowardDir a (x * 0.2) cr @@ -120,7 +120,7 @@ pressedMBEffectsTopInventory pkeys w | isDown SDL.ButtonLeft && isDown SDL.ButtonRight && inTopInv = useItem (you w) w | isDown SDL.ButtonLeft && inTopInv = doTopInvLeftClick (you w) w | isDown SDL.ButtonMiddle = - w & cWorld . cwCamPos . camRot -~ rotation + w & cWorld . cwCam . camRot -~ rotation & input . clickMousePos .~ _mousePos (_input w) | otherwise = w where diff --git a/src/Dodge/Data/CWorld.hs b/src/Dodge/Data/CWorld.hs index a7a1b19af..143429c40 100644 --- a/src/Dodge/Data/CWorld.hs +++ b/src/Dodge/Data/CWorld.hs @@ -6,7 +6,7 @@ module Dodge.Data.CWorld ( module Dodge.Data.CWorld, module Dodge.Data.LWorld, - module Dodge.Data.CamPos + module Dodge.Data.Camera ) where import Data.Tile @@ -18,13 +18,13 @@ import Data.Aeson.TH --import Dodge.Data.GenParams import Dodge.GameRoom import Geometry.ConvexPoly -import Dodge.Data.CamPos +import Dodge.Data.Camera import qualified Data.IntSet as IS import Data.Graph.Inductive data CWorld = CWorld { _lWorld :: LWorld - , _cwCamPos :: CamPos + , _cwCam :: Camera , _cwGen :: CWGen , _cClock :: Int , _seenWalls :: IS.IntSet diff --git a/src/Dodge/Data/CamPos.hs b/src/Dodge/Data/CamPos.hs deleted file mode 100644 index 46c5c6c74..000000000 --- a/src/Dodge/Data/CamPos.hs +++ /dev/null @@ -1,28 +0,0 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE StrictData #-} -{-# LANGUAGE TemplateHaskell #-} -module Dodge.Data.CamPos where - -import Control.Lens -import Data.Aeson -import Data.Aeson.TH -import Geometry.Data - -data CamPos = CamPos - { _camCenter :: Point2 - , _camRot :: Float - , _camZoom :: Float -- smaller values zoom out - , _camItemZoom :: Float - , _camDefaultZoom :: Float - , _camViewFrom :: Point2 - , _camViewDistance :: Float - , _camBoundBox :: [Point2] - , _camBoundDist :: (Float, Float, Float, Float) -- NSEW, S and W negative - } - -makeLenses ''CamPos -concat - <$> mapM - (deriveJSON defaultOptions) - [ ''CamPos ] diff --git a/src/Dodge/Data/Input.hs b/src/Dodge/Data/Input.hs index 280f1e0fc..cd01d50d9 100644 --- a/src/Dodge/Data/Input.hs +++ b/src/Dodge/Data/Input.hs @@ -1,24 +1,27 @@ -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE StrictData #-} {-# LANGUAGE TemplateHaskell #-} + module Dodge.Data.Input where + import Control.Lens import qualified Data.Map.Strict as M import Geometry.Data import SDL (MouseButton, Scancode) -data PressType = InitialPress +data PressType + = InitialPress | ShortPress | LongPress - deriving (Eq,Show) + deriving (Eq, Show) 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 - , _scrollAmount :: Int + , _scrollAmount :: Int , _previousScrollAmount :: Int , _lLine :: (Point2, Point2) , _rLine :: (Point2, Point2) @@ -26,9 +29,20 @@ data Input = Input , _lSelect :: Point2 , _rSelect :: Point2 , _clickMousePos :: Point2 - , _textInput :: String + , _textInput :: [Either TermSignal Char] , _scrollTestFloat :: Float , _scrollTestInt :: Int } +data TermSignal + = TSescape + | TSreturn + | TSbackspace + | TSdelete + | TStab + | TSleft + | TSright + | TSup + | TSdown + makeLenses ''Input diff --git a/src/Dodge/Debug/Picture.hs b/src/Dodge/Debug/Picture.hs index fe9d92690..74e48ad9c 100644 --- a/src/Dodge/Debug/Picture.hs +++ b/src/Dodge/Debug/Picture.hs @@ -17,7 +17,7 @@ printRotPoint r p = . uncurryV translate p $ pictures [circle 3, rotate (negate r) $ scale 0.1 0.1 $ text (show p)] -outsideScreenPolygon :: Configuration -> CamPos -> [Point2] +outsideScreenPolygon :: Configuration -> Camera -> [Point2] outsideScreenPolygon cfig w = [tr, tl, bl, br] where scRot = rotateV (w ^. camRot) @@ -39,14 +39,14 @@ lineOnScreenCone cfig w p1 p2 = || pointInPolygon p2 sp || any (isJust . uncurry (intersectSegSeg p1 p2)) sps where - sp' = screenPolygon cfig (w ^. cWorld . cwCamPos) - vp = w ^. cWorld . cwCamPos . camViewFrom + sp' = screenPolygon cfig (w ^. cWorld . cwCam) + vp = w ^. cWorld . cwCam . camViewFrom sp | pointInPolygon vp sp' = sp' - | otherwise = orderPolygon ((w ^. cWorld . cwCamPos . camViewFrom) : sp') + | otherwise = orderPolygon ((w ^. cWorld . cwCam . camViewFrom) : sp') sps = zip sp (tail sp ++ [head sp]) -pointOnScreen :: Configuration -> CamPos -> Point2 -> Bool +pointOnScreen :: Configuration -> Camera -> Point2 -> Bool pointOnScreen cfig w p = pointInPolygon p $ screenPolygon cfig w drawWallFace :: Configuration -> World -> Wall -> Picture @@ -56,13 +56,13 @@ drawWallFace cfig w wall where (x, y) = _wlLine wall points = extendConeToScreenEdge cfig w sightFrom (x, y) - sightFrom = w ^. cWorld . cwCamPos . camViewFrom + sightFrom = w ^. cWorld . cwCam . camViewFrom extendConeToScreenEdge :: Configuration -> World -> Point2 -> (Point2, Point2) -> [Point2] extendConeToScreenEdge cfig w c (x, y) = orderPolygon $ wallScreenIntersect ++ [x, y] ++ borderPs ++ cornerPs where borderPs = mapMaybe (intersectLinefromScreen cfig w c) [x, y] - scpoly = reverse $ screenPolygon cfig (w ^. cWorld . cwCamPos) + scpoly = reverse $ screenPolygon cfig (w ^. cWorld . cwCam) cornerPs = filter (pointIsInCone c (x, y)) scpoly wallScreenIntersect = mapMaybe (uncurry $ intersectSegSeg y ((2 *.* y) -.- x)) @@ -77,4 +77,4 @@ intersectLinefromScreen cfig w a b = listToMaybe . mapMaybe (\(x, y) -> intersectSegLineFrom x y b (b +.+ b -.- a)) . loopPairs - $ screenPolygon cfig (w ^. cWorld . cwCamPos) + $ screenPolygon cfig (w ^. cWorld . cwCam) diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index acd7b3a08..7fbe860ce 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -62,9 +62,9 @@ defaultCWGen = , _cwgRoomClipping = [] } -defaultCWCam :: CamPos +defaultCWCam :: Camera defaultCWCam = - CamPos + Camera { _camCenter = V2 0 0 , _camRot = 0 , _camZoom = 1 @@ -74,12 +74,13 @@ defaultCWCam = , _camItemZoom = 1 , _camBoundBox = square 100 , _camBoundDist = (100, -100, 100, -100) + , _camControl = CamInGame } defaultCWorld :: CWorld defaultCWorld = CWorld - { _cwCamPos = defaultCWCam + { _cwCam = defaultCWCam , _lWorld = defaultLWorld , _cwGen = defaultCWGen , _cClock = 0 diff --git a/src/Dodge/Event/Input.hs b/src/Dodge/Event/Input.hs index bd0a54eaf..eb526aaa2 100644 --- a/src/Dodge/Event/Input.hs +++ b/src/Dodge/Event/Input.hs @@ -1,4 +1,5 @@ --- | Deals with events that only affect Input. +-- | Capture input events, store them in structures for later use. +-- Should not update the world other than this. module Dodge.Event.Input ( handleKeyboardEvent, handleTextInput, @@ -15,19 +16,27 @@ import SDL -- annoyingly, the text input event doesn't register backspace, so deletion has to be -- dealt with separately handleTextInput :: String -> Input -> Input -handleTextInput text = textInput %~ (++ text) +handleTextInput text = textInput %~ (++ map Right text) -- | Handles keyboard press and release. handleKeyboardEvent :: KeyboardEventData -> Input -> Input handleKeyboardEvent kev = case keyboardEventKeyMotion kev of Released -> pressedKeys . at scode .~ Nothing - Pressed -> pressedKeys . at scode ?~ val + Pressed -> (pressedKeys . at scode ?~ val) + . addTermSignal scode where val | keyboardEventRepeat kev = LongPress | otherwise = InitialPress scode = (keysymScancode . keyboardEventKeysym) kev +addTermSignal :: Scancode -> Input -> Input +addTermSignal sc = case sc of + ScancodeBackspace -> textInput .:~ Left TSbackspace + ScancodeEscape -> textInput .:~ Left TSescape + ScancodeReturn -> textInput .:~ Left TSreturn + _ -> id + handleMouseMotionEvent :: MouseMotionEventData -> Configuration -> Input -> Input handleMouseMotionEvent mmev cfig = set mousePos themousepos diff --git a/src/Dodge/HeldUse.hs b/src/Dodge/HeldUse.hs index 3621919b1..f1c8b2917 100644 --- a/src/Dodge/HeldUse.hs +++ b/src/Dodge/HeldUse.hs @@ -349,7 +349,7 @@ useMod hm = case hm of directedTelPos _ cr w = (p, a) where p = fromMaybe (_crPos cr) $ cr ^? crTargeting . ctPos . _Just - a = argV (mouseWorldPos (w ^. input) (w ^. cWorld . cwCamPos) -.- p) + a = argV (mouseWorldPos (w ^. input) (w ^. cWorld . cwCam) -.- p) moddelay x = itUse . heldConsumption . laAmmoType . amBullet . buDelayFraction .~ x modcrpos x cr = cr & crDir %~ tweenAngles x (_crOldDir cr) @@ -513,7 +513,7 @@ shootTeslaArc it cr w = useForceFieldGun :: Item -> Creature -> World -> World useForceFieldGun itm cr w = fromMaybe w $ do a <- cr ^? crTargeting . ctPos . _Just - let mwp = mouseWorldPos (w ^. input) (w ^. cWorld . cwCamPos) + let mwp = mouseWorldPos (w ^. input) (w ^. cWorld . cwCam) b = if dist a mwp < 100 then mwp else a +.+ 100 *.* normalizeV (mwp -.- a) wlline = (a, b) return $ diff --git a/src/Dodge/Initialisation.hs b/src/Dodge/Initialisation.hs index 7b6672a4b..67c179386 100644 --- a/src/Dodge/Initialisation.hs +++ b/src/Dodge/Initialisation.hs @@ -16,7 +16,7 @@ splashScreen = initialWorld :: World initialWorld = defaultWorld - & cWorld . cwCamPos . camZoom .~ 10 + & cWorld . cwCam . camZoom .~ 10 & cWorld . lWorld . creatures .~ IM.fromList [(0, startCr)] & cWorld . lWorld . worldEvents .~ SoundStart BackgroundSound (V2 0 0) foamSprayFadeOutS Nothing : [MakeStartCloudAt (V3 x y 5) | x <- [-5, -4 .. 5], y <- [-5, -4 .. 5]] diff --git a/src/Dodge/Item/Weapon/BatteryGuns.hs b/src/Dodge/Item/Weapon/BatteryGuns.hs index 8368ed458..437a751a0 100644 --- a/src/Dodge/Item/Weapon/BatteryGuns.hs +++ b/src/Dodge/Item/Weapon/BatteryGuns.hs @@ -149,7 +149,7 @@ circleLaser it cr w | otherwise = w where cpos = _crPos cr - mwp = mouseWorldPos (w ^. input) (w ^. cWorld . cwCamPos) + mwp = mouseWorldPos (w ^. input) (w ^. cWorld . cwCam) pos = _crPos cr +.+ rotateV dir (V2 0 (max 70 $ dist cpos mwp)) dir = fromIntegral (_lasCycle (_itParams it)) * pi / 1000 phasev = _phaseV . _itParams $ _crInv cr IM.! itRef @@ -169,7 +169,7 @@ shootDualLaser it cr w = gap = _dbGap . _itParams $ it posl = pos +.+ (- gap) *.* vNormal (unitVectorAtAngle dir) posr = pos +.+ gap *.* vNormal (unitVectorAtAngle dir) - mwp = mouseWorldPos (w ^. input) (w ^. cWorld . cwCamPos) + mwp = mouseWorldPos (w ^. input) (w ^. cWorld . cwCam) mwp' | dist mwp (_crPos cr) < aimlength + 5 = _crPos cr +.+ (aimlength + 5) *.* unitVectorAtAngle dir | otherwise = mwp diff --git a/src/Dodge/Item/Weapon/TriggerType.hs b/src/Dodge/Item/Weapon/TriggerType.hs index 046c92418..67653b3d7 100644 --- a/src/Dodge/Item/Weapon/TriggerType.hs +++ b/src/Dodge/Item/Weapon/TriggerType.hs @@ -589,7 +589,7 @@ torqueBefore torque feff item cr w w & randGen .~ g & cWorld . lWorld . creatures . ix cid . crDir +~ rot - & cWorld . cwCamPos . camRot +~ rot + & cWorld . cwCam . camRot +~ rot | otherwise = feff item cr $ set randGen g $ over (cWorld . lWorld . creatures . ix cid . crDir) (+ rot) w where cid = _crID cr @@ -610,7 +610,7 @@ torqueBeforeAtLeast minTorque exTorque feff item cr w w & randGen .~ g & cWorld . lWorld . creatures . ix cid . crDir +~ rot' - & cWorld . cwCamPos . camRot +~ rot' + & cWorld . cwCam . camRot +~ rot' | otherwise = feff item cr $ set randGen g $ over (cWorld . lWorld . creatures . ix cid . crDir) (+ rot') w where cid = _crID cr @@ -623,7 +623,7 @@ torqueBeforeAtLeast minTorque exTorque feff item cr w withTorqueAfter :: ChainEffect withTorqueAfter feff item cr w -- | cid == 0 = rotateScope $ set randGen g $ over cameraRot (+rot) $ feff item cr w - | cid == 0 = set randGen g $ over (cWorld . cwCamPos . camRot) (+ rot) $ feff item cr w + | cid == 0 = set randGen g $ over (cWorld . cwCam . camRot) (+ rot) $ feff item cr w | otherwise = set randGen g $ over (cWorld . lWorld . creatures . ix cid . crDir) (+ rot) $ feff item cr w where cid = _crID cr @@ -661,7 +661,7 @@ sideEffectOnFrame i sf f it cr w = torqueSideEffect :: Float -> Item -> Creature -> World -> World torqueSideEffect torque _ cr w - | cid == 0 = set randGen g $ over (cWorld . cwCamPos . camRot) (+ rot) w + | cid == 0 = set randGen g $ over (cWorld . cwCam . camRot) (+ rot) w | otherwise = set randGen g $ over (cWorld . lWorld . creatures . ix cid . crDir) (+ rot) w where cid = _crID cr @@ -708,12 +708,12 @@ duplicateOffsetsFocus xs eff item cr w = foldr f w poss & crPos %~ (+.+ pos) & crDir .~ thedir pos thedir pos - | dist (mouseWorldPos (w ^. input) (w ^. cWorld . cwCamPos)) (_crPos cr) < aimingMuzzlePos cr item = + | dist (mouseWorldPos (w ^. input) (w ^. cWorld . cwCam)) (_crPos cr) < aimingMuzzlePos cr item = argV ( _crPos cr +.+ aimingMuzzlePos cr item *.* unitVectorAtAngle (_crDir cr) -.- (_crPos cr +.+ pos) ) - | otherwise = argV (mouseWorldPos (w ^. input) (w ^. cWorld . cwCamPos) -.- (_crPos cr +.+ pos)) + | otherwise = argV (mouseWorldPos (w ^. input) (w ^. cWorld . cwCam) -.- (_crPos cr +.+ pos)) duplicateItem :: (Item -> [Item]) -> ChainEffect duplicateItem fit eff itm cr w = foldr f w (fit itm) diff --git a/src/Dodge/Layout.hs b/src/Dodge/Layout.hs index bef1c3606..65020471b 100644 --- a/src/Dodge/Layout.hs +++ b/src/Dodge/Layout.hs @@ -57,7 +57,7 @@ generateLevelFromRoomList gr' w = randomCompass :: World -> World -randomCompass w = w & cWorld . cwCamPos . camRot .~ (takeOne [0, 0.5 * pi, pi, 1.5 * pi] & evalState $ _randGen w) +randomCompass w = w & cWorld . cwCam . camRot .~ (takeOne [0, 0.5 * pi, pi, 1.5 * pi] & evalState $ _randGen w) -- note the order of traversal of the rooms is important -- hence the reverse diff --git a/src/Dodge/Luse.hs b/src/Dodge/Luse.hs index 496e6090f..6fab9b357 100644 --- a/src/Dodge/Luse.hs +++ b/src/Dodge/Luse.hs @@ -113,7 +113,7 @@ boostPoint x cr w = case mayp2 of where cpos = _crPos cr r = 1.5 * _crRad cr - p1 = cpos +.+ x *.* squashNormalizeV (mouseWorldPos (w ^. input) (w ^. cWorld . cwCamPos) -.- cpos) + p1 = cpos +.+ x *.* squashNormalizeV (mouseWorldPos (w ^. input) (w ^. cWorld . cwCam) -.- cpos) mayp2 = bouncePoint (const True) 1 cpos p1 w addBoostShockwave :: diff --git a/src/Dodge/Menu.hs b/src/Dodge/Menu.hs index 49c64c24a..d2ce8a0fb 100644 --- a/src/Dodge/Menu.hs +++ b/src/Dodge/Menu.hs @@ -219,18 +219,20 @@ displayControls = titleOptionsNoWrite "CONTROLS" $ map (Toggle id . const . uncu listControls :: [(String, String)] listControls = - [ ("wasd", "MOVEMENT") - , ("[rmb]", "AIM") - , ("[rmb+lmb]", "SHOOT/USE/EQUIP SELECTED") - , ("[lmb]", "USE EQUIPPED") - , ("[wheelscroll]", "SELECT ITEM") - , ("[space]", "PICKUP ITEM") + [ ("w|a|s|d", "MOVEMENT") + , ("", "AIM") + , ("&", "SHOOT/USE/EQUIP SELECTED") + , ("", "USE EQUIPPED") + , ("", "SELECT ITEM") + , ("", "PICKUP ITEM") , ("m", "DISPLAY MAP") , ("f", "DROP ITEM") , ("c", "COMBINE ITEMS") , ("x", "EXAMINE ITEMS") - , ("c[esc]", "PAUSE") - , ("qe", "ROTATE CAMERA") - , ("F5", "QUICKSAVE") - , ("F9", "QUICKLOAD") + , ("c|", "PAUSE AND DISPLAY MENU") + , ("q|e", "ROTATE CAMERA") + , ("", "PAUSE AND FLOAT CAMERA") + , ("", "PAUSE AND PAN CAMERA") + , ("", "QUICKSAVE") + , ("", "QUICKLOAD") ] diff --git a/src/Dodge/Picture/SizeInvariant.hs b/src/Dodge/Picture/SizeInvariant.hs index 735949bc1..392945d7e 100644 --- a/src/Dodge/Picture/SizeInvariant.hs +++ b/src/Dodge/Picture/SizeInvariant.hs @@ -13,7 +13,7 @@ import Picture --fixedSizePicAt :: -- Picture -> -- Point2 -> --- CamPos -> +-- Camera -> -- Picture --fixedSizePicAt pic p w = -- setLayer DebugLayer @@ -35,7 +35,7 @@ import Picture -- Picture -> -- Point2 -> -- Configuration -> --- CamPos -> +-- Camera -> -- Picture --fixedSizePicClamp xbord ybord pic p cfig w = -- setLayer DebugLayer @@ -70,16 +70,16 @@ fixedSizePicClampArrow xbord ybord pic p cfig w = , setLayer DebugLayer . color white . setDepth 20 $ arrowPic ] where - winps = screenPolygon cfig (w ^. cwCamPos) - bords = screenPolygonBord xbord ybord cfig (w ^. cwCamPos) + winps = screenPolygon cfig (w ^. cwCam) + bords = screenPolygonBord xbord ybord cfig (w ^. cwCam) borderPoint = intersectSegPolyFirst campos p bords windowPoint = intersectSegPolyFirst campos p winps arrowPic = case borderPoint of Nothing -> blank Just bp -> thickLine 5 [bp, fromMaybe p windowPoint] (V2 x y) = fromMaybe p borderPoint - campos = w ^. cwCamPos . camCenter - theScale = 1 / (w ^. cwCamPos . camZoom) + campos = w ^. cwCam . camCenter + theScale = 1 / (w ^. cwCam . camZoom) --absClamp :: -- -- | clamping value, assumed positive diff --git a/src/Dodge/Projectile/Update.hs b/src/Dodge/Projectile/Update.hs index e31ee344d..5b930d397 100644 --- a/src/Dodge/Projectile/Update.hs +++ b/src/Dodge/Projectile/Update.hs @@ -97,7 +97,7 @@ setRemoteDir cid itid pj w = w & cWorld . lWorld . projectiles . ix (_prjID pj) | SDL.ButtonRight `M.member` _mouseButtons (_input w) && w ^? cWorld . lWorld . creatures . ix cid . crManipulation . manObject . inInventory . ispItem == w ^? cWorld . lWorld . itemLocations . ix itid . ipInvID - = (w ^. cWorld . cwCamPos . camRot) + argV (_mousePos (_input w)) + = (w ^. cWorld . cwCam . camRot) + argV (_mousePos (_input w)) | otherwise = _prjDir pj doThrust :: Proj -> World -> World diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs index 00746c53e..d6805d723 100644 --- a/src/Dodge/Render.hs +++ b/src/Dodge/Render.hs @@ -49,13 +49,13 @@ doDrawing' win pdata u = do checkGLError let w = _uvWorld u cfig = _uvConfig u - rot = w ^. cWorld . cwCamPos . camRot - camzoom = w ^. cWorld . cwCamPos . camZoom - trans = w ^. cWorld . cwCamPos . camCenter + rot = w ^. cWorld . cwCam . camRot + camzoom = w ^. cWorld . cwCam . camZoom + trans = w ^. cWorld . cwCam . camCenter wins = V2 (windowXFloat cfig) (windowYFloat cfig) (windowPoints, wallSPics, wallsToPoke) = wallsToDraw w - lightPoints = lightsToRender cfig (w ^. cWorld . cwCamPos) (w ^. cWorld . lWorld) - viewFroms@(V2 vfx vfy) = w ^. cWorld . cwCamPos . camViewFrom + lightPoints = lightsToRender cfig (w ^. cWorld . cwCam) (w ^. cWorld . lWorld) + viewFroms@(V2 vfx vfy) = w ^. cWorld . cwCam . camViewFrom shadV = _pictureShaders pdata nFls = w ^. cWorld . numberFloorVerxs -- bind as much data into vbos as feasible at this point diff --git a/src/Dodge/Render/InfoBox.hs b/src/Dodge/Render/InfoBox.hs index d74c64cda..e529f7230 100644 --- a/src/Dodge/Render/InfoBox.hs +++ b/src/Dodge/Render/InfoBox.hs @@ -4,14 +4,14 @@ module Dodge.Render.InfoBox ) where import Dodge.Base -import Dodge.Data.CamPos +import Dodge.Data.Camera import Dodge.Data.Config import Dodge.Render.Connectors import Dodge.Render.List import Geometry import Picture -renderInfoListAt :: Float -> Float -> Configuration -> CamPos -> (Point2, [String]) -> Picture +renderInfoListAt :: Float -> Float -> Configuration -> Camera -> (Point2, [String]) -> Picture renderInfoListAt x y cfig cam (p, ss) = renderListAt x y cfig (zip ss (repeat white)) <> color white (lConnect (V2 (x - hw) (hh -25 - y)) (worldPosToScreen cam p)) @@ -20,7 +20,7 @@ renderInfoListAt x y cfig cam (p, ss) = hw = halfWidth cfig hh = halfHeight cfig -renderInfoListsAt :: Float -> Float -> Configuration -> CamPos -> [(Point2, [String])] -> Picture +renderInfoListsAt :: Float -> Float -> Configuration -> Camera -> [(Point2, [String])] -> Picture renderInfoListsAt x y cfig w = fst . foldr f (mempty, 0) where diff --git a/src/Dodge/Render/Lights.hs b/src/Dodge/Render/Lights.hs index d75697f62..dc5b6173d 100644 --- a/src/Dodge/Render/Lights.hs +++ b/src/Dodge/Render/Lights.hs @@ -5,13 +5,13 @@ module Dodge.Render.Lights ( import Data.List (sortOn) import Data.Maybe import Dodge.Data.LWorld -import Dodge.Data.CamPos +import Dodge.Data.Camera import Dodge.Data.Config import Geometry import qualified IntMapHelp as IM import Control.Lens -lightsToRender :: Configuration -> CamPos -> LWorld -> [(Point3, Float, Point3)] +lightsToRender :: Configuration -> Camera -> LWorld -> [(Point3, Float, Point3)] {-# INLINE lightsToRender #-} lightsToRender cfig campos w = take (fromEnum $ cfig ^. graphics_num_shadow_casters) $ sortOn (\(_,x,_) -> negate x) $ diff --git a/src/Dodge/Render/Picture.hs b/src/Dodge/Render/Picture.hs index 8d272cb43..90d80f85f 100644 --- a/src/Dodge/Render/Picture.hs +++ b/src/Dodge/Render/Picture.hs @@ -76,8 +76,8 @@ mouseCursorType u a = fromMaybe 0 $ do cpos <- w ^? cWorld . lWorld . creatures . ix 0 . crPos return . toClosestMultiple (pi / 32) $ - argV (mouseWorldPos (w ^. input) (w ^. cWorld . cwCamPos) -.- cpos) - - w ^. cWorld . cwCamPos . camRot + argV (mouseWorldPos (w ^. input) (w ^. cWorld . cwCam) -.- cpos) + - w ^. cWorld . cwCam . camRot mousePlus :: Picture mousePlus = pictures [line [V2 (-5) 0, V2 5 0], line [V2 0 (-5), V2 0 5]] diff --git a/src/Dodge/Render/ShapePicture.hs b/src/Dodge/Render/ShapePicture.hs index 4692c2ccd..d3823ea2b 100644 --- a/src/Dodge/Render/ShapePicture.hs +++ b/src/Dodge/Render/ShapePicture.hs @@ -83,7 +83,7 @@ drawSweep cr w = fromMaybe mempty $ do cdir = _crDir cr rot = campos ^. camRot p = _crPos cr - campos = w ^. cWorld . cwCamPos + campos = w ^. cWorld . cwCam theinput = w ^. input mwp = mouseWorldPos theinput campos @@ -134,8 +134,8 @@ shiftDraw' fpos fdir fdraw x = cullPoint :: Configuration -> World -> Point2 -> Bool cullPoint cfig w p - | debugOn Close_shape_culling cfig = pointInPolygon p (w ^. cWorld . cwCamPos . camBoundBox) - | otherwise = dist (w ^. cWorld . cwCamPos . camCenter) p < (w ^. cWorld . cwCamPos . camViewDistance) + | debugOn Close_shape_culling cfig = pointInPolygon p (w ^. cWorld . cwCam . camBoundBox) + | otherwise = dist (w ^. cWorld . cwCam . camCenter) p < (w ^. cWorld . cwCam . camViewDistance) extraPics :: Configuration -> Universe -> Picture extraPics cfig u = @@ -243,7 +243,7 @@ drawWallsNearYou w = fromMaybe mempty $ do drawWallsNearCursor :: World -> Picture drawWallsNearCursor w = - setLayer DebugLayer $ foldMap f $ wlsNearPoint (mouseWorldPos (_input w) (_cwCamPos $ _cWorld w)) w + setLayer DebugLayer $ foldMap f $ wlsNearPoint (mouseWorldPos (_input w) (_cwCam $ _cWorld w)) w where f wl = color rose $ thickLine 3 [a, b] where @@ -307,13 +307,13 @@ drawFarWallDetect w = ) $ getViewpoints p (_cWorld w) where - p = w ^. cWorld . cwCamPos . camViewFrom + p = w ^. cWorld . cwCam . camViewFrom drawZoneNearPointCursor :: World -> Picture drawZoneNearPointCursor w = foldMap (drawZoneCol orange 50) ps where - mwp = mouseWorldPos (w ^. input) (w ^. cWorld . cwCamPos) + mwp = mouseWorldPos (w ^. input) (w ^. cWorld . cwCam) ps = [zoneOfPoint 50 mwp] drawDDATest :: World -> Picture @@ -321,8 +321,8 @@ drawDDATest w = foldMap (drawZoneCol orange 50) ps <> setLayer DebugLayer (color yellow (line [cvf, mwp])) where - cvf = w ^. cWorld . cwCamPos . camViewFrom - mwp = mouseWorldPos (w ^. input) (w ^. cWorld . cwCamPos) + cvf = w ^. cWorld . cwCam . camViewFrom + mwp = mouseWorldPos (w ^. input) (w ^. cWorld . cwCam) ps = zoneOfSeg 50 cvf mwp drawZoneCol :: Color -> Float -> V2 Int -> Picture @@ -342,7 +342,7 @@ drawWallSearchRays w = foldMap (f . fst) $ allVisibleWalls w setLayer DebugLayer $ color yellow $ uncurryV translate p (circle 5) - <> line [w ^. cWorld . cwCamPos . camViewFrom, p] + <> line [w ^. cWorld . cwCam . camViewFrom, p] testPic :: Configuration -> World -> Picture testPic _ _ = mempty @@ -350,7 +350,7 @@ testPic _ _ = mempty drawBoundingBox :: World -> Picture drawBoundingBox w = setLayer DebugLayer $ color green $ line $ (x : xs) ++ [x] where - (x : xs) = w ^. cWorld . cwCamPos . camBoundBox + (x : xs) = w ^. cWorld . cwCam . camBoundBox ppDraw :: PressPlate -> Picture ppDraw c = uncurryV translate (_ppPos c) $ rotate (_ppRot c) (_ppPict c) @@ -375,7 +375,7 @@ soundPic cfig w s = fixedSizePicClampArrow 50 50 thePic p cfig (w ^. cWorld) where p = _soundPos s thePic = - rotate (w ^. cWorld . cwCamPos . camRot) + rotate (w ^. cWorld . cwCam . camRot) . scale theScale theScale . centerText . soundToOnomato @@ -391,7 +391,7 @@ drawMousePosition w = . text $ shortPoint2 mwp where - mwp = mouseWorldPos (w ^. input) (w ^. cWorld . cwCamPos) + mwp = mouseWorldPos (w ^. input) (w ^. cWorld . cwCam) drawWlIDs :: World -> Picture drawWlIDs w = setLayer FixedCoordLayer $ foldMap f (w ^. cWorld . lWorld . walls) @@ -404,7 +404,7 @@ drawWlIDs w = setLayer FixedCoordLayer $ foldMap f (w ^. cWorld . lWorld . walls . text $ show $ _wlID wl where - p = worldPosToScreen (w ^. cWorld . cwCamPos) $ 0.5 *.* uncurry (+.+) (_wlLine wl) + p = worldPosToScreen (w ^. cWorld . cwCam) $ 0.5 *.* uncurry (+.+) (_wlLine wl) edgeToPic :: [Point2] -> PathEdge -> Picture edgeToPic poly pe @@ -417,13 +417,13 @@ edgeToPic poly pe drawPathing :: Configuration -> World -> Picture drawPathing cfig w = setLayer DebugLayer $ - foldMap (edgeToPic (screenPolygon cfig (w ^. cWorld . cwCamPos)) . (^?! _3)) (FGL.labEdges gr) + foldMap (edgeToPic (screenPolygon cfig (w ^. cWorld . cwCam)) . (^?! _3)) (FGL.labEdges gr) <> foldMap dispInc (graphToIncidence gr) where dispInc (p, n) = setDepth 2 . uncurryV translate p . scale 0.1 0.1 $ text $ show n gr = w ^. cWorld . pathGraph -crDisplayInfo :: Configuration -> CamPos -> Creature -> Maybe (Point2, [String]) +crDisplayInfo :: Configuration -> Camera -> Creature -> Maybe (Point2, [String]) crDisplayInfo cfig cam cr | _crID cr == 0 = Nothing | crOnScreen = @@ -454,7 +454,7 @@ drawCrInfo cfig w = renderInfoListsAt (2 * hw - 400) 0 cfig cam $ mapMaybe (crDisplayInfo cfig cam) $ IM.elems $ w ^. lWorld . creatures where - cam = w ^. cwCamPos + cam = w ^. cwCam hw = halfWidth cfig viewBoundaries :: CWorld -> Picture @@ -463,7 +463,7 @@ viewBoundaries w = color green (foldMap (polygonWire . _grBound) grs) <> color yellow (foldMap (\q -> line [p, q]) $ getViewpoints p w) where - p = w ^. cwCamPos . camViewFrom + p = w ^. cwCam . camViewFrom grs = filter (pointInOrOnPolygon p . _grBound) (_cwgGameRooms $ _cwGen w) viewClipBounds :: Configuration -> World -> Picture diff --git a/src/Dodge/SoundLogic.hs b/src/Dodge/SoundLogic.hs index c9cd3e75a..430477874 100644 --- a/src/Dodge/SoundLogic.hs +++ b/src/Dodge/SoundLogic.hs @@ -163,9 +163,9 @@ soundAngle p w . radToDeg . normalizeAngle . (+ pi) - $ argV (vNormal (p -.- earPos)) - (w ^. cWorld . cwCamPos . camRot) + $ argV (vNormal (p -.- earPos)) - (w ^. cWorld . cwCam . camRot) where - earPos = w ^. cWorld . cwCamPos . camViewFrom + earPos = w ^. cWorld . cwCam . camViewFrom {- | Uses the first free origin from a list. Does nothing if all origins are already creating sounds. diff --git a/src/Dodge/Targeting.hs b/src/Dodge/Targeting.hs index a0f356c87..761d1a51d 100644 --- a/src/Dodge/Targeting.hs +++ b/src/Dodge/Targeting.hs @@ -49,7 +49,7 @@ targetRBCreatureUp cr w . filter (canseepos . _crPos) $ crsNearCirc mwp 40 w canseepos p = hasLOS (_crPos cr) p w - mwp = mouseWorldPos (w ^. input) (w ^. cWorld . cwCamPos) + mwp = mouseWorldPos (w ^. input) (w ^. cWorld . cwCam) updatePos t' = t' & ctPos .~ posFromMaybeID (_ctID t') posFromMaybeID Nothing = Nothing posFromMaybeID (Just i) = w ^? cWorld . lWorld . creatures . ix i . crPos @@ -61,7 +61,7 @@ targetRBCreatureUp cr w targetCursorUpdate :: World -> CreatureTargeting -> CreatureTargeting targetCursorUpdate w ct = ct - & ctPos . _Just .~ mouseWorldPos (w ^. input) (w ^. cWorld . cwCamPos) + & ctPos . _Just .~ mouseWorldPos (w ^. input) (w ^. cWorld . cwCam) & ctActive .~ True & ctType ?~ TargetCursor @@ -69,7 +69,7 @@ targetRBPressUpdate :: World -> CreatureTargeting -> CreatureTargeting targetRBPressUpdate w t | SDL.ButtonRight `M.member` _mouseButtons (_input w) = t - & ctPos %~ maybe (Just $ mouseWorldPos (w ^. input) (w ^. cWorld . cwCamPos)) Just + & ctPos %~ maybe (Just $ mouseWorldPos (w ^. input) (w ^. cWorld . cwCam)) Just & ctActive .~ True & ctType ?~ TargetRBPress | otherwise = @@ -100,7 +100,7 @@ targetLaserUpdate cr w t where (mp, _) = reflectLaserAlong 0.2 sp ep w sp = _crPos cr +.+ 15 *.* unitVectorAtAngle (_crDir cr) - ep = sp +.+ 5000 *.* normalizeV (mouseWorldPos (w ^. input) (w ^. cWorld . cwCamPos) -.- sp) + ep = sp +.+ 5000 *.* normalizeV (mouseWorldPos (w ^. input) (w ^. cWorld . cwCam) -.- sp) addLaserPic = cWorld . lWorld . lasers .:~ LaserStart diff --git a/src/Dodge/Targeting/Draw.hs b/src/Dodge/Targeting/Draw.hs index e7e8056ce..6a8d1851a 100644 --- a/src/Dodge/Targeting/Draw.hs +++ b/src/Dodge/Targeting/Draw.hs @@ -26,7 +26,7 @@ targetDistanceDraw :: Creature -> Configuration -> World -> Picture targetDistanceDraw cr _ w = fromMaybe mempty $ do p <- cr ^? crTargeting . ctPos . _Just let p1 = worldPosToScreen cam p - mwp = mouseWorldPos (w ^. input) (w ^. cWorld . cwCamPos) + mwp = mouseWorldPos (w ^. input) (w ^. cWorld . cwCam) p2 = worldPosToScreen cam mwp thecol = if dist p mwp > 100 then red else white return . @@ -35,7 +35,7 @@ targetDistanceDraw cr _ w = fromMaybe mempty $ do line [p1, p2] <> transMidLine p1 p2 (scale 0.1 0.1 . text . shortShow $ dist p mwp) where - cam = w ^. cWorld . cwCamPos + cam = w ^. cWorld . cwCam targetDraw :: Picture -> Creature -> Configuration -> World -> Picture targetDraw f cr _ _ = fromMaybe mempty $ do diff --git a/src/Dodge/TestString.hs b/src/Dodge/TestString.hs index ea85fa508..a3d03efca 100644 --- a/src/Dodge/TestString.hs +++ b/src/Dodge/TestString.hs @@ -15,7 +15,7 @@ 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 . cwCamPos) +testStringInit u = [show $ length $ lightsToRender (u ^. uvConfig) (u ^. uvWorld . cWorld . cwCam) (u ^. uvWorld . cWorld . lWorld) , show a , show $ u ^. uvWorld . input . mousePos @@ -27,8 +27,8 @@ testStringInit u = [show $ length $ lightsToRender (u ^. uvConfig) (u ^. uvWorld 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 . cwCamPos) -.- cpos) - - w ^. cWorld . cwCamPos . camRot + 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] diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 64aa017dd..f94368dd4 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -74,7 +74,8 @@ updateUniverse u = . maybeOpenTerminal . over (uvWorld . input . textInput) (const mempty) . updateUniverseMid - . updateUseInput + . 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) . over (uvWorld . input) updateScrollTestValue . over (uvWorld . cWorld . cClock) (+ 1) @@ -281,9 +282,9 @@ zoneClouds :: World -> World zoneClouds w = w & clZoning .~ foldl' (flip zoneCloud) mempty (w ^. cWorld . lWorld . clouds) updateWorldSelect' :: World -> World -updateWorldSelect' w = over input (updateWorldSelect (w ^. cWorld . cwCamPos)) w +updateWorldSelect' w = over input (updateWorldSelect (w ^. cWorld . cwCam)) w -updateWorldSelect :: CamPos -> Input -> Input +updateWorldSelect :: Camera -> Input -> Input updateWorldSelect cam inp = f . g $ case (inp ^? mouseButtons . ix ButtonLeft, inp ^? mouseButtons . ix ButtonRight) of (Just False, Nothing) -> inp & lLine . _1 .~ mwp diff --git a/src/Dodge/Update/Camera.hs b/src/Dodge/Update/Camera.hs index 8f3b44b98..76df9d4a8 100644 --- a/src/Dodge/Update/Camera.hs +++ b/src/Dodge/Update/Camera.hs @@ -26,15 +26,21 @@ import qualified SDL {- Update the screen camera rotation and position, including any in rold scope/remote camera modifiers; update where your avatar's view is from. -} updateCamera :: Configuration -> World -> World -updateCamera cfig w = +updateCamera cfig w = case w ^. cWorld . cwCam . camControl of + CamInGame -> updateInGameCamera cfig w + CamFloat -> w + CamPan -> w + +updateInGameCamera :: Configuration -> World -> World +updateInGameCamera cfig w = w & updateBounds cfig - & over (cWorld . cwCamPos) (setViewDistance cfig) - & cWorld . cwCamPos %~ moveZoomCamera cfig (w ^. input) (you w) + & over (cWorld . cwCam) (setViewDistance cfig) + & cWorld . cwCam %~ moveZoomCamera cfig (w ^. input) (you w) & updateScopeZoom & rotateCamera cfig -moveZoomCamera :: Configuration -> Input -> Creature -> CamPos -> CamPos +moveZoomCamera :: Configuration -> Input -> Creature -> Camera -> Camera moveZoomCamera cfig theinput cr campos = campos & camCenter .~ newcen @@ -98,7 +104,7 @@ updateScopeZoom' i w wppointer = cWorld . lWorld . creatures . ix 0 . crInv . ix i . itScope resetscope (ZoomScope _ _ _ defz bl) = ZoomScope (V2 0 0) 0 defz defz bl resetscope otherAtt = otherAtt - mp = rotateV (w ^. cWorld . cwCamPos . camRot) $ _mousePos (_input w) + mp = rotateV (w ^. cWorld . cwCam . camRot) $ _mousePos (_input w) doScopeZoom :: Point2 -> Scope -> Scope doScopeZoom mp sc = case sc ^? scopeZoomChange of @@ -163,11 +169,11 @@ rotateToOverlappingWall w = p = _crPos (you w) doWallRotate :: Wall -> World -> World -doWallRotate wl w = rotateUsing $ (argV . uncurry (-.-) $ _wlLine wl) - (w ^. cWorld . cwCamPos . camRot) +doWallRotate wl w = rotateUsing $ (argV . uncurry (-.-) $ _wlLine wl) - (w ^. cWorld . cwCam . camRot) where rotateUsing a - | b - b' > 0.01 = w & cWorld . cwCamPos . camRot +~ 0.01 - | b - b' < negate 0.01 = w & cWorld . cwCamPos . camRot -~ 0.01 + | b - b' > 0.01 = w & cWorld . cwCam . camRot +~ 0.01 + | b - b' < negate 0.01 = w & cWorld . cwCam . camRot -~ 0.01 | otherwise = w where --b = a * (2 / pi) @@ -177,7 +183,7 @@ doWallRotate wl w = rotateUsing $ (argV . uncurry (-.-) $ _wlLine wl) - (w ^. cW rotateCameraBy :: Float -> CWorld -> CWorld rotateCameraBy x w = w - & cwCamPos . camRot +~ x + & cwCam . camRot +~ x & rotateanyscope where rotateanyscope = fromMaybe id $ do @@ -208,7 +214,7 @@ clipZoom :: Float clipZoom = min 20 . max 0.2 -setViewDistance :: Configuration -> CamPos -> CamPos +setViewDistance :: Configuration -> Camera -> Camera setViewDistance cfig w = w & camViewDistance .~ sqrt (halfWidth cfig ** 2 + halfHeight cfig ** 2) / (w ^. camZoom) @@ -218,7 +224,7 @@ farWallDistDirection p w = boundPoints $ map f $ getViewpoints p (_cWorld w) where - f q = (rotateV (negate (w ^. cWorld . cwCamPos . camRot)) . (-.- p)) (foldl' findPoint q (wls q)) + f q = (rotateV (negate (w ^. cWorld . cwCam . camRot)) . (-.- p)) (foldl' findPoint q (wls q)) wls q = filter wlIsOpaque $ wlsNearSeg p q w findPoint q = fromMaybe q . uncurry (intersectSegSeg p q) . _wlLine @@ -226,7 +232,7 @@ findBoundDists :: Configuration -> World -> (Float, Float, Float, Float) findBoundDists cfig w | debugOn Bound_box_screen cfig = (hh, - hh, hw, - hw) -- | otherwise = fromMaybe (0, 0, 0, 0) $ farWallDistDirection (w ^. cWorld . camPos . camCenter) w - | otherwise = fromMaybe (0, 0, 0, 0) $ farWallDistDirection (w ^. cWorld . cwCamPos . camViewFrom) w + | otherwise = fromMaybe (0, 0, 0, 0) $ farWallDistDirection (w ^. cWorld . cwCam . camViewFrom) w where hw = halfWidth cfig hh = halfHeight cfig @@ -234,8 +240,8 @@ findBoundDists cfig w updateBounds :: Configuration -> World -> World updateBounds cfig w = w - & cWorld . cwCamPos . camBoundDist .~ bdists - & cWorld . cwCamPos . camBoundBox - .~ map ((+.+ w ^. cWorld . cwCamPos . camCenter) . rotateV (w ^. cWorld . cwCamPos . camRot)) (rectNSWE n s w' e) + & cWorld . cwCam . camBoundDist .~ bdists + & cWorld . cwCam . camBoundBox + .~ map ((+.+ w ^. cWorld . cwCam . camCenter) . rotateV (w ^. cWorld . cwCam . camRot)) (rectNSWE n s w' e) where bdists@(n, s, e, w') = findBoundDists cfig w diff --git a/src/Dodge/Update/Input/InGame.hs b/src/Dodge/Update/Input/InGame.hs index 77b2af840..12c0ebce2 100644 --- a/src/Dodge/Update/Input/InGame.hs +++ b/src/Dodge/Update/Input/InGame.hs @@ -8,6 +8,7 @@ import qualified Data.Map.Strict as M import Data.Maybe import Dodge.Base.You import Dodge.Button.Event +import Dodge.Camera import Dodge.Creature.Action import Dodge.Data.Combine import Dodge.Data.Universe @@ -46,9 +47,6 @@ updateUseInputInGame h u = case h of (uvWorld . worldEventFlags . at InventoryChange ?~ ()) . maybeExitCombine $ over uvWorld (tryCombine sss) u & uvWorld . worldEventFlags . at CombineInventoryChange ?~ () - -- _ -> case regexFocus w of - -- Nothing -> M.foldlWithKey' updateKeyInGame u pkeys - -- Just (filtpoint,selpoint,i) -> u & uvWorld . p %~ doRegexInput _ | inInvRegex (u ^. uvWorld) -> u & uvWorld . hud . hudElement . diSections %~ doRegexInput u (-1) @@ -108,6 +106,8 @@ updateKeyInGame uv sc pt = case pt of updateInitialPressInGame :: Universe -> Scancode -> Universe updateInitialPressInGame uv sc = case sc of + ScancodeF2 -> pauseAndFloatCam uv + ScancodeF3 -> pauseAndPanCam uv ScancodeF5 -> doQuicksave uv ScancodeF9 -> doQuickload uv ScancodeEscape -> pauseGame uv diff --git a/src/Dodge/Update/Input/Text.hs b/src/Dodge/Update/Input/Text.hs index caad91620..7c5b1973b 100644 --- a/src/Dodge/Update/Input/Text.hs +++ b/src/Dodge/Update/Input/Text.hs @@ -3,6 +3,7 @@ module Dodge.Update.Input.Text ( doTextInputOver', ) where +import Data.Either import Data.Char import Dodge.Data.Universe import LensHelp @@ -13,7 +14,7 @@ doTextInputOver p u = doTextInputOver' u p u doTextInputOver' :: Universe -> ASetter' a String -> a -> a doTextInputOver' u p x = - x & p %~ (++ map toUpper str) + x & p %~ (++ map toUpper (rights str)) & checkBackspace where str = u ^. uvWorld . input . textInput diff --git a/src/Dodge/Update/Scroll.hs b/src/Dodge/Update/Scroll.hs index 07e7421a2..21219a721 100644 --- a/src/Dodge/Update/Scroll.hs +++ b/src/Dodge/Update/Scroll.hs @@ -30,7 +30,7 @@ updateWheelEvent yi w = case w ^. hud . hudElement of (_, EquipOptions{}) -> w & rbOptions %~ scrollRBOption yi (Nothing, _) -> closeObjScrollDir y w (Just f, _) -> doHeldScroll f y (you w) w - | lbDown -> w & cWorld . cwCamPos . camZoom +~ y + | lbDown -> w & cWorld . cwCam . camZoom +~ y | invKeyDown -> changeSwapSel yi w | otherwise -> stopSoundFrom (CrReloadSound 0) $ scrollAugInvSel yi w DisplayInventory {_subInventory = ExamineInventory mi} diff --git a/src/Dodge/WorldEffect.hs b/src/Dodge/WorldEffect.hs index 90b2ed0ef..c15fa54c0 100644 --- a/src/Dodge/WorldEffect.hs +++ b/src/Dodge/WorldEffect.hs @@ -58,7 +58,7 @@ accessTerminal mtmid w = case mtmid of torqueCr :: Float -> Int -> World -> World torqueCr x cid w - | cid == 0 = set randGen g $ over (cWorld . cwCamPos . camRot) (+ rot) w + | cid == 0 = set randGen g $ over (cWorld . cwCam . camRot) (+ rot) w | otherwise = set randGen g $ over (cWorld . lWorld . creatures . ix cid . crDir) (+ rot) w where (rot, g) = randomR (- x, x) $ _randGen w diff --git a/src/Dodge/WorldEvent/Cloud.hs b/src/Dodge/WorldEvent/Cloud.hs index 4f99ad6d2..0ef245fe2 100644 --- a/src/Dodge/WorldEvent/Cloud.hs +++ b/src/Dodge/WorldEvent/Cloud.hs @@ -73,4 +73,4 @@ makeFlamerSmokeAt p w = makeCloudAt (CloudColor 4 300 (greyN x)) 6 200 40 p w spawnSmokeAtCursor :: World -> World spawnSmokeAtCursor w = shellTrailCloud 400 100 (V3 x y 20) w where - V2 x y = mouseWorldPos (w ^. input) (w ^. cWorld . cwCamPos) + V2 x y = mouseWorldPos (w ^. input) (w ^. cWorld . cwCam) diff --git a/src/Dodge/Zoning/World.hs b/src/Dodge/Zoning/World.hs index 0709bd1bf..d27513a0a 100644 --- a/src/Dodge/Zoning/World.hs +++ b/src/Dodge/Zoning/World.hs @@ -2,11 +2,11 @@ module Dodge.Zoning.World ( zoneOfSight ) where -import Dodge.Data.CamPos +import Dodge.Data.Camera import Geometry.Data import Control.Lens -zoneOfSight :: Float -> CamPos -> [Int2] +zoneOfSight :: Float -> Camera -> [Int2] zoneOfSight s w = [ V2 a b | a <- [minimum xs .. maximum xs]