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

Implement pulse rifle with explodable pulse balls

Browse Source
This commit is contained in:
justin
2025-07-27 11:10:30 +01:00
parent 68a4bc7aab
commit f1fb0ee768
19 changed files with 190 additions and 108 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/State.hs
+4 -4
View File
@@ -68,7 +68,7 @@ crUpdate f =
, checkDeath -- must be in this order 24/7/22
, updateWalkCycle
, f
, invRootItemEffs
, invItemEffs
]
-- I have changed the ordering of item/equipment effects, which may have
@@ -143,8 +143,8 @@ applyPastDamages cr w
& randGen .~ g
-- a loop going over all root inventory items
invRootItemEffs :: Creature -> World -> World
invRootItemEffs cr =
invItemEffs :: Creature -> World -> World
invItemEffs cr =
appEndo $
foldMap
(reduceLocDT (Endo . invItemLocUpdate cr) . LocDT TopDT)
@@ -235,7 +235,7 @@ tryDrawToCapacitor loc w = fromMaybe w $ do
itm <- loc ^? locDT . dtValue . _1
i <- itm ^? itLocation . ilInvID
x <- loc ^? locDT . dtValue . _1 . itConsumables . _Just
guard $ x < 250
guard $ x < 200
bat <- loc ^? locDT . dtLeft . ix 0 . dtValue . _1
j <- bat ^? itLocation . ilInvID
y <- bat ^? itConsumables . _Just
src/Dodge/Data/Muzzle.hs
+1 -1
View File
@@ -18,7 +18,7 @@ data Muzzle = Muzzle
}
deriving (Eq, Ord, Show, Read) --Generic, Flat)
data AmmoExtractPosition = MagBelow Int | CapacitorBelow Int | CapacitorSelf
data AmmoExtractPosition = MagBelow Int | CapacitorBelow | CapacitorSelf
deriving (Eq, Ord, Show, Read) --Generic, Flat)
data FlareType
src/Dodge/Data/Object.hs
+13
View File
@@ -0,0 +1,13 @@
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.Object where
import Dodge.Data.Wall
import Dodge.Data.Creature
import Dodge.Data.PulseLaser
data Object
= OPulseBall PulseBall
| OCreature Creature
| OWall Wall
src/Dodge/Data/ObjectType.hs
+12 -11
View File
@@ -9,17 +9,18 @@ import Data.Aeson
import Data.Aeson.TH
data ObjectType
= ObTerminal
| ObCreature
| ObMachine
| ObWall
| ObDoor
| ObButton
| ObForegroundShape
| ObLightSource
| ObProp
| ObTrigger
| ObItem
= OTTerminal
| OTCreature
| OTMachine
| OTWall
| OTDoor
| OTButton
| OTForegroundShape
| OTLightSource
| OTProp
| OTTrigger
| OTItem
| OTPulseBall
deriving (Eq, Show, Ord, Enum, Bounded, Read) --Generic, Flat)
deriveJSON defaultOptions ''ObjectType
src/Dodge/HeldUse.hs
+19 -22
View File
@@ -135,11 +135,9 @@ heldEffectMuzzles loc cr w =
setusetime . doHeldUseEffect t cr
. uncurry (applyCME loc cr)
$ bw
-- . foldl' (useLoadedAmmo loc cr) (bw)
-- $ loadedmuzzles
where
t = loc ^. locDT
((bw,_), loadedmuzzles) = mapAccumR (loadMuzzle loc cr) ((False,w),t) . locMuzzles $ loc
bw = foldl' (loadMuzzle loc cr) (False,w) (locMuzzles loc)
setusetime =
cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix itid . itTimeLastUsed
.~ w ^. cWorld . lWorld . lClock
@@ -153,10 +151,11 @@ locMuzzles loc
& ix 0 . mzInaccuracy .~ 0
& ix 0 . mzFlareType .~ TeslaGunFlare
& ix 0 . mzEffect .~ MuzzlePulseLaser
& ix 0 . mzAmmoPerShot .~ UseExactly 250
& ix 0 . mzAmmoPerShot .~ UseExactly 200
& ix 0 . mzAmmoSlot .~ CapacitorBelow
| PulseBallSF <- loc ^. locDT . dtValue . _2 = dbwMuzzles
& ix 0 . mzEffect .~ MuzzlePulseBall
& ix 0 . mzAmmoPerShot .~ UseExactly 250
& ix 0 . mzAmmoPerShot .~ UseExactly 200
& ix 0 . mzAmmoSlot .~ CapacitorSelf
& ix 0 . mzInaccuracy .~ 0
& ix 0 . mzFlareType .~ TeslaGunFlare
@@ -642,26 +641,24 @@ heldTorqueAmount = \case
BLINKER -> 0
BLINKERUNSAFE -> 0
loadMuzzle :: LocationDT OItem -> Creature -> ((Bool,World),DTree OItem)
-> Muzzle -> (((Bool,World),DTree OItem), Maybe (Muzzle, Int, DTree OItem))
loadMuzzle loc cr ((b,w),t@(DT _ l _)) mz = fromMaybe (((b,w),t), Nothing) $ do
loadMuzzle :: LocationDT OItem -> Creature -> (Bool,World) -> Muzzle -> (Bool,World)
loadMuzzle loc cr (b,w) mz = fromMaybe (b,w) $ do
let as = _mzAmmoSlot mz
amamount = _mzAmmoPerShot mz
(i, mag) <- case as of
MagBelow mi -> findWithIx (isAmmoIntLink mi . (^. dtValue . _2)) l
_ -> undefined
availableammo <- mag ^. dtValue . _1 . itConsumables
mag <- case as of
MagBelow mi -> find (isAmmoIntLink mi . (^. dtValue . _2)) (loc ^. locDT . dtLeft)
CapacitorSelf -> loc ^? locDT
CapacitorBelow -> find
((== PulseBallSF) . (^. dtValue . _2)) (loc ^. locDT . dtLeft)
mid <- mag ^? dtValue . _1 . itLocation . ilInvID
availableammo <- w ^? cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix mid . itConsumables . _Just
let usedammo = case amamount of
UseUpTo x -> min x availableammo
UseExactly x
| x <= availableammo -> x
| otherwise -> 0
guard $ usedammo > 0
let bw = useLoadedAmmo loc cr (b,w) (Just (mz,usedammo,mag))
return
( (bw,t & dtLeft . ix i . dtValue . _1 . itConsumables . _Just -~ usedammo)
, Just (mz, usedammo, mag)
)
return $ useLoadedAmmo loc cr (b,w) (Just (mz,usedammo,mag))
makeMuzzleFlare :: Muzzle -> LocationDT OItem -> Creature -> World -> World
makeMuzzleFlare mz loc cr = case mz ^. mzFlareType of
@@ -796,9 +793,9 @@ itemDetectorEffect itm mitid armitid cr w = fromMaybe w $ do
DETECTOR dt <- itm ^? itType
return $ aRadarPulse (itm ^. itID) mitid armitid (f dt) cr w
where
f ITEMDETECTOR = ObItem
f CREATUREDETECTOR = ObCreature
f WALLDETECTOR = ObWall
f ITEMDETECTOR = OTItem
f CREATUREDETECTOR = OTCreature
f WALLDETECTOR = OTWall
walkNozzle :: Muzzle -> Item -> Creature -> World -> World
walkNozzle mz itm cr w = fromMaybe w $ do
@@ -936,8 +933,8 @@ shootPulseBall p dir w =
& cWorld . lWorld . pulseBalls . at i ?~
PulseBall
{ _pbPos = p
, _pbVel = 5 * unitVectorAtAngle dir
, _pbTimer = 50
, _pbVel = 3.5 * unitVectorAtAngle dir
, _pbTimer = 100
, _pbID = i
}
& soundStart (PBSound i) p energyReleaseS Nothing
src/Dodge/Item/Grammar.hs
+1
View File
@@ -48,6 +48,7 @@ itemAboveAttachables (itm,sf) = case (itm ^. itType, sf) of
itemBelowAttachables :: CItem -> [ItemSF]
itemBelowAttachables (itm,sf) = case (itm ^. itType, sf) of
(HELD LASER, _) -> getAmmoLinks itm <> [PulseBallSF]
--(HELD LASER, _) -> [PulseBallSF]
(HELD TORCH, _) -> getAmmoLinks itm
(ATTACH CAPACITOR, _) -> [AmmoMagSF 0 ElectricalAmmo]
(ATTACH UNDERBARRELSLOT, _) -> [UnderBarrelPlatformSF]
src/Dodge/Item/Weapon/LaserPath.hs
+29
View File
@@ -1,7 +1,10 @@
module Dodge.Item.Weapon.LaserPath (
reflectLaserAlong,
reflectPulseLaserAlong,
) where
import Dodge.Data.Object
import Data.Maybe
import Data.Bifunctor
import Data.Tuple
import Dodge.Base.Wall
@@ -61,3 +64,29 @@ refract phasev x y wl p
| otherwise = asin $ phasev * sin angleInc'
reflectInternal = 1 < abs (phasev * sin angleInc')
reflectExternal = 1 < abs (sin angleInc / phasev)
reflectPulseLaserAlong :: Float -> Point2 -> Point2 -> World ->
(Maybe (Point2, Object), [Point2])
{-# INLINE reflectPulseLaserAlong #-}
reflectPulseLaserAlong phasev sp ep w = case listToMaybe . filter (isunshad . snd) $ crWlPbHit sp ep w of
Just (p, OWall wl)
| _wlReflect wl ->
second (p :) $
reflectPulseLaserAlong
phasev
(p +.+ unitVectorAtAngle (reflDirWall sp p wl))
(p +.+ dist p ep *.* unitVectorAtAngle (reflDirWall sp p wl))
w
| wlIsSeeThrough wl ->
second (p :) $
reflectPulseLaserAlong
phasev
(p +.+ normalizeV (refract phasev sp ep wl p))
(refract phasev sp ep wl p)
w
| otherwise -> (Just (p, OWall wl), [p])
Just (p, obj) -> (Just (p, obj), [p])
Nothing -> (Nothing, [ep])
where
isunshad (OWall wl) = _wlUnshadowed wl
isunshad _ = True
src/Dodge/Machine/Destroy.hs
+2 -2
View File
@@ -25,7 +25,7 @@ destroyMcType mt mc = case mt of
mcKillTerm :: Machine -> World -> World
mcKillTerm mc w = fromMaybe w $ do
tmid <- mc ^? mcMounts . ix ObTerminal
tmid <- mc ^? mcMounts . ix OTTerminal
tm <- w ^? cWorld . lWorld . terminals . ix tmid
return $
w
@@ -33,5 +33,5 @@ mcKillTerm mc w = fromMaybe w $ do
mcKillBut :: Machine -> World -> World
mcKillBut mc w = fromMaybe w $ do
btid <- mc ^? mcMounts . ix ObButton
btid <- mc ^? mcMounts . ix OTButton
return $ w & cWorld . lWorld . buttons . at btid .~ Nothing
src/Dodge/Machine/Draw.hs
+1 -1
View File
@@ -31,7 +31,7 @@ terminalSPic lw = noPic . terminalShape lw
terminalShape :: LWorld -> Machine -> Shape
terminalShape lw mc = fromMaybe mempty $ do
tid <- mc ^? mcMounts . ix ObTerminal
tid <- mc ^? mcMounts . ix OTTerminal
term <- lw ^? terminals . ix tid
return $
colorSH
src/Dodge/Machine/Update.hs
+3 -3
View File
@@ -34,7 +34,7 @@ mcTypeUpdate mc = case mc ^. mcType of
terminalScreenGlow :: Machine -> World -> World
terminalScreenGlow mc w = fromMaybe w $ do
tid <- mc ^? mcMounts . ix ObTerminal
tid <- mc ^? mcMounts . ix OTTerminal
term <- w ^? cWorld . lWorld . terminals . ix tid
V4 x y z _ <- termScreenColor term
return $
@@ -92,7 +92,7 @@ mcUseItem mc = fromMaybe id $ do
mcSensorTriggerUpdate :: Sensor -> Machine -> World -> World
mcSensorTriggerUpdate se mc = fromMaybe id $ do
trid <- mc ^? mcMounts . ix ObTrigger
trid <- mc ^? mcMounts . ix OTTrigger
bval <- mcTriggerVal se
return $ cWorld . lWorld . triggers . ix trid ||~ bval
@@ -172,7 +172,7 @@ senseDamage threshold dt mc =
x = sum . map _dmAmount $ filter f (_mcDamage mc)
ni = fromIntegral (mc ^?! mcType . _McSensor . sensAmount) / fromIntegral threshold
updatels = fromMaybe id $ do
lsid <- mc ^? mcMounts . ix ObLightSource
lsid <- mc ^? mcMounts . ix OTLightSource
return $ cWorld . lWorld . lightSources . ix lsid . lsParam . lsCol .~ V3 ni ni ni
sensorTypeDamages :: SensorType -> Damage -> Bool
src/Dodge/Placement/Instance/Analyser.hs
+1 -1
View File
@@ -18,7 +18,7 @@ analyser proxreq pslight psmc = extTrigLitPos pslight $ \tp ->
Just $
plSpot .~ psmc $
putTerminal (dark magenta)
(themachine & mcMounts . at ObTrigger .~ _plMID tp)
(themachine & mcMounts . at OTTrigger .~ _plMID tp)
tparams -- (linksensortotrigger tp)
where
tparams = basicTerminal & tmScrollCommands .:~ sensorCommand
src/Dodge/Placement/Instance/Sensor.hs
+2 -2
View File
@@ -27,8 +27,8 @@ damageSensor dt wdth mtrid ps = pContID ps (PutLS $ lsPosCol (V3 0 0 30) 0.1) $
(reverse $ square wdth)
( defaultMachine
& mcColor .~ yellow
& mcMounts . at ObTrigger .~ mtrid
& mcMounts . at ObLightSource ?~ lsid
& mcMounts . at OTTrigger .~ mtrid
& mcMounts . at OTLightSource ?~ lsid
& mcType
.~ McSensor
( DamageSensor
src/Dodge/Placement/Instance/Terminal.hs
+2 -2
View File
@@ -22,7 +22,7 @@ putTerminal col mc tm =
pt0
( PutMachine
(reverse $ square 10)
( mc & mcMounts . at ObButton ?~ fromJust (_plMID btpl)
( mc & mcMounts . at OTButton ?~ fromJust (_plMID btpl)
& mcCloseSound ?~ fridgeHumS
)
defaultSensorWall
@@ -33,7 +33,7 @@ putTerminal col mc tm =
w
& cWorld . lWorld . terminals . ix tmid . tmButtonID .~ btid
& cWorld . lWorld . terminals . ix tmid . tmMachineID .~ mcid
& cWorld . lWorld . machines . ix mcid . mcMounts . at ObTerminal ?~ tmid
& cWorld . lWorld . machines . ix mcid . mcMounts . at OTTerminal ?~ tmid
& cWorld . lWorld . buttons . ix btid . btTermMID ?~ tmid
where
tmid = fromJust (_plMID tmpl)
src/Dodge/RadarSweep.hs
+6 -6
View File
@@ -61,16 +61,16 @@ updateRadarSweep w pt
findBlips :: ObjectType -> Point2 -> Float -> World -> ([Point2], S.Set (Point2, Point2))
findBlips ob = case ob of
ObCreature -> crBlips
ObItem -> itemBlips
ObWall -> wallBlips
OTCreature -> crBlips
OTItem -> itemBlips
OTWall -> wallBlips
_ -> undefined
makeBlip :: ObjectType -> Point2 -> RadarBlip
makeBlip ob = case ob of
ObCreature -> blipAt 8 (withAlpha 0.2 green) 50
ObWall -> blipAt 2 red 50
ObItem -> blipAt 6 blue 50
OTCreature -> blipAt 8 (withAlpha 0.2 green) 50
OTWall -> blipAt 2 red 50
OTItem -> blipAt 6 blue 50
_ -> undefined
-- | Radar blip at a point.
src/Dodge/RadarSweep/Draw.hs
+3 -3
View File
@@ -33,7 +33,7 @@ drawRadarSweep pt
rsObjectColor :: ObjectType -> Color
rsObjectColor ob = case ob of
ObWall -> red
ObCreature -> green
ObItem -> blue
OTWall -> red
OTCreature -> green
OTItem -> blue
_ -> yellow
src/Dodge/Update.hs
+15 -5
View File
@@ -7,6 +7,8 @@ Description : Simulation update
-}
module Dodge.Update (updateUniverse) where
import Dodge.WorldEvent.Explosion
import Dodge.Data.Object
import Color
import Control.Applicative
import Control.Monad
@@ -633,14 +635,22 @@ updatePulseLaser pz = case pz ^. pzTimer of
5 -> (Endo f, [pz & pzTimer -~ 1])
_ -> (Endo g, [pz & pzTimer -~ 1])
where
f w =
damThingHitWith
(\p2 -> Lasering (pz ^. pzDamage) p2 (xp - sp))
thHit
f w = dodam thHit ps
w
& cWorld . lWorld . flares <>~ drawLaser cyan (sp : ps)
where
(thHit, ps) = reflectLaserAlong phasev sp xp w
(thHit, ps) = reflectPulseLaserAlong phasev sp xp w
dodam thit ps = case thit of
Just (p, OCreature cr) ->
cWorld . lWorld . creatures . ix (_crID cr) . crDamage
.:~ Lasering (pz ^. pzDamage) p (xp - sp)
Just (p, OWall wl) ->
cWorld . lWorld . wallDamages . at (_wlID wl) . non mempty
.:~ Lasering (pz ^. pzDamage) p (xp - sp)
Just (p, OPulseBall pb) ->
(cWorld . lWorld . pulseBalls . ix (_pbID pb) . pbTimer .~ 0)
. makeExplosionAt (_pbPos pb) 0
_ -> id
phasev = _pzPhaseV pz
sp = _pzPos pz
dir = _pzDir pz
src/Dodge/WorldEvent/ThingsHit.hs
+22
View File
@@ -11,8 +11,10 @@ module Dodge.WorldEvent.ThingsHit (
crsHitRadial,
wlsHitRadial,
crHit,
crWlPbHit,
) where
import Dodge.Data.Object
import Dodge.Creature.Radius
import Control.Monad
import Control.Lens
@@ -26,6 +28,7 @@ import Dodge.Zoning.Creature
import Dodge.Zoning.Wall
import Geometry
import qualified ListHelp as List
import qualified Data.IntMap.Strict as IM
{- List those objects that appear on a line. -}
thingsHit :: Point2 -> Point2 -> World -> [(Point2, Either Creature Wall)]
@@ -35,6 +38,16 @@ thingsHit sp ep w =
(map (second Left) (crsHit sp ep w))
(map (second Right) (wlsHit sp ep w))
crWlPbHit :: Point2 -> Point2 -> World -> [(Point2, Object)]
crWlPbHit sp ep w =
List.mergeOn
(dist sp . fst)
(map (fmap toobj) (thingsHit sp ep w))
(map (fmap OPulseBall) (pbsHit sp ep w))
where
toobj (Left cr) = OCreature cr
toobj (Right wl) = OWall wl
crsHit :: Point2 -> Point2 -> World -> [(Point2, Creature)]
crsHit sp ep w
| sp == ep = mempty
@@ -46,6 +59,15 @@ crsHit sp ep w
. crixsNearSeg sp ep
$ w
pbsHit :: Point2 -> Point2 -> World -> [(Point2, PulseBall)]
pbsHit sp ep w
| sp == ep = mempty
| otherwise =
sortOn (dist sp . fst)
. mapMaybe (\pb -> (,pb) <$> listToMaybe (intersectCircSeg (_pbPos pb) 8 sp ep))
. IM.elems
$ w ^. cWorld . lWorld . pulseBalls
thingHitFilt ::
(Creature -> Bool) ->
(Wall -> Bool) ->