diff --git a/src/Dodge/Creature/Impulse/UseItem.hs b/src/Dodge/Creature/Impulse/UseItem.hs index 93c75c9b1..ef18b226f 100644 --- a/src/Dodge/Creature/Impulse/UseItem.hs +++ b/src/Dodge/Creature/Impulse/UseItem.hs @@ -56,7 +56,7 @@ activateDetonator det _ w = foldl' remoteDetonate w remoteDetonate :: World -> Int -> World remoteDetonate w pjid = w - & cWorld . lWorld . projectiles . ix pjid . prjTimer .~ 0 + & cWorld . lWorld . projectiles . ix pjid . pjTimer .~ 0 useLocation :: LocationLDT ItemLink ComposedItem -> UseFocus useLocation loc diff --git a/src/Dodge/Data/Projectile.hs b/src/Dodge/Data/Projectile.hs index 7f7c8e6b4..f62b47e02 100644 --- a/src/Dodge/Data/Projectile.hs +++ b/src/Dodge/Data/Projectile.hs @@ -15,17 +15,17 @@ import Geometry.Data data Projectile = Shell - { _prjPos :: Point2 - , _prjVel :: Point2 - , _prjDir :: Float - , _prjSpin :: Float - , _prjID :: Int - , _prjPayload :: Payload - , _prjTimer :: Int - , _prjZ :: Float - , _prjZVel :: Float - , _prjUpdates :: [ProjectileUpdate] - , _prjType :: ProjectileType + { _pjPos :: Point2 + , _pjVel :: Point2 + , _pjDir :: Float + , _pjSpin :: Float + , _pjID :: Int + , _pjPayload :: Payload + , _pjTimer :: Int + , _pjZ :: Float + , _pjZVel :: Float + , _pjUpdates :: [ProjectileUpdate] + , _pjType :: ProjectileType } deriving (Eq, Ord, Show, Read) --Generic, Flat) diff --git a/src/Dodge/HeldUse.hs b/src/Dodge/HeldUse.hs index e7e77531a..3413bab0e 100644 --- a/src/Dodge/HeldUse.hs +++ b/src/Dodge/HeldUse.hs @@ -299,8 +299,8 @@ useLoadedAmmo itmtree cr (cme, w) (mzid, Just (mz, x, magtree)) = (,) (cme & cme MuzzleLaser -> shootLaser itmtree cr mz w MuzzleTesla -> shootTeslaArc itm cr mz w MuzzleTractor -> shootTractorBeam cr w - MuzzleRLauncher -> createProjectileR magtree mz itmtree cr w - MuzzleGLauncher -> createProjectile Grenade magtree mz itmtree cr w + MuzzleRLauncher -> createProjectileR itmtree magtree mz cr w + MuzzleGLauncher -> createProjectile Grenade magtree mz cr w MuzzleNozzle{} -> useGasParams mid mz itm cr $ walkNozzle mzid mz itm cr w MuzzleShatter -> shootShatter itm cr w MuzzleDetector -> itemDetectorEffect itm cr w @@ -608,17 +608,17 @@ determineProjectileTracking magtree itmtree = fromMaybe NoHoming $ createProjectileR :: LabelDoubleTree ComposeLinkType Item -> - Muzzle -> LabelDoubleTree ComposeLinkType Item -> + Muzzle -> Creature -> World -> World -createProjectileR magtree muz itmtree = +createProjectileR itmtree magtree = createProjectile (Rocket (determineProjectileTracking magtree itmtree) smoke - ) magtree muz itmtree + ) magtree where smoke | isJust $ lookup SmokeReducerLink (magtree ^. ldtLeft) = Just ReducedRocketSmoke @@ -628,23 +628,20 @@ createProjectile :: ProjectileType -> LabelDoubleTree ComposeLinkType Item -> Muzzle -> - LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World -createProjectile pjtype magtree muz itmtree cr = fromMaybe failsound $ do +createProjectile pjtype magtree muz cr = fromMaybe failsound $ do magid <- magtree ^? ldtValue . itLocation . ilInvID ammoitem <- cr ^? crInv . ix magid - let homing = determineProjectileTracking magtree itmtree - rdetonate = (^. ldtValue . itID) <$> + let rdetonate = (^. ldtValue . itID) <$> lookup RemoteDetonatorLink (magtree ^. ldtLeft) rscreen = (^. ldtValue . itID) <$> lookup RemoteScreenLink (magtree ^. ldtLeft) aparams <- ((magtree ^? ldtLeft) >>= lookup AmmoPayloadLink >>= (^? ldtValue . itType . ibtAttach . shellPayload)) <|> ammoitem ^? itConsumables . magParams . ampPayload return $ - --createShell homing rdetonate rscreen issmokeless pjtype aparams muz cr - createShell homing rdetonate rscreen pjtype aparams muz cr + createShell rdetonate rscreen pjtype aparams muz cr . startthesound where -- the sound should be moved to the projectile firing diff --git a/src/Dodge/Projectile/Create.hs b/src/Dodge/Projectile/Create.hs index efd73c260..d21faebfc 100644 --- a/src/Dodge/Projectile/Create.hs +++ b/src/Dodge/Projectile/Create.hs @@ -13,36 +13,32 @@ import qualified IntMapHelp as IM import LensHelp -- assumes the mscreen is in your inventory -createShell :: RocketHoming +createShell ::Maybe (NewInt ItmInt) -> Maybe (NewInt ItmInt) - -> Maybe (NewInt ItmInt) --- -> Bool -> ProjectileType -> Payload -> Muzzle -> Creature -> World -> World ---createShell homing mdetonator mscreen smokestatus pjtype payload muz cr w = w -createShell homing mdetonator mscreen pjtype payload muz cr w = w +createShell mdetonator mscreen pjtype payload muz cr w = w & updatescreen & updatedetonator & cWorld . lWorld . projectiles . at i ?~ Shell - { _prjPos = pos - , _prjZ = 20 - , _prjZVel = 5 - , _prjVel = rotateV dir (V2 speed 0) + cr ^. crPos - cr ^. crOldPos - , _prjID = i --- , _prjAcc = rotateV dir (V2 3 0) - , _prjDir = dir - , _prjSpin = 0 - , _prjPayload = payload - , _prjTimer = lifespan - , _prjUpdates = + { _pjPos = pos + , _pjZ = 20 + , _pjZVel = 5 + , _pjVel = rotateV dir (V2 speed 0) + cr ^. crPos - cr ^. crOldPos + , _pjID = i + , _pjDir = dir + , _pjSpin = 0 + , _pjPayload = payload + , _pjTimer = lifespan + , _pjUpdates = [ CollisionEffectPU mdetonator mscreen , TimePU , StartSpinPU (lifespan - 15) (_crID cr) spinamount , RemoteDirectionPU (lifespan - thrustdelay) 0 , ReduceSpinPU (1 - spindrag * 2 / 200) ] <> thrustorgrav - , _prjType = pjtype + , _pjType = pjtype } where speed = case pjtype of diff --git a/src/Dodge/Projectile/Draw.hs b/src/Dodge/Projectile/Draw.hs index 03119ae5e..5aff444bf 100644 --- a/src/Dodge/Projectile/Draw.hs +++ b/src/Dodge/Projectile/Draw.hs @@ -13,18 +13,18 @@ import ShapePicture drawProjectile :: Projectile -> SPic drawProjectile pj - | Just DestroyPU{} <- pj ^? prjUpdates . ix 0 = mempty - | Just NoHoming <- pj ^? prjType . rkHoming = + | Just DestroyPU{} <- pj ^? pjUpdates . ix 0 = mempty + | Just NoHoming <- pj ^? pjType . rkHoming = drawShell Nothing pj - | Just _ <- pj ^? prjType . rkHoming = + | Just _ <- pj ^? pjType . rkHoming = drawRemoteShell pj | otherwise = drawShell Nothing pj drawShell :: Maybe Color -> Projectile -> SPic drawShell mcol pj = - translateSPz (_prjZ pj) - . uncurryV translateSPxy (_prjPos pj) - $ rotateSP (_prjDir pj) $ + translateSPz (_pjZ pj) + . uncurryV translateSPxy (_pjPos pj) + $ rotateSP (_pjDir pj) $ shellShape :!: thelight where thelight = @@ -43,4 +43,4 @@ drawRemoteShell pj col | t > (-99) = green | otherwise = red - t = _prjTimer pj + t = _pjTimer pj diff --git a/src/Dodge/Projectile/Update.hs b/src/Dodge/Projectile/Update.hs index ccc9c4d12..57f8ae5e8 100644 --- a/src/Dodge/Projectile/Update.hs +++ b/src/Dodge/Projectile/Update.hs @@ -22,10 +22,10 @@ import NewInt import RandomHelp updateProjectile :: Projectile -> World -> World -updateProjectile pj w = foldl' (\w' pu -> upProjectile pu pj w') w (_prjUpdates pj) +updateProjectile pj w = foldl' (flip $ upProjectile pj) w (_pjUpdates pj) -upProjectile :: ProjectileUpdate -> Projectile -> World -> World -upProjectile pu pj = case pu of +upProjectile :: Projectile -> ProjectileUpdate -> World -> World +upProjectile pj pu = case pu of CollisionEffectPU mdetonatorid mscreenid -> shellCollisionCheck mdetonatorid @@ -33,51 +33,51 @@ upProjectile pu pj = case pu of pj TimePU -> decTimMvVel pj ThrustPU st et - | act st et -> doThrust pj (pj ^? prjType . rkSmoke . _Just) + | act st et -> doThrust pj (pj ^? pjType . rkSmoke . _Just) | otherwise -> id StartSpinPU t cid spinamount | time == t -> trySpinByCID cid spinamount pj | otherwise -> id RemoteDirectionPU st et - | act st et -> pjRemoteSetDirection (pj ^? prjType . rkHoming) pj + | act st et -> pjRemoteSetDirection (pj ^? pjType . rkHoming) pj | otherwise -> id - ReduceSpinPU x -> reduceSpinBy x (_prjID pj) - DestroyPU mitid 0 -> destroyProjectile mitid (_prjID pj) + ReduceSpinPU x -> reduceSpinBy x (_pjID pj) + DestroyPU mitid 0 -> destroyProjectile mitid (_pjID pj) -- the following requires that this is at the top of the update list, which is -- not ideal - DestroyPU _ _ -> cWorld . lWorld . projectiles . ix (_prjID pj) . prjUpdates . ix 0 . pjuTimer -~ 1 + DestroyPU _ _ -> cWorld . lWorld . projectiles . ix (_pjID pj) . pjUpdates . ix 0 . pjuTimer -~ 1 ApplyGravityPU -> applyGravityPU pj where - time = _prjTimer pj + time = _pjTimer pj act st et = time <= st && time >= et applyGravityPU :: Projectile -> World -> World applyGravityPU pj w - | newz <= 0 && abs (pj ^. prjZVel) < 1 = + | newz <= 0 && abs (pj ^. pjZVel) < 1 = w - & topj . prjVel %~ decvel - & topj . prjSpin %~ decspin + & topj . pjVel %~ decvel + & topj . pjSpin %~ decspin | newz < 0 = - w & topj . prjZ .~ 0 - & topj . prjZVel %~ bouncez - & topj . prjVel %~ decvel - & topj . prjSpin %~ decspin - & soundStart (ShellSound (pj ^. prjID)) (pj ^. prjPos) click1S Nothing + w & topj . pjZ .~ 0 + & topj . pjZVel %~ bouncez + & topj . pjVel %~ decvel + & topj . pjSpin %~ decspin + & soundStart (ShellSound (pj ^. pjID)) (pj ^. pjPos) click1S Nothing | otherwise = - w & topj . prjZ .~ newz - & topj . prjZVel -~ 0.5 + w & topj . pjZ .~ newz + & topj . pjZVel -~ 0.5 where - topj = cWorld . lWorld . projectiles . ix (pj ^. prjID) + topj = cWorld . lWorld . projectiles . ix (pj ^. pjID) bouncez z | z < -1 = -0.5 * z | otherwise = 0 decvel v - | magV v > 1 = rotateV (5 * pj ^. prjSpin) $ 0.8 * v + | magV v > 1 = rotateV (5 * pj ^. pjSpin) $ 0.8 * v | otherwise = 0 decspin x | abs x < 0.01 = 0 | otherwise = x * 0.9 - newz = pj ^. prjZ + pj ^. prjZVel + newz = pj ^. pjZ + pj ^. pjZVel --shellCollisionCheck :: (Projectile -> World -> World) -> Projectile -> World -> World shellCollisionCheck :: @@ -87,14 +87,13 @@ shellCollisionCheck :: World -> World shellCollisionCheck detid screenid pj w - | anythingHitCirc 2 oldPos newPos w = g + | anythingHitCirc 2 oldPos (oldPos + _pjVel pj) w = g | time <= 0 = g | otherwise = w where g = explodeShell detid screenid pj w - time = _prjTimer pj - oldPos = _prjPos pj - newPos = oldPos +.+ _prjVel pj + time = _pjTimer pj + oldPos = _pjPos pj destroyProjectile :: Maybe (NewInt ItmInt) -> Int -> World -> World destroyProjectile mitid pjid w = @@ -112,10 +111,10 @@ doThrust :: Projectile -> Maybe RocketSmoke -> World -> World doThrust pj smoke w = w & randGen .~ g - & cWorld . lWorld . projectiles . ix i . prjVel %~ (\v -> accel +.+ frict *.* v) + & cWorld . lWorld . projectiles . ix i . pjVel %~ (\v -> accel +.+ frict *.* v) & soundContinue (ShellSound i) newPos missileLaunchS (Just 1) -- & makeFlamelet (oldPos -.- vel) (vel + 2 * rotateV (pi + sparkD) accel) 3 10 - & makeFlamelet oldPos (vel +.+ rotateV (pi + sparkD) accel) 3 10 + & makeFlamelet (oldPos -.- vel) (vel +.+ rotateV (pi + sparkD) accel) 3 10 & shellTrailCloud lifetime trailfadetime @@ -126,10 +125,10 @@ doThrust pj smoke w = | smoke == Just ReducedRocketSmoke = (50, 200) | otherwise = (300, 500) trailfadetime = fst . randomR (100, 300) $ _randGen w - accel = rotateV (pj ^. prjDir) (V2 3 0) - i = _prjID pj - oldPos = _prjPos pj - vel = _prjVel pj + accel = rotateV (pj ^. pjDir) (V2 3 0) + i = _pjID pj + oldPos = _pjPos pj + vel = _pjVel pj newPos = oldPos +.+ vel (frict, g) = randomR (0.6, 0.9) $ _randGen w (sparkD, _) = randomR (-0.2, 0.2) $ _randGen w @@ -143,10 +142,10 @@ trySpinByCID :: Projectile -> World -> World -trySpinByCID cid i pj w = w & cWorld . lWorld . projectiles . ix pjid . prjSpin .~ newSpin +trySpinByCID cid i pj w = w & cWorld . lWorld . projectiles . ix pjid . pjSpin .~ newSpin where - pjid = _prjID pj - dir = argV $ _prjVel pj + pjid = _pjID pj + dir = argV $ _pjVel pj newSpin = case w ^? cWorld . lWorld . creatures . ix cid of Just cr -> negate $ min 0.2 $ max (-0.2) $ normalizeAnglePi (dir - _crDir cr) / spinFactor _ -> 0 @@ -158,30 +157,29 @@ pjRemoteSetDirection ph pj w = case ph of Just (HomeUsingRemoteScreen screenid) | lw ^? creatures . ix 0 . crManipulation . manObject . imSelectedItem == lw ^? itemLocations . ix (_unNInt screenid) . ilInvID -> - w & cWorld . lWorld . projectiles . ix (_prjID pj) . prjDir + w & cWorld . lWorld . projectiles . ix (_pjID pj) . pjDir .~ (w ^. wCam . camRot) + argV (w ^. input . mousePos) Just (HomeUsingTargeting itid) | Just tp <- w ^? pointerToItemID itid . itTargeting . itTgPos . _Just -> - w & cWorld . lWorld . projectiles . ix (_prjID pj) . prjDir - %~ turnTo 0.2 (_prjPos pj) tp + w & cWorld . lWorld . projectiles . ix (_pjID pj) . pjDir + %~ turnTo 0.2 (_pjPos pj) tp _ -> w where lw = w ^. cWorld . lWorld reduceSpinBy :: Float -> Int -> World -> World -reduceSpinBy x pjid = cWorld . lWorld . projectiles . ix pjid . prjSpin *~ x +reduceSpinBy x pjid = cWorld . lWorld . projectiles . ix pjid . pjSpin *~ x decTimMvVel :: Projectile -> World -> World decTimMvVel pj = - cWorld . lWorld . projectiles . ix pjid - %~ ( (prjTimer -~ 1) - . (prjPos %~ (+.+ vel)) - . (prjDir +~ rot) + cWorld . lWorld . projectiles . ix (_pjID pj) + %~ ( (pjTimer -~ 1) + . (pjPos %~ (+.+ vel)) + . (pjDir +~ rot) ) where - rot = _prjSpin pj - vel = _prjVel pj - pjid = _prjID pj + rot = _pjSpin pj + vel = _pjVel pj explodeShell :: Maybe (NewInt ItmInt) -> @@ -191,14 +189,12 @@ explodeShell :: World explodeShell mdetid screenid pj w = w - & cWorld . lWorld . projectiles . ix pjid . prjUpdates .~ [DestroyPU screenid 30] - & usePayload (_prjPayload pj) (_prjPos pj) (_prjVel pj) + & cWorld . lWorld . projectiles . ix pjid . pjUpdates .~ [DestroyPU screenid 30] + & usePayload (_pjPayload pj) (_pjPos pj) (_pjVel pj) & stopSoundFrom (ShellSound pjid) & updatedetonator where updatedetonator = fromMaybe id $ do detid <- mdetid return $ pointerToItemID detid . itUse . uaParams . apProjectiles %~ delete pjid - deleteif (Just x) | x == pjid = Nothing - deleteif x = x - pjid = pj ^. prjID + pjid = pj ^. pjID diff --git a/src/Dodge/Render/ShapePicture.hs b/src/Dodge/Render/ShapePicture.hs index d07df8c74..bb67f7a85 100644 --- a/src/Dodge/Render/ShapePicture.hs +++ b/src/Dodge/Render/ShapePicture.hs @@ -24,7 +24,7 @@ worldSPic :: Configuration -> Universe -> SPic worldSPic cfig u = (mempty :!: extraPics cfig u) <> foldup drawProp' (filtOn _prPos _props) - <> foldup drawProjectile (filtOn _prjPos _projectiles) + <> foldup drawProjectile (filtOn _pjPos _projectiles) <> foldup (shiftDraw _blPos _blDir (drawBlock . _blDraw)) (filtOn _blPos _blocks) <> foldup (shiftDraw _fsPos _fsDir (const _fsSPic)) (filtOn _fsPos _foregroundShapes) <> foldup (shiftDraw' _cpPos _cpDir _cpSPic) (filtOn _cpPos _corpses) diff --git a/src/Dodge/TestString.hs b/src/Dodge/TestString.hs index 8e5ee4dd9..b2ce0a9b2 100644 --- a/src/Dodge/TestString.hs +++ b/src/Dodge/TestString.hs @@ -29,7 +29,7 @@ testStringInit :: Universe -> [String] testStringInit u = [show (u ^?! uvWorld . cWorld . lWorld . creatures . ix 0 . crPos)] <> - map show (u ^.. uvWorld . cWorld . lWorld . projectiles . each . prjPos) + map show (u ^.. uvWorld . cWorld . lWorld . projectiles . each . pjPos) --testStringInit u = foldMap prettyShort $ u ^. uvWorld . cWorld . lWorld . projectiles -- (map (show . _ebPos) $ u ^. uvWorld . cWorld . lWorld . energyBalls) -- <> diff --git a/src/Dodge/Update/Camera.hs b/src/Dodge/Update/Camera.hs index 43850e880..1af5cad79 100644 --- a/src/Dodge/Update/Camera.hs +++ b/src/Dodge/Update/Camera.hs @@ -89,7 +89,7 @@ moveZoomCamera cfig theinput cr w campos = mremotepos = do i <- cr ^? crManipulation . manObject . imSelectedItem j <- cr ^? crInv . ix i . itUse . uaParams . apLinkedProjectile . _Just - w ^? cWorld . lWorld . projectiles . ix j . prjPos + w ^? cWorld . lWorld . projectiles . ix j . pjPos docamrot = rotateV (campos ^. camRot) offset = fromMaybe noscopeoffset $ do guard (SDL.ButtonRight `M.member` _mouseButtons theinput) diff --git a/src/Dodge/Update/Input/DebugTest.hs b/src/Dodge/Update/Input/DebugTest.hs index 789ef510a..0e55e66a6 100644 --- a/src/Dodge/Update/Input/DebugTest.hs +++ b/src/Dodge/Update/Input/DebugTest.hs @@ -56,7 +56,7 @@ doDebugTestF7 = uvIOEffects %~ \f u -> do doDebugTestF8 :: Universe -> Universe doDebugTestF8 = uvIOEffects %~ \f u -> do appendFile "log/proj" $ show - (u ^?! uvWorld . cWorld . lWorld . projectiles . ix 5 . prjPos) ++ "/n" + (u ^?! uvWorld . cWorld . lWorld . projectiles . ix 5 . pjPos) ++ "/n" putStrLn "log/proj written" f u doDebugTestF10 :: Universe -> Universe