Add ItEffect data as parameter to the effect itself

This commit is contained in:
jgk
2021-05-24 21:37:42 +02:00
parent 38682049c4
commit a7d4d8911d
12 changed files with 109 additions and 59 deletions
+3 -2
View File
@@ -119,9 +119,10 @@ movementSideEff cr w
invSideEff :: Creature -> World -> World
invSideEff cr w = weaponReloadSounds cr $ IM.foldrWithKey f w (_crInv cr)
where
f i it w' = case it ^? itEffect . itInvEffect of
f i it w' = case it ^? itEffect of
Nothing -> w'
Just g -> g cr i w'
Just NoItEffect -> w'
Just g -> dbArg _itInvEffect g cr i w'
weaponReloadSounds :: Creature -> World -> World
weaponReloadSounds cr w = case _crInv cr IM.!? _crInvSel cr of
+12 -4
View File
@@ -285,11 +285,12 @@ data Item
| NoItem
data ItEffect = NoItEffect
| ItInvEffect
{_itInvEffect :: Creature -> Int -> World -> World
{_itInvEffect :: ItEffect -> Creature -> Int -> World -> World
-- the Int is the items inventory position
,_itEffectCounter :: Int
}
| ItEffect
{_itInvEffect :: Creature -> Int -> World -> World
{_itInvEffect :: ItEffect -> Creature -> Int -> World -> World
,_itFloorEffect :: Int -> World -> World
,_itEffectCounter :: Int
}
@@ -386,7 +387,7 @@ data Projectile
, _pjVel :: Point2
, _pjDraw :: Projectile -> Picture
, _pjID :: Int
, _pjUpdate :: World -> World
, _pjUpdate :: Projectile -> World -> World
}
| Shell
{ _pjPos :: Point2
@@ -394,9 +395,16 @@ data Projectile
, _pjVel :: Point2
, _pjDraw :: Projectile -> Picture
, _pjID :: Int
, _pjUpdate :: World -> World
, _pjUpdate :: Projectile -> World -> World
, _pjPayload :: Point2-> World -> World
}
| LinearShockwave
{ _pjDraw :: Projectile -> Picture
, _pjID :: Int
, _pjUpdate :: Projectile -> World -> World
, _pjPoints :: [(Point2,Point2)]
, _pjTimer :: Int
}
data Either3 a b c = E3x1 a | E3x2 b | E3x3 c
data Wall
= Wall
+6 -6
View File
@@ -16,7 +16,7 @@ drawCircleAtFor p t w = w & projectiles %~
, _pjVel = (0,0)
, _pjDraw = \_ -> onLayer PtLayer $ uncurry translate p $ color white $ circleSolid 20
, _pjID = k
, _pjUpdate = pjTimer t k
, _pjUpdate = \_ -> pjTimerF t k
}
where
k = IM.newKey $ _projectiles w
@@ -28,7 +28,7 @@ drawCircleAtForCol p t col w = w & projectiles %~
, _pjVel = (0,0)
, _pjDraw = \_ -> onLayer PtLayer $ uncurry translate p $ color col $ circleSolid 20
, _pjID = k
, _pjUpdate = pjTimer t k
, _pjUpdate = \_ -> pjTimerF t k
}
where
k = IM.newKey $ _projectiles w
@@ -40,12 +40,12 @@ drawLineForCol ps t col w = w & projectiles %~
, _pjVel = (0,0)
, _pjDraw = \_ -> onLayer PtLayer $ color col $ lineOfThickness 5 ps
, _pjID = k
, _pjUpdate = pjTimer t k
, _pjUpdate = \_ -> pjTimerF t k
}
where
k = IM.newKey $ _projectiles w
pjTimer :: Int -> Int -> World -> World
pjTimer 0 i = projectiles %~ IM.delete i
pjTimer time i = projectiles . ix i . pjUpdate .~ pjTimer (time - 1) i
pjTimerF :: Int -> Int -> World -> World
pjTimerF 0 i = projectiles %~ IM.delete i
pjTimerF time i = projectiles . ix i . pjUpdate .~ (\_ -> pjTimerF (time - 1) i)
+1 -1
View File
@@ -208,7 +208,7 @@ defaultPT = Projectile
, _pjVel = (0,0)
, _pjDraw = \_ -> blank
, _pjID = 0
, _pjUpdate = id
, _pjUpdate = \_ -> id
}
defaultPP :: PressPlate
defaultPP = PressPlate
+1
View File
@@ -18,5 +18,6 @@ data ItAttachment
| ItMode {_itMode :: Int}
| ItCharMode {_itCharMode :: Seq.Seq Char }
| ItTargetPos { _itTargetPos :: Point2 }
| ItInt { _itInt :: Int }
makeLenses ''ItAttachment
+20 -19
View File
@@ -588,12 +588,13 @@ boosterGun = defaultGun
, _wpReloadState = 0
, _itUseRate = 0
, _itUseTime = 0
, _itUse = shoot $ boostSelf Nothing 20
, _itUse = boostSelf 20
, _wpSpread = 0.05
, _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ polygon [(-2,-2),(-2,2),(2,2),(2,0),(0,0),(0,-2)]
, _itAimingSpeed = 1
, _itAimingRange = 0
, _itEffect = resetAttachmentID
}
aTeslaArc :: Creature -> World -> World
@@ -640,7 +641,7 @@ makeShellAt pl i cid pos dir = Shell
, _pjVel = rotateV dir (1,0)
, _pjDraw = \_ -> blank
, _pjID = i
, _pjUpdate = moveShell 50 i cid 0 (rotateV dir (3,0))
, _pjUpdate = \_ -> moveShell 50 i cid 0 (rotateV dir (3,0))
, _pjPayload = pl
}
@@ -657,21 +658,21 @@ moveShell time i cid rot accel w
else w
& projectiles . ix i . pjPos %~ (+.+ vel)
& projectiles . ix i . pjDraw .~ (\_ -> piclow)
& projectiles . ix i . pjUpdate .~ moveShell (time-1) i cid rot (rotateV rot accel)
& projectiles . ix i . pjUpdate .~ (\_ -> moveShell (time-1) i cid rot (rotateV rot accel))
| isJust thingHit = doExplode
| time == 35 = w
& projectiles . ix i . pjPos %~ (+.+ vel)
& projectiles . ix i . pjDraw .~ (\_ -> pic)
& projectiles . ix i . pjUpdate .~ moveShell (time-1) i cid spin accel
& projectiles . ix i . pjUpdate .~ \_ -> moveShell (time-1) i cid spin accel
| time >= 20 = w
& projectiles . ix i . pjPos %~ (+.+ vel)
& projectiles . ix i . pjDraw .~ (\_ -> pic)
& projectiles . ix i . pjUpdate .~ moveShell (time-1) i cid rot' (rotateV rot accel)
& projectiles . ix i . pjUpdate .~ (\_ -> moveShell (time-1) i cid rot' (rotateV rot accel))
| time > -99 = w
& projectiles . ix i . pjPos %~ (+.+ vel)
& randGen .~ g
& projectiles . ix i . pjDraw .~ (\_ -> pic)
& projectiles . ix i . pjUpdate .~ moveShell (time-1) i cid rot' (rotateV rot accel)
& projectiles . ix i . pjUpdate .~ (\_ -> moveShell (time-1) i cid rot' (rotateV rot accel))
& projectiles . ix i . pjVel %~ (\v -> accel +.+ frict *.* v)
& soundFromPos (ShellSound i) newPos (fromIntegral smokeTrailSound) 1 250
& makeFlameletTimed (oldPos -.- vel) (vel +.+ rotateV (pi+sparkD) accel) Nothing 3 10
@@ -679,7 +680,7 @@ moveShell time i cid rot accel w
| time > -200 = w
& projectiles . ix i . pjPos %~ (+.+ vel)
& projectiles . ix i . pjDraw .~ (\_ -> pic)
& projectiles . ix i . pjUpdate .~ moveShell (time-1) i cid rot' (rotateV rot accel)
& projectiles . ix i . pjUpdate .~ (\_ -> moveShell (time-1) i cid rot' (rotateV rot accel))
| otherwise = doExplode
where
doExplode = w
@@ -761,7 +762,7 @@ retireRemoteRocket itid 0 pjid w =
$ set (pointToItem (_itemPositions w IM.! itid) . itUse) (hammerCheck fireRemoteLauncher)
(w & projectiles %~ IM.delete pjid)
retireRemoteRocket itid t pjid w = setScope w
& projectiles . ix pjid . pjUpdate .~ retireRemoteRocket itid (t-1) pjid
& projectiles . ix pjid . pjUpdate .~ (\_ -> retireRemoteRocket itid (t-1) pjid)
where
setScope w' = case _itemPositions w' IM.! itid of
InInv cid invid -> w'
@@ -777,7 +778,7 @@ retireRemoteBomb itid 0 pjid w =
$ set (pointToItem (_itemPositions w IM.! itid) . itUse) (hammerCheck throwRemoteBomb)
(w & projectiles %~ IM.delete pjid)
retireRemoteBomb itid t pjid w = setScope w
& projectiles . ix pjid . pjUpdate .~ retireRemoteBomb itid (t-1) pjid
& projectiles . ix pjid . pjUpdate .~ (\_ -> retireRemoteBomb itid (t-1) pjid)
where
setScope w' = case _itemPositions w' IM.! itid of
InInv cid invid -> w'
@@ -790,7 +791,7 @@ moveRemoteBomb :: Int -> Int -> Int -> World -> World
moveRemoteBomb itid time pID w
| time < -4 = setScope
$ updatePicture
$ set (projectiles .ix pID.pjUpdate) (moveRemoteBomb itid (f time) pID)
$ set (projectiles .ix pID.pjUpdate) (\_ -> moveRemoteBomb itid (f time) pID)
w
| time < 2
= case hitWl of
@@ -804,7 +805,7 @@ moveRemoteBomb itid time pID w
updatedWorld
= updateV $ set (projectiles . ix pID . pjPos) finalPos
$ updatePicture
$ set (projectiles .ix pID.pjUpdate) (moveRemoteBomb itid (time-1) pID)
$ set (projectiles .ix pID.pjUpdate) (\_ -> moveRemoteBomb itid (time-1) pID)
$ setScope
w
setScope w' = case _itemPositions w' IM.! itid of
@@ -916,7 +917,7 @@ fireRemoteLauncher cr w = setLocation
, _pjVel = rotateV dir (1,0)
, _pjDraw = \_ -> blank
, _pjID = i
, _pjUpdate = moveRemoteShell 50 i cid itid dir
, _pjUpdate = \_ -> moveRemoteShell 50 i cid itid dir
}
j = _crInvSel cr
newitid = IM.newKey $ _itemPositions w
@@ -938,7 +939,7 @@ moveRemoteShell time i cid itid _ w
else over (projectiles . ix i . pjPos) (+.+ vel)
$ set (projectiles . ix i . pjDraw) (\_ -> piclow)
$ set (projectiles . ix i . pjUpdate)
(moveRemoteShell (time-1) i cid itid newdir)
(\_ -> moveRemoteShell (time-1) i cid itid newdir)
$ setScope
w
| time >= 20 = case thingHit of
@@ -946,7 +947,7 @@ moveRemoteShell time i cid itid _ w
Nothing -> over (projectiles . ix i . pjPos) (+.+ vel)
$ set (projectiles . ix i . pjDraw) (\_ -> pic)
$ set (projectiles . ix i . pjUpdate)
(moveRemoteShell (time-1) i cid itid newdir)
(\_ -> moveRemoteShell (time-1) i cid itid newdir)
$ setScope
w
| time > -99 = case thingHit of
@@ -956,7 +957,7 @@ moveRemoteShell time i cid itid _ w
Nothing -> over (projectiles . ix i . pjPos) (+.+ vel)
$ set randGen g
$ set (projectiles . ix i . pjDraw) (\_ -> pic)
$ set (projectiles . ix i . pjUpdate) (moveRemoteShell (time-1) i cid itid newdir)
$ set (projectiles . ix i . pjUpdate) (\_ -> moveRemoteShell (time-1) i cid itid newdir)
$ over (projectiles . ix i . pjVel) (\v -> accel +.+ frict *.* v)
$ soundFromPos (ShellSound i) newPos (fromIntegral smokeTrailSound) 1 250
$ smokeGen
@@ -969,7 +970,7 @@ moveRemoteShell time i cid itid _ w
w
Nothing -> over (projectiles . ix i . pjPos) (+.+ vel)
$ set (projectiles . ix i . pjDraw) (\_ -> pic)
$ set (projectiles . ix i . pjUpdate) (moveRemoteShell (time-1) i cid itid newdir)
$ set (projectiles . ix i . pjUpdate) (\_ -> moveRemoteShell (time-1) i cid itid newdir)
$ setScope
w
| otherwise = doExplosion
@@ -1013,7 +1014,7 @@ explodeRemoteRocket
-> World
-> World
explodeRemoteRocket itid pjid w
= set (projectiles . ix pjid . pjUpdate) (retireRemoteRocket itid 30 pjid)
= set (projectiles . ix pjid . pjUpdate) (\_ -> retireRemoteRocket itid 30 pjid)
$ set (projectiles . ix pjid . pjDraw) (\_ -> blank)
$ set (itPoint . itUse) (const id)
$ resetName
@@ -1036,7 +1037,7 @@ throwRemoteBomb cr w = setLocation
, _pjVel = v
, _pjDraw = \_ -> blank
, _pjID = i
, _pjUpdate = moveRemoteBomb itid 50 i
, _pjUpdate = \_ -> moveRemoteBomb itid 50 i
}
i = newProjectileKey w
v' = 0.02 / _cameraZoom w *.* rotateV (_cameraRot w) ( _mousePos w)
@@ -1061,7 +1062,7 @@ throwRemoteBomb cr w = setLocation
explodeRemoteBomb :: Int -> Int -> Creature -> World -> World
explodeRemoteBomb itid pjid cr w
= set (projectiles . ix pjid . pjUpdate) (retireRemoteBomb itid 30 pjid)
= set (projectiles . ix pjid . pjUpdate) (\_ -> retireRemoteBomb itid 30 pjid)
$ set (projectiles . ix pjid . pjDraw) (\_ -> blank)
$ set (creatures . ix cid . crInv . ix j . itUse) (const id)
$ resetName
+47 -8
View File
@@ -3,7 +3,10 @@ module Dodge.Item.Weapon.Booster
import Dodge.Data
import Dodge.Base
import Geometry
import IntMapHelp
import qualified IntMapHelp as IM
import Dodge.Picture.Layer
import Picture
import Dodge.Item.Attachment.Data
import Data.Maybe
import Control.Lens
@@ -22,13 +25,12 @@ boostPoint x cr w = case mayp2 of
p1 = cpos +.+ x *.* normalizeV (mouseWorldPos w -.- cpos)
mayp2 = reflectPointWalls cpos p1 $ wallsAlongLine cpos p1 w
boostSelf
:: Maybe Int -- ^ shockwave projectile id
-> Float -- ^ boost amount
boostSelf
:: Float -- ^ boost amount
-> Creature
-> World
-> World
boostSelf mpid x cr w = case boostPoint x cr w of
boostSelf x cr w = case boostPoint x cr w of
Left p -> wWithShock
& creatures . ix cid %~ ( (crPos .~ p) . (crInv . ix (_crInvSel cr) . wpLoadedAmmo .~ 1))
Right p -> wWithShock & creatures . ix cid . crPos .~ p
@@ -36,8 +38,8 @@ boostSelf mpid x cr w = case boostPoint x cr w of
cid = _crID cr
cpos = _crPos cr
r = _crRad cr
pid = fromMaybe (newKey $ _projectiles w) mpid
wWithShock = addBoostShockwave pid cpos (vNormal $ r *.* unitVectorAtAngle (_crDir cr)) w
pid = fromMaybe (IM.newKey $ _projectiles w) (cr ^? crInv . ix (_crInvSel cr) . itAttachment . _Just . itInt)
wWithShock = addBoostShockwave pid cpos (r *.* unitVectorAtAngle (_crDir cr)) w
addBoostShockwave
:: Int
@@ -45,5 +47,42 @@ addBoostShockwave
-> Point2
-> World
-> World
addBoostShockwave _ _ _ w = w
addBoostShockwave pjid p v w = w & projectiles %~
IM.insertWith f pjid thePJ
where
thePJ = LinearShockwave
{ _pjDraw = drawBoostShockwave
, _pjID = pjid
, _pjUpdate = updateLinearShockwave
, _pjPoints = [(p,v)]
, _pjTimer = 10
}
f newVal oldVal = newVal & pjPoints %~ (++ _pjPoints oldVal)
updateLinearShockwave :: Projectile -> World -> World
updateLinearShockwave pj w
| t < 1 = w & projectiles %~ IM.delete pjid
| otherwise = w & projectiles . ix (_pjID pj) . pjTimer -~ 1
where
pjid = _pjID pj
t = _pjTimer pj
drawBoostShockwave :: Projectile -> Picture
drawBoostShockwave pj = setLayer 1 $ onLayer UPtLayer $ color red $ pictures $
[ line (map fst pvs)
, line [(0,0),(0,200)]
, uncurry translate (fst $ head pvs) $ circle 20
]
where
pvs = _pjPoints pj
t = _pjTimer pj
xs = drop (10 - t) [1,1.2..]
lps = zipWith f pvs xs
rps = zipWith g pvs xs
f (p,v) x = p -- +.+ x *.* vNormal v
g (p,v) x = p -- -.- x *.* vNormal v
resetAttachmentID :: ItEffect
resetAttachmentID = ItInvEffect f 0
where
f _ cr invid w = w
+11 -11
View File
@@ -27,7 +27,7 @@ wpRecock = ItInvEffect
,_itEffectCounter = 0
}
where
f cr i = creatures . ix (_crID cr) . crInv %~ IM.adjust fOnIt i
f _ cr i = creatures . ix (_crID cr) . crInv %~ IM.adjust fOnIt i
moveHammerUp HammerDown = HammerReleased
moveHammerUp HammerReleased = HammerUp
moveHammerUp HammerUp = HammerUp
@@ -42,7 +42,7 @@ bezierRecock = ItInvEffect
,_itEffectCounter = 0
}
where
f cr i = creatures . ix (_crID cr) . crInv %~ IM.adjust fOnIt i
f _ cr i = creatures . ix (_crID cr) . crInv %~ IM.adjust fOnIt i
fOnIt it = case _itHammer it of
HammerDown -> it & itHammer .~ HammerUp
_ -> it & itAttachment .~ Nothing
@@ -55,7 +55,7 @@ itemLaserScopeEffect
where
moveHammerUp !HammerDown = HammerReleased
moveHammerUp !_ = HammerUp
f cr invid w
f _ cr invid w
| invid == _crInvSel cr = w
& particles %~ (:) (makeLaserScope sp ep reloadFrac)
& creatures . ix (_crID cr) . crInv . ix invid . itHammer %~ moveHammerUp
@@ -83,11 +83,11 @@ Automatically send out radar pulses that detect walls. -}
autoRadarEffect :: ItEffect
autoRadarEffect = ItInvEffect {_itInvEffect = f 50 ,_itEffectCounter = 0 }
where
f :: Int -> Creature -> Int -> World -> World
f 0 cr i w = aRadarPulse cr w
f :: Int -> ItEffect -> Creature -> Int -> World -> World
f 0 _ cr i w = aRadarPulse cr w
& creatures . ix (_crID cr) . crInv . ix i
. itEffect . itInvEffect .~ f 100
f t cr i w = w
f t _ cr i w = w
& creatures . ix (_crID cr) . crInv . ix i
. itEffect . itInvEffect .~ f (t-1)
{- |
@@ -95,11 +95,11 @@ Automatically send out sonar pulses that detect creatures. -}
autoSonarEffect :: ItEffect
autoSonarEffect = ItInvEffect {_itInvEffect = f 50 ,_itEffectCounter = 0 }
where
f :: Int -> Creature -> Int -> World -> World
f 0 cr i w = aSonarPulse cr
f :: Int -> ItEffect -> Creature -> Int -> World -> World
f 0 _ cr i w = aSonarPulse cr
w & creatures . ix (_crID cr) . crInv . ix i
. itEffect . itInvEffect .~ f 140
f t cr i w = w & creatures . ix (_crID cr) . crInv . ix i
f t _ cr i w = w & creatures . ix (_crID cr) . crInv . ix i
. itEffect . itInvEffect .~ f (t-1)
bezierTargetEffect :: ItEffect
@@ -107,8 +107,8 @@ bezierTargetEffect = ItInvEffect
{_itInvEffect = setBezierTarget
,_itEffectCounter = 0
}
setBezierTarget :: Creature -> Int -> World -> World
setBezierTarget cr invid w
setBezierTarget :: ItEffect -> Creature -> Int -> World -> World
setBezierTarget _ cr invid w
| _crInvSel cr /= invid = w
| SDL.ButtonRight `S.member` _mouseButtons w = w
& creatures . ix (_crID cr) . crInv . ix invid . itAttachment
+3 -3
View File
@@ -35,7 +35,7 @@ moveGrenade time dir pID w = case hitWl of
$ set (projectiles .ix pID. pjDraw)
(\ _ -> onLayer PtLayer $ uncurry translate newPos
$ rotate dir $ grenadePic time)
$ set (projectiles .ix pID.pjUpdate) (moveGrenade (time-1) dir pID) w
$ set (projectiles .ix pID.pjUpdate) (\_ -> moveGrenade (time-1) dir pID) w
pj = _projectiles w IM.! pID
oldPos = _pjPos pj
newPos = _pjVel pj +.+ oldPos
@@ -69,7 +69,7 @@ throwGrenade explosion cr w = setWp $ removePict $ over projectiles addG w
, _pjVel = v
, _pjDraw = \_ -> onLayer PtLayer $ uncurry translate p $ grenadePic 0
, _pjID = i
, _pjUpdate = moveGrenade fuseTime dir i
, _pjUpdate = \_ -> moveGrenade fuseTime dir i
, _pjPayload = explosion
}
j = _crInvSel cr
@@ -91,7 +91,7 @@ throwGrenade explosion cr w = setWp $ removePict $ over projectiles addG w
throwArmReset :: Int -> ItEffect
throwArmReset x = ItInvEffect {_itInvEffect = f ,_itEffectCounter = x }
where
f cr i = creatures . ix (_crID cr) . crInv %~ IM.adjust counterDown i
f _ cr i = creatures . ix (_crID cr) . crInv %~ IM.adjust counterDown i
counterDown it
| _itEffectCounter (_itEffect it) == 0 = it
& itHammer .~ HammerUp
+2 -2
View File
@@ -128,7 +128,7 @@ tractorBeamAt colID i pos dir = Projectile
, _pjVel = d
, _pjDraw = \_ -> blank
, _pjID = i
, _pjUpdate = updateTractor colID 10 i
, _pjUpdate = \_ -> updateTractor colID 10 i
}
where
d = unitVectorAtAngle dir
@@ -138,7 +138,7 @@ tractorBeamAt colID i pos dir = Projectile
The interaction of this with objects, walls etc needs more thought. -}
updateTractor :: Int -> Int -> Int -> World -> World
updateTractor colID time i w
| time > 0 = set (projectiles . ix i . pjUpdate) (updateTractor colID (time-1) i)
| time > 0 = set (projectiles . ix i . pjUpdate) (\_ -> updateTractor colID (time-1) i)
$ set (projectiles . ix i . pjDraw) (\_ -> pic)
$ over creatures (IM.map tractCr)
$ over floorItems (IM.map tractFlIt)
+1 -1
View File
@@ -108,7 +108,7 @@ updateLightSources w = set tempLightSources (catMaybes tlss) w'
(w',tlss) = mapAccumR (\a b -> _tlsUpdate b a b) w $ _tempLightSources w
updateProjectiles :: World -> World
updateProjectiles w = IM.foldr' _pjUpdate w $ _projectiles w
updateProjectiles w = IM.foldr' (dbArg _pjUpdate) w $ _projectiles w
{-
Apply internal particle updates, delete 'Nothing's. -}
updateParticles :: World -> World
+2 -2
View File
@@ -248,7 +248,7 @@ makeTeslaArcAt i pos dir = Projectile
, _pjVel = (0,0)
, _pjDraw = \_ -> onLayer PtLayer $ line [(0,0),(0,0)]
, _pjID = i
, _pjUpdate = moveTeslaArc pos dir i
, _pjUpdate = \_ -> moveTeslaArc pos dir i
}
moveTeslaArc
@@ -260,7 +260,7 @@ moveTeslaArc
moveTeslaArc p d i w =
set (projectiles . ix i . pjDraw) (\_ -> pic)
$ set (projectiles . ix i . pjUpdate)
(pjTimer 2 i)
(\_ -> pjTimerF 2 i)
$ set randGen g
$ createSpark 8 nc q2 (argV sv + d1) Nothing
$ foldr damCrs w hitCrs