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

Work on rocket/grenade launcher

Browse Source
This commit is contained in:
justin
2024-12-27 21:46:46 +00:00
parent 0ef28c132e
commit 5c749bff63
19 changed files with 400 additions and 324 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature.hs
+2 -1
View File
@@ -246,8 +246,9 @@ inventoryX c = case c of
, rLauncher
, megaShellMag
, homingModule
, smokeReducer
, remoteScreen
, remoteController
, joystick
, remoteDetonator
, rLauncherX 3
, megaShellMag
src/Dodge/Creature/Impulse/UseItem.hs
+19 -5
View File
@@ -2,6 +2,7 @@ module Dodge.Creature.Impulse.UseItem (
useSelectedItem,
) where
import Data.Foldable (foldl')
import Dodge.DoubleTree
import Control.Lens
import Control.Monad
@@ -20,9 +21,7 @@ import qualified IntMapHelp as IM
useSelectedItem :: Int -> World -> World
useSelectedItem crid w = (worldEventFlags . at InventoryChange ?~ ()) . fromMaybe w $ do
cr <- w ^? cWorld . lWorld . creatures . ix crid
itRef <- cr ^? crManipulation . manObject . imRootSelectedItem
invid <- cr ^? crManipulation . manObject . imSelectedItem
itmtree <- invRootTrees (_crInv cr) ^? ix itRef
itmloc <- allInvLocs (_crInv cr) ^? ix invid . _2
let usedloc = case useLocation itmloc of
UseFromLocation -> itmloc ^. locLDT
@@ -31,13 +30,15 @@ useSelectedItem crid w = (worldEventFlags . at InventoryChange ?~ ()) . fromMayb
case usedloc ^. ldtValue . _2 of
HeldPlatformSF ->
return $
heldEffect (bimap _iatType fst3 itmtree) cr w
heldEffect (bimap _iatType fst3 usedloc) cr w
& pointerToItem itm . itUse . heldHammer .~ HammerDown
GadgetPlatformSF ->
return $
heldEffect (bimap _iatType fst3 itmtree) cr w
heldEffect (bimap _iatType fst3 usedloc) cr w
& pointerToItem itm . itUse . heldHammer .~ HammerDown
--EquipmentPlatformSF -> do
RemoteDetonatorSF -> do
guard (_crHammerPosition cr == HammerUp)
return $ activateDetonator usedloc cr w
_ | isJust $ itm ^? itUse . uequipEffect -> do
guard (_crHammerPosition cr == HammerUp)
invid' <- itm ^? itLocation . ilInvID
@@ -46,11 +47,24 @@ useSelectedItem crid w = (worldEventFlags . at InventoryChange ?~ ()) . fromMayb
where
fst3 (x,_,_) = x
activateDetonator
:: LabelDoubleTree ItemLink ComposedItem -> Creature -> World
-> World
activateDetonator det _ w = (foldl' remoteDetonate w
$ det ^. ldtValue . _1 . itUse . uaParams . apProjectiles)
& pointerToItemID (det ^. ldtValue . _1 . itID) . itUse . uaParams . apProjectiles .~ []
remoteDetonate :: World -> Int -> World
remoteDetonate w pjid = w
& cWorld . lWorld . projectiles . ix pjid . prjTimer .~ 0
useLocation :: LocationLDT ItemLink ComposedItem -> UseFocus
useLocation loc
| isJust $ loc ^? locLDT . ldtValue . _1 . itUse . uequipEffect = UseFromLocation
| isJust $ loc ^? locLDT . ldtValue . _1 . itUse . uaParams . apLinkedProjectile . _Just
= UseFromLocation
| isJust $ loc ^? locLDT . ldtValue . _1 . itUse . uaParams . apProjectiles . ix 0
= UseFromLocation
| otherwise = UseFromRoot
toggleEquipmentAt :: Int -> Creature -> World -> World
src/Dodge/Data/ComposedItem.hs
+4 -2
View File
@@ -21,9 +21,10 @@ data ComposeLinkType
| AmmoEffectLink
| WeaponScopeLink
| WeaponTargetingLink
| RemoteControllerLink
| JoystickLink
| RemoteScreenLink
| RemoteDetonatorLink
| SmokeReducerLink
| AugmentedHUDLink
| FunctionChangeLink
| MakeAutoLink
@@ -39,8 +40,9 @@ data ItemStructuralFunction
| AugmentedHUDSF
| AmmoMagSF AmmoType
| RemoteScreenSF
| RemoteControllerSF
| JoystickSF
| RemoteDetonatorSF
| SmokeReducerSF
| UncomposableIsolateSF
| AmmoModifierSF AmmoType
| AmmoTargetingSF AmmoType
src/Dodge/Data/Item/Combine.hs
+2 -1
View File
@@ -70,8 +70,9 @@ data AttachType
= ZOOMSCOPE
| BULLETSYNTH
| REMOTESCREEN
| REMOTECONTROLLER
| JOYSTICK
| REMOTEDETONATOR
| SMOKEREDUCER
| HOMINGMODULE
| AUGMENTEDHUD
| SHELLPAYLOAD {_shellPayload :: Payload}
src/Dodge/Data/Item/Use.hs
+2
View File
@@ -70,6 +70,8 @@ data TriggerType = AutoTrigger | HammerTrigger
data AttachParams
= APLinkProjectile
{_apLinkedProjectile :: Maybe Int}
| APProjectiles
{_apProjectiles :: [Int]}
| APInt {_apInt :: Int}
| APNothing
deriving (Eq, Show, Read)
src/Dodge/Data/Item/Use/Consumption/Ammo.hs
+3 -2
View File
@@ -27,11 +27,12 @@ data ProjectileHoming
deriving (Show, Eq, Ord, Read) --Generic, Flat)
data ProjectileUpdate
= ThrustPU {_pjuStart :: Int, _pjuEnd :: Int}
= ThrustPU {_pjuStart :: Int, _pjuEnd :: Int, _pjuSmokeless :: Bool}
| StartSpinPU {_pjuTime :: Int, _pjuCID :: Int, _pjuSpinAmound :: Int}
| RemoteDirectionPU {_pjuStart :: Int, _pjuEnd :: Int, _pjuControllerID :: ProjectileHoming}
| ReduceSpinPU {_pjuReduceSpin :: Float}
| DestroyPU {_pjuScreenID :: Maybe (NewInt ItmInt), _pjuTimer :: Int}
| DestroyPU {_pjuScreenID :: Maybe (NewInt ItmInt)
,_pjuTimer :: Int}
| TimePU
| CollisionEffectPU {_pjuControlID :: Maybe (NewInt ItmInt)
,_pjuDetonatorID :: Maybe (NewInt ItmInt)
src/Dodge/Data/Projectile.hs
+7
View File
@@ -11,6 +11,11 @@ import Data.Aeson.TH
import Dodge.Data.Item.Use.Consumption.Ammo
import Geometry.Data
data ProjectileType
= Grenade
| Rocket
deriving (Eq, Ord, Show, Read) --Generic, Flat)
data Projectile
= Shell
{ _prjPos :: Point2
@@ -25,8 +30,10 @@ data Projectile
, _prjZ :: Float
, _prjZVel :: Float
, _prjUpdates :: [ProjectileUpdate]
, _prjType :: ProjectileType
}
deriving (Eq, Ord, Show, Read) --Generic, Flat)
makeLenses ''Projectile
deriveJSON defaultOptions ''ProjectileType
deriveJSON defaultOptions ''Projectile
src/Dodge/EnergyBall.hs
+1 -1
View File
@@ -52,7 +52,7 @@ updateEnergyBall w eb
)
where
p = eb ^. ebPos + eb ^. ebVel
(bp,bv) = fromMaybe (p,eb^.ebVel) $ bouncePoint (const True) 0.5 (eb ^. ebPos) p w
(bp,bv) = fromMaybe (p,eb^.ebVel) $ bouncePoint (const True) 0 (eb ^. ebPos) p w
-- (bp,bv) = fromMaybe (p,eb^.ebVel) $ bouncePoint (const True) 0.5 (eb ^. ebPos) p w
incBallAt :: Point2 -> World -> World
src/Dodge/HeldUse.hs
+13 -7
View File
@@ -594,11 +594,16 @@ determineProjectileTracking ::
LabelDoubleTree ComposeLinkType Item ->
LabelDoubleTree ComposeLinkType Item ->
ProjectileHoming
determineProjectileTracking magtree itmtree = case lookup RemoteControllerLink (magtree ^. ldtLeft) of
Just screen -> HomeUsingRemoteScreen (screen ^. ldtValue . itID)
Nothing -> fromMaybe NoHoming $ do
_ <- lookup AmmoTargetingLink (magtree ^. ldtLeft) -- should not have to give a direction
targetingtree <- lookup WeaponTargetingLink (itmtree ^. ldtRight) -- left or right for these
determineProjectileTracking magtree itmtree = fromMaybe NoHoming $
finddronecontrols <|> findexternaltracking
where
finddronecontrols = do
screen <- lookup RemoteScreenLink (magtree ^. ldtLeft)
_ <- lookup JoystickLink (screen ^. ldtLeft)
return $ HomeUsingRemoteScreen (screen ^. ldtValue . itID)
findexternaltracking = do
_ <- lookup AmmoTargetingLink (magtree ^. ldtLeft)
targetingtree <- lookup WeaponTargetingLink (itmtree ^. ldtRight)
return $ HomeUsingTargeting (targetingtree ^. ldtValue . itID)
createProjectile ::
@@ -616,10 +621,11 @@ createProjectile magtree muz itmtree cr = fromMaybe failsound $ do
lookup RemoteDetonatorLink (magtree ^. ldtLeft)
rscreen = fmap (^. ldtValue . itID) $
lookup RemoteScreenLink (magtree ^. ldtLeft)
issmokeless = isJust $ lookup SmokeReducerLink (magtree ^. ldtLeft)
aparams <- ((magtree ^? ldtLeft) >>= lookup AmmoPayloadLink >>= (^? ldtValue . itType . ibtAttach . shellPayload))
<|> ammoitem ^? itConsumables . magParams . ampPayload
return $
createShell homing rdetonate rscreen aparams muz cr
createGShell homing rdetonate rscreen issmokeless Rocket aparams muz cr
. startthesound
where
-- the sound should be moved to the projectile firing
@@ -651,7 +657,7 @@ createGProjectile magtree muz itmtree cr = fromMaybe failsound $ do
aparams <- ((magtree ^? ldtLeft) >>= lookup AmmoPayloadLink >>= (^? ldtValue . itType . ibtAttach . shellPayload))
<|> ammoitem ^? itConsumables . magParams . ampPayload
return $
createGShell homing rdetonate rscreen aparams muz cr
createGShell homing rdetonate rscreen False Grenade aparams muz cr
. startthesound
where
-- the sound should be moved to the projectile firing
src/Dodge/Item.hs
+2 -1
View File
@@ -39,8 +39,9 @@ itemFromAttachType at = case at of
ZOOMSCOPE -> zoomScope
BULLETSYNTH -> bulletSynthesizer
REMOTESCREEN -> remoteScreen
REMOTECONTROLLER -> remoteController
JOYSTICK -> joystick
REMOTEDETONATOR -> remoteDetonator
SMOKEREDUCER -> smokeReducer
-- ROCKETHOMER -> rocketHomer
HOMINGMODULE -> homingModule
AUGMENTEDHUD -> augmentedHUD
src/Dodge/Item/Display.hs
+3 -1
View File
@@ -72,8 +72,9 @@ showAttachItem t = case t of
ZOOMSCOPE -> "ZOOMSCOPE"
BULLETSYNTH -> "BSYNTH"
REMOTESCREEN -> "REM.SCREEN"
REMOTECONTROLLER -> "REM.CONTR0LR"
JOYSTICK -> "JOYSTICK"
REMOTEDETONATOR -> "REM.DETONATR"
SMOKEREDUCER -> "SMOKE.REDUCR"
HOMINGMODULE -> "HOMING MOD"
AUGMENTEDHUD -> "AUGMENTED HUD"
SHELLPAYLOAD x -> show x
@@ -99,6 +100,7 @@ itemNumberDisplay cr ci
| Just x <- ci ^? _1 . itConsumables . magLoadStatus . iaLoaded = [shortShow x]
| UseAttach (APInt i) <- ci ^. _1 . itUse = [show i]
| UseAttach (APLinkProjectile i) <- ci ^. _1 . itUse = [show i]
| UseAttach (APProjectiles x) <- ci ^. _1 . itUse = [show x]
| UseScope OpticScope{_opticZoom = x} <- ci ^. _1 . itUse = [shortShow x]
| otherwise = mempty
src/Dodge/Item/Grammar.hs
+6 -2
View File
@@ -67,7 +67,6 @@ itemToBreakLists itm itmf = case (itm ^. itType, itmf) of
let screenanddet = case atype of
LauncherAmmo -> [ (RemoteScreenSF, RemoteScreenLink)
, (RemoteDetonatorSF, RemoteDetonatorLink)
, (RemoteControllerSF, RemoteControllerLink)
]
_ -> []
return
@@ -76,9 +75,13 @@ itemToBreakLists itm itmf = case (itm ^. itType, itmf) of
, (AmmoTargetingSF atype, AmmoTargetingLink)
, (AmmoPayloadSF atype, AmmoPayloadLink)
, (AmmoEffectSF atype, AmmoEffectLink)
, (SmokeReducerSF, SmokeReducerLink)
] <> screenanddet
, []
)
(_, RemoteScreenSF) ->
( [(JoystickSF, JoystickLink)]
, [])
(_, WeaponTargetingSF) -> (getAmmoLinks itm ++ [(AugmentedHUDSF, AugmentedHUDLink)], [])
(ATTACH BULLETSYNTH, _) ->
([(AmmoMagSF ElectricalAmmo, AmmoInLink 0 ElectricalAmmo)], [])
@@ -107,8 +110,9 @@ itemToFunction itm = case itm ^. itType of
AmmoMagSF amtype
AMMOMAG{} -> maybe UncomposableIsolateSF AmmoMagSF $ itm ^? itConsumables . magType
ATTACH REMOTESCREEN -> RemoteScreenSF
ATTACH REMOTECONTROLLER -> RemoteControllerSF
ATTACH JOYSTICK -> JoystickSF
ATTACH REMOTEDETONATOR -> RemoteDetonatorSF
ATTACH SMOKEREDUCER -> SmokeReducerSF
ATTACH BULLETSYNTH -> AmmoModifierSF BulletAmmo
ATTACH ZOOMSCOPE -> WeaponScopeSF
ATTACH HOMINGMODULE -> AmmoTargetingSF LauncherAmmo
src/Dodge/Item/InventoryColor.hs
+2 -1
View File
@@ -18,8 +18,9 @@ itemInvColor ci = case ci ^. _2 of
AugmentedHUDSF -> rose
AmmoMagSF{} -> red
RemoteScreenSF -> azure
RemoteControllerSF -> azure
JoystickSF -> azure
RemoteDetonatorSF -> azure
SmokeReducerSF -> azure
UncomposableIsolateSF -> greyN 0.5
AmmoModifierSF{} -> orange
AmmoTargetingSF{} -> green
src/Dodge/Item/Scope.hs
+9 -5
View File
@@ -3,13 +3,14 @@ module Dodge.Item.Scope (
zoomScope,
targetingScope,
remoteScreen,
remoteController,
joystick,
remoteDetonator,
homingModule,
-- bulletTargetingModule,
augmentedHUD,
bulletModule,
bulletPayloadModule,
smokeReducer,
) where
import Dodge.Item.Attach
@@ -61,8 +62,11 @@ remoteScreen = makeAttach REMOTESCREEN
remoteDetonator :: Item
remoteDetonator = makeAttach REMOTEDETONATOR
& itUse . uaParams .~ APLinkProjectile Nothing
& itUse . uaParams .~ APProjectiles []
remoteController :: Item
remoteController = makeAttach REMOTECONTROLLER
& itUse . uaParams .~ APLinkProjectile Nothing
joystick :: Item
joystick = makeAttach JOYSTICK
-- & itUse . uaParams .~ APLinkProjectile Nothing
smokeReducer :: Item
smokeReducer = makeAttach SMOKEREDUCER
src/Dodge/Projectile/Create.hs
+35 -18
View File
@@ -1,5 +1,5 @@
module Dodge.Projectile.Create (
createShell,
-- createShell,
createGShell,
) where
@@ -23,8 +23,10 @@ homingDrawType ht = case ht of
createShell :: ProjectileHoming
-> Maybe (NewInt ItmInt)
-> Maybe (NewInt ItmInt)
-> Bool
-> ProjectileType
-> Payload -> Muzzle -> Creature -> World -> World
createShell homing mdetonator mscreen payload muz cr w = w
createShell homing mdetonator mscreen smokestatus pjtype payload muz cr w = w
& updatescreen
& updatedetonator
& cWorld . lWorld . projectiles . at i
@@ -39,27 +41,30 @@ createShell homing mdetonator mscreen payload muz cr w = w
, _prjDir = dir
, _prjSpin = 0
, _prjPayload = payload
, _prjTimer = 350
, _prjTimer = lifespan
, _prjUpdates =
[ CollisionEffectPU (homing ^? phRemoteID) mdetonator mscreen
, TimePU
, StartSpinPU 335 (_crID cr) spinamount
, RemoteDirectionPU (350 - thrustdelay) 0 homing
, ThrustPU (350 - thrustdelay) 0
, RemoteDirectionPU (lifespan - thrustdelay) 0 homing
, ThrustPU (lifespan - thrustdelay) 0 smokestatus
, ReduceSpinPU (1 - spindrag * 2 / 200)
]
, _prjType = pjtype
}
where
lifespan = 350
spindrag = 1
spinamount = 2
thrustdelay = 20
updatedetonator = fromMaybe id $ do
screenid <- mdetonator
return $ pointerToItemID screenid . itUse . uaParams
. apLinkedProjectile
?~ i
. apProjectiles
.:~ i
updatescreen = fromMaybe id $ do
screenid <- homing ^? phRemoteID
--screenid <- homing ^? phRemoteID
screenid <- mscreen
return $ pointerToItemID screenid . itUse . uaParams
. apLinkedProjectile
?~ i
@@ -71,8 +76,10 @@ createShell homing mdetonator mscreen payload muz cr w = w
createGShell :: ProjectileHoming
-> Maybe (NewInt ItmInt)
-> Maybe (NewInt ItmInt)
-> Bool
-> ProjectileType
-> Payload -> Muzzle -> Creature -> World -> World
createGShell homing mdetonator mscreen payload muz cr w = w
createGShell homing mdetonator mscreen smokestatus pjtype payload muz cr w = w
& updatescreen
& updatedetonator
& cWorld . lWorld . projectiles . at i
@@ -80,34 +87,44 @@ createGShell homing mdetonator mscreen payload muz cr w = w
{ _prjPos = pos
, _prjZ = 20
, _prjZVel = 5
, _prjVel = rotateV dir (V2 4 0) + cr ^. crPos - cr ^. crOldPos
, _prjVel = rotateV dir (V2 speed 0) + cr ^. crPos - cr ^. crOldPos
, _prjDraw = homingDrawType homing
, _prjID = i
, _prjAcc = rotateV dir (V2 3 0)
, _prjDir = dir
, _prjSpin = 0
, _prjPayload = payload
, _prjTimer = 350
, _prjTimer = lifespan
, _prjUpdates =
[ CollisionEffectPU (homing ^? phRemoteID) mdetonator mscreen
, TimePU
, StartSpinPU 335 (_crID cr) spinamount
, RemoteDirectionPU (350 - thrustdelay) 0 homing
, StartSpinPU (lifespan - 15) (_crID cr) spinamount
, RemoteDirectionPU (lifespan - thrustdelay) 0 homing
, ReduceSpinPU (1 - spindrag * 2 / 200)
, ApplyGravityPU
]
] <> thrustorgrav
, _prjType = pjtype
}
where
speed = case pjtype of
Grenade -> 4
Rocket -> 1
lifespan = case pjtype of
Grenade -> 150
Rocket -> 350
thrustorgrav = case pjtype of
Grenade -> [ApplyGravityPU]
Rocket -> [ThrustPU (lifespan - thrustdelay) 0 smokestatus]
spindrag = 1
spinamount = 2
thrustdelay = 20
updatedetonator = fromMaybe id $ do
screenid <- mdetonator
return $ pointerToItemID screenid . itUse . uaParams
. apLinkedProjectile
?~ i
. apProjectiles
.:~ i
updatescreen = fromMaybe id $ do
screenid <- homing ^? phRemoteID
--screenid <- homing ^? phRemoteID
screenid <- mscreen
return $ pointerToItemID screenid . itUse . uaParams
. apLinkedProjectile
?~ i
src/Dodge/Projectile/Update.hs
+11 -8
View File
@@ -3,6 +3,7 @@ module Dodge.Projectile.Update (
updateProjectile,
) where
import Data.List (delete)
import LensHelp
import Control.Monad
import Data.Foldable
@@ -28,8 +29,8 @@ upProjectile pu pj = case pu of
CollisionEffectPU mcontrolid mdetonatorid mscreenid -> shellCollisionCheck
mcontrolid mdetonatorid mscreenid pj
TimePU -> decTimMvVel pj
ThrustPU st et
| act st et -> doThrust pj
ThrustPU st et smoke
| act st et -> doThrust pj smoke
| otherwise -> id
StartSpinPU t cid spinamount
| time == t -> trySpinByCID cid spinamount pj
@@ -100,20 +101,22 @@ destroyProjectile mitid pjid w =
guard $ itm == pjid
return $ pointerToItemLocation loc . itUse . uaParams . apLinkedProjectile .~ Nothing
doThrust :: Projectile -> World -> World
doThrust pj w =
doThrust :: Projectile -> Bool -> World -> World
doThrust pj smoke w =
w
& randGen .~ g
& cWorld . lWorld . projectiles . ix i . prjVel %~ (\v -> accel +.+ frict *.* v)
& soundContinue (ShellSound i) newPos missileLaunchS (Just 1)
& makeFlamelet (oldPos -.- vel) (vel +.+ rotateV (pi + sparkD) accel) 3 10
& shellTrailCloud
trailage
lifetime
trailfadetime
(addZ 20 (oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos)))
where
trailage = fst . randomR (300, 500) $ _randGen w
trailfadetime = fst . randomR (100, 300) $ _randGen w
lifetime = fst . randomR lt $ _randGen w
lt | smoke = (50, 200)
| otherwise = (300,500)
trailfadetime = fst . randomR (100,300) $ _randGen w
accel = _prjAcc pj
i = _prjID pj
oldPos = _prjPos pj
@@ -198,7 +201,7 @@ explodeShell controlid mdetid screenid pj w =
where
updatedetonator = fromMaybe id $ do
detid <- mdetid
return $ pointerToItemID detid . itUse . uaParams . apLinkedProjectile %~ deleteif
return $ pointerToItemID detid . itUse . uaParams . apProjectiles %~ delete pjid
deleteif (Just x) | x == pjid = Nothing
deleteif x = x
updatecontroller = fromMaybe id $ do
src/Dodge/WorldEvent/Explosion.hs
+1 -1
View File
@@ -84,6 +84,6 @@ makeExplosionAt p vel w =
fVs' = zipWith (+.+) fVs $ map inversePushOut fPs'
sizes = randomRs (2, 9) $ _randGen w
times = randomRs (15, 20) $ _randGen w
mF q v size time = makeFlamelet (q - (v + 2* vel)) (v + vel) size time
mF q v size time = makeFlamelet (q - (2*v + 2* vel)) (v + vel) size time
newFs = zipWith3 (mF p) (zipWith (+) fPs' (fmap (3 *.*) fVs')) sizes times
addFlames w' = foldl' (flip ($)) w' newFs
src/Geometry/Intersect.hs
+1
View File
@@ -301,6 +301,7 @@ inSegArea a b c = param >= 0 && param <= dotV (b -.- a) (b -.- a)
param = dotV (b -.- a) (c -.- a)
-- I suspect that this may not be correct...
-- it should probably use closestPointOnSeg
intersectCircSeg :: Point2 -> Float -> Point2 -> Point2 -> [Point2]
intersectCircSeg c r a b
| y < 0 = []
tags
+277 -268
View File
File diff suppressed because it is too large Load Diff