Reorganise modules. Broken layout-- to be diagnosed
This commit is contained in:
@@ -245,7 +245,6 @@ startCr = defaultCreature
|
|||||||
, _crDir = 0
|
, _crDir = 0
|
||||||
, _crID = 0
|
, _crID = 0
|
||||||
, _crPict = basicCrPict $ greyN 0.8
|
, _crPict = basicCrPict $ greyN 0.8
|
||||||
|
|
||||||
, _crUpdate = stateUpdate yourControl
|
, _crUpdate = stateUpdate yourControl
|
||||||
, _crRad = 10
|
, _crRad = 10
|
||||||
, _crMass = 10
|
, _crMass = 10
|
||||||
@@ -275,21 +274,6 @@ startCr = defaultCreature
|
|||||||
,poisonSprayer
|
,poisonSprayer
|
||||||
]
|
]
|
||||||
++ repeat NoItem))
|
++ repeat NoItem))
|
||||||
-- startInv
|
|
||||||
-- ([pistol,flameGrenade, teslaGrenade, autoGun,launcher,flameLauncher, poisonLauncher, teslaLauncher, lasGun,grenade
|
|
||||||
-- ,ltAutoGun,flamer,multGun,spreadGun,remoteLauncher
|
|
||||||
-- ,longGun
|
|
||||||
-- ,hvAutoGun
|
|
||||||
-- ,teslaGun
|
|
||||||
-- ,latchkey 0
|
|
||||||
-- ,miniGun
|
|
||||||
-- ,medkit 50
|
|
||||||
-- ,bezierGun
|
|
||||||
-- ,poisonSprayer
|
|
||||||
-- ,blinkGun
|
|
||||||
-- ]
|
|
||||||
-- ++ repeat NoItem))
|
|
||||||
-- -- startInv
|
|
||||||
, _crCorpse = onLayer CorpseLayer $ color (greyN 0.5) $ pictures [color (greyN 0.8) $ circleSolid 10, circLine 10]
|
, _crCorpse = onLayer CorpseLayer $ color (greyN 0.5) $ pictures [color (greyN 0.8) $ circleSolid 10, circLine 10]
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|||||||
@@ -890,26 +890,6 @@ aGasCloud cid w
|
|||||||
vel = (_crPos cr -.- _crOldPos cr) +.+ 10 *.* unitVectorAtAngle dir
|
vel = (_crPos cr -.- _crOldPos cr) +.+ 10 *.* unitVectorAtAngle dir
|
||||||
insertCloud = makeGasCloud pos vel -- . makeFlame pos2 vel (Just cid)
|
insertCloud = makeGasCloud pos vel -- . makeFlame pos2 vel (Just cid)
|
||||||
|
|
||||||
makeGasCloud :: Point2 -> Point2 -> World -> World
|
|
||||||
makeGasCloud pos vel w = over clouds (IM.insert i theCloud)
|
|
||||||
$ set randGen g w
|
|
||||||
where i = newKey $ _clouds w
|
|
||||||
theCloud = Cloud { _clID = i
|
|
||||||
, _clPos = pos
|
|
||||||
, _clVel = vel
|
|
||||||
, _clPict = \_ -> onLayer CrLayer $ color (withAlpha 0.1 col)
|
|
||||||
$ circleSolid 20
|
|
||||||
, _clRad = 20
|
|
||||||
, _clTimer = 400
|
|
||||||
, _clEffect = cloudPoisonDamage
|
|
||||||
}
|
|
||||||
(col, g) = runState (takeOne [green,yellow]) $ _randGen w
|
|
||||||
|
|
||||||
cloudPoisonDamage :: Cloud -> World -> World
|
|
||||||
cloudPoisonDamage c w = w & creatures %~ flip (foldr (IM.adjust doDam)) damagedCrs
|
|
||||||
where damagedCrs = IM.keys $ IM.filter f $ creaturesNearPoint (_clPos c) w
|
|
||||||
f cr = dist (_crPos cr) (_clPos c) < _crRad cr + _clRad c
|
|
||||||
doDam cr = cr & crState . crDamage %~ (:) (PoisonDam 1)
|
|
||||||
|
|
||||||
aFlame :: Float -> Int -> World -> World
|
aFlame :: Float -> Int -> World -> World
|
||||||
aFlame a cid w
|
aFlame a cid w
|
||||||
@@ -929,119 +909,7 @@ aFlame a cid w
|
|||||||
resetAngle = set (creatures . ix cid . crInv . ix (_crInvSel cr) . wpFire)
|
resetAngle = set (creatures . ix cid . crInv . ix (_crInvSel cr) . wpFire)
|
||||||
(shoot $ aFlame angle)
|
(shoot $ aFlame angle)
|
||||||
|
|
||||||
-- The following should be improved.... I've made a first pass
|
|
||||||
makePoisonExplosionAt :: Point2 -> World -> World
|
|
||||||
makePoisonExplosionAt p w = soundOnce grenadeBang $ foldr (makeGasCloud p) w vels
|
|
||||||
where
|
|
||||||
vels = evalState (sequence ( replicate 25 (randInCirc 2) )) (_randGen w)
|
|
||||||
-- just change the number after replicate to get more or less clouds
|
|
||||||
-- suggested change: use random positions, offset from p, rather than velocities
|
|
||||||
-- so, p +.+ randomOffset
|
|
||||||
-- currently the clouds push away from each other rather hard if they are close
|
|
||||||
|
|
||||||
makeTeslaExplosionAt :: Point2 -> World -> World
|
|
||||||
makeTeslaExplosionAt pos w = soundOnce grenadeBang $ foldr ($) w listOfFunctions -- a bit shorter
|
|
||||||
where
|
|
||||||
-- rad or 360? Radians (hopefully) everywhere
|
|
||||||
xs = randomRs (0, 2*pi) $ _randGen w
|
|
||||||
p = newProjectileKey w
|
|
||||||
pks = [p..]
|
|
||||||
listOfFunctions = map
|
|
||||||
(\i -> over projectiles (IM.insert (pks!!i) (makeTeslaArcAt (pks!!i) pos (xs!!i))))
|
|
||||||
[1 .. 29]
|
|
||||||
|
|
||||||
-- slightly more work done on this one, want the flames to last for different
|
|
||||||
-- times
|
|
||||||
-- the new flames are directly added to the list of particles
|
|
||||||
makeFlameExplosionAt :: Point2 -> World -> World
|
|
||||||
makeFlameExplosionAt p w = soundOnce grenadeBang $ over particles' (newFlames ++ ) w
|
|
||||||
where
|
|
||||||
newFlames = zipWith makeFlameWithVelAndTime velocities timers
|
|
||||||
makeFlameWithVelAndTime vel time = aFlameParticle time p vel Nothing
|
|
||||||
velocities = evalState (sequence ( replicate 15 (randInCirc 1) )) (_randGen w)
|
|
||||||
timers = randomRs (80,100) $ _randGen w
|
|
||||||
-- the ( Nthing :: Maybe Int ) here is "maybe" a creature id that the
|
|
||||||
-- particle passes through for the first frame of its existence
|
|
||||||
|
|
||||||
-- take out the flame particle from makeFlame
|
|
||||||
aFlameParticle :: Int -> Point2 -> Point2 -> Maybe Int -> Particle'
|
|
||||||
aFlameParticle t pos vel maycid = Pt'
|
|
||||||
{ _ptDraw = drawFlame vel
|
|
||||||
, _ptUpdate' = moveFlame vel
|
|
||||||
, _btVel' = vel
|
|
||||||
, _btColor' = red
|
|
||||||
, _btPos' = pos
|
|
||||||
, _btPassThrough' = maycid
|
|
||||||
, _btWidth' = 4
|
|
||||||
, _btTimer' = t
|
|
||||||
, _btHitEffect' = destroyOnImpact (doFlameDam 1) noEff noEff
|
|
||||||
}
|
|
||||||
|
|
||||||
makeFlame :: Point2 -> Point2 -> Maybe Int -> World -> World
|
|
||||||
makeFlame pos vel maycid = over particles' (aFlameParticle 100 pos vel maycid : )
|
|
||||||
|
|
||||||
drawFlame :: Point2 -> Particle' -> Picture
|
|
||||||
drawFlame rotd pt = thePic
|
|
||||||
where ep = _btPos' pt
|
|
||||||
thePic = pictures
|
|
||||||
[ glow
|
|
||||||
, aPic prot2 0.2998 (scaleChange + 1,2) red
|
|
||||||
, aPic prot 0.2996 (scaleChange + 0.5,1.5) orange
|
|
||||||
, aPic prot3 0.2994 (scaleChange,1) white
|
|
||||||
]
|
|
||||||
aPic :: (Point2 -> Point2) -> Float -> Point2 -> Color -> Picture
|
|
||||||
aPic offset depth (scalex,scaley) col
|
|
||||||
= setLayer 1
|
|
||||||
. setDepth depth
|
|
||||||
. uncurry translate (offset ep)
|
|
||||||
. rotate (pi * 0.5 + argV rotd)
|
|
||||||
. scale scalex scaley
|
|
||||||
. color col
|
|
||||||
$ circleSolid 5
|
|
||||||
glow = setLayer 1 $ setDepth 0.3 $ uncurry translate ep
|
|
||||||
$ circleSolidCol (withAlpha 0 orange) (withAlpha 0.02 orange) 50
|
|
||||||
time = _btTimer' pt
|
|
||||||
scaleChange | time < 80 = 3
|
|
||||||
| otherwise = 3 - (fromIntegral time - 80) * 0.2
|
|
||||||
prot p' = p' +.+ rotateV (fromIntegral time * 1) (0,1)
|
|
||||||
prot2 p' = p' +.+ rotateV (negate $ fromIntegral time * 1) (0,1)
|
|
||||||
prot3 p' = p' +.+ rotateV (2 + fromIntegral time * 0.1) (0,2)
|
|
||||||
|
|
||||||
moveFlame :: Point2 -> World -> Particle' -> (World, Maybe Particle')
|
|
||||||
moveFlame rotd w pt
|
|
||||||
| time <= 0 = (smokeGen w, Nothing)
|
|
||||||
| otherwise = case thingsHitExceptCr (_btPassThrough' pt) sp ep w of
|
|
||||||
((p,(E3x1 cr)):_) -> (soundAndGlare damcrs , mvPt')
|
|
||||||
(thing@(p,(E3x2 wl)):_) -> (fst $ hiteff [thing] damcrs , rfl wl p)
|
|
||||||
_ -> (soundAndGlare damcrs , mvPt)
|
|
||||||
where time = _btTimer' pt
|
|
||||||
soundAndGlare = soundFrom Flame fireSound 2 500
|
|
||||||
. over worldEvents ((.) $ flameGlareAt ep)
|
|
||||||
sp = _btPos' pt
|
|
||||||
vel = _btVel' pt
|
|
||||||
ep = sp +.+ vel
|
|
||||||
mvPt = Just $ pt {_btTimer' = time - 1, _btPos' = ep
|
|
||||||
, _btPassThrough' = Nothing
|
|
||||||
,_btVel' = 0.98 *.* vel}
|
|
||||||
mvPt' = Just $ pt {_btTimer' = time - 1, _btPos' = ep
|
|
||||||
, _btPassThrough' = Nothing
|
|
||||||
,_btVel' = 0.7 *.* vel}
|
|
||||||
damcrs = foldr ($) w $ map (\cr -> fst . hiteff [(ep,E3x1 cr)]) $ filter closeCrs
|
|
||||||
$ IM.elems $ _creatures w
|
|
||||||
closeCrs cr = dist ep (_crPos cr)
|
|
||||||
< _crRad cr + 10 - min 9 (max 0 (fromIntegral time - 80))
|
|
||||||
+ 5 * angleCoeff (angleVV (ep -.- _crPos cr) rotd)
|
|
||||||
angleCoeff x = abs $ 1 - (abs $ (x * 2 - pi) / (pi))
|
|
||||||
hiteff = _btHitEffect' pt pt
|
|
||||||
rfl wl p = Just $ pt {_btTimer' = time -1, _btPos' = pOut p
|
|
||||||
, _btVel' = reflV wl--, _ptDraw = const $ thepic $ pOut p
|
|
||||||
}
|
|
||||||
pOut p = p +.+ safeNormalizeV (sp -.- p)
|
|
||||||
reflV wall = (0.3 *.* reflectIn (_wlLine wall !! 1 -.- _wlLine wall !! 0)
|
|
||||||
vel )
|
|
||||||
+.+
|
|
||||||
(0.2 *.* vel)
|
|
||||||
smokeGen = makeFlamerSmokeAt ep
|
|
||||||
|
|
||||||
|
|
||||||
flamerAngle = 0.3
|
flamerAngle = 0.3
|
||||||
@@ -1663,123 +1531,6 @@ remoteBombUnarmedPic :: Picture
|
|||||||
remoteBombUnarmedPic = color (dark $ dark orange) $ circleSolid 5
|
remoteBombUnarmedPic = color (dark $ dark orange) $ circleSolid 5
|
||||||
|
|
||||||
|
|
||||||
makeTeslaArcAt :: Int -> Point2 -> Float -> Projectile
|
|
||||||
makeTeslaArcAt i pos dir = Projectile
|
|
||||||
{ _ptPos = pos
|
|
||||||
, _ptStartPos = pos
|
|
||||||
, _ptVel = (0,0)
|
|
||||||
, _ptPict = onLayer PtLayer $ line [(0,0),(0,0)]
|
|
||||||
, _ptID = i
|
|
||||||
, _ptUpdate = moveTeslaArc pos dir i
|
|
||||||
}
|
|
||||||
|
|
||||||
moveTeslaArc :: Point2 -> Float -> Int -> World -> World
|
|
||||||
moveTeslaArc p d i w =
|
|
||||||
set (projectiles . ix i . ptPict) pic
|
|
||||||
$ set (projectiles . ix i . ptUpdate)
|
|
||||||
(ptTimer 2 i)
|
|
||||||
$ set randGen g
|
|
||||||
$ createSpark 8 nc q2 (argV sv + d1) Nothing
|
|
||||||
$ foldr damCrs w hitCrs
|
|
||||||
where pic = setLayer 1 $ pictures
|
|
||||||
[ onLayer PtLayer $ color (f2 nc) $ line ps'
|
|
||||||
, onLayer UPtLayer $ color (withAlpha 0.02 cyan) $ lineOfThickness 20 ps'
|
|
||||||
, onLayer UPtLayer $ color (withAlpha 0.02 cyan) $ lineOfThickness 25 ps'
|
|
||||||
, onLayer UPtLayer $ color (withAlpha 0.02 cyan) $ lineOfThickness 30 ps'
|
|
||||||
]
|
|
||||||
ps' = lightningMids d pers ps
|
|
||||||
ps = take 15 $ p : map f (crsLightChain p d 0 w)
|
|
||||||
f (E3x1 cr) = _crPos cr
|
|
||||||
f (E3x2 p1) = p1
|
|
||||||
f (E3x3 p1) = p1
|
|
||||||
pers = evalState (sequence $ repeat $ randInCirc 5) $ _randGen w
|
|
||||||
(nc,g) = randomR (0::Int,11) $ _randGen w
|
|
||||||
f1 (E3x1 cr) = Just $ _crID cr
|
|
||||||
f1 _ = Nothing
|
|
||||||
hitCrs = mapMaybe f1 $ take 14 $ crsLightChain p d 0 w
|
|
||||||
damCrs i = over (creatures . ix i . crHP) (\hp -> hp - 5)
|
|
||||||
f2 0 = cyan
|
|
||||||
f2 1 = azure
|
|
||||||
f2 _ = white
|
|
||||||
sID = newProjectileKey w
|
|
||||||
q1 = last $ init ps'
|
|
||||||
q2 = last ps'
|
|
||||||
hitWall = collidePointWalls q1 ((2 *.* q2) -.- q1) $ wallsNearPoint q1 w
|
|
||||||
(d1,_) = randomR (-0.7,0.7) $ _randGen w
|
|
||||||
sv = fromMaybe (q2 -.- q1) $ fmap snd hitWall
|
|
||||||
|
|
||||||
lightningMid :: Float -> Point2 -> Point2 -> Point2
|
|
||||||
lightningMid d p1 p2 = (0.25 *.* (p1 +.+ p2)) +.+ 0.5 *.* p3
|
|
||||||
where p3 = errorClosestPointOnLine 1 p1 (p1 +.+ unitVectorAtAngle d) p2
|
|
||||||
|
|
||||||
lightningMids :: Float -> [Point2] -> [Point2] -> [Point2]
|
|
||||||
lightningMids d1 (p:pers) (p1:p3:ps)
|
|
||||||
= let p2 = p +.+ lightningMid d1 p1 p3
|
|
||||||
d2 = argV $ p3 -.- p2
|
|
||||||
in p1 : p2 : lightningMids d2 pers (p3:ps)
|
|
||||||
lightningMids _ _ ps = ps
|
|
||||||
|
|
||||||
crsLightChain' :: Point2 -> Float -> World -> [Either3 Creature Point2 Point2]
|
|
||||||
crsLightChain' p d w
|
|
||||||
= case crOrWall p d w of
|
|
||||||
E3x1 cr -> E3x1 cr : crsLightChain' (_crPos cr) (argV (_crPos cr -.- p)) w
|
|
||||||
E3x2 p1 -> [E3x2 p1]
|
|
||||||
E3x3 p1 -> E3x3 p1 : crsLightChain' p1 (dChange + argV (p1 -.- p)) (set randGen g w)
|
|
||||||
-- where (dChange, g) = (0, _randGen w)
|
|
||||||
where (dChange, g) = randomR (-0.05,0.05) $ _randGen w
|
|
||||||
|
|
||||||
crsLightChain :: Point2 -> Float -> Float -> World -> [Either3 Creature Point2 Point2]
|
|
||||||
crsLightChain p d wlAttract w
|
|
||||||
= case crOrWallSensitive p d wlAttract w of
|
|
||||||
E3x1 cr -> E3x1 cr : crsLightChain (_crPos cr) (argV (_crPos cr -.- p))
|
|
||||||
(min 1 (wlAttract + 0.3)) w
|
|
||||||
E3x2 p1 -> [E3x2 p1]
|
|
||||||
E3x3 p1 -> E3x3 p1 : crsLightChain p1 (dChange + argV (p1 -.- p)) (min 1 (wlAttract + 0.3)) (set randGen g w)
|
|
||||||
-- where (dChange, g) = (0, _randGen w)
|
|
||||||
where (dChange, g) = randomR (-0.05,0.05) $ _randGen w
|
|
||||||
|
|
||||||
crOrWallSensitive :: Point2 -> Float -> Float -> World -> Either3 Creature Point2 Point2
|
|
||||||
crOrWallSensitive p dir wlAttract w = fromMaybe (E3x3 $ p +.+ rotateV dir (arcLen,0))
|
|
||||||
$ listToMaybe $ sortBy (compare `on` g)
|
|
||||||
$ catMaybes [cr,wlp]
|
|
||||||
where cr = fmap E3x1 $ nearestCrInFront p dir 100 w
|
|
||||||
wlp = fmap E3x2 $ listToMaybe
|
|
||||||
$ sortBy (compare `on` dist p)
|
|
||||||
$ mapMaybe
|
|
||||||
( fmap fst
|
|
||||||
. (\p1 -> collidePointWalls p p1 $ wallsNearPoint p w)
|
|
||||||
. (+.+) p
|
|
||||||
. (\d -> rotateV d (100,0))
|
|
||||||
. (+) dir
|
|
||||||
)
|
|
||||||
(fmap (*wlAttract) [-(3*pi/8),-pi/4,-pi/8,0,pi/8,pi/4,3*pi/8])
|
|
||||||
--[-pi/4,-pi/8,0,pi/8,pi/4]
|
|
||||||
g (E3x2 p1) = 100 + dist p p1 -- tweak makes it more likely to hit crs first
|
|
||||||
--g (E3x2 p1) = dist p p1 - 100 -- tweak makes it more likely to hit walls first
|
|
||||||
g (E3x1 cr1) = dist p $ _crPos cr1
|
|
||||||
(arcLen,_) = randomR (25,50) $ _randGen w
|
|
||||||
-- BUG: can hit crs through walls
|
|
||||||
|
|
||||||
crOrWall :: Point2 -> Float -> World -> Either3 Creature Point2 Point2
|
|
||||||
crOrWall p dir w = fromMaybe (E3x3 $ p +.+ rotateV dir (arcLen,0))
|
|
||||||
$ listToMaybe $ sortBy (compare `on` g)
|
|
||||||
$ catMaybes [cr,wlp]
|
|
||||||
where cr = fmap E3x1 $ nearestCrInFront p dir 100 w
|
|
||||||
wlp = fmap E3x2 $ listToMaybe
|
|
||||||
$ sortBy (compare `on` dist p)
|
|
||||||
$ mapMaybe
|
|
||||||
( fmap fst
|
|
||||||
. (\p1 -> collidePointWalls p p1 $ wallsNearPoint p w)
|
|
||||||
. (+.+) p
|
|
||||||
. (\d -> rotateV d (100,0))
|
|
||||||
. (+) dir
|
|
||||||
)
|
|
||||||
[-(3*pi/8),-pi/4,-pi/8,0,pi/8,pi/4,3*pi/8]
|
|
||||||
--[-pi/4,-pi/8,0,pi/8,pi/4]
|
|
||||||
g (E3x2 p1) = 100 + dist p p1 -- tweak makes it more likely to hit crs first
|
|
||||||
--g (E3x2 p1) = dist p p1 - 100 -- tweak makes it more likely to hit walls first
|
|
||||||
g (E3x1 cr1) = dist p $ _crPos cr1
|
|
||||||
(arcLen,_) = randomR (25,50) $ _randGen w
|
|
||||||
|
|
||||||
spreadGunSpread,autogunSpread :: Float
|
spreadGunSpread,autogunSpread :: Float
|
||||||
spreadGunSpread = 0.5
|
spreadGunSpread = 0.5
|
||||||
|
|||||||
+5
-5
@@ -256,7 +256,7 @@ glassSwitchBack = do
|
|||||||
,blockLine (wth-wllen, 2*hf) ( wth,2*hf)
|
,blockLine (wth-wllen, 2*hf) ( wth,2*hf)
|
||||||
,blockLine ( 0, 3*hf) (wllen,3*hf)
|
,blockLine ( 0, 3*hf) (wllen,3*hf)
|
||||||
,blockLine (wth-wllen, 4*hf) ( wth,4*hf)
|
,blockLine (wth-wllen, 4*hf) ( wth,4*hf)
|
||||||
, PS (wth/2,hgt/2) 0 $ PutCrit lamp
|
, PS (wth/2,hgt/2) 0 $ putLamp
|
||||||
]
|
]
|
||||||
return $ set rmPS plmnts $ roomRect' wth hgt 2 6
|
return $ set rmPS plmnts $ roomRect' wth hgt 2 6
|
||||||
|
|
||||||
@@ -494,14 +494,13 @@ weaponLongCorridor = do
|
|||||||
i2 <- state $ randomR (2,5)
|
i2 <- state $ randomR (2,5)
|
||||||
let branch1 = treeTrunk (replicate i1 $ Left corridor) (connectRoom $ putCrs connectingRoom)
|
let branch1 = treeTrunk (replicate i1 $ Left corridor) (connectRoom $ putCrs connectingRoom)
|
||||||
let branch2 = treeTrunk (replicate i2 $ Left corridor) (deadRoom $ putWp corridorN)
|
let branch2 = treeTrunk (replicate i2 $ Left corridor) (deadRoom $ putWp corridorN)
|
||||||
return $ Node (Left $ addLS root) [branch1,branch2]
|
return $ Node (Left root) [branch1,branch2]
|
||||||
where putCrs = set rmPS [PS (10,40) (-pi/2) $ randC
|
where putCrs = set rmPS [PS (10,40) (-pi/2) $ randC
|
||||||
,PS (-10,40) (-pi/2) $ randC
|
,PS (-10,40) (-pi/2) $ randC
|
||||||
]
|
]
|
||||||
putWp = set rmPS [PS (20,40) 0 $ RandPS randFirstWeapon
|
putWp = set rmPS [PS (20,40) 0 $ RandPS randFirstWeapon
|
||||||
,PS (20,60) 0 $ putLamp
|
,PS (20,60) 0 $ putLamp
|
||||||
]
|
]
|
||||||
addLS = id -- set rmPS [PS (0,60) 0 $ putLamp]
|
|
||||||
|
|
||||||
critInDeadEnd :: Room
|
critInDeadEnd :: Room
|
||||||
critInDeadEnd = set rmPS [PS (0,0) 0 $ randC] deadEndRoom
|
critInDeadEnd = set rmPS [PS (0,0) 0 $ randC] deadEndRoom
|
||||||
@@ -531,10 +530,11 @@ weaponRoom = do
|
|||||||
|
|
||||||
roomCCrits :: RandomGen g => State g (Tree (Either Room Room))
|
roomCCrits :: RandomGen g => State g (Tree (Either Room Room))
|
||||||
roomCCrits = do
|
roomCCrits = do
|
||||||
ps <- sequence $ replicate 25 $ randInCirc 9
|
ps <- sequence $ replicate 20 $ randInCirc 9
|
||||||
let plmnts = map (\p -> PS p 0 $ randC)
|
let plmnts = map (\p -> PS p 0 $ randC)
|
||||||
$ zipWith (+.+) [(x,y) | x<-[110,130,150,170,190], y<- [70,90,110,130,150]] ps
|
$ zipWith (+.+) [(x,y) | x<-[110,130,150,170,190], y<- [70,90,110,130,150]] ps
|
||||||
return $ connectRoom $ over rmPS (++plmnts) $ roomC 200 200
|
lamps = [PS (50,100) 0 putLamp , PS (175,100) 0 putLamp]
|
||||||
|
return $ connectRoom $ over rmPS ((lamps ++) . (plmnts ++)) $ roomC 200 200
|
||||||
|
|
||||||
branchRectWith :: RandomGen g => State g (Tree (Either Room Room)) -> State g (Tree (Either Room Room))
|
branchRectWith :: RandomGen g => State g (Tree (Either Room Room)) -> State g (Tree (Either Room Room))
|
||||||
branchRectWith t = do
|
branchRectWith t = do
|
||||||
|
|||||||
+4
-189
@@ -6,6 +6,8 @@ module Dodge.WorldEvent
|
|||||||
, module Dodge.WorldEvent.HelperParticle
|
, module Dodge.WorldEvent.HelperParticle
|
||||||
, module Dodge.WorldEvent.Cloud
|
, module Dodge.WorldEvent.Cloud
|
||||||
, module Dodge.WorldEvent.HitEffect
|
, module Dodge.WorldEvent.HitEffect
|
||||||
|
, module Dodge.WorldEvent.Explosion
|
||||||
|
, module Dodge.WorldEvent.SpawnParticle
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
@@ -15,6 +17,8 @@ import Dodge.WorldEvent.ThingsHit
|
|||||||
import Dodge.WorldEvent.HelperParticle
|
import Dodge.WorldEvent.HelperParticle
|
||||||
import Dodge.WorldEvent.Cloud
|
import Dodge.WorldEvent.Cloud
|
||||||
import Dodge.WorldEvent.HitEffect
|
import Dodge.WorldEvent.HitEffect
|
||||||
|
import Dodge.WorldEvent.Explosion
|
||||||
|
import Dodge.WorldEvent.SpawnParticle
|
||||||
import Dodge.LightSources
|
import Dodge.LightSources
|
||||||
|
|
||||||
import Dodge.Data
|
import Dodge.Data
|
||||||
@@ -34,25 +38,6 @@ import Data.Function
|
|||||||
import Data.List
|
import Data.List
|
||||||
import qualified Data.IntMap.Strict as IM
|
import qualified Data.IntMap.Strict as IM
|
||||||
|
|
||||||
makeExplosionAt :: Point2 -> World -> World
|
|
||||||
makeExplosionAt p w = soundOnce grenadeBang
|
|
||||||
. addFlames
|
|
||||||
. explosionFlashAt p
|
|
||||||
$ makeShockwaveAt p 50 10 1 white
|
|
||||||
w
|
|
||||||
where fVs = fst $ runState ((sequence . take 75 . repeat . randInCirc) 1) $ _randGen w
|
|
||||||
fPs' = evalState ((sequence . take 75 . repeat . randInCirc) 15) $ _randGen w
|
|
||||||
fPs = map (pushAgainstWalls . (+.+) p . (*.*) 0.5)
|
|
||||||
fPs'
|
|
||||||
inversePushOut v = (15 - magV v) * 0.01 *.* v
|
|
||||||
fVs' = zipWith (+.+) fVs $ map inversePushOut fPs'
|
|
||||||
sizes = randomRs (2,6) $ _randGen w
|
|
||||||
times = randomRs (20,25) $ _randGen w
|
|
||||||
mF q v size time = makeFlameletTimed q v Nothing size time
|
|
||||||
newFs = zipWith4 mF fPs (fmap (3 *.*) fVs') sizes times
|
|
||||||
addFlames w = foldr ($) w newFs
|
|
||||||
pushAgainstWalls q = fromMaybe q $ fmap (\(x,y)-> x +.+ y)
|
|
||||||
$ collidePointWalls p q $ wallsNearPoint q w
|
|
||||||
|
|
||||||
shockWaveDamage :: Point2 -> Float -> Int -> World -> World
|
shockWaveDamage :: Point2 -> Float -> Int -> World -> World
|
||||||
shockWaveDamage p rad amount w = flip (foldr damageBlocks) hitBlocks $ over creatures (IM.map f) w
|
shockWaveDamage p rad amount w = flip (foldr damageBlocks) hitBlocks $ over creatures (IM.map f) w
|
||||||
@@ -67,75 +52,6 @@ shockWaveDamage p rad amount w = flip (foldr damageBlocks) hitBlocks $ over crea
|
|||||||
(_blIDs wall)
|
(_blIDs wall)
|
||||||
_ -> w
|
_ -> w
|
||||||
|
|
||||||
makeShockwaveAt :: Point2 -> Float -> Int -> Float -> Color
|
|
||||||
-> World -> World
|
|
||||||
makeShockwaveAt p rad dam push col = over particles' ((:) theShockwave)
|
|
||||||
where theShockwave = shockwaveAt p rad dam push col 10
|
|
||||||
|
|
||||||
shockwaveAt :: Point2 -> Float -> Int -> Float -> Color -> Int -> Particle'
|
|
||||||
shockwaveAt p rad dam push col maxtime
|
|
||||||
= Shockwave'
|
|
||||||
{ _ptDraw = const blank
|
|
||||||
, _ptUpdate' = mvShockwave'
|
|
||||||
, _btColor' = col
|
|
||||||
, _btPos' = p
|
|
||||||
, _btRad' = rad
|
|
||||||
, _btDam' = dam
|
|
||||||
, _btPush' = push
|
|
||||||
, _btMaxTime' = maxtime
|
|
||||||
, _btTimer' = maxtime
|
|
||||||
}
|
|
||||||
|
|
||||||
mvShockwave' :: World -> Particle' -> (World, Maybe Particle')
|
|
||||||
mvShockwave' w pt
|
|
||||||
| _btTimer' pt <= 0 = (w, Nothing)
|
|
||||||
| otherwise
|
|
||||||
= (dams w , Just $ set btTimer' (t - 1) $ set ptDraw (const pic) pt)
|
|
||||||
where r = _btRad' pt
|
|
||||||
p = _btPos' pt
|
|
||||||
push = _btPush' pt
|
|
||||||
dam = _btDam' pt
|
|
||||||
t = _btTimer' pt
|
|
||||||
tFraction = fromIntegral t / fromIntegral (_btMaxTime' pt)
|
|
||||||
pic = onLayer PtLayer $ uncurry translate p
|
|
||||||
$ color (_btColor' pt) $ thickCircle rad thickness
|
|
||||||
rad = r - (3/4) * r * tFraction
|
|
||||||
thickness = tFraction**2 * r
|
|
||||||
dams = over creatures (IM.map damCr) . flip (foldr damageBlocks) hitBlocks
|
|
||||||
hitBlocks = wallsOnCirc p rad $ wallsNearPoint p w
|
|
||||||
damageBlocks wall w
|
|
||||||
= case wall ^? blHP of
|
|
||||||
Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 1))
|
|
||||||
w
|
|
||||||
(_blIDs wall)
|
|
||||||
_ -> w
|
|
||||||
damCr cr | dist (_crPos cr) p < rad + _crRad cr
|
|
||||||
= over (crState . crDamage)
|
|
||||||
((:) $ PushDam dam (25 * push *.* safeNormalizeV (_crPos cr -.- p)))
|
|
||||||
cr
|
|
||||||
| otherwise = cr
|
|
||||||
moveShockWave :: Int -> Point2 -> Float -> Float -> Float -> World -> Particle' -> (World, Maybe Particle')
|
|
||||||
moveShockWave 0 _ _ _ _ w _ = (w, Nothing)
|
|
||||||
moveShockWave t p r push pushexp w pt
|
|
||||||
= (dams w, Just $ newupdate $ newpic pt )
|
|
||||||
where newupdate = set ptUpdate' $ moveShockWave (t-1) p r push pushexp
|
|
||||||
newpic = set ptDraw (const $ onLayer PtLayer $ uncurry translate p
|
|
||||||
$ color cyan $ thickCircle rad thickness)
|
|
||||||
rad = r - (3/40) * r * fromIntegral t
|
|
||||||
thickness = (fromIntegral t)**2 * rad / 40
|
|
||||||
dams = over creatures (IM.map damCr) . flip (foldr damageBlocks) hitBlocks
|
|
||||||
hitBlocks = wallsOnCirc p rad $ wallsNearPoint p w
|
|
||||||
damageBlocks wall w
|
|
||||||
= case wall ^? blHP of
|
|
||||||
Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 1))
|
|
||||||
w
|
|
||||||
(_blIDs wall)
|
|
||||||
_ -> w
|
|
||||||
damCr cr | dist (_crPos cr) p < rad + _crRad cr
|
|
||||||
= over (crState . crDamage)
|
|
||||||
((:) $ PushDam 1 (25 *.* safeNormalizeV (_crPos cr -.- p)))
|
|
||||||
cr
|
|
||||||
| otherwise = cr
|
|
||||||
|
|
||||||
inverseShockwaveAt :: Point2 -> Float -> Int -> Float -> Float -> World -> World
|
inverseShockwaveAt :: Point2 -> Float -> Int -> Float -> Float -> World -> World
|
||||||
inverseShockwaveAt p rad dam push pushexp = over particles' ((:) theShockwave)
|
inverseShockwaveAt p rad dam push pushexp = over particles' ((:) theShockwave)
|
||||||
@@ -167,33 +83,6 @@ moveInverseShockWave t p r push pushexp w pt
|
|||||||
cr
|
cr
|
||||||
| otherwise = cr
|
| otherwise = cr
|
||||||
|
|
||||||
-- if the spark is created by another Particle', it cannot be directly added to
|
|
||||||
-- the list, hence the redirect through worldEvents
|
|
||||||
createSpark :: Int -> Int -> Point2 -> Float -> Maybe Int -> World -> World
|
|
||||||
createSpark time colid pos dir maycid w = over worldEvents
|
|
||||||
((.) $ ( over particles' ((:) spark)
|
|
||||||
-- . flareAt' white 0.02 0.05 pos')
|
|
||||||
. sparkFlashAt pos')
|
|
||||||
) w
|
|
||||||
where spark = Bul' { _ptDraw = drawBul
|
|
||||||
, _ptUpdate' = mvGenBullet'
|
|
||||||
, _btVel' = rotateV dir (5,0)
|
|
||||||
, _btColor' = numColor colid
|
|
||||||
, _btTrail' = [pos]
|
|
||||||
, _btPassThrough' = maycid
|
|
||||||
, _btWidth' = 1
|
|
||||||
, _btTimer' = time
|
|
||||||
, _btHitEffect' = destroyOnImpact sparkEff noEff noEff
|
|
||||||
}
|
|
||||||
x = fst $ randomR (0,20) $ _randGen w
|
|
||||||
pos' = pos +.+ rotateV dir (x,0)
|
|
||||||
sparkEff bt p cr = over (creatures . ix (_crID cr) . crState . crDamage)
|
|
||||||
((:) $ SparkDam 1 sp p ep)
|
|
||||||
where sp = head (_btTrail' bt)
|
|
||||||
ep = sp +.+ _btVel' bt
|
|
||||||
|
|
||||||
drawBul :: Particle' -> Picture
|
|
||||||
drawBul pt = setLayer 1 . color white $ thickLine (take 2 $ _btTrail' pt) (_btWidth' pt)
|
|
||||||
|
|
||||||
createBarrelSpark :: Int -> Int -> Point2 -> Float -> Maybe Int -> World -> World
|
createBarrelSpark :: Int -> Int -> Point2 -> Float -> Maybe Int -> World -> World
|
||||||
createBarrelSpark time colid pos dir maycid w = over worldEvents
|
createBarrelSpark time colid pos dir maycid w = over worldEvents
|
||||||
@@ -217,83 +106,9 @@ createBarrelSpark time colid pos dir maycid w = over worldEvents
|
|||||||
where sp = head (_btTrail' bt)
|
where sp = head (_btTrail' bt)
|
||||||
ep = sp +.+ _btVel' bt
|
ep = sp +.+ _btVel' bt
|
||||||
|
|
||||||
noEff _ _ _ = id
|
|
||||||
|
|
||||||
makeFlameletTimed :: Point2 -> Point2 -> Maybe Int -> Float -> Int -> World -> World
|
|
||||||
makeFlameletTimed pos vel maycid size time w
|
|
||||||
= set randGen g $ over particles' ((:) theFlamelet) w
|
|
||||||
where theFlamelet =
|
|
||||||
Pt' { _ptDraw = drawFlamelet rot
|
|
||||||
, _ptUpdate' = moveFlamelet
|
|
||||||
, _btVel' = vel
|
|
||||||
, _btColor' = red
|
|
||||||
, _btPos' = pos
|
|
||||||
, _btPassThrough' = maycid
|
|
||||||
, _btWidth' = size
|
|
||||||
, _btTimer' = time
|
|
||||||
, _btHitEffect' = destroyOnImpact (doFlameDam 1) noEff noEff
|
|
||||||
}
|
|
||||||
(rot ,g) = randomR (0,3) $ _randGen w
|
|
||||||
|
|
||||||
drawFlamelet :: Float -> Particle' -> Picture
|
|
||||||
drawFlamelet rot pt = setLayer 1 $ pictures [pic , piu , pi2 , glow]
|
|
||||||
where
|
|
||||||
sp = _btPos' pt
|
|
||||||
vel = _btVel' pt
|
|
||||||
ep = sp +.+ vel
|
|
||||||
size = _btWidth' pt
|
|
||||||
siz2 = size + 0.2
|
|
||||||
time = _btTimer' pt
|
|
||||||
glow = setDepth 0.336 $ uncurry translate ep
|
|
||||||
$ circleSolidCol (withAlpha 0 red) (withAlpha 0.05 red) 30
|
|
||||||
piu = setDepth 0.334 $ uncurry translate ep
|
|
||||||
$ color (dark red) $ rotate (0 - (rot - 0.1 * fromIntegral time))
|
|
||||||
$ scale s1 s1
|
|
||||||
$ polygon $ rectNSWE (siz2) (-siz2) (-siz2) (siz2)
|
|
||||||
pi2 = setDepth 0.332 $ uncurry translate ep
|
|
||||||
$ color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time)
|
|
||||||
orange (dark red)
|
|
||||||
)
|
|
||||||
$ rotate (0 - (rot + 0.2 * fromIntegral time))
|
|
||||||
$ scale s2 s2
|
|
||||||
$ polygon $ rectNSWE (siz2) (-siz2) (-siz2) (siz2)
|
|
||||||
pic = setDepth 0.33 $ uncurry translate ep
|
|
||||||
$ color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time)
|
|
||||||
white (dark red)
|
|
||||||
)
|
|
||||||
$ rotate (0 - ( 0.1 * fromIntegral time + rot))
|
|
||||||
$ scale sc sc
|
|
||||||
$ polygon [(-size,-size),(size,-size),(size,size),(-size,size)]
|
|
||||||
sc = (*) 2 $ log $ 1 + fromIntegral time / 20
|
|
||||||
s1 = (*) 2 $ log $ 2 + fromIntegral time / 40
|
|
||||||
s2 = 0.5 * (sc + s1)
|
|
||||||
thepicture = pictures [pic , piu , pi2 , glow]
|
|
||||||
|
|
||||||
moveFlamelet :: World -> Particle' -> (World, Maybe Particle')
|
|
||||||
moveFlamelet w pt
|
|
||||||
| _btTimer' pt <= 0 = ( w, Nothing)
|
|
||||||
| otherwise = (damcrs, mvPt)
|
|
||||||
where
|
|
||||||
sp = _btPos' pt
|
|
||||||
vel = _btVel' pt
|
|
||||||
ep = sp +.+ vel
|
|
||||||
size = _btWidth' pt
|
|
||||||
mvPt = Just $ pt & btTimer' -~ 1
|
|
||||||
& btPos' .~ ep
|
|
||||||
& btPassThrough' .~ Nothing
|
|
||||||
& btVel' .~ 0.8 *.* vel
|
|
||||||
damcrs = foldr ($) w $ map dodam $ filter closeCrs $ IM.elems $ _creatures w
|
|
||||||
closeCrs cr = dist ep (_crPos cr) < _crRad cr + size
|
|
||||||
dodam cr = over (creatures . ix (_crID cr) . crState . crDamage)
|
|
||||||
((:) $ Flaming 3 sp ep ep)
|
|
||||||
|
|
||||||
|
|
||||||
doFlameDam :: Int -> Particle' -> Point2 -> Creature -> World -> World
|
|
||||||
doFlameDam amount pt p cr = over (creatures . ix (_crID cr) . crState . crDamage)
|
|
||||||
((:) $ Flaming amount sp p ep)
|
|
||||||
where sp = _btPos' pt
|
|
||||||
ep = sp +.+ _btVel' pt
|
|
||||||
|
|
||||||
damCrsOnLine :: Int -> Point2 -> Point2 -> World -> World
|
damCrsOnLine :: Int -> Point2 -> Point2 -> World -> World
|
||||||
damCrsOnLine dam p1 p2 = over creatures (IM.map damIfOnLine)
|
damCrsOnLine dam p1 p2 = over creatures (IM.map damIfOnLine)
|
||||||
where damIfOnLine cr | circOnLine p1 p2 (_crPos cr) (_crRad cr)
|
where damIfOnLine cr | circOnLine p1 p2 (_crPos cr) (_crRad cr)
|
||||||
|
|||||||
@@ -0,0 +1,146 @@
|
|||||||
|
module Dodge.WorldEvent.Explosion
|
||||||
|
where
|
||||||
|
|
||||||
|
import Dodge.Data
|
||||||
|
import Dodge.Base
|
||||||
|
import Dodge.WorldEvent.SpawnParticle
|
||||||
|
import Dodge.WorldEvent.Flash
|
||||||
|
import Dodge.RandomHelp
|
||||||
|
import Dodge.SoundLogic
|
||||||
|
|
||||||
|
import Geometry
|
||||||
|
import Picture
|
||||||
|
|
||||||
|
import Control.Monad.State
|
||||||
|
import Data.List
|
||||||
|
import Data.Maybe
|
||||||
|
import System.Random
|
||||||
|
import qualified Data.IntMap.Strict as IM
|
||||||
|
import Control.Lens
|
||||||
|
|
||||||
|
-- The following should be improved.... I've made a first pass
|
||||||
|
makePoisonExplosionAt :: Point2 -> World -> World
|
||||||
|
makePoisonExplosionAt p w = soundOnce grenadeBang $ foldr (makeGasCloud p) w vels
|
||||||
|
where
|
||||||
|
vels = evalState (sequence ( replicate 25 (randInCirc 2) )) (_randGen w)
|
||||||
|
-- just change the number after replicate to get more or less clouds
|
||||||
|
-- suggested change: use random positions, offset from p, rather than velocities
|
||||||
|
-- so, p +.+ randomOffset
|
||||||
|
-- currently the clouds push away from each other rather hard if they are close
|
||||||
|
|
||||||
|
makeTeslaExplosionAt :: Point2 -> World -> World
|
||||||
|
makeTeslaExplosionAt pos w = soundOnce grenadeBang $ foldr ($) w listOfFunctions -- a bit shorter
|
||||||
|
where
|
||||||
|
-- rad or 360? Radians (hopefully) everywhere
|
||||||
|
xs = randomRs (0, 2*pi) $ _randGen w
|
||||||
|
p = newProjectileKey w
|
||||||
|
pks = [p..]
|
||||||
|
listOfFunctions = map
|
||||||
|
(\i -> over projectiles (IM.insert (pks!!i) (makeTeslaArcAt (pks!!i) pos (xs!!i))))
|
||||||
|
[1 .. 29]
|
||||||
|
|
||||||
|
-- slightly more work done on this one, want the flames to last for different
|
||||||
|
-- times
|
||||||
|
-- the new flames are directly added to the list of particles
|
||||||
|
makeFlameExplosionAt :: Point2 -> World -> World
|
||||||
|
makeFlameExplosionAt p w = soundOnce grenadeBang $ over particles' (newFlames ++ ) w
|
||||||
|
where
|
||||||
|
newFlames = zipWith makeFlameWithVelAndTime velocities timers
|
||||||
|
makeFlameWithVelAndTime vel time = aFlameParticle time p vel Nothing
|
||||||
|
velocities = evalState (sequence ( replicate 15 (randInCirc 1) )) (_randGen w)
|
||||||
|
timers = randomRs (80,100) $ _randGen w
|
||||||
|
-- the ( Nthing :: Maybe Int ) here is "maybe" a creature id that the
|
||||||
|
-- particle passes through for the first frame of its existence
|
||||||
|
|
||||||
|
|
||||||
|
makeExplosionAt :: Point2 -> World -> World
|
||||||
|
makeExplosionAt p w = soundOnce grenadeBang
|
||||||
|
. addFlames
|
||||||
|
. explosionFlashAt p
|
||||||
|
$ makeShockwaveAt p 50 10 1 white
|
||||||
|
w
|
||||||
|
where
|
||||||
|
fVs = fst $ runState ((sequence . take 75 . repeat . randInCirc) 1) $ _randGen w
|
||||||
|
fPs' = evalState ((sequence . take 75 . repeat . randInCirc) 15) $ _randGen w
|
||||||
|
fPs = map (pushAgainstWalls . (+.+) p . (*.*) 0.5)
|
||||||
|
fPs'
|
||||||
|
inversePushOut v = (15 - magV v) * 0.01 *.* v
|
||||||
|
fVs' = zipWith (+.+) fVs $ map inversePushOut fPs'
|
||||||
|
sizes = randomRs (2,6) $ _randGen w
|
||||||
|
times = randomRs (20,25) $ _randGen w
|
||||||
|
mF q v size time = makeFlameletTimed q v Nothing size time
|
||||||
|
newFs = zipWith4 mF fPs (fmap (3 *.*) fVs') sizes times
|
||||||
|
addFlames w = foldr ($) w newFs
|
||||||
|
pushAgainstWalls q = fromMaybe q $ fmap (\(x,y)-> x +.+ y)
|
||||||
|
$ collidePointWalls p q $ wallsNearPoint q w
|
||||||
|
|
||||||
|
makeShockwaveAt :: Point2 -> Float -> Int -> Float -> Color
|
||||||
|
-> World -> World
|
||||||
|
makeShockwaveAt p rad dam push col = over particles' ((:) theShockwave)
|
||||||
|
where theShockwave = shockwaveAt p rad dam push col 10
|
||||||
|
|
||||||
|
shockwaveAt :: Point2 -> Float -> Int -> Float -> Color -> Int -> Particle'
|
||||||
|
shockwaveAt p rad dam push col maxtime
|
||||||
|
= Shockwave'
|
||||||
|
{ _ptDraw = const blank
|
||||||
|
, _ptUpdate' = mvShockwave'
|
||||||
|
, _btColor' = col
|
||||||
|
, _btPos' = p
|
||||||
|
, _btRad' = rad
|
||||||
|
, _btDam' = dam
|
||||||
|
, _btPush' = push
|
||||||
|
, _btMaxTime' = maxtime
|
||||||
|
, _btTimer' = maxtime
|
||||||
|
}
|
||||||
|
|
||||||
|
mvShockwave' :: World -> Particle' -> (World, Maybe Particle')
|
||||||
|
mvShockwave' w pt
|
||||||
|
| _btTimer' pt <= 0 = (w, Nothing)
|
||||||
|
| otherwise
|
||||||
|
= (dams w , Just $ set btTimer' (t - 1) $ set ptDraw (const pic) pt)
|
||||||
|
where
|
||||||
|
r = _btRad' pt
|
||||||
|
p = _btPos' pt
|
||||||
|
push = _btPush' pt
|
||||||
|
dam = _btDam' pt
|
||||||
|
t = _btTimer' pt
|
||||||
|
tFraction = fromIntegral t / fromIntegral (_btMaxTime' pt)
|
||||||
|
pic = onLayer PtLayer $ uncurry translate p
|
||||||
|
$ color (_btColor' pt) $ thickCircle rad thickness
|
||||||
|
rad = r - (3/4) * r * tFraction
|
||||||
|
thickness = tFraction**2 * r
|
||||||
|
dams = over creatures (IM.map damCr) . flip (foldr damageBlocks) hitBlocks
|
||||||
|
hitBlocks = wallsOnCirc p rad $ wallsNearPoint p w
|
||||||
|
damageBlocks wall w
|
||||||
|
= case wall ^? blHP of
|
||||||
|
Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 1))
|
||||||
|
w
|
||||||
|
(_blIDs wall)
|
||||||
|
_ -> w
|
||||||
|
damCr cr | dist (_crPos cr) p < rad + _crRad cr
|
||||||
|
= over (crState . crDamage)
|
||||||
|
((:) $ PushDam dam (25 * push *.* safeNormalizeV (_crPos cr -.- p)))
|
||||||
|
cr
|
||||||
|
| otherwise = cr
|
||||||
|
moveShockWave :: Int -> Point2 -> Float -> Float -> Float -> World -> Particle' -> (World, Maybe Particle')
|
||||||
|
moveShockWave 0 _ _ _ _ w _ = (w, Nothing)
|
||||||
|
moveShockWave t p r push pushexp w pt
|
||||||
|
= (dams w, Just $ newupdate $ newpic pt )
|
||||||
|
where newupdate = set ptUpdate' $ moveShockWave (t-1) p r push pushexp
|
||||||
|
newpic = set ptDraw (const $ onLayer PtLayer $ uncurry translate p
|
||||||
|
$ color cyan $ thickCircle rad thickness)
|
||||||
|
rad = r - (3/40) * r * fromIntegral t
|
||||||
|
thickness = (fromIntegral t)**2 * rad / 40
|
||||||
|
dams = over creatures (IM.map damCr) . flip (foldr damageBlocks) hitBlocks
|
||||||
|
hitBlocks = wallsOnCirc p rad $ wallsNearPoint p w
|
||||||
|
damageBlocks wall w
|
||||||
|
= case wall ^? blHP of
|
||||||
|
Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 1))
|
||||||
|
w
|
||||||
|
(_blIDs wall)
|
||||||
|
_ -> w
|
||||||
|
damCr cr | dist (_crPos cr) p < rad + _crRad cr
|
||||||
|
= over (crState . crDamage)
|
||||||
|
((:) $ PushDam 1 (25 *.* safeNormalizeV (_crPos cr -.- p)))
|
||||||
|
cr
|
||||||
|
| otherwise = cr
|
||||||
@@ -56,3 +56,11 @@ penWalls crEff wlEff ffEff pt hitThings w = case hitThings of
|
|||||||
trl = _btTrail' pt
|
trl = _btTrail' pt
|
||||||
wth = _btWidth' pt
|
wth = _btWidth' pt
|
||||||
newP = head trl +.+ _btVel' pt
|
newP = head trl +.+ _btVel' pt
|
||||||
|
|
||||||
|
doFlameDam :: Int -> Particle' -> Point2 -> Creature -> World -> World
|
||||||
|
doFlameDam amount pt p cr = over (creatures . ix (_crID cr) . crState . crDamage)
|
||||||
|
((:) $ Flaming amount sp p ep)
|
||||||
|
where sp = _btPos' pt
|
||||||
|
ep = sp +.+ _btVel' pt
|
||||||
|
|
||||||
|
noEff _ _ _ = id
|
||||||
|
|||||||
@@ -0,0 +1,339 @@
|
|||||||
|
module Dodge.WorldEvent.SpawnParticle
|
||||||
|
where
|
||||||
|
import Dodge.Data
|
||||||
|
import Dodge.Base
|
||||||
|
import Dodge.WorldEvent.HitEffect
|
||||||
|
import Dodge.WorldEvent.ThingsHit
|
||||||
|
import Dodge.WorldEvent.Cloud
|
||||||
|
import Dodge.WorldEvent.Flash
|
||||||
|
import Dodge.WorldEvent.HelperParticle
|
||||||
|
import Dodge.WorldEvent.Bullet
|
||||||
|
import Dodge.SoundLogic
|
||||||
|
import Dodge.RandomHelp
|
||||||
|
import Dodge.Debug
|
||||||
|
|
||||||
|
import Picture
|
||||||
|
import Geometry
|
||||||
|
|
||||||
|
import Control.Lens
|
||||||
|
import qualified Data.IntMap.Strict as IM
|
||||||
|
import System.Random
|
||||||
|
import Control.Monad.State
|
||||||
|
import Data.Function (on)
|
||||||
|
import Data.List
|
||||||
|
import Data.Maybe
|
||||||
|
|
||||||
|
-- take out the flame particle from makeFlame
|
||||||
|
aFlameParticle :: Int -> Point2 -> Point2 -> Maybe Int -> Particle'
|
||||||
|
aFlameParticle t pos vel maycid = Pt'
|
||||||
|
{ _ptDraw = drawFlame vel
|
||||||
|
, _ptUpdate' = moveFlame vel
|
||||||
|
, _btVel' = vel
|
||||||
|
, _btColor' = red
|
||||||
|
, _btPos' = pos
|
||||||
|
, _btPassThrough' = maycid
|
||||||
|
, _btWidth' = 4
|
||||||
|
, _btTimer' = t
|
||||||
|
, _btHitEffect' = destroyOnImpact (doFlameDam 1) noEff noEff
|
||||||
|
}
|
||||||
|
|
||||||
|
makeFlame :: Point2 -> Point2 -> Maybe Int -> World -> World
|
||||||
|
makeFlame pos vel maycid = over particles' (aFlameParticle 100 pos vel maycid : )
|
||||||
|
|
||||||
|
drawFlame :: Point2 -> Particle' -> Picture
|
||||||
|
drawFlame rotd pt = thePic
|
||||||
|
where ep = _btPos' pt
|
||||||
|
thePic = pictures
|
||||||
|
[ glow
|
||||||
|
, aPic prot2 0.2998 (scaleChange + 1,2) red
|
||||||
|
, aPic prot 0.2996 (scaleChange + 0.5,1.5) orange
|
||||||
|
, aPic prot3 0.2994 (scaleChange,1) white
|
||||||
|
]
|
||||||
|
aPic :: (Point2 -> Point2) -> Float -> Point2 -> Color -> Picture
|
||||||
|
aPic offset depth (scalex,scaley) col
|
||||||
|
= setLayer 1
|
||||||
|
. setDepth depth
|
||||||
|
. uncurry translate (offset ep)
|
||||||
|
. rotate (pi * 0.5 + argV rotd)
|
||||||
|
. scale scalex scaley
|
||||||
|
. color col
|
||||||
|
$ circleSolid 5
|
||||||
|
glow = setLayer 1 $ setDepth 0.3 $ uncurry translate ep
|
||||||
|
$ circleSolidCol (withAlpha 0 orange) (withAlpha 0.02 orange) 50
|
||||||
|
time = _btTimer' pt
|
||||||
|
scaleChange | time < 80 = 3
|
||||||
|
| otherwise = 3 - (fromIntegral time - 80) * 0.2
|
||||||
|
prot p' = p' +.+ rotateV (fromIntegral time * 1) (0,1)
|
||||||
|
prot2 p' = p' +.+ rotateV (negate $ fromIntegral time * 1) (0,1)
|
||||||
|
prot3 p' = p' +.+ rotateV (2 + fromIntegral time * 0.1) (0,2)
|
||||||
|
|
||||||
|
moveFlame :: Point2 -> World -> Particle' -> (World, Maybe Particle')
|
||||||
|
moveFlame rotd w pt
|
||||||
|
| time <= 0 = (smokeGen w, Nothing)
|
||||||
|
| otherwise = case thingsHitExceptCr (_btPassThrough' pt) sp ep w of
|
||||||
|
((p,(E3x1 cr)):_) -> (soundAndGlare damcrs , mvPt')
|
||||||
|
(thing@(p,(E3x2 wl)):_) -> (fst $ hiteff [thing] damcrs , rfl wl p)
|
||||||
|
_ -> (soundAndGlare damcrs , mvPt)
|
||||||
|
where time = _btTimer' pt
|
||||||
|
soundAndGlare = soundFrom Flame fireSound 2 500
|
||||||
|
. over worldEvents ((.) $ flameGlareAt ep)
|
||||||
|
sp = _btPos' pt
|
||||||
|
vel = _btVel' pt
|
||||||
|
ep = sp +.+ vel
|
||||||
|
mvPt = Just $ pt {_btTimer' = time - 1, _btPos' = ep
|
||||||
|
, _btPassThrough' = Nothing
|
||||||
|
,_btVel' = 0.98 *.* vel}
|
||||||
|
mvPt' = Just $ pt {_btTimer' = time - 1, _btPos' = ep
|
||||||
|
, _btPassThrough' = Nothing
|
||||||
|
,_btVel' = 0.7 *.* vel}
|
||||||
|
damcrs = foldr ($) w $ map (\cr -> fst . hiteff [(ep,E3x1 cr)]) $ filter closeCrs
|
||||||
|
$ IM.elems $ _creatures w
|
||||||
|
closeCrs cr = dist ep (_crPos cr)
|
||||||
|
< _crRad cr + 10 - min 9 (max 0 (fromIntegral time - 80))
|
||||||
|
+ 5 * angleCoeff (angleVV (ep -.- _crPos cr) rotd)
|
||||||
|
angleCoeff x = abs $ 1 - (abs $ (x * 2 - pi) / (pi))
|
||||||
|
hiteff = _btHitEffect' pt pt
|
||||||
|
rfl wl p = Just $ pt {_btTimer' = time -1, _btPos' = pOut p
|
||||||
|
, _btVel' = reflV wl--, _ptDraw = const $ thepic $ pOut p
|
||||||
|
}
|
||||||
|
pOut p = p +.+ safeNormalizeV (sp -.- p)
|
||||||
|
reflV wall = (0.3 *.* reflectIn (_wlLine wall !! 1 -.- _wlLine wall !! 0)
|
||||||
|
vel )
|
||||||
|
+.+
|
||||||
|
(0.2 *.* vel)
|
||||||
|
smokeGen = makeFlamerSmokeAt ep
|
||||||
|
|
||||||
|
makeFlameletTimed :: Point2 -> Point2 -> Maybe Int -> Float -> Int -> World -> World
|
||||||
|
makeFlameletTimed pos vel maycid size time w
|
||||||
|
= set randGen g $ over particles' ((:) theFlamelet) w
|
||||||
|
where theFlamelet =
|
||||||
|
Pt' { _ptDraw = drawFlamelet rot
|
||||||
|
, _ptUpdate' = moveFlamelet
|
||||||
|
, _btVel' = vel
|
||||||
|
, _btColor' = red
|
||||||
|
, _btPos' = pos
|
||||||
|
, _btPassThrough' = maycid
|
||||||
|
, _btWidth' = size
|
||||||
|
, _btTimer' = time
|
||||||
|
, _btHitEffect' = destroyOnImpact (doFlameDam 1) noEff noEff
|
||||||
|
}
|
||||||
|
(rot ,g) = randomR (0,3) $ _randGen w
|
||||||
|
|
||||||
|
drawFlamelet :: Float -> Particle' -> Picture
|
||||||
|
drawFlamelet rot pt = setLayer 1 $ pictures [pic , piu , pi2 , glow]
|
||||||
|
where
|
||||||
|
sp = _btPos' pt
|
||||||
|
vel = _btVel' pt
|
||||||
|
ep = sp +.+ vel
|
||||||
|
size = _btWidth' pt
|
||||||
|
siz2 = size + 0.2
|
||||||
|
time = _btTimer' pt
|
||||||
|
glow = setDepth 0.336 $ uncurry translate ep
|
||||||
|
$ circleSolidCol (withAlpha 0 red) (withAlpha 0.05 red) 30
|
||||||
|
piu = setDepth 0.334 $ uncurry translate ep
|
||||||
|
$ color (dark red) $ rotate (0 - (rot - 0.1 * fromIntegral time))
|
||||||
|
$ scale s1 s1
|
||||||
|
$ polygon $ rectNSWE (siz2) (-siz2) (-siz2) (siz2)
|
||||||
|
pi2 = setDepth 0.332 $ uncurry translate ep
|
||||||
|
$ color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time)
|
||||||
|
orange (dark red)
|
||||||
|
)
|
||||||
|
$ rotate (0 - (rot + 0.2 * fromIntegral time))
|
||||||
|
$ scale s2 s2
|
||||||
|
$ polygon $ rectNSWE (siz2) (-siz2) (-siz2) (siz2)
|
||||||
|
pic = setDepth 0.33 $ uncurry translate ep
|
||||||
|
$ color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time)
|
||||||
|
white (dark red)
|
||||||
|
)
|
||||||
|
$ rotate (0 - ( 0.1 * fromIntegral time + rot))
|
||||||
|
$ scale sc sc
|
||||||
|
$ polygon [(-size,-size),(size,-size),(size,size),(-size,size)]
|
||||||
|
sc = (*) 2 $ log $ 1 + fromIntegral time / 20
|
||||||
|
s1 = (*) 2 $ log $ 2 + fromIntegral time / 40
|
||||||
|
s2 = 0.5 * (sc + s1)
|
||||||
|
thepicture = pictures [pic , piu , pi2 , glow]
|
||||||
|
|
||||||
|
moveFlamelet :: World -> Particle' -> (World, Maybe Particle')
|
||||||
|
moveFlamelet w pt
|
||||||
|
| _btTimer' pt <= 0 = ( w, Nothing)
|
||||||
|
| otherwise = (damcrs, mvPt)
|
||||||
|
where
|
||||||
|
sp = _btPos' pt
|
||||||
|
vel = _btVel' pt
|
||||||
|
ep = sp +.+ vel
|
||||||
|
size = _btWidth' pt
|
||||||
|
mvPt = Just $ pt & btTimer' -~ 1
|
||||||
|
& btPos' .~ ep
|
||||||
|
& btPassThrough' .~ Nothing
|
||||||
|
& btVel' .~ 0.8 *.* vel
|
||||||
|
damcrs = foldr ($) w $ map dodam $ filter closeCrs $ IM.elems $ _creatures w
|
||||||
|
closeCrs cr = dist ep (_crPos cr) < _crRad cr + size
|
||||||
|
dodam cr = over (creatures . ix (_crID cr) . crState . crDamage)
|
||||||
|
((:) $ Flaming 3 sp ep ep)
|
||||||
|
|
||||||
|
makeGasCloud :: Point2 -> Point2 -> World -> World
|
||||||
|
makeGasCloud pos vel w = over clouds (IM.insert i theCloud)
|
||||||
|
$ set randGen g w
|
||||||
|
where i = newKey $ _clouds w
|
||||||
|
theCloud = Cloud { _clID = i
|
||||||
|
, _clPos = pos
|
||||||
|
, _clVel = vel
|
||||||
|
, _clPict = \_ -> onLayer CrLayer $ color (withAlpha 0.1 col)
|
||||||
|
$ circleSolid 20
|
||||||
|
, _clRad = 20
|
||||||
|
, _clTimer = 400
|
||||||
|
, _clEffect = cloudPoisonDamage
|
||||||
|
}
|
||||||
|
(col, g) = runState (takeOne [green,yellow]) $ _randGen w
|
||||||
|
|
||||||
|
cloudPoisonDamage :: Cloud -> World -> World
|
||||||
|
cloudPoisonDamage c w = w & creatures %~ flip (foldr (IM.adjust doDam)) damagedCrs
|
||||||
|
where damagedCrs = IM.keys $ IM.filter f $ creaturesNearPoint (_clPos c) w
|
||||||
|
f cr = dist (_crPos cr) (_clPos c) < _crRad cr + _clRad c
|
||||||
|
doDam cr = cr & crState . crDamage %~ (:) (PoisonDam 1)
|
||||||
|
|
||||||
|
makeTeslaArcAt :: Int -> Point2 -> Float -> Projectile
|
||||||
|
makeTeslaArcAt i pos dir = Projectile
|
||||||
|
{ _ptPos = pos
|
||||||
|
, _ptStartPos = pos
|
||||||
|
, _ptVel = (0,0)
|
||||||
|
, _ptPict = onLayer PtLayer $ line [(0,0),(0,0)]
|
||||||
|
, _ptID = i
|
||||||
|
, _ptUpdate = moveTeslaArc pos dir i
|
||||||
|
}
|
||||||
|
|
||||||
|
moveTeslaArc :: Point2 -> Float -> Int -> World -> World
|
||||||
|
moveTeslaArc p d i w =
|
||||||
|
set (projectiles . ix i . ptPict) pic
|
||||||
|
$ set (projectiles . ix i . ptUpdate)
|
||||||
|
(ptTimer 2 i)
|
||||||
|
$ set randGen g
|
||||||
|
$ createSpark 8 nc q2 (argV sv + d1) Nothing
|
||||||
|
$ foldr damCrs w hitCrs
|
||||||
|
where pic = setLayer 1 $ pictures
|
||||||
|
[ onLayer PtLayer $ color (f2 nc) $ line ps'
|
||||||
|
, onLayer UPtLayer $ color (withAlpha 0.02 cyan) $ lineOfThickness 20 ps'
|
||||||
|
, onLayer UPtLayer $ color (withAlpha 0.02 cyan) $ lineOfThickness 25 ps'
|
||||||
|
, onLayer UPtLayer $ color (withAlpha 0.02 cyan) $ lineOfThickness 30 ps'
|
||||||
|
]
|
||||||
|
ps' = lightningMids d pers ps
|
||||||
|
ps = take 15 $ p : map f (crsLightChain p d 0 w)
|
||||||
|
f (E3x1 cr) = _crPos cr
|
||||||
|
f (E3x2 p1) = p1
|
||||||
|
f (E3x3 p1) = p1
|
||||||
|
pers = evalState (sequence $ repeat $ randInCirc 5) $ _randGen w
|
||||||
|
(nc,g) = randomR (0::Int,11) $ _randGen w
|
||||||
|
f1 (E3x1 cr) = Just $ _crID cr
|
||||||
|
f1 _ = Nothing
|
||||||
|
hitCrs = mapMaybe f1 $ take 14 $ crsLightChain p d 0 w
|
||||||
|
damCrs i = over (creatures . ix i . crHP) (\hp -> hp - 5)
|
||||||
|
f2 0 = cyan
|
||||||
|
f2 1 = azure
|
||||||
|
f2 _ = white
|
||||||
|
sID = newProjectileKey w
|
||||||
|
q1 = last $ init ps'
|
||||||
|
q2 = last ps'
|
||||||
|
hitWall = collidePointWalls q1 ((2 *.* q2) -.- q1) $ wallsNearPoint q1 w
|
||||||
|
(d1,_) = randomR (-0.7,0.7) $ _randGen w
|
||||||
|
sv = fromMaybe (q2 -.- q1) $ fmap snd hitWall
|
||||||
|
|
||||||
|
lightningMid :: Float -> Point2 -> Point2 -> Point2
|
||||||
|
lightningMid d p1 p2 = (0.25 *.* (p1 +.+ p2)) +.+ 0.5 *.* p3
|
||||||
|
where p3 = errorClosestPointOnLine 1 p1 (p1 +.+ unitVectorAtAngle d) p2
|
||||||
|
|
||||||
|
lightningMids :: Float -> [Point2] -> [Point2] -> [Point2]
|
||||||
|
lightningMids d1 (p:pers) (p1:p3:ps)
|
||||||
|
= let p2 = p +.+ lightningMid d1 p1 p3
|
||||||
|
d2 = argV $ p3 -.- p2
|
||||||
|
in p1 : p2 : lightningMids d2 pers (p3:ps)
|
||||||
|
lightningMids _ _ ps = ps
|
||||||
|
|
||||||
|
crsLightChain' :: Point2 -> Float -> World -> [Either3 Creature Point2 Point2]
|
||||||
|
crsLightChain' p d w
|
||||||
|
= case crOrWall p d w of
|
||||||
|
E3x1 cr -> E3x1 cr : crsLightChain' (_crPos cr) (argV (_crPos cr -.- p)) w
|
||||||
|
E3x2 p1 -> [E3x2 p1]
|
||||||
|
E3x3 p1 -> E3x3 p1 : crsLightChain' p1 (dChange + argV (p1 -.- p)) (set randGen g w)
|
||||||
|
-- where (dChange, g) = (0, _randGen w)
|
||||||
|
where (dChange, g) = randomR (-0.05,0.05) $ _randGen w
|
||||||
|
|
||||||
|
crsLightChain :: Point2 -> Float -> Float -> World -> [Either3 Creature Point2 Point2]
|
||||||
|
crsLightChain p d wlAttract w
|
||||||
|
= case crOrWallSensitive p d wlAttract w of
|
||||||
|
E3x1 cr -> E3x1 cr : crsLightChain (_crPos cr) (argV (_crPos cr -.- p))
|
||||||
|
(min 1 (wlAttract + 0.3)) w
|
||||||
|
E3x2 p1 -> [E3x2 p1]
|
||||||
|
E3x3 p1 -> E3x3 p1 : crsLightChain p1 (dChange + argV (p1 -.- p)) (min 1 (wlAttract + 0.3)) (set randGen g w)
|
||||||
|
-- where (dChange, g) = (0, _randGen w)
|
||||||
|
where (dChange, g) = randomR (-0.05,0.05) $ _randGen w
|
||||||
|
|
||||||
|
crOrWallSensitive :: Point2 -> Float -> Float -> World -> Either3 Creature Point2 Point2
|
||||||
|
crOrWallSensitive p dir wlAttract w = fromMaybe (E3x3 $ p +.+ rotateV dir (arcLen,0))
|
||||||
|
$ listToMaybe $ sortBy (compare `on` g)
|
||||||
|
$ catMaybes [cr,wlp]
|
||||||
|
where cr = fmap E3x1 $ nearestCrInFront p dir 100 w
|
||||||
|
wlp = fmap E3x2 $ listToMaybe
|
||||||
|
$ sortBy (compare `on` dist p)
|
||||||
|
$ mapMaybe
|
||||||
|
( fmap fst
|
||||||
|
. (\p1 -> collidePointWalls p p1 $ wallsNearPoint p w)
|
||||||
|
. (+.+) p
|
||||||
|
. (\d -> rotateV d (100,0))
|
||||||
|
. (+) dir
|
||||||
|
)
|
||||||
|
(fmap (*wlAttract) [-(3*pi/8),-pi/4,-pi/8,0,pi/8,pi/4,3*pi/8])
|
||||||
|
--[-pi/4,-pi/8,0,pi/8,pi/4]
|
||||||
|
g (E3x2 p1) = 100 + dist p p1 -- tweak makes it more likely to hit crs first
|
||||||
|
--g (E3x2 p1) = dist p p1 - 100 -- tweak makes it more likely to hit walls first
|
||||||
|
g (E3x1 cr1) = dist p $ _crPos cr1
|
||||||
|
(arcLen,_) = randomR (25,50) $ _randGen w
|
||||||
|
-- BUG: can hit crs through walls
|
||||||
|
|
||||||
|
crOrWall :: Point2 -> Float -> World -> Either3 Creature Point2 Point2
|
||||||
|
crOrWall p dir w = fromMaybe (E3x3 $ p +.+ rotateV dir (arcLen,0))
|
||||||
|
$ listToMaybe $ sortBy (compare `on` g)
|
||||||
|
$ catMaybes [cr,wlp]
|
||||||
|
where cr = fmap E3x1 $ nearestCrInFront p dir 100 w
|
||||||
|
wlp = fmap E3x2 $ listToMaybe
|
||||||
|
$ sortBy (compare `on` dist p)
|
||||||
|
$ mapMaybe
|
||||||
|
( fmap fst
|
||||||
|
. (\p1 -> collidePointWalls p p1 $ wallsNearPoint p w)
|
||||||
|
. (+.+) p
|
||||||
|
. (\d -> rotateV d (100,0))
|
||||||
|
. (+) dir
|
||||||
|
)
|
||||||
|
[-(3*pi/8),-pi/4,-pi/8,0,pi/8,pi/4,3*pi/8]
|
||||||
|
--[-pi/4,-pi/8,0,pi/8,pi/4]
|
||||||
|
g (E3x2 p1) = 100 + dist p p1 -- tweak makes it more likely to hit crs first
|
||||||
|
--g (E3x2 p1) = dist p p1 - 100 -- tweak makes it more likely to hit walls first
|
||||||
|
g (E3x1 cr1) = dist p $ _crPos cr1
|
||||||
|
(arcLen,_) = randomR (25,50) $ _randGen w
|
||||||
|
|
||||||
|
-- if the spark is created by another Particle', it cannot be directly added to
|
||||||
|
-- the list, hence the redirect through worldEvents
|
||||||
|
createSpark :: Int -> Int -> Point2 -> Float -> Maybe Int -> World -> World
|
||||||
|
createSpark time colid pos dir maycid w = over worldEvents
|
||||||
|
((.) $ ( over particles' ((:) spark)
|
||||||
|
-- . flareAt' white 0.02 0.05 pos')
|
||||||
|
. sparkFlashAt pos')
|
||||||
|
) w
|
||||||
|
where spark = Bul' { _ptDraw = drawBul
|
||||||
|
, _ptUpdate' = mvGenBullet'
|
||||||
|
, _btVel' = rotateV dir (5,0)
|
||||||
|
, _btColor' = numColor colid
|
||||||
|
, _btTrail' = [pos]
|
||||||
|
, _btPassThrough' = maycid
|
||||||
|
, _btWidth' = 1
|
||||||
|
, _btTimer' = time
|
||||||
|
, _btHitEffect' = destroyOnImpact sparkEff noEff noEff
|
||||||
|
}
|
||||||
|
x = fst $ randomR (0,20) $ _randGen w
|
||||||
|
pos' = pos +.+ rotateV dir (x,0)
|
||||||
|
sparkEff bt p cr = over (creatures . ix (_crID cr) . crState . crDamage)
|
||||||
|
((:) $ SparkDam 1 sp p ep)
|
||||||
|
where sp = head (_btTrail' bt)
|
||||||
|
ep = sp +.+ _btVel' bt
|
||||||
|
|
||||||
|
drawBul :: Particle' -> Picture
|
||||||
|
drawBul pt = setLayer 1 . color white $ thickLine (take 2 $ _btTrail' pt) (_btWidth' pt)
|
||||||
Reference in New Issue
Block a user