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

Cleanup

Browse Source
This commit is contained in:
justin
2024-12-28 10:31:58 +00:00
parent 39a76f758a
commit e028c54948
10 changed files with 91 additions and 102 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/Impulse/UseItem.hs
+1 -1
View File
@@ -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
src/Dodge/Data/Projectile.hs
+11 -11
View File
@@ -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)
src/Dodge/HeldUse.hs
+8 -11
View File
@@ -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
src/Dodge/Projectile/Create.hs
+13 -17
View File
@@ -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
src/Dodge/Projectile/Draw.hs
+7 -7
View File
@@ -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
src/Dodge/Projectile/Update.hs
+47 -51
View File
@@ -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
src/Dodge/Render/ShapePicture.hs
+1 -1
View File
@@ -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)
src/Dodge/TestString.hs
+1 -1
View File
@@ -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)
-- <>
src/Dodge/Update/Camera.hs
+1 -1
View File
@@ -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)
src/Dodge/Update/Input/DebugTest.hs
+1 -1
View File
@@ -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