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

Add intersecting beams

Browse Source
This commit is contained in:
justin
2022-04-06 11:40:22 +01:00
parent bca1236a85
commit de8da05bdf
9 changed files with 224 additions and 14 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Combine/Combinations.hs
+3 -1
View File
@@ -69,7 +69,9 @@ itemCombinations =
, p [o PRISM,o TRANSFORMER,o PIPE] lasGun
, p [o LASGUN,o PRISM] lasGunSway
, p [o LASGUN,o HARDWARE] lasGunSwing
, p [o LASGUN,o PIPE] lasGunPulse
-- , p [o LASGUN,o PIPE] lasGunPulse
, p [o LASGUN,p 2 PIPE] lasGunDual
, p [o LASGUN,o PIPE, o PRISM] lasGunWidePulse
, p [o LASGUN,o TRANSFORMER,o PRISM] (lasGunWide 2)
, p [o TRANSFORMER,p 2 CAN] sparkGun
src/Dodge/Combine/Data.hs
+2
View File
@@ -51,8 +51,10 @@ data CombineType
| TESLAGUN
| LASGUN
| LASPULSE
| LASGUNDUAL
| LASGUNSWING
| LASGUNSWAY
| LASGUNWIDEPULSE
| LASGUNWIDE Int
| LASGUNFOCUS Int
| SONICGUN
src/Dodge/Data.hs
+32
View File
@@ -86,6 +86,8 @@ data World = World
, _props :: IM.IntMap Prop
, _instantParticles :: [Particle]
, _particles :: [Particle]
, _newBeams :: WorldBeams
, _beams :: WorldBeams
, _walls :: IM.IntMap Wall
, _doors :: IM.IntMap Door
, _machines :: IM.IntMap Machine
@@ -496,6 +498,33 @@ data ItEffect
,_itEffectID :: Maybe Int
}
data IntID a = IntID Int a
data WorldBeams = WorldBeams
{_blockingBeams :: [Beam]
,_lightBeams :: [Beam]
,_positronBeams :: [Beam]
,_electronBeams :: [Beam]
}
{- | Linear beams. Last only one frame.
- Can interact with one another in a limited manner
-}
data Beam = Beam
{ _bmDraw :: Beam -> Picture
, _bmPos :: Point2
, _bmDir :: Float
, _bmDamage :: Int
, _bmColor :: Color
, _bmPoints :: [Point2]
, _bmFirstPoints :: [Point2]
, _bmRange :: Float
, _bmPhaseV :: Float
, _bmType :: BeamType
}
data BeamType
= BeamCombine
{_beamCombine :: (Point2 , (Point2,Point2,Beam) , (Point2,Point2,Beam)) -> World -> World}
| BeamSimple
{- Objects without ids.
Update themselves, perhaps with side effects. -}
data Particle
@@ -1136,3 +1165,6 @@ makeLenses ''TerminalLine
makeLenses ''ItemValue
makeLenses ''ScreenLayer
makeLenses ''Sensor
makeLenses ''Beam
makeLenses ''BeamType
makeLenses ''WorldBeams
src/Dodge/Default/World.hs
+2
View File
@@ -38,6 +38,8 @@ defaultWorld = World
, _props = IM.empty
, _instantParticles = []
, _particles = []
, _newBeams = WorldBeams [] [] [] []
, _beams = WorldBeams [] [] [] []
, _walls = IM.empty
, _blocks = IM.empty
, _machines = IM.empty
src/Dodge/Item/Weapon/BatteryGuns.hs
+105 -10
View File
@@ -1,6 +1,8 @@
module Dodge.Item.Weapon.BatteryGuns
( lasGun
, lasGunDual
, lasGunWide
, lasGunWidePulse
, lasGunSway
, lasGunSwing
, lasGunFocus
@@ -14,6 +16,7 @@ import Dodge.Data
import Dodge.Item.Weapon.LaserPath
import Dodge.Creature.HandPos
import Dodge.Particle.TeslaArc
import Dodge.Particle.Flame
import Dodge.SoundLogic.LoadSound
import Dodge.WorldEvent.Flash
import Dodge.WorldEvent.Damage
@@ -137,27 +140,34 @@ lasGunWide n = lasGun
where
n' = 9 * n
xs = [ 0.25 * (fromIntegral x - fromIntegral (n'-1) /2) | x <- [0..n'-1] ]
lasGunWidePulse :: Int -> Item
lasGunWidePulse n = lasGun
& itName .~ "PARALELLASPULSE"++show n
& itType .~ LASGUNWIDE n
lasGunWidePulse :: Item
lasGunWidePulse = lasGun
& itName .~ "LASWIDEPULSE"
& itType .~ LASGUNWIDEPULSE
& itParams . lasColor .~ orange
& itParams . lasDamage .~ 2
& itUse .~ ( ruseInstant shootLaser NoHammer
[ ammoCheckI
, withItem $ \it -> withTempLight 1 100 (xyzV4 (_lasColor $ _itParams it))
, withItem $ \it -> withMuzPos $ flareCircleAt (_lasColor $ _itParams it) 0.8
, withSoundForI tone440sawtoothquietS 2
, withItem $ \it -> withTempLight 1 (100 * frac it) (xyzV4 (_lasColor $ _itParams it))
, withItem $ \it -> withSoundForVol (frac it) tone440sawtoothquietS 2
, withItemUpdate itup
$ \it -> withMuzPos $ flareCircleAt (_lasColor $ _itParams it) (frac it * 0.8)
, useAmmoAmount 1
, duplicateOffsets xs
, withItemUpdate itup $ \it -> duplicateOffsets (xs it)
]
& useAim . aimSpeed .~ 0.4
& useAim . aimRange .~ 1
& useAim . aimStance .~ TwoHandTwist
)
where
n' = 9 * n
xs = [ 0.25 * (fromIntegral x - fromIntegral (n'-1) /2) | x <- [0..n'-1] ]
itup it = it
& itParams . lasCycle %~ (\i -> (i+1) `mod` 40)
& itParams . lasDamage .~ ceiling ((22 :: Float) * frac it)
& itParams . lasColor .~ frac it * orange
frac it = 0.5 * (1 + sin (pi * fromIntegral (_lasCycle $ _itParams it) * 0.05))
xs it = [ 0.25 * (fromIntegral x - fromIntegral (n'-1) /2) | x <- [0..n'-1] ]
where
n' = (ceiling $ (150 :: Float) * frac it) :: Int
lasGunSway :: Item
lasGunSway = lasGun
& itName .~ "SWAYLAS"
@@ -197,6 +207,24 @@ lasGunFocus n = lasGunWide n
where
n' = 9 * n
xs = [ 0.25 * (fromIntegral x - fromIntegral (n'-1) /2) | x <- [0..n'-1] ]
lasGunDual :: Item
lasGunDual = lasGun
& itName .~ "DUALAS"
& itType .~ LASGUNDUAL
& itParams . lasColor .~ red
& itUse .~ (ruseInstant shootDualLaser NoHammer
[ ammoCheckI
, withItem $ \it -> withTempLight 1 100 (xyzV4 (_lasColor $ _itParams it))
, withItem $ \it -> withMuzPos $ flareCircleAt (_lasColor $ _itParams it) 0.8
, withSoundForI tone440sawtoothquietS 2
, useAmmoAmount 1
]
& useAim . aimSpeed .~ 0.4
& useAim . aimRange .~ 1
& useAim . aimStance .~ TwoHandTwist
)
lasGunSwing :: Item
lasGunSwing = lasGun
& itName .~ "SWINGLAS"
@@ -404,6 +432,73 @@ shootLaser it cr = instantParticles .:~ lasRayAt (_lasColor $ _itParams it) dam
phasev = _phaseV . _itParams $ _crInv cr IM.! _crInvSel cr
dam = _lasDamage $ _itParams it
shootDualLaser :: Item -> Creature -> World -> World
shootDualLaser it cr w = w
& newBeams . positronBeams .:~ dualRayAt w orange dam phasev posl dirl
& newBeams . electronBeams .:~ dualRayAtNoFlame w blue dam phasev posr dirr
where
dir = _crDir cr
pos = _crPos cr +.+ aimlength *.* unitVectorAtAngle dir
aimlength = aimingMuzzlePos cr it
posl = pos +.+ (-10) * vNormal (unitVectorAtAngle dir)
posr = pos +.+ 10 * vNormal (unitVectorAtAngle dir)
mwp = mouseWorldPos w
mwp' | dist mwp (_crPos cr) < aimlength + 5 = _crPos cr +.+ (aimlength + 5) *.* unitVectorAtAngle dir
| otherwise = mwp
dirl = argV $ mwp' -.- posl
dirr = argV $ mwp' -.- posr
phasev = _phaseV . _itParams $ _crInv cr IM.! _crInvSel cr
dam = _lasDamage $ _itParams it
drawBeam :: Beam -> Picture
drawBeam bm = setLayer 1 $ pictures
[ setDepth 19 . color (brightX 0 0.5 col) $ thickLine 20 ps
, setDepth 19.5 . color (brightX 10 1 col) $ thickLine 3 ps
]
where
col = _bmColor bm
ps = _bmFirstPoints bm
dualRayAt :: World -> Color -> Int -> Float -> Point2 -> Float -> Beam
dualRayAt w col dam phasev pos dir = Beam
{ _bmDraw = drawBeam
, _bmPos = pos
, _bmDir = dir
, _bmDamage = dam
-- , _ptUpdate = mvLaser phasev pos dir
, _bmRange = 800
-- , _ptDamage = dam
, _bmPhaseV = phasev
, _bmColor = col
, _bmPoints = pos:ps
, _bmFirstPoints = []
, _bmType = BeamCombine
$ \(p,(a,b,_),(x,y,_)) -> makeFlame p (2 *.* normalizeV (normalizeV (b-.-a)+.+normalizeV (y-.-x)))
-- $ \(p,(a,b,_),(x,y,_)) -> makeFlame p (V2 5 0)
}
where
(_,ps) = reflectLaserAlong phasev [] pos (pos +.+ 800 *.* unitVectorAtAngle dir) w
-- ps = [pos,pos +.+ 800 *.* unitVectorAtAngle dir]
dualRayAtNoFlame :: World -> Color -> Int -> Float -> Point2 -> Float -> Beam
dualRayAtNoFlame w col dam phasev pos dir = Beam
{ _bmDraw = drawBeam
, _bmPos = pos
, _bmDir = dir
, _bmDamage = dam
-- , _ptUpdate = mvLaser phasev pos dir
, _bmRange = 800
-- , _ptDamage = dam
, _bmPhaseV = phasev
, _bmColor = col
, _bmPoints = pos:ps
, _bmFirstPoints = []
, _bmType = BeamCombine
$ \_ -> id
-- $ \(p,(a,b,_),(x,y,_)) -> makeFlame p (V2 5 0)
}
where
(_,ps) = reflectLaserAlong phasev [] pos (pos +.+ 800 *.* unitVectorAtAngle dir) w
lasRayAt :: Color -> Int -> Float -> Point2 -> Float -> Particle
lasRayAt col dam phasev pos dir = LaserParticle
{ _ptDraw = const blank
src/Dodge/Item/Weapon/SprayGuns.hs
+4 -2
View File
@@ -7,6 +7,7 @@ module Dodge.Item.Weapon.SprayGuns
, flameWall
) where
import Dodge.Data
import Dodge.Particle.Flame
--import Dodge.Data.SoundOrigin
--import Dodge.Base
--import Dodge.Zone
@@ -204,7 +205,8 @@ useGasParams nz it cr = _amCreateGas (_aoType (_itConsumption it)) (_nzPressure
pos = _crPos cr +.+ (_nzLength nz *.* unitVectorAtAngle (_crDir cr))
aFlame :: Float -> Point2 -> Float -> Creature -> World -> World
aFlame pressure pos dir cr w = w & instantParticles .:~ aFlameParticle t pos vel (Just $ _crID cr)
aFlame pressure pos dir cr = makeFlame pos vel
--w & instantParticles .:~ aFlameParticle t pos vel Nothing -- (Just $ _crID cr)
where
(t,_) = randomR (99,101) (_randGen w)
-- (t,_) = randomR (99,101) (_randGen w)
vel = (_crPos cr -.- _crOldPos cr) +.+ pressure *.* unitVectorAtAngle dir
src/Dodge/Particle/Damage.hs
+5 -1
View File
@@ -1,10 +1,12 @@
module Dodge.Particle.Damage where
import Dodge.Data
import Geometry
import LensHelp
import System.Random
import Control.Monad.State
-- TODO unify particle position in a sensible manner
spawnAtBulDams :: (Point2 -> State StdGen Particle)
-> Particle -> Point2 -> [Damage]
spawnAtBulDams thespawn bt p =
@@ -21,7 +23,9 @@ simpleDam dt amount bt p =
[ Damage dt amount sp p ep NoDamageEffect
]
where
sp = head $ _ptTrail bt
sp = case bt ^? ptTrail of
Nothing -> _ptPos bt
Just xs -> head xs
bulVel = _ptVel bt
ep = sp +.+ bulVel
src/Dodge/Render/ShapePicture.hs
+2
View File
@@ -46,6 +46,8 @@ extraShapes = _foregroundShape
extraPics :: Configuration -> World -> Picture
extraPics cfig w = pictures (_decorations w)
<> concatMapPic (dbArg _ptDraw) (_particles w)
<> concatMapPic (dbArg _bmDraw) (_positronBeams $ _beams w)
<> concatMapPic (dbArg _bmDraw) (_electronBeams $ _beams w)
<> concatMapPic (dbArg _lsPict) (_lightSources w)
<> testPic w
<> concatMapPic clDraw (_clouds w )
src/Dodge/Update.hs
+69
View File
@@ -59,6 +59,7 @@ functionalUpdate cfig w = checkEndGame
. dbArg _worldEvents
. updateIMl _modifications _mdUpdate
. updateParticles
. updateBeams
. updateIMl _props _pjUpdate
. updateLightSources
. updateClouds
@@ -141,6 +142,74 @@ updateParticles :: World -> World
updateParticles w = updateInstantParticles $ set particles (catMaybes ps) w'
where
(w',ps) = mapAccumR (\a b -> _ptUpdate b a b) w $ _particles w
updateBeams :: World -> World
updateBeams w = w
& newBeams .~ WorldBeams [] [] [] []
& beams .~ thebeams
& combineBeams thebeams
where
thebeams = _newBeams w
combineBeams :: WorldBeams -> World -> World
combineBeams wbeams w = w''
& beams . positronBeams .~ pbeams
& beams . electronBeams .~ ebeams
where
(w',pbeams) = mapAccumR (combineBeamBeams (_electronBeams wbeams)) w $ _positronBeams wbeams
(w'',ebeams) = mapAccumR (combineBeamBeams (_positronBeams wbeams)) w' $ _electronBeams wbeams
combineBeamBeams :: [Beam] -> World -> Beam -> (World,Beam)
combineBeamBeams bms w bm = case intersectBeamBeams bm bms of
(ps,Nothing) -> (w, bm & bmFirstPoints .~ ps)
(ps,Just a) -> (_beamCombine (_bmType bm) a w, bm & bmFirstPoints .~ ps)
-- intersect a beam with a list of beams.
-- returns the (reversed) travel of the beam up to maybe an intersection point
intersectBeamBeams :: Beam -> [Beam]
-> ([Point2], Maybe (Point2,(Point2,Point2,Beam),(Point2,Point2,Beam)))
intersectBeamBeams bm bms = f [] $ _bmPoints bm
where
f ps (x:y:ys) = case intersectSegBeams x y bms of
Just (z,a) -> ((z:x:ps), Just (z,(x,y,bm),a))
Nothing -> f (x:ps) (y:ys)
f ps (x:[]) = (x:ps, Nothing)
f _ _ = error "made an empty beam"
intersectSegBeams :: Point2 -> Point2 -> [Beam] -> Maybe (Point2,(Point2,Point2,Beam))
intersectSegBeams sp ep (bm:bms) = case intersectSegBeam sp ep bm of
Nothing -> intersectSegBeams sp ep bms
Just a@(z,_) -> maybe (Just a) Just $ intersectSegBeams sp z bms
intersectSegBeams _ _ _ = Nothing
intersectSegBeam :: Point2 -> Point2 -> Beam -> Maybe (Point2,(Point2,Point2,Beam))
intersectSegBeam sp ep bm = case intersectSegSegs' sp ep (_bmPoints bm) of
Nothing -> Nothing
Just (z,x,y) -> Just (z,(x,y,bm))
intersectSegSegs' :: Point2 -> Point2 -> [Point2] -> Maybe (Point2,Point2,Point2)
intersectSegSegs' sp ep (x:y:ys) = case intersectSegSeg sp ep x y of
Just z -> maybe (Just (z,x,y)) Just $ intersectSegSegs' sp z (y:ys)
Nothing -> intersectSegSegs' sp ep (y:ys)
intersectSegSegs' _ _ _ = Nothing
--intersectSegSegs :: Point2 -> Point2 -> [Point2] -> Maybe Point2
--intersectSegSegs sp ep (x:y:ys) = case intersectSegSeg sp ep x y of
-- Just z -> maybe (Just z) Just $ intersectSegSegs sp z (y:ys)
-- Nothing -> intersectSegSegs sp ep (y:ys)
--intersectSegSegs _ _ _ = Nothing
--
--intersectSegSegss :: Point2 -> Point2 -> [[Point2]] -> Maybe Point2
--intersectSegSegss sp ep (as:ass) = case intersectSegSegs sp ep as of
-- Just z -> maybe (Just z) Just $ intersectSegSegss sp z ass
-- Nothing -> intersectSegSegss sp ep ass
--intersectSegSegss _ _ _ = Nothing
--
--intersectSegsSegss :: [Point2] -> [[Point2]] -> Maybe Point2
--intersectSegsSegss (x:y:ys) ass = maybe
-- (intersectSegsSegss (y:ys) ass)
-- Just
-- (intersectSegSegss x y ass)
--intersectSegsSegss _ _ = Nothing
updateInstantParticles :: World -> World
updateInstantParticles w = case _instantParticles w of