From afaef480db3bb1eb6ecaee8bf4cdb45e6501a0ab Mon Sep 17 00:00:00 2001 From: justin Date: Sat, 29 Oct 2022 12:20:19 +0100 Subject: [PATCH] Minor tweaking, argument refining --- src/Dodge/Base/Coordinate.hs | 18 +++++++------- src/Dodge/Bullet.hs | 2 +- src/Dodge/Clock.hs | 6 ++--- src/Dodge/Creature/Action/Blink.hs | 6 ++--- src/Dodge/Creature/Picture/Awareness.hs | 3 ++- src/Dodge/Creature/YourControl.hs | 2 +- src/Dodge/HeldUse.hs | 2 +- src/Dodge/Item/Weapon/BatteryGuns.hs | 4 ++-- src/Dodge/Item/Weapon/ExtraEffect.hs | 8 +++---- src/Dodge/Item/Weapon/TriggerType.hs | 4 ++-- src/Dodge/Item/Weapon/Utility.hs | 2 +- src/Dodge/Luse.hs | 2 +- src/Dodge/Render/HUD.hs | 16 ++++++------- src/Dodge/Render/ShapePicture.hs | 4 ++-- src/Dodge/Targeting/Draw.hs | 2 +- src/Dodge/Update.hs | 32 +++++++++++++------------ src/Dodge/WorldEvent/Cloud.hs | 2 +- 17 files changed, 59 insertions(+), 56 deletions(-) diff --git a/src/Dodge/Base/Coordinate.hs b/src/Dodge/Base/Coordinate.hs index 2398f95da..270871b00 100644 --- a/src/Dodge/Base/Coordinate.hs +++ b/src/Dodge/Base/Coordinate.hs @@ -6,7 +6,10 @@ module Dodge.Base.Coordinate ( import Control.Lens import Dodge.Base.WinScale -import Dodge.Data.Universe +import Dodge.Data.CamPos +import Dodge.Data.Config +import Dodge.Data.HUD +import Dodge.Data.Input import Geometry ---- | Transform coordinates from world position to screen coordinates. @@ -30,10 +33,9 @@ worldPosToScreen cam = {- | Transform coordinates from the map position to screen coordinates. -} -cartePosToScreen :: Configuration -> World -> Point2 -> Point2 -cartePosToScreen cfig w = doWindowScale cfig . doRotate . doZoom . doTranslate +cartePosToScreen :: Configuration -> HUD -> Point2 -> Point2 +cartePosToScreen cfig thehud = doWindowScale cfig . doRotate . doZoom . doTranslate where - thehud = w ^. cWorld . lWorld . hud doTranslate p = p -.- (thehud ^. carteCenter) -- _carteCenter (_hud (_cWorld w)) doZoom p = (thehud ^. carteZoom) *.* p doRotate p = rotateV (negate $ thehud ^. carteRot) p @@ -42,12 +44,10 @@ cartePosToScreen cfig w = doWindowScale cfig . doRotate . doZoom . doTranslate --crToMousePosOffset cr w = (mouseWorldPos w -.- _crPos cr, 0) -- | The mouse position in world coordinates. -mouseWorldPos :: World -> Point2 -mouseWorldPos w = +mouseWorldPos :: Input -> CamPos -> Point2 +mouseWorldPos inp cam = (cam ^. camCenter) - +.+ (1 / (cam ^. camZoom)) *.* rotateV (cam ^. camRot) (_mousePos $ _input w) - where - cam = w ^. cWorld . lWorld . camPos + +.+ (1 / (cam ^. camZoom)) *.* rotateV (cam ^. camRot) (_mousePos inp) ---- | The mouse position in map coordinates --mouseCartePos :: World -> Point2 diff --git a/src/Dodge/Bullet.hs b/src/Dodge/Bullet.hs index 4a70e552c..d021a4049 100644 --- a/src/Dodge/Bullet.hs +++ b/src/Dodge/Bullet.hs @@ -78,7 +78,7 @@ useAmmoParams it cr w = return $ FlechetteTrajectory tpos BezierTrajectory{} -> fromMaybe BasicBulletTrajectory $ do tpos <- it ^? itTargeting . tgPos . _Just - return $ BezierTrajectory sp tpos (mouseWorldPos w) + return $ BezierTrajectory sp tpos (mouseWorldPos (w ^. input) (w ^. cWorld . lWorld . camPos)) bounceDir :: (Point2, Either Creature Wall) -> Maybe Point2 bounceDir (_, Right wl) | _wlBouncy wl = Just $ uncurry (-.-) (_wlLine wl) diff --git a/src/Dodge/Clock.hs b/src/Dodge/Clock.hs index 6e9a74a88..cd096acf9 100644 --- a/src/Dodge/Clock.hs +++ b/src/Dodge/Clock.hs @@ -4,12 +4,12 @@ module Dodge.Clock ( import Control.Lens import qualified Data.Vector as V -import Dodge.Data.World +import Dodge.Data.LWorld -clockCycle :: Int -> V.Vector a -> World -> a +clockCycle :: Int -> V.Vector a -> LWorld -> a {-# INLINEABLE clockCycle #-} clockCycle tPeriod xs w = xs V.! i where l = V.length xs - t = (w ^. cWorld . lWorld . lClock) `mod` (l * tPeriod) + t = (w ^. lClock) `mod` (l * tPeriod) i = t `div` tPeriod diff --git a/src/Dodge/Creature/Action/Blink.hs b/src/Dodge/Creature/Action/Blink.hs index 95aa0de3f..983c76846 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 + p1 = mouseWorldPos (w ^. input) (w ^. cWorld . lWorld . camPos) 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 + mwp = mouseWorldPos (w ^. input) (w ^. cWorld . lWorld . camPos) 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 + p1 = mouseWorldPos (w ^. input) (w ^. cWorld . lWorld . camPos) 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 764e65d47..b97d182ca 100644 --- a/src/Dodge/Creature/Picture/Awareness.hs +++ b/src/Dodge/Creature/Picture/Awareness.hs @@ -24,9 +24,10 @@ creatureDisplayText w cr = , \cr' -> [crDisplayAwareness cr'] ] ) - w + lw cr where + lw = w ^. cWorld . lWorld campos = w ^. cWorld . lWorld . camPos . camViewFrom theScale = 0.15 / (w ^. cWorld . lWorld . camPos . camZoom) cpos = _crPos cr diff --git a/src/Dodge/Creature/YourControl.hs b/src/Dodge/Creature/YourControl.hs index b2e7debbd..f45789d74 100644 --- a/src/Dodge/Creature/YourControl.hs +++ b/src/Dodge/Creature/YourControl.hs @@ -61,7 +61,7 @@ wasdWithAiming w speed cr movAbs = rotateV (w ^. cWorld . lWorld . camPos . camRot) $ normalizeV movDir isAiming = _posture (_crStance cr) == Aiming mouseDir = case cr ^? crInv . ix (crSel cr) . itScope . scopePos of - Just _ -> argV $ mouseWorldPos w -.- _crPos cr + Just _ -> argV $ mouseWorldPos (w ^. input) (w ^. cWorld . lWorld . camPos) -.- _crPos cr _ -> argV (_mousePos (_input w)) + (w ^. cWorld . lWorld . camPos . camRot) wasdM :: SDL.Scancode -> Point2 diff --git a/src/Dodge/HeldUse.hs b/src/Dodge/HeldUse.hs index 70ebeca99..925139d18 100644 --- a/src/Dodge/HeldUse.hs +++ b/src/Dodge/HeldUse.hs @@ -348,7 +348,7 @@ useMod hm = case hm of directedTelPos it cr w = (p, a) where p = fromMaybe (_crPos cr) $ it ^? itTargeting . tgPos . _Just - a = argV (mouseWorldPos w -.- p) + a = argV (mouseWorldPos (w ^. input) (w ^. cWorld . lWorld . camPos) -.- p) moddelay x = itUse . heldConsumption . laAmmoType . amBullet . buDelayFraction .~ x modcrpos x cr = cr & crDir %~ tweenAngles x (_crOldDir cr) diff --git a/src/Dodge/Item/Weapon/BatteryGuns.hs b/src/Dodge/Item/Weapon/BatteryGuns.hs index dcf02eb58..45480df80 100644 --- a/src/Dodge/Item/Weapon/BatteryGuns.hs +++ b/src/Dodge/Item/Weapon/BatteryGuns.hs @@ -148,7 +148,7 @@ circleLaser it cr w | otherwise = w where cpos = _crPos cr - mwp = mouseWorldPos w + mwp = mouseWorldPos (w ^. input) (w ^. cWorld . lWorld . camPos) 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.! crSel cr @@ -167,7 +167,7 @@ shootDualLaser it cr w = gap = _dbGap . _itParams $ it posl = pos +.+ (- gap) *.* vNormal (unitVectorAtAngle dir) posr = pos +.+ gap *.* vNormal (unitVectorAtAngle dir) - mwp = mouseWorldPos w + mwp = mouseWorldPos (w ^. input) (w ^. cWorld . lWorld . camPos) mwp' | dist mwp (_crPos cr) < aimlength + 5 = _crPos cr +.+ (aimlength + 5) *.* unitVectorAtAngle dir | otherwise = mwp diff --git a/src/Dodge/Item/Weapon/ExtraEffect.hs b/src/Dodge/Item/Weapon/ExtraEffect.hs index ddc9cf865..f21d84b3e 100644 --- a/src/Dodge/Item/Weapon/ExtraEffect.hs +++ b/src/Dodge/Item/Weapon/ExtraEffect.hs @@ -83,7 +83,7 @@ targetRBCreatureUp it cr w t . filter (canseepos . _crPos) $ crsNearCirc mwp 40 w canseepos p = hasLOS (_crPos cr) p w - mwp = mouseWorldPos w + mwp = mouseWorldPos (w ^. input) (w ^. cWorld . lWorld . camPos) updatePos t' = t' & tgPos .~ posFromMaybeID (_tgID t') posFromMaybeID Nothing = Nothing posFromMaybeID (Just i) = w ^? cWorld . lWorld . creatures . ix i . crPos @@ -107,7 +107,7 @@ targetCursorUpdate :: World -> Targeting -> Targeting targetCursorUpdate w t | SDL.ButtonRight `M.member` _mouseButtons (_input w) = t - & tgPos . _Just .~ mouseWorldPos w + & tgPos . _Just .~ mouseWorldPos (w ^. input) (w ^. cWorld . lWorld . camPos) & tgActive .~ True | otherwise = t & tgPos %~ const Nothing @@ -117,7 +117,7 @@ targetRBPressUpdate :: World -> Targeting -> Targeting targetRBPressUpdate w t | SDL.ButtonRight `M.member` _mouseButtons (_input w) = t - & tgPos %~ maybe (Just $ mouseWorldPos w) Just + & tgPos %~ maybe (Just $ mouseWorldPos (w ^. input) (w ^. cWorld . lWorld . camPos)) Just & tgActive .~ True | otherwise = t & tgPos %~ const Nothing @@ -139,7 +139,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 -.- sp) + ep = sp +.+ 5000 *.* normalizeV (mouseWorldPos (w ^. input) (w ^. cWorld . lWorld . camPos) -.- sp) addLaserPic = cWorld . lWorld . lasers .:~ LaserStart diff --git a/src/Dodge/Item/Weapon/TriggerType.hs b/src/Dodge/Item/Weapon/TriggerType.hs index c4456f2b2..2d0fd92b6 100644 --- a/src/Dodge/Item/Weapon/TriggerType.hs +++ b/src/Dodge/Item/Weapon/TriggerType.hs @@ -698,12 +698,12 @@ duplicateOffsetsFocus xs eff item cr w = foldr f w poss & crPos %~ (+.+ pos) & crDir .~ thedir pos thedir pos - | dist (mouseWorldPos w) (_crPos cr) < aimingMuzzlePos cr item = + | dist (mouseWorldPos (w ^. input) (w ^. cWorld . lWorld . camPos)) (_crPos cr) < aimingMuzzlePos cr item = argV ( _crPos cr +.+ aimingMuzzlePos cr item *.* unitVectorAtAngle (_crDir cr) -.- (_crPos cr +.+ pos) ) - | otherwise = argV (mouseWorldPos w -.- (_crPos cr +.+ pos)) + | otherwise = argV (mouseWorldPos (w ^. input) (w ^. cWorld . lWorld . camPos) -.- (_crPos cr +.+ pos)) duplicateItem :: (Item -> [Item]) -> ChainEffect duplicateItem fit eff itm cr w = foldr f w (fit itm) diff --git a/src/Dodge/Item/Weapon/Utility.hs b/src/Dodge/Item/Weapon/Utility.hs index 2d1c4245b..f34cdf6db 100644 --- a/src/Dodge/Item/Weapon/Utility.hs +++ b/src/Dodge/Item/Weapon/Utility.hs @@ -84,7 +84,7 @@ unsafeBlinkGun = useForceFieldGun :: Item -> Creature -> World -> World useForceFieldGun itm cr w = fromMaybe w $ do a <- _tgPos $ _itTargeting itm - let mwp = mouseWorldPos w + let mwp = mouseWorldPos (w ^. input) (w ^. cWorld . lWorld . camPos) b = if dist a mwp < 100 then mwp else a +.+ 100 *.* normalizeV (mwp -.- a) wlline = (a, b) return $ diff --git a/src/Dodge/Luse.hs b/src/Dodge/Luse.hs index b3cb7e630..62f9b8e13 100644 --- a/src/Dodge/Luse.hs +++ b/src/Dodge/Luse.hs @@ -98,7 +98,7 @@ boostPoint x cr w = case mayp2 of where cpos = _crPos cr r = 1.5 * _crRad cr - p1 = cpos +.+ x *.* squashNormalizeV (mouseWorldPos w -.- cpos) + p1 = cpos +.+ x *.* squashNormalizeV (mouseWorldPos (w ^. input) (w ^. cWorld . lWorld . camPos) -.- cpos) mayp2 = bouncePoint (const True) 1 cpos p1 w addBoostShockwave :: diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index 876daf531..0d38be7bc 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -92,7 +92,7 @@ subInventoryDisplay subinv cfig w = case subinv of , invHead cfig "TWEAK" , listPicturesAt subInvX 60 cfig $ map text (ammoTweakStrings it) ] - DisplayTerminal tid -> displayTerminal tid cfig w + DisplayTerminal tid -> displayTerminal tid cfig (w ^. cWorld . lWorld) CombineInventory mi -> pictures [ invHead cfig "COMBINE" @@ -160,9 +160,9 @@ itmInfo mit = fromMaybe [] $ do itm <- mit return (map show . M.assocs . _iyModules $ _itType itm) -displayTerminal :: Int -> Configuration -> World -> Picture +displayTerminal :: Int -> Configuration -> LWorld -> Picture displayTerminal tid cfig w = fromMaybe mempty $ do - tm <- w ^? cWorld . lWorld . terminals . ix tid + tm <- w ^? terminals . ix tid return $ pictures [ invHead cfig (_tmTitle tm ++ ":T" ++ show tid) @@ -334,7 +334,7 @@ drawCarte cfig w = where iPos = w ^. cWorld . lWorld . selLocation locs = map (\(_, s) -> (s, white)) . IM.elems . _seenLocations . _lWorld $ _cWorld w - locPoss = map (cartePosToScreen cfig w . ($ w) . doWorldPos . fst) . IM.elems . _seenLocations . _lWorld $ _cWorld w + locPoss = map (cartePosToScreen cfig (w ^. cWorld . lWorld . hud) . ($ w) . doWorldPos . fst) . IM.elems . _seenLocations . _lWorld $ _cWorld w locTexts = map fst locs displayListEndCoords :: Configuration -> [String] -> [Point2] @@ -348,12 +348,12 @@ displayListEndCoords cfig ss = map (doWindowScale cfig) $ zipWith h ss $ map f [ mapOverlay :: Configuration -> World -> [Picture] mapOverlay cfig w = (color (withAlpha 0.5 black) . polygon $ reverse $ rectNSWE 1 (-1) 1 (-1)) : - (mapMaybe (mapWall cfig w) . IM.elems $ w ^. cWorld . lWorld . walls) + (mapMaybe (mapWall cfig (w ^. cWorld . lWorld . hud)) . IM.elems $ w ^. cWorld . lWorld . walls) -mapWall :: Configuration -> World -> Wall -> Maybe Picture -mapWall cfig w wl = +mapWall :: Configuration -> HUD -> Wall -> Maybe Picture +mapWall cfig thehud wl = if _wlSeen wl - then Just . color c . polygon $ map (cartePosToScreen cfig w) [x, x +.+ n2, y +.+ n2, y] + then Just . color c . polygon $ map (cartePosToScreen cfig thehud) [x, x +.+ n2, y +.+ n2, y] else Nothing where t = normalizeV (y -.- x) diff --git a/src/Dodge/Render/ShapePicture.hs b/src/Dodge/Render/ShapePicture.hs index d7bba0bbf..71cb3b35b 100644 --- a/src/Dodge/Render/ShapePicture.hs +++ b/src/Dodge/Render/ShapePicture.hs @@ -291,7 +291,7 @@ drawDDATest w = <> setLayer DebugLayer (color yellow (line [cvf, mwp])) where cvf = w ^. cWorld . lWorld . camPos . camViewFrom - mwp = mouseWorldPos w + mwp = mouseWorldPos (w ^. input) (w ^. cWorld . lWorld . camPos) --ps = ddaStreamX 50 cvf mwp ps = zoneOfSeg 50 cvf mwp @@ -378,7 +378,7 @@ drawMousePosition cfig w = $ shortPoint2 mwp where p = worldPosToScreen (w ^. cWorld . lWorld . camPos) mwp - mwp = mouseWorldPos w + mwp = mouseWorldPos (w ^. input) (w ^. cWorld . lWorld . camPos) drawWlIDs :: Configuration -> World -> Picture drawWlIDs cfig w = setLayer FixedCoordLayer $ foldMap f (w ^. cWorld . lWorld . walls) diff --git a/src/Dodge/Targeting/Draw.hs b/src/Dodge/Targeting/Draw.hs index e5674dac3..4f1d6745d 100644 --- a/src/Dodge/Targeting/Draw.hs +++ b/src/Dodge/Targeting/Draw.hs @@ -23,7 +23,7 @@ targetDistanceDraw :: Item -> Creature -> Configuration -> World -> Picture targetDistanceDraw itm _ cfig w = fromMaybe mempty $ do p <- itm ^? itTargeting . tgPos . _Just let p1 = worldPosToScreen cam p - mwp = mouseWorldPos w + mwp = mouseWorldPos (w ^. input) (w ^. cWorld . lWorld . camPos) p2 = worldPosToScreen cam mwp thecol = if dist p mwp > 100 then red else white return $ diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 25d0ece62..df6ec79ea 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -147,7 +147,7 @@ functionalUpdate w = checkEndGame -- . updateRandGen . over uvWorld (cWorld . lWorld . lClock +~ 1) - . over uvWorld updateWorldSelect + . over uvWorld updateWorldSelect' -- . over uvWorld doRewind -- . over uvWorld (hammers . each %~ moveHammerUp) -- . over (uvWorld . hammers . each) moveHammerUp @@ -248,29 +248,31 @@ zoneClouds w = & cWorld . lWorld . clZoning %~ \zn -> foldl' (flip zoneCloud) zn (w ^. cWorld . lWorld . clouds) +updateWorldSelect' :: World -> World +updateWorldSelect' w = over input (updateWorldSelect (w ^. cWorld . lWorld . camPos)) w -updateWorldSelect :: World -> World -updateWorldSelect w = f . g $ case (w ^? input . mouseButtons . ix ButtonLeft, w ^? input . mouseButtons . ix ButtonRight) of +updateWorldSelect :: CamPos -> Input -> Input +updateWorldSelect cam inp = f . g $ case (inp ^? mouseButtons . ix ButtonLeft, inp ^? mouseButtons . ix ButtonRight) of (Just False, Nothing) -> - w & input . lLine . _1 .~ mwp - & input . lrLine . _1 .~ mwp + inp & lLine . _1 .~ mwp + & lrLine . _1 .~ mwp (Just True, Nothing) -> - w & input . lLine . _2 .~ mwp - & input . lrLine . _1 .~ mwp + inp & lLine . _2 .~ mwp + & lrLine . _1 .~ mwp (Nothing, Just False) -> - w & input . rLine . _1 .~ mwp - & input . lrLine . _2 .~ mwp + inp & rLine . _1 .~ mwp + & lrLine . _2 .~ mwp (Nothing, Just True) -> - w & input . rLine . _2 .~ mwp - & input . lrLine . _2 .~ mwp - _ -> w + inp & rLine . _2 .~ mwp + & lrLine . _2 .~ mwp + _ -> inp where - mwp = mouseWorldPos w + mwp = mouseWorldPos inp cam f - | ButtonLeft `M.member` _mouseButtons (_input w) = input . lSelect .~ mwp + | ButtonLeft `M.member` _mouseButtons inp = lSelect .~ mwp | otherwise = id g - | ButtonRight `M.member` _mouseButtons (_input w) = input . rSelect .~ mwp + | ButtonRight `M.member` _mouseButtons inp = rSelect .~ mwp | otherwise = id --mcChooseUpdate :: Machine -> Machine -> World -> World diff --git a/src/Dodge/WorldEvent/Cloud.hs b/src/Dodge/WorldEvent/Cloud.hs index fb346269b..2c96c2d8c 100644 --- a/src/Dodge/WorldEvent/Cloud.hs +++ b/src/Dodge/WorldEvent/Cloud.hs @@ -72,4 +72,4 @@ makeFlamerSmokeAt p w = makeCloudAt (CloudColor 4 300 (greyN x)) 6 200 40 p w spawnSmokeAtCursor :: World -> World spawnSmokeAtCursor w = shellTrailCloud (V3 x y 20) w where - V2 x y = mouseWorldPos w + V2 x y = mouseWorldPos (w ^. input) (w ^. cWorld . lWorld . camPos)