diff --git a/src/Dodge/Base.hs b/src/Dodge/Base.hs index b9de94f81..4c6ef9a05 100644 --- a/src/Dodge/Base.hs +++ b/src/Dodge/Base.hs @@ -484,7 +484,7 @@ newKey m = case IM.lookupMax m of Nothing -> 0 newParticleKey :: World -> Int -newParticleKey w = case IM.lookupMax (_particles w) of +newParticleKey w = case IM.lookupMax (_projectiles w) of Just (n,_) -> n+1 Nothing -> 0 newCrKey :: World -> Int diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index e0e9c1e07..b90b597ac 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -35,57 +35,53 @@ import qualified Data.DList as DL --}}} -- datatypes {{{ - - - - data World = World - { _keys :: !(S.Set Keycode) - , _mouseButtons :: !(S.Set MouseButton) - , _cameraPos :: !Point2 - , _cameraAimTime :: Int - , _cameraRot :: !Float - , _cameraZoom :: !Float - , _cameraCenter :: !Point2 - , _creatures :: IM.IntMap Creature - , _creaturesZone :: IM.IntMap (IM.IntMap (IM.IntMap Creature)) - , _itemPositions :: IM.IntMap ItemPos - , _clouds :: IM.IntMap Cloud - , _cloudsZone :: IM.IntMap (IM.IntMap (IM.IntMap Cloud)) - , _particles :: IM.IntMap Particle - , _particles' :: ![Particle'] - , _smoke :: [Smoke] - , _walls :: !(IM.IntMap Wall) - , _wallsZone :: (IM.IntMap (IM.IntMap (IM.IntMap Wall))) - , _forceFields :: IM.IntMap ForceField - , _floorItems :: IM.IntMap FloorItem - , _randGen :: StdGen - , _mousePos :: !(Float,Float) - , _testString :: String - , _yourID :: !Int - , _worldEvents :: !(World -> World) - , _pressPlates :: IM.IntMap PressPlate - , _buttons :: IM.IntMap Button - , _soundQueue :: [Int] - , _sounds :: M.Map SoundOrigin Sound - , _decorations :: IM.IntMap Drawing - , _corpses :: IM.IntMap (IM.IntMap [Corpse]) - , _lbClickMousePos :: (Float,Float) - , _lbRotation :: Float - , _pathGraph :: ~(Gr Point2 Float) - , _pathGraph' :: ~[(Point2,Point2)] - , _pathPoints :: ~(IM.IntMap (IM.IntMap [(Int,Point2)])) - , _pathInc :: ~(M.Map Point2 [Point2]) - , _storedLevel :: Maybe World - , _menuState :: MenuState - , _worldState :: M.Map WorldState Bool - , _windowX :: Float - , _windowY :: Float - , _mapDisplay :: (Bool, Float) - , _lightSources :: !(IM.IntMap LightSource) + { _keys :: !(S.Set Keycode) + , _mouseButtons :: !(S.Set MouseButton) + , _cameraPos :: !Point2 + , _cameraAimTime :: Int + , _cameraRot :: !Float + , _cameraZoom :: !Float + , _cameraCenter :: !Point2 + , _creatures :: IM.IntMap Creature + , _creaturesZone :: IM.IntMap (IM.IntMap (IM.IntMap Creature)) + , _itemPositions :: IM.IntMap ItemPos + , _clouds :: IM.IntMap Cloud + , _cloudsZone :: IM.IntMap (IM.IntMap (IM.IntMap Cloud)) + , _projectiles :: IM.IntMap Projectile + , _particles' :: ![Particle'] + , _smoke :: [Smoke] + , _walls :: !(IM.IntMap Wall) + , _wallsZone :: (IM.IntMap (IM.IntMap (IM.IntMap Wall))) + , _forceFields :: IM.IntMap ForceField + , _floorItems :: IM.IntMap FloorItem + , _randGen :: StdGen + , _mousePos :: !(Float,Float) + , _testString :: String + , _yourID :: !Int + , _worldEvents :: !(World -> World) + , _pressPlates :: IM.IntMap PressPlate + , _buttons :: IM.IntMap Button + , _soundQueue :: [Int] + , _sounds :: M.Map SoundOrigin Sound + , _decorations :: IM.IntMap Drawing + , _corpses :: IM.IntMap (IM.IntMap [Corpse]) + , _lbClickMousePos :: (Float,Float) + , _lbRotation :: Float + , _pathGraph :: ~(Gr Point2 Float) + , _pathGraph' :: ~[(Point2,Point2)] + , _pathPoints :: ~(IM.IntMap (IM.IntMap [(Int,Point2)])) + , _pathInc :: ~(M.Map Point2 [Point2]) + , _storedLevel :: Maybe World + , _menuState :: MenuState + , _worldState :: M.Map WorldState Bool + , _windowX :: Float + , _windowY :: Float + , _mapDisplay :: (Bool, Float) + , _lightSources :: !(IM.IntMap LightSource) , _tempLightSources :: ![TempLightSource] , _closeActiveObjects :: [Either FloorItem Button] - , _remap :: Keycode -> Keycode + , _remap :: Keycode -> Keycode } --deriving (Show) type Drawing = Picture @@ -435,9 +431,10 @@ data ItemIdentity deriving (Eq,Show,Ord,Enum) data Particle' = - Particle' { _ptPict' :: Drawing - , _ptUpdate' :: World -> Particle' -> (World, Maybe Particle') - } + Particle' + { _ptPict' :: Drawing + , _ptUpdate' :: World -> Particle' -> (World, Maybe Particle') + } | Bul' { _ptPict' :: Drawing , _ptUpdate' :: World -> Particle' -> (World, Maybe Particle') , _btVel' :: Point2 @@ -478,31 +475,14 @@ type HitEffect = Particle' -> [(Point2, (Either3 Creature Wall ForceField))] -> -> (World,Maybe Particle') -data Particle = - Particle { _ptPos :: Point2 +data Projectile = + Projectile { _ptPos :: Point2 , _ptStartPos :: Point2 , _ptVel :: Point2 , _ptPict :: Drawing , _ptID :: Int , _ptUpdate :: World -> World } - | Bullet { _ptPos :: Point2 - , _ptVel :: Point2 - , _ptPict :: Drawing - , _ptID :: Int - , _ptUpdate :: World -> World - , _btTrail :: [Point2] - , _btPassThrough :: Maybe Int - , _btColor :: Color - , _btWidth :: Float - } - | Bullet' - { _ptPos :: Point2 - , _ptVel :: Point2 - , _ptPict :: Drawing - , _ptID :: Int - , _ptUpdate :: World -> World - } data DamageType = Piercing {_dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 } | Blunt {_dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 } @@ -656,7 +636,7 @@ makeLenses ''ItEffect makeLenses ''ItAttachment makeLenses ''ItZoom makeLenses ''FloorItem -makeLenses ''Particle +makeLenses ''Projectile makeLenses ''Particle' makeLenses ''Wall makeLenses ''Smoke diff --git a/src/Dodge/Debug.hs b/src/Dodge/Debug.hs index 11f66d5a4..6331c4702 100644 --- a/src/Dodge/Debug.hs +++ b/src/Dodge/Debug.hs @@ -14,8 +14,8 @@ import qualified Data.IntMap.Strict as IM drawCircleAtFor :: Point2 -> Int -> World -> World drawCircleAtFor p t w = let n = newParticleKey w - in over particles ( IM.insert n - Particle { _ptPos = p + in over projectiles ( IM.insert n + Projectile { _ptPos = p , _ptStartPos = p , _ptVel = (0,0) , _ptPict = onLayer PtLayer $ uncurry translate p $ color white $ circleSolid 20 @@ -25,8 +25,8 @@ drawCircleAtFor p t w = drawCircleAtForCol :: Point2 -> Int -> Color -> World -> World drawCircleAtForCol p t col w = let n = newParticleKey w - in over particles ( IM.insert n - Particle { _ptPos = p + in over projectiles ( IM.insert n + Projectile { _ptPos = p , _ptStartPos = p , _ptVel = (0,0) , _ptPict = onLayer PtLayer $ uncurry translate p $ color col $ circleSolid 20 @@ -36,8 +36,8 @@ drawCircleAtForCol p t col w = drawLineForCol :: [Point2] -> Int -> Color -> World -> World drawLineForCol ps t col w = let n = newParticleKey w - in over particles ( IM.insert n - Particle { _ptPos = head ps + in over projectiles ( IM.insert n + Projectile { _ptPos = head ps , _ptStartPos = head ps , _ptVel = (0,0) , _ptPict = onLayer PtLayer $ color col $ lineOfThickness 5 ps @@ -46,5 +46,5 @@ drawLineForCol ps t col w = } ) w ptTimer :: Int -> Int -> World -> World -ptTimer 0 i = over particles (IM.delete i) -ptTimer time i = set (particles . ix i . ptUpdate) $ ptTimer (time - 1) i +ptTimer 0 i = over projectiles (IM.delete i) +ptTimer time i = set (projectiles . ix i . ptUpdate) $ ptTimer (time - 1) i diff --git a/src/Dodge/Initialisation.hs b/src/Dodge/Initialisation.hs index 4e63bcae8..70d20c9f0 100644 --- a/src/Dodge/Initialisation.hs +++ b/src/Dodge/Initialisation.hs @@ -29,7 +29,7 @@ initialWorld = basicWorld , _cameraRot = 0 , _cameraZoom = 1 , _creatures = IM.fromList [(0,startCr)] - , _particles = IM.empty + , _projectiles = IM.empty , _walls = IM.empty , _forceFields = IM.empty , _floorItems = IM.empty diff --git a/src/Dodge/Item/Weapon.hs b/src/Dodge/Item/Weapon.hs index b297546dc..c89985fda 100644 --- a/src/Dodge/Item/Weapon.hs +++ b/src/Dodge/Item/Weapon.hs @@ -534,7 +534,7 @@ multGun = defaultGun , _wpFire = shootWithSound (fromIntegral shotgunSound) . withRecoil 200 . withMuzFlare - $ numVelWthHitEff 5 (50,0) 4 bulletEffect' + $ numVelWthHitEff 5 (50,0) 5 bulletEffect' , _wpSpread = spreadGunSpread , _wpRange = 20 , _itFloorPict = onLayer FlItLayer $ multGunPic @@ -664,7 +664,7 @@ aTeslaArc cid w = aTeslaArc' cid aTeslaArc' :: Int -> World -> World aTeslaArc' cid w = flareAt' cyan 0.03 0.1 (pos +.+ 5 *.* unitVectorAtAngle dir) - $ over particles (IM.insert i (makeTeslaArcAt i pos dir)) + $ over projectiles (IM.insert i (makeTeslaArcAt i pos dir)) $ set randGen g w where cr = (_creatures w IM.! cid) i = newParticleKey w @@ -690,7 +690,7 @@ aTractorBeam :: Int -> Int -> World -> World aTractorBeam col cid w = set (creatures . ix cid . crInv . ix itRef . wpFire) (shoot $ aTractorBeam ((col + 1) `mod` 10)) - $ over particles (IM.insert i (tractorBeamAt col i pos dir)) w + $ over projectiles (IM.insert i (tractorBeamAt col i pos dir)) w where i = newParticleKey w cr = (_creatures w IM.! cid) pos = _crPos cr +.+ ((_crRad cr +10) *.* unitVectorAtAngle dir) @@ -700,14 +700,14 @@ aTractorBeam col cid w aRocket :: Int -> World -> World aRocket cid w = soundOnce (fromIntegral launcherSound) - $ over particles (IM.insert i (makeShellAt i cid pos dir)) w + $ over projectiles (IM.insert i (makeShellAt i cid pos dir)) w where i = newParticleKey w cr = (_creatures w IM.! cid) pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir) dir = _crDir cr -makeShellAt :: Int -> Int -> Point2 -> Float -> Particle -makeShellAt i cid pos dir = Particle +makeShellAt :: Int -> Int -> Point2 -> Float -> Projectile +makeShellAt i cid pos dir = Projectile { _ptPos = pos , _ptStartPos = pos , _ptVel = rotateV dir (1,0) @@ -719,39 +719,39 @@ makeShellAt i cid pos dir = Particle moveShell :: Int -> Int -> Int -> Float -> Point2 -> World -> World moveShell time i cid rot accel w | time > 40 = if circOnSomeWall oldPos 4 w - then shellExplosionAt oldPos $ over particles (IM.delete i) w - else over (particles . ix i . ptPos) (+.+ vel) - $ set (particles . ix i . ptPict) piclow - $ set (particles . ix i . ptUpdate) + then shellExplosionAt oldPos $ over projectiles (IM.delete i) w + else over (projectiles . ix i . ptPos) (+.+ vel) + $ set (projectiles . ix i . ptPict) piclow + $ set (projectiles . ix i . ptUpdate) (moveShell (time-1) i cid rot (rotateV rot accel)) w | time == 35 = case thingHit of Just p -> shellExplosionAt oldPos - $ over particles (IM.delete i) w - Nothing -> over (particles . ix i . ptPos) (+.+ vel) - $ set (particles . ix i . ptPict) pic - $ set (particles . ix i . ptUpdate) + $ over projectiles (IM.delete i) w + Nothing -> over (projectiles . ix i . ptPos) (+.+ vel) + $ set (projectiles . ix i . ptPict) pic + $ set (projectiles . ix i . ptUpdate) (moveShell (time-1) i cid spin accel) w | time >= 20 = case thingHit of Just p -> shellExplosionAt oldPos - $ over particles (IM.delete i) w - Nothing -> over (particles . ix i . ptPos) (+.+ vel) - $ set (particles . ix i . ptPict) pic - $ set (particles . ix i . ptUpdate) + $ over projectiles (IM.delete i) w + Nothing -> over (projectiles . ix i . ptPos) (+.+ vel) + $ set (projectiles . ix i . ptPict) pic + $ set (projectiles . ix i . ptUpdate) (moveShell (time-1) i cid rot (rotateV rot accel)) w | time > -99 = case thingHit of Just p -> shellExplosionAt oldPos $ stopSoundFrom (ShellSound i) - $ over particles (IM.delete i) w - Nothing -> over (particles . ix i . ptPos) (+.+ vel) + $ over projectiles (IM.delete i) w + Nothing -> over (projectiles . ix i . ptPos) (+.+ vel) $ set randGen g - $ set (particles . ix i . ptPict) pic - $ set (particles . ix i . ptUpdate) + $ set (projectiles . ix i . ptPict) pic + $ set (projectiles . ix i . ptUpdate) (moveShell (time-1) i cid rot (rotateV rot accel)) - $ over (particles . ix i . ptVel) (\v -> accel +.+ frict *.* v) + $ over (projectiles . ix i . ptVel) (\v -> accel +.+ frict *.* v) $ soundFrom (ShellSound i) (fromIntegral smokeTrailSound) (1) 250 $ makeFlameletTimed oldPos (0.5 *.* rotateV (pi+sparkD) accel) (levLayer UPtLayer) Nothing 3 20 @@ -762,16 +762,16 @@ moveShell time i cid rot accel w | time > -200 = case thingHit of Just p -> shellExplosionAt oldPos $ stopSoundFrom (ShellSound i) - $ over particles (IM.delete i) w - Nothing -> over (particles . ix i . ptPos) (+.+ vel) - $ set (particles . ix i . ptPict) pic - $ set (particles . ix i . ptUpdate) + $ over projectiles (IM.delete i) w + Nothing -> over (projectiles . ix i . ptPos) (+.+ vel) + $ set (projectiles . ix i . ptPict) pic + $ set (projectiles . ix i . ptUpdate) (moveShell (time-1) i cid rot (rotateV rot accel)) w | otherwise = shellExplosionAt oldPos $ stopSoundFrom (ShellSound i) - $ over particles (IM.delete i) w - where pt = _particles w IM.! i + $ over projectiles (IM.delete i) w + where pt = _projectiles w IM.! i oldPos = _ptPos pt vel = _ptVel pt newPos = oldPos +.+ vel @@ -813,8 +813,8 @@ remoteShellPic i | rem (i+200) 20 < 9 = polygon [(-6,4),(-6,-4),(6,-4),(8,0),(6, shellExplosionAt = makeExplosionAt -tractorBeamAt :: Int -> Int -> Point2 -> Float -> Particle -tractorBeamAt colID i pos dir = Particle +tractorBeamAt :: Int -> Int -> Point2 -> Float -> Projectile +tractorBeamAt colID i pos dir = Projectile { _ptPos = pos , _ptStartPos = p' , _ptVel = d @@ -1003,8 +1003,8 @@ reflect :: Float -> Float -> Float reflect a b = a + 2*(a-b) moveGrenade :: Int -> Float -> Int -> World -> World -moveGrenade 0 dir pID w = over particles (IM.delete pID) - $ makeExplosionAt (_ptPos (_particles w IM.! pID)) +moveGrenade 0 dir pID w = over projectiles (IM.delete pID) + $ makeExplosionAt (_ptPos (_projectiles w IM.! pID)) -- $ set (pointToItem (_itemPositions w IM.! wpID) . itEquipPict) -- (drawWeapon $ grenadePic 50) w @@ -1013,17 +1013,17 @@ moveGrenade time dir pID w Just _ -> soundOnce (fromIntegral tapQuiet) updatedWorld _ -> updatedWorld where - updatedWorld = updateV $ set (particles . ix pID . ptPos) finalPos - $ set (particles.ix pID.ptPict) + updatedWorld = updateV $ set (projectiles . ix pID . ptPos) finalPos + $ set (projectiles .ix pID.ptPict) (onLayer PtLayer $ uncurry translate newPos $ rotate dir $ grenadePic time) - $ set (particles.ix pID.ptUpdate) (moveGrenade (time-1) dir pID) w - pt = _particles w IM.! pID + $ set (projectiles .ix pID.ptUpdate) (moveGrenade (time-1) dir pID) w + pt = _projectiles w IM.! pID oldPos = _ptPos pt newPos = _ptVel pt +.+ oldPos hitWl = collideCircWalls' oldPos newPos 4 $ wallsNearPoint newPos w finalPos = fromMaybe newPos (fmap fst hitWl) - setV v = set (particles.ix pID.ptVel) v + setV v = set (projectiles .ix pID.ptVel) v updateV = fromMaybe id (fmap (setV.snd) hitWl) pointToItem (InInv cid invid) = creatures . ix cid . crInv . ix invid @@ -1035,15 +1035,15 @@ retireRemoteRocket itid 0 ptid w (0,0) $ set (pointToItem (_itemPositions w IM.! itid) . wpFire) fireRemoteLauncher - (w & particles %~ IM.delete ptid) -retireRemoteRocket itid t ptid w = setScope w & particles . ix ptid . ptUpdate .~ retireRemoteRocket itid (t-1) ptid + (w & projectiles %~ IM.delete ptid) +retireRemoteRocket itid t ptid w = setScope w & projectiles . ix ptid . ptUpdate .~ retireRemoteRocket itid (t-1) ptid where setScope w' = case _itemPositions w' IM.! itid of InInv cid invid -> w' & creatures . ix cid . crInv . ix invid . itAttachment . _Just . scopePos .~ (pos -.- _crPos (_creatures w' IM.! cid)) _ -> w' - pos = fromMaybe (0,0) $ w ^? particles . ix ptid . ptPos + pos = fromMaybe (0,0) $ w ^? projectiles . ix ptid . ptPos retireRemoteBomb :: Int -> Int -> Int -> World -> World retireRemoteBomb itid 0 ptid w @@ -1053,22 +1053,22 @@ retireRemoteBomb itid 0 ptid w basicItZoom $ set (pointToItem (_itemPositions w IM.! itid) . twFire) throwRemoteBomb - (w & particles %~ IM.delete ptid) + (w & projectiles %~ IM.delete ptid) retireRemoteBomb itid t ptid w - = setScope w & particles . ix ptid . ptUpdate .~ retireRemoteBomb itid (t-1) ptid + = setScope w & projectiles . ix ptid . ptUpdate .~ retireRemoteBomb itid (t-1) ptid where setScope w' = case _itemPositions w' IM.! itid of InInv cid invid -> w' & creatures . ix cid . crInv . ix invid . itAttachment . _Just . scopePos .~ (pos -.- _crPos (_creatures w' IM.! cid)) _ -> w' - pos = fromMaybe (0,0) $ w ^? particles . ix ptid . ptPos + pos = fromMaybe (0,0) $ w ^? projectiles . ix ptid . ptPos moveRemoteBomb :: Int -> Int -> Int -> World -> World moveRemoteBomb itid time pID w | time < -4 = setScope $ updatePicture - $ set (particles.ix pID.ptUpdate) (moveRemoteBomb itid (f time) pID) + $ set (projectiles .ix pID.ptUpdate) (moveRemoteBomb itid (f time) pID) w | time < 2 = case hitWl of @@ -1080,9 +1080,9 @@ moveRemoteBomb itid time pID w _ -> updatedWorld where updatedWorld - = updateV $ set (particles . ix pID . ptPos) finalPos + = updateV $ set (projectiles . ix pID . ptPos) finalPos $ updatePicture - $ set (particles.ix pID.ptUpdate) (moveRemoteBomb itid (time-1) pID) + $ set (projectiles .ix pID.ptUpdate) (moveRemoteBomb itid (time-1) pID) $ setScope w setScope w' = case _itemPositions w' IM.! itid of @@ -1092,7 +1092,7 @@ moveRemoteBomb itid time pID w & creatures . ix cid . crInv . ix invid . itZoom .~ (basicItZoom {_itAimZoomMax = 0.5, _itAimZoomMin = 0.5}) _ -> w' - pt = _particles w IM.! pID + pt = _projectiles w IM.! pID oldPos = _ptPos pt newPos = _ptVel pt +.+ oldPos -- this is hacky, should use a version of collidePointWalls' that collides @@ -1100,12 +1100,12 @@ moveRemoteBomb itid time pID w invShift x = x -.- 5 *.* normalizeV (_ptVel pt) hitWl = collideCircWalls' oldPos newPos 4 $ wallsNearPoint newPos w finalPos = fromMaybe newPos (fmap (invShift . fst) hitWl) - setV v = set (particles.ix pID.ptVel) v + setV v = set (projectiles .ix pID.ptVel) v updateV = fromMaybe id (fmap (setV.snd) hitWl) - halfV = over (particles . ix pID . ptVel) (\v -> 0.5 *.* v) + halfV = over (projectiles . ix pID . ptVel) (\v -> 0.5 *.* v) f x | x < -369 = -10 | otherwise = x - 1 - updatePicture = set (particles . ix pID.ptPict) + updatePicture = set (projectiles . ix pID.ptPict) (onLayer PtLayer $ uncurry translate newPos $ remoteBombPic time) . lowLightDirected red 0.1 newPos @@ -1196,9 +1196,9 @@ withThickSmoke eff cid w = eff cid $ foldr ($) w smokeGen makeThinSmokeAt :: Color -> Point2 -> Float -> Int -> Point2 -> World -> World -makeThinSmokeAt col vel scal time p w = over particles (IM.insert n smP) w +makeThinSmokeAt col vel scal time p w = over projectiles (IM.insert n smP) w where n = newParticleKey w - smP = Particle + smP = Projectile { _ptPos = p , _ptStartPos = p , _ptVel = vel @@ -1210,22 +1210,22 @@ makeThinSmokeAt col vel scal time p w = over particles (IM.insert n smP) w moveThinSmoke :: Color -> Float -> Int -> Int -> World -> World moveThinSmoke col scal time i w | time > 0 - = set (particles . ix i . ptPict) pic - . set (particles . ix i . ptUpdate) (moveThinSmoke col scal (time-1) i) - . set (particles . ix i . ptPos) newPos + = set (projectiles . ix i . ptPict) pic + . set (projectiles . ix i . ptUpdate) (moveThinSmoke col scal (time-1) i) + . set (projectiles . ix i . ptPos) newPos . setVel $ w | time > -10 - = set (particles . ix i . ptPict) pi1 - . set (particles . ix i . ptUpdate) (moveThinSmoke col scal (time-1) i) - . set (particles . ix i . ptPos) newPos + = set (projectiles . ix i . ptPict) pi1 + . set (projectiles . ix i . ptUpdate) (moveThinSmoke col scal (time-1) i) + . set (projectiles . ix i . ptPos) newPos . setVel $ w | otherwise - = over particles (IM.delete i) w - where oldPos = _ptPos $ _particles w IM.! i - newPos = oldPos +.+ (_ptVel $ _particles w IM.! i) - setVel = over (particles . ix i . ptVel) $ (*.*) 0.99 + = over projectiles (IM.delete i) w + where oldPos = _ptPos $ _projectiles w IM.! i + newPos = oldPos +.+ (_ptVel $ _projectiles w IM.! i) + setVel = over (projectiles . ix i . ptVel) $ (*.*) 0.99 pic = onLayer PtLayer $ uncurry translate newPos $ color (withAlpha 0.1 col) $ circleSolid scal pi1 = onLayer PtLayer $ uncurry translate newPos $ color (withAlpha (0.1 + fromIntegral time /100) col) @@ -1389,9 +1389,9 @@ remoteBomb = defaultThrowable throwGrenade :: Int -> Int -> World -> World -throwGrenade fuseTime n w = setWp $ removePict $ over particles addG $ set randGen g w +throwGrenade fuseTime n w = setWp $ removePict $ over projectiles addG $ set randGen g w where addG = IM.insert i - $ Particle { _ptPos = p + $ Projectile { _ptPos = p , _ptStartPos = p , _ptVel = v , _ptPict = onLayer PtLayer $ uncurry translate p $ grenadePic 0 @@ -1441,13 +1441,13 @@ grenadePic x = pictures [ color (dark $ dark green) $ circleSolid 5 fireRemoteLauncher :: Int -> World -> World fireRemoteLauncher cid w = setLocation $ resetFire $ resetName $ soundOnce (fromIntegral launcherSound) - $ over particles remRocket w + $ over projectiles remRocket w where - i = newKey $ _particles w + i = newKey $ _projectiles w cr = _creatures w IM.! cid dir = _crDir cr pos = _crPos cr +.+ rotateV dir (_crRad cr + 1,0) - remRocket = IM.insert i $ Particle { _ptPos = pos + remRocket = IM.insert i $ Projectile { _ptPos = pos , _ptStartPos = pos , _ptVel = rotateV dir (1,0) , _ptPict = blank @@ -1470,17 +1470,17 @@ moveRemoteShell :: Int -> Int -> Int -> Int -> Float -> World -> World moveRemoteShell time i cid itid dir w | time > 40 = if circOnSomeWall oldPos 4 w then doExplosion w - else over (particles . ix i . ptPos) (+.+ vel) - $ set (particles . ix i . ptPict) piclow - $ set (particles . ix i . ptUpdate) + else over (projectiles . ix i . ptPos) (+.+ vel) + $ set (projectiles . ix i . ptPict) piclow + $ set (projectiles . ix i . ptUpdate) (moveRemoteShell (time-1) i cid itid newdir) $ setScope w | time >= 20 = case thingHit of Just p -> doExplosion w - Nothing -> over (particles . ix i . ptPos) (+.+ vel) - $ set (particles . ix i . ptPict) pic - $ set (particles . ix i . ptUpdate) + Nothing -> over (projectiles . ix i . ptPos) (+.+ vel) + $ set (projectiles . ix i . ptPict) pic + $ set (projectiles . ix i . ptUpdate) (moveRemoteShell (time-1) i cid itid newdir) $ setScope w @@ -1489,12 +1489,12 @@ moveRemoteShell time i cid itid dir w Just p -> doExplosion $ stopSoundFrom (ShellSound i) w - Nothing -> over (particles . ix i . ptPos) (+.+ vel) + Nothing -> over (projectiles . ix i . ptPos) (+.+ vel) $ set randGen g - $ set (particles . ix i . ptPict) pic - $ set (particles . ix i . ptUpdate) + $ set (projectiles . ix i . ptPict) pic + $ set (projectiles . ix i . ptUpdate) (moveRemoteShell (time-1) i cid itid newdir) - $ over (particles . ix i . ptVel) (\v -> accel +.+ frict *.* v) + $ over (projectiles . ix i . ptVel) (\v -> accel +.+ frict *.* v) $ soundFrom (ShellSound i) (fromIntegral smokeTrailSound) (1) 250 $ smokeGen $ makeFlameletTimed oldPos @@ -1507,16 +1507,16 @@ moveRemoteShell time i cid itid dir w Just p -> doExplosion $ stopSoundFrom (ShellSound i) w - Nothing -> over (particles . ix i . ptPos) (+.+ vel) - $ set (particles . ix i . ptPict) pic - $ set (particles . ix i . ptUpdate) + Nothing -> over (projectiles . ix i . ptPos) (+.+ vel) + $ set (projectiles . ix i . ptPict) pic + $ set (projectiles . ix i . ptUpdate) (moveRemoteShell (time-1) i cid itid newdir) $ setScope w | otherwise = doExplosion $ stopSoundFrom (ShellSound i) w - where pt = _particles w IM.! i + where pt = _projectiles w IM.! i oldPos = _ptPos pt vel = _ptVel pt newPos = oldPos +.+ vel @@ -1557,23 +1557,23 @@ moveRemoteShell time i cid itid dir w explodeRemoteRocket :: Int -> Int -> Int -> World -> World explodeRemoteRocket itid ptid n w - = set (particles . ix ptid . ptUpdate) (retireRemoteRocket itid 30 ptid) - $ set (particles . ix ptid . ptPict) blank + = set (projectiles . ix ptid . ptUpdate) (retireRemoteRocket itid 30 ptid) + $ set (projectiles . ix ptid . ptPict) blank $ set (itPoint . wpFire) (flip const) $ resetName -- $ resetScope - $ makeExplosionAt (_ptPos (_particles w IM.! ptid)) w - -- $ makeShrapnelBombAt (_ptPos (_particles w IM.! ptid)) w + $ makeExplosionAt (_ptPos (_projectiles w IM.! ptid)) w + -- $ makeShrapnelBombAt (_ptPos (_projectiles w IM.! ptid)) w where resetName = set (itPoint . itName) "REMOTELAUNCHER" -- resetScope = creatures . ix n . crInv . ix j . itScope . _Just . scopePos .~ (0,0) itPoint = pointToItem $ _itemPositions w IM.! itid throwRemoteBomb :: Int -> World -> World throwRemoteBomb n w = setLocation $ removePict $ resetFire - -- $ resetName $ over particles addG $ set randGen g w - $ resetName $ over particles addG w + -- $ resetName $ over projectiles addG $ set randGen g w + $ resetName $ over projectiles addG w where addG = IM.insert i - $ Particle { _ptPos = p + $ Projectile { _ptPos = p , _ptStartPos = p , _ptVel = v , _ptPict = blank @@ -1608,14 +1608,14 @@ throwRemoteBomb n w = setLocation $ removePict $ resetFire explodeRemoteBomb :: Int -> Int -> Int -> World -> World explodeRemoteBomb itid ptid n w - = set (particles . ix ptid . ptUpdate) (retireRemoteBomb itid 30 ptid) - $ set (particles . ix ptid . ptPict) blank + = set (projectiles . ix ptid . ptUpdate) (retireRemoteBomb itid 30 ptid) + $ set (projectiles . ix ptid . ptPict) blank $ set (creatures . ix n . crInv . ix j . twFire) (flip const) $ resetName $ resetPict -- $ resetScope - $ makeExplosionAt (_ptPos (_particles w IM.! ptid)) w - -- $ makeShrapnelBombAt (_ptPos (_particles w IM.! ptid)) w + $ makeExplosionAt (_ptPos (_projectiles w IM.! ptid)) w + -- $ makeShrapnelBombAt (_ptPos (_projectiles w IM.! ptid)) w where resetName = set (creatures . ix n . crInv . ix j . itName) "REMOTEBOMB" resetPict = set (creatures . ix n . crInv . ix j . itEquipPict ) (drawWeapon $ remoteBombUnarmedPic) @@ -1635,8 +1635,8 @@ remoteBombUnarmedPic :: Picture remoteBombUnarmedPic = color (dark $ dark orange) $ circleSolid 5 -makeTeslaArcAt :: Int -> Point2 -> Float -> Particle -makeTeslaArcAt i pos dir = Particle +makeTeslaArcAt :: Int -> Point2 -> Float -> Projectile +makeTeslaArcAt i pos dir = Projectile { _ptPos = pos , _ptStartPos = pos , _ptVel = (0,0) @@ -1647,8 +1647,8 @@ makeTeslaArcAt i pos dir = Particle moveTeslaArc :: Point2 -> Float -> Int -> World -> World moveTeslaArc p d i w = - set (particles . ix i . ptPict) pic - $ set (particles . ix i . ptUpdate) + 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 @@ -1854,7 +1854,7 @@ forceFieldFire cid w = w -- (_wpFireRate (_crInv cr IM.! itRef)) -- $ over (creatures . ix n . crInv . ix itRef . wpLoadedAmmo) -- (\x -> x - 1) --- $ over particles (IM.insert i $ makeTremorAt i pos dir) w +-- $ over projectiles (IM.insert i $ makeTremorAt i pos dir) w -- | reloadCondition = let remAmmo = _crAmmo cr M.! _wpAmmoType item -- (newA,newTotalA) = moveInt (_wpMaxAmmo item) remAmmo -- in set (pointerToItem . wpReloadState) rTime @@ -1888,12 +1888,12 @@ moveInt toReload totalAmmo = (x, totalAmmo-x) updateTractor :: Int -> Int -> Int -> World -> World updateTractor colID time i w - | time > 0 = set (particles . ix i . ptUpdate) (updateTractor colID (time-1) i) - $ set (particles . ix i . ptPict) pic + | time > 0 = set (projectiles . ix i . ptUpdate) (updateTractor colID (time-1) i) + $ set (projectiles . ix i . ptPict) pic $ over creatures (IM.map tractCr) $ over floorItems (IM.map tractFlIt) w - | otherwise = over particles (IM.delete i) w + | otherwise = over projectiles (IM.delete i) w where tractCr cr | circOnLine p1 p2 cP 10 = over crPos (\p -> p -.- m *.* ((0.3/ x) *.* q +.+ (f y *.* p4)) @@ -1914,7 +1914,7 @@ updateTractor colID time i w iP = _flItPos it m | dist iP p1 < 350 = 1 | otherwise = (410 - dist iP p1) / 60 - pt = _particles w IM.! i + pt = _projectiles w IM.! i q = _ptVel pt p1 = _ptPos pt p' = _ptStartPos pt diff --git a/src/Dodge/Item/Weapon/Bullet.hs b/src/Dodge/Item/Weapon/Bullet.hs index 09eed9c81..49f3bb217 100644 --- a/src/Dodge/Item/Weapon/Bullet.hs +++ b/src/Dodge/Item/Weapon/Bullet.hs @@ -132,7 +132,7 @@ bulHitWall' bt p x w = damageBlocks x pOut = p +.+ safeNormalizeV (sp -.- p) (colID,g) = randomR (0,11) $ _randGen w (a, _) = randomR (-0.1,0.1) $ _randGen w - spid = newKey $ _particles w + spid = newKey $ _projectiles w reflectDir wall = a + (argV $ reflectIn (_wlLine wall !! 1 -.- _wlLine wall !! 0) (p -.- sp) @@ -160,7 +160,7 @@ bulBounceWall' bt p wl w = damageBlocks wl reflectVel = (reflectIn wallV (_btVel' bt)) addBouncer = (.) (over particles' ((:) bouncer)) -- the hack is to get around the fact that the particles' list gets reset after --- all particles in it are checked, so we cannot add to it as we accumulate over +-- all projectiles in it are checked, so we cannot add to it as we accumulate over -- this list bulIncWall' :: Particle' -> Point2 -> Wall -> World -> World @@ -181,7 +181,6 @@ bulIncWall' bt p wl w = damageBlocks wl bulConWall' :: Particle' -> Point2 -> Wall -> World -> World bulConWall' bt p wl w = damageBlocks wl $ mkwave - -- yay for hack -- should have used this before? or never? w where sp = head $ _btTrail' bt pOut = p +.+ safeNormalizeV (sp -.- p) @@ -199,7 +198,7 @@ hvBulHitWall' bt p x w = damageBlocks x where sp = head $ _btTrail' bt pOut = p +.+ safeNormalizeV (sp -.- p) (a, g) = randomR (-0.1,0.1) $ _randGen w - spid = newKey $ _particles w + spid = newKey $ _projectiles w reflectDir wall = a + (argV $ reflectIn (_wlLine wall !! 1 -.- _wlLine wall !! 0) (p -.- sp) diff --git a/src/Dodge/Prototypes.hs b/src/Dodge/Prototypes.hs index 0c1276ea7..df8050b11 100644 --- a/src/Dodge/Prototypes.hs +++ b/src/Dodge/Prototypes.hs @@ -159,7 +159,7 @@ basicButton = Button , _btText = "Button" , _btState = BtOff } -basicPT = Particle +basicPT = Projectile { _ptPos = (0,0) , _ptStartPos = (0,0) , _ptVel = (0,0) @@ -190,7 +190,7 @@ basicWorld = World , _clouds = IM.empty , _cloudsZone = IM.empty , _itemPositions = IM.empty - , _particles = IM.empty + , _projectiles = IM.empty , _particles' = [] , _walls = IM.empty , _wallsZone = IM.empty diff --git a/src/Dodge/Rendering.hs b/src/Dodge/Rendering.hs index 7cf2cc800..6cfa87e8e 100644 --- a/src/Dodge/Rendering.hs +++ b/src/Dodge/Rendering.hs @@ -37,7 +37,7 @@ fixedCoordPictures w = pictures worldPictures :: World -> Picture worldPictures w = pictures $ concat [ IM.elems $ _decorations w - , map _ptPict . IM.elems $ _particles w + , map _ptPict . IM.elems $ _projectiles w , map drawItem . IM.elems $ _floorItems w , map crDraw . IM.elems $ _creatures w , map clDraw . IM.elems $ _clouds w diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index df1e96558..e0145a3cd 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -69,7 +69,7 @@ updateSoundQueue = set soundQueue [] updateLightSources w = set tempLightSources (catMaybes tlss) w' where (w',tlss) = mapAccumR (\a b -> _tlsUpdate b a b) w $ _tempLightSources w -updateParticles w = IM.foldr' _ptUpdate w $ _particles w +updateParticles w = IM.foldr' _ptUpdate w $ _projectiles w updateSmoke :: World -> World updateSmoke w = w & smoke %~ mapMaybe (\s -> _smUpdate s s) @@ -113,7 +113,7 @@ setTestStringIO = fmap (\ w -> set testString (show $ s w) w) -- fmap (set testString $ show $ last $ show $ pairsToIncidence' $ _pathGraph' w') w -- update logic: creature old position set, creatures perform actions including movement, --- creatures collided with each other, camera updated, particles updated, creatures +-- creatures collided with each other, camera updated, projectiles updated, creatures -- collided with walls diff --git a/src/Dodge/WorldEvent.hs b/src/Dodge/WorldEvent.hs index 8e0b2cf6f..1a46ff0eb 100644 --- a/src/Dodge/WorldEvent.hs +++ b/src/Dodge/WorldEvent.hs @@ -4,9 +4,11 @@ module Dodge.WorldEvent , module Dodge.WorldEvent.Flash , module Dodge.WorldEvent.ThingsHit , module Dodge.WorldEvent.HelperParticle + , module Dodge.WorldEvent.Projectile ) where +import Dodge.WorldEvent.Projectile import Dodge.WorldEvent.Bullet import Dodge.WorldEvent.Flash import Dodge.WorldEvent.ThingsHit @@ -25,7 +27,6 @@ import Control.Monad.State import System.Random -import Data.Bifunctor import Data.Maybe import Data.Function import Data.List @@ -35,10 +36,10 @@ makeExplosionAt :: Point2 -> World -> World makeExplosionAt p w = soundOnce grenadeBang $ over tempLightSources ((:) $ tLightFade 20 150 intensityF p) $ fs - $ over particles (IM.insert n exp) + $ over projectiles (IM.insert n exp) w where n = newParticleKey w - exp = Particle + exp = Projectile { _ptPos = p , _ptStartPos = p , _ptVel = (0,0) @@ -66,11 +67,11 @@ makeExplosionAt p w = soundOnce grenadeBang | otherwise = 1 explosionWaveDamage :: Int -> Point2 -> Int -> World -> World -explosionWaveDamage 0 p ptid = over particles (IM.delete ptid) +explosionWaveDamage 0 p ptid = over projectiles (IM.delete ptid) explosionWaveDamage time p ptid - = set (particles . ix ptid . ptUpdate) (explosionWaveDamage (time-1) p ptid) + = set (projectiles . ix ptid . ptUpdate) (explosionWaveDamage (time-1) p ptid) . shockWaveDamage p rad 20 - . set (particles . ix ptid . ptPict) shockwavePic + . set (projectiles . ix ptid . ptPict) shockwavePic . explosionFlashAt p where shockwavePic = onLayer PtLayer $ uncurry translate p $ color (withAlpha 0.9 white) $ thickCircle rad (thickness*2) @@ -244,48 +245,7 @@ createBarrelSpark time colid pos dir maycid w = over worldEvents noEff _ _ _ = id -type HitCreatureEffect = Particle' -> Point2 -> Creature -> World -> World -type HitWallEffect = Particle' -> Point2 -> Wall -> World -> World -type HitForceFieldEffect = Particle' -> Point2 -> ForceField -> World -> World -destroyOnImpact :: HitCreatureEffect -> HitWallEffect -> HitForceFieldEffect -> - Particle' -> [(Point2, Either3 Creature Wall ForceField)] -> World -> (World, Maybe Particle') -destroyOnImpact crEff wlEff ffEff pt hitThings w = case hitThings of - [] -> ( w, mvPt) - ((p,E3x1 cr):_) -> (crEff pt p cr w, destroyAt p) - ((p,E3x2 wl):_) -> (wlEff pt p wl w, destroyAt p) - ((p,E3x3 ff):_) -> (ffEff pt p ff w, destroyAt p) - where destroyAt hitp = Just $ pt & btTrail' .~ (hitp : trl) - & ptPict' .~ bulLine col wth (hitp: trl) - & btTimer' .~ 3 - mvPt = Just $ pt & btTrail' .~ (newP : trl) - & ptPict' .~ bulLine col wth (newP : trl) - & btTimer' %~ (\t -> t - 1) - & btPassThrough' .~ Nothing - trl = _btTrail' pt - col = _btColor' pt - wth = _btWidth' pt - newP = head trl +.+ _btVel' pt -penWalls :: HitCreatureEffect -> HitWallEffect -> HitForceFieldEffect -> - Particle' -> [(Point2, Either3 Creature Wall ForceField)] -> World -> (World, Maybe Particle') -penWalls crEff wlEff ffEff pt hitThings w = case hitThings of - [] -> ( w, mvPt) - ((p,E3x1 cr):_) -> (crEff pt p cr w, destroyAt p) - ((p,E3x3 ff):_) -> (ffEff pt p ff w, destroyAt p) - ((p,E3x2 wl):hs) | isJust (wl ^? blHP) - -> first (wlEff pt p wl) $ penWalls crEff wlEff ffEff pt hs w - ((p,E3x2 wl):_) | otherwise -> (wlEff pt p wl w, destroyAt p) - where destroyAt hitp = Just $ pt & btTrail' .~ (hitp : trl) - & ptPict' .~ bulLine col wth (hitp: trl) - & btTimer' .~ 3 - mvPt = Just $ pt & btTrail' .~ (newP : trl) - & ptPict' .~ bulLine col wth (newP : trl) - & btTimer' %~ (\t -> t - 1) - & btPassThrough' .~ Nothing - trl = _btTrail' pt - col = _btColor' pt - wth = _btWidth' pt - newP = head trl +.+ _btVel' pt makeFlameletTimed :: Point2 -> Point2 -> Int -> Maybe Int -> Float -> Int -> World -> World makeFlameletTimed pos vel levelInt maycid size time w @@ -404,9 +364,9 @@ moveSmoke'' scal time p vel w pt ] makeColorSmokeAt :: Color -> Point2 -> Float -> Int -> Point2 -> World -> World -makeColorSmokeAt col vel scal time p w = over particles (IM.insert n smP) w +makeColorSmokeAt col vel scal time p w = over projectiles (IM.insert n smP) w where n = newParticleKey w - smP = Particle + smP = Projectile { _ptPos = p , _ptStartPos = p , _ptVel = vel @@ -418,22 +378,22 @@ makeColorSmokeAt col vel scal time p w = over particles (IM.insert n smP) w moveColorSmoke :: Color -> Float -> Int -> Int -> World -> World moveColorSmoke col scal time i w | time > 0 - = set (particles . ix i . ptPict) pic - . set (particles . ix i . ptUpdate) (moveColorSmoke col scal (time-1) i) - . set (particles . ix i . ptPos) newPos + = set (projectiles . ix i . ptPict) pic + . set (projectiles . ix i . ptUpdate) (moveColorSmoke col scal (time-1) i) + . set (projectiles . ix i . ptPos) newPos . setVel $ w | time > -50 - = set (particles . ix i . ptPict) pi1 - . set (particles . ix i . ptUpdate) (moveColorSmoke col scal (time-1) i) - . set (particles . ix i . ptPos) newPos + = set (projectiles . ix i . ptPict) pi1 + . set (projectiles . ix i . ptUpdate) (moveColorSmoke col scal (time-1) i) + . set (projectiles . ix i . ptPos) newPos . setVel $ w | otherwise - = over particles (IM.delete i) w - where oldPos = _ptPos $ _particles w IM.! i - newPos = oldPos +.+ (_ptVel $ _particles w IM.! i) - setVel = over (particles . ix i . ptVel) $ (*.*) 0.99 + = over projectiles (IM.delete i) w + where oldPos = _ptPos $ _projectiles w IM.! i + newPos = oldPos +.+ (_ptVel $ _projectiles w IM.! i) + setVel = over (projectiles . ix i . ptVel) $ (*.*) 0.99 pic = onLayer PtLayer $ uncurry translate newPos $ color col $ circleSolid $ (21 - fromIntegral time) * scal pi1 = onLayer PtLayer $ uncurry translate newPos $ color (withAlpha (1 + fromIntegral time /50) col) diff --git a/src/Dodge/WorldEvent/Projectile.hs b/src/Dodge/WorldEvent/Projectile.hs new file mode 100644 index 000000000..7fe0a9030 --- /dev/null +++ b/src/Dodge/WorldEvent/Projectile.hs @@ -0,0 +1,55 @@ +module Dodge.WorldEvent.Projectile + where +import Dodge.Data +import Control.Lens + +import Data.Bifunctor +import Data.Maybe + +import Picture + +import Geometry + +type HitCreatureEffect = Particle' -> Point2 -> Creature -> World -> World +type HitWallEffect = Particle' -> Point2 -> Wall -> World -> World +type HitForceFieldEffect = Particle' -> Point2 -> ForceField -> World -> World + +destroyOnImpact :: HitCreatureEffect -> HitWallEffect -> HitForceFieldEffect -> + Particle' -> [(Point2, Either3 Creature Wall ForceField)] -> World -> (World, Maybe Particle') +destroyOnImpact crEff wlEff ffEff pt hitThings w = case hitThings of + [] -> ( w, mvPt) + ((p,E3x1 cr):_) -> (crEff pt p cr w, destroyAt p) + ((p,E3x2 wl):_) -> (wlEff pt p wl w, destroyAt p) + ((p,E3x3 ff):_) -> (ffEff pt p ff w, destroyAt p) + where destroyAt hitp = Just $ pt & btTrail' .~ (hitp : trl) + & ptPict' .~ drawBul wth (hitp: trl) + & btTimer' .~ 3 + mvPt = Just $ pt & btTrail' .~ (newP : trl) + & ptPict' .~ drawBul wth (newP : trl) + & btTimer' %~ (\t -> t - 1) + & btPassThrough' .~ Nothing + trl = _btTrail' pt + wth = _btWidth' pt + newP = head trl +.+ _btVel' pt +penWalls :: HitCreatureEffect -> HitWallEffect -> HitForceFieldEffect -> + Particle' -> [(Point2, Either3 Creature Wall ForceField)] -> World -> (World, Maybe Particle') +penWalls crEff wlEff ffEff pt hitThings w = case hitThings of + [] -> ( w, mvPt) + ((p,E3x1 cr):_) -> (crEff pt p cr w, destroyAt p) + ((p,E3x3 ff):_) -> (ffEff pt p ff w, destroyAt p) + ((p,E3x2 wl):hs) | isJust (wl ^? blHP) + -> first (wlEff pt p wl) $ penWalls crEff wlEff ffEff pt hs w + ((p,E3x2 wl):_) | otherwise -> (wlEff pt p wl w, destroyAt p) + where destroyAt hitp = Just $ pt & btTrail' .~ (hitp : trl) + & ptPict' .~ drawBul wth (hitp: trl) + & btTimer' .~ 3 + mvPt = Just $ pt & btTrail' .~ (newP : trl) + & ptPict' .~ drawBul wth (newP : trl) + & btTimer' %~ (\t -> t - 1) + & btPassThrough' .~ Nothing + trl = _btTrail' pt + wth = _btWidth' pt + newP = head trl +.+ _btVel' pt +drawBul :: Float -> [Point2] -> Picture +drawBul width (a:b:_) = setLayer 1 . color white $ thickLine [a,b] width +drawBul _ _ = blank