From 3cce959d001f1c97e4efae5f7b6ef01dd15421e0 Mon Sep 17 00:00:00 2001 From: jgk Date: Wed, 24 Mar 2021 13:42:31 +0100 Subject: [PATCH] Replace particle pictures with draw functions --- src/Dodge/Data.hs | 8 ++-- src/Dodge/Item/Weapon.hs | 60 +++++++++++++++++++++++------- src/Dodge/Item/Weapon/Bullet.hs | 4 +- src/Dodge/Rendering.hs | 2 +- src/Dodge/WorldEvent.hs | 23 +++++++----- src/Dodge/WorldEvent/Bullet.hs | 40 -------------------- src/Dodge/WorldEvent/Flash.hs | 6 +-- src/Dodge/WorldEvent/Projectile.hs | 7 ---- 8 files changed, 70 insertions(+), 80 deletions(-) diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index fa59e5374..c9b9df4af 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -429,10 +429,10 @@ data ItemIdentity data Particle' = Particle' - { _ptPict' :: Picture + { _ptDraw :: Particle' -> Picture , _ptUpdate' :: World -> Particle' -> (World, Maybe Particle') } - | Bul' { _ptPict' :: Picture + | Bul' { _ptDraw :: Particle' -> Picture , _ptUpdate' :: World -> Particle' -> (World, Maybe Particle') , _btVel' :: Point2 , _btColor' :: Color @@ -442,7 +442,7 @@ data Particle' = , _btTimer' :: Int , _btHitEffect' :: HitEffect } - | Pt' { _ptPict' :: Picture + | Pt' { _ptDraw :: Particle' -> Picture , _ptUpdate' :: World -> Particle' -> (World, Maybe Particle') , _btVel' :: Point2 , _btColor' :: Color @@ -453,7 +453,7 @@ data Particle' = , _btHitEffect' :: HitEffect } | Shockwave' - { _ptPict' :: Picture + { _ptDraw :: Particle' -> Picture , _ptUpdate' :: World -> Particle' -> (World, Maybe Particle') , _btColor' :: Color , _btPos' :: Point2 diff --git a/src/Dodge/Item/Weapon.hs b/src/Dodge/Item/Weapon.hs index 03230ae64..de78461d2 100644 --- a/src/Dodge/Item/Weapon.hs +++ b/src/Dodge/Item/Weapon.hs @@ -878,7 +878,7 @@ aFlame a cid w makeFlame :: Point2 -> Point2 -> Maybe Int -> World -> World makeFlame pos vel maycid = over particles' ((:) theFlame) where theFlame = - Pt' { _ptPict' = blank + Pt' { _ptDraw = drawFlame , _ptUpdate' = moveFlame vel , _btVel' = vel , _btColor' = red @@ -889,6 +889,40 @@ makeFlame pos vel maycid = over particles' ((:) theFlame) , _btHitEffect' = destroyOnImpact (doFlameDam 1) noEff noEff } +drawFlame :: Particle' -> Picture +drawFlame pt = thePic ep + where ep = _btPos' pt + rotd = _btVel' pt + thePic p' = pictures $ reverse [ pic p' , piu p' , pi2 p' , glow p' ] + pic p' = setLayer 1 . setDepth 0.2994 $ uncurry translate (prot3 p') + $ rotate (pi * 0.5 + argV rotd) + $ scale scaleChange 1 + $ pictures $ reverse [color white $ circleSolid 4 + ,color (withAlpha 0.5 white) $ circleSolid 5 + ] + piu p' = setLayer 1 . setDepth 0.2998 $ uncurry translate (prot2 p') + $ rotate (pi*0.5 + argV rotd) + $ scale (scaleChange + 1) 2 + $ pictures $ reverse [color red $ circleSolid 4.5 + ,color (withAlpha 0.5 red) $ circleSolid 5 + ] + pi2 p' = setLayer 1 + . setDepth 0.2996 + . uncurry translate (prot p') + $ rotate (pi * 0.5 + argV rotd) + $ scale (scaleChange + 0.5) 1.5 + $ pictures $ reverse [color orange $ circleSolid 4.5 + ,color (withAlpha 0.5 orange) $ circleSolid 5 + ] + glow p' = setLayer 1 $ setDepth 0.3 $ uncurry translate p' + $ 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) @@ -902,10 +936,10 @@ moveFlame rotd w pt sp = _btPos' pt vel = _btVel' pt ep = sp +.+ vel - mvPt = Just $ pt {_btTimer' = time - 1, _btPos' = ep, _ptPict' = thepic ep + mvPt = Just $ pt {_btTimer' = time - 1, _btPos' = ep--, _ptDraw = const $ thepic ep , _btPassThrough' = Nothing ,_btVel' = 0.98 *.* vel} - mvPt' = Just $ pt {_btTimer' = time - 1, _btPos' = ep, _ptPict' = thepic ep + mvPt' = Just $ pt {_btTimer' = time - 1, _btPos' = ep--, _ptDraw = const $ thepic ep , _btPassThrough' = Nothing ,_btVel' = 0.7 *.* vel} damcrs = foldr ($) w $ map (\cr -> fst . hiteff [(ep,E3x1 cr)]) $ filter closeCrs @@ -940,7 +974,7 @@ moveFlame rotd w pt ,color (withAlpha 0.5 red) $ circleSolid 5 ] rfl wl p = Just $ pt {_btTimer' = time -1, _btPos' = pOut p - , _btVel' = reflV wl, _ptPict' = thepic $ pOut p + , _btVel' = reflV wl--, _ptDraw = const $ thepic $ pOut p } glow p' = setLayer 1 $ setDepth 0.3 $ uncurry translate p' $ circleSolidCol (withAlpha 0 orange) (withAlpha 0.02 orange) 50 @@ -1133,7 +1167,7 @@ rateIncAB startRate fastRate shooteff1 shooteff2 cid w makeLaserAt :: Float -> Point2 -> Float -> Maybe Int -> Particle' makeLaserAt phaseV pos dir mcid = Particle' - { _ptPict' = blank + { _ptDraw = const blank , _ptUpdate' = moveLaser phaseV pos dir mcid } @@ -1142,7 +1176,7 @@ moveLaser phaseV pos dir mcid w pt = ( set randGen g -- $ over worldEvents ((.) flares) $ hitEffect w - , Just pt {_ptPict' = onLayer PtLayer $ pic + , Just pt {_ptDraw = const $ onLayer PtLayer $ pic ,_ptUpdate' = ptTimer' 0 } ) @@ -1900,7 +1934,7 @@ aRadarPulse cid w = over particles' ((:) $ radarPulseAt (_crPos (_creatures w IM blipAt :: Point2 -> Color -> Int -> Particle' blipAt p col i = Particle' - {_ptPict' = blank + {_ptDraw = const blank ,_ptUpdate' = mvBlip p col i i } @@ -1908,7 +1942,7 @@ mvBlip :: Point2 -> Color -> Int -> Int -> World -> Particle' -> (World, Maybe P mvBlip p col maxt 0 w pt = (w, Nothing) mvBlip p col maxt t w pt = (w, Just $ pt & ptUpdate' .~ mvBlip p col maxt (t-1) - & ptPict' .~ (onLayerL [levLayer ShadowLayer, 2] + & ptDraw .~ (const $ onLayerL [levLayer ShadowLayer, 2] $ uncurry translate p $ color (withAlpha (fromIntegral t / fromIntegral maxt) col) $ circleSolid 2) @@ -1916,13 +1950,13 @@ mvBlip p col maxt t w pt sonarPulseAt :: Point2 -> Particle' sonarPulseAt p = Particle' - { _ptPict' = blank + { _ptDraw = const blank , _ptUpdate' = mvSonar 100 p } mvSonar :: Int -> Point2 -> World -> Particle' -> (World, Maybe Particle') mvSonar 0 _ w _ = (w, Nothing) -mvSonar x p w pt = (w, Just $ pt {_ptPict' = pic +mvSonar x p w pt = (w, Just $ pt {_ptDraw = const pic ,_ptUpdate' = mvSonar (x-1) p } ) @@ -1949,13 +1983,13 @@ mvSonar x p w pt = (w, Just $ pt {_ptPict' = pic radarPulseAt :: Point2 -> Particle' radarPulseAt p = Particle' - { _ptPict' = blank + { _ptDraw = const blank , _ptUpdate' = mvRadar 50 p } mvRadar :: Int -> Point2 -> World -> Particle' -> (World, Maybe Particle') mvRadar 0 _ w _ = (w, Nothing) -mvRadar x p w pt = (putBlips w, Just $ pt {_ptPict' = pic +mvRadar x p w pt = (putBlips w, Just $ pt {_ptDraw = const pic ,_ptUpdate' = mvRadar (x-1) p } ) @@ -2057,7 +2091,7 @@ itemLaserScopeEffect makeLaserScope :: Point2 -> Point2 -> Float -> Float -> Particle' makeLaserScope p ep d relFrac = Particle' - {_ptPict' = onLayer PtLayer $ pictures + {_ptDraw = const $ onLayer PtLayer $ pictures [color (withAlpha 0.5 $ mixColors relFrac (1-relFrac) red green) $ lineOfThickness 0.5 [p,ep] ,color (withAlpha 0.2 $ mixColors relFrac (1-relFrac) red green) diff --git a/src/Dodge/Item/Weapon/Bullet.hs b/src/Dodge/Item/Weapon/Bullet.hs index 38367dfeb..d50e42400 100644 --- a/src/Dodge/Item/Weapon/Bullet.hs +++ b/src/Dodge/Item/Weapon/Bullet.hs @@ -223,7 +223,7 @@ bulletParticleSideEffect pt = destroyOnImpact mkPt mkPt noEff aGenBulAt' :: Maybe Int -> Color -> Point2 -> Point2 -> HitEffect -> Float -> Particle' aGenBulAt' maycid col pos vel hiteff width = Bul' - { _ptPict' = blank + { _ptDraw = drawBul , _ptUpdate' = mvGenBullet' , _btVel' = vel , _btColor' = col @@ -236,7 +236,7 @@ aGenBulAt' maycid col pos vel hiteff width = Bul' aCurveBulAt :: Maybe Int -> Color -> Point2 -> Point2 -> Point2 -> HitEffect -> Float -> Particle' aCurveBulAt maycid col pos control targ hiteff width = Bul' - { _ptPict' = blank + { _ptDraw = drawBul , _ptUpdate' = mvBulletTrajectory f , _btVel' = (0,0) , _btColor' = col diff --git a/src/Dodge/Rendering.hs b/src/Dodge/Rendering.hs index ef884787e..a66494835 100644 --- a/src/Dodge/Rendering.hs +++ b/src/Dodge/Rendering.hs @@ -42,7 +42,7 @@ worldPictures w , map crDraw . IM.elems $ _creatures w , map clDraw . IM.elems $ _clouds w , map btDraw (IM.elems (_buttons w)) - , map _ptPict' $ _particles' w + , map (\pt -> _ptDraw pt pt) $ _particles' w , map drawWallFloor (wallFloorsToDraw w) -- , map (drawWallFace w) (wallShadowsToDraw w) , testPic w diff --git a/src/Dodge/WorldEvent.hs b/src/Dodge/WorldEvent.hs index cc07fae55..777ae5da9 100644 --- a/src/Dodge/WorldEvent.hs +++ b/src/Dodge/WorldEvent.hs @@ -75,7 +75,7 @@ makeShockwaveAt p rad dam push col = over particles' ((:) theShockwave) shockwaveAt :: Point2 -> Float -> Int -> Float -> Color -> Int -> Particle' shockwaveAt p rad dam push col maxtime = Shockwave' - { _ptPict' = blank + { _ptDraw = const blank , _ptUpdate' = mvShockwave' , _btColor' = col , _btPos' = p @@ -90,7 +90,7 @@ mvShockwave' :: World -> Particle' -> (World, Maybe Particle') mvShockwave' w pt | _btTimer' pt <= 0 = (w, Nothing) | otherwise - = (dams w , Just $ set btTimer' (t - 1) $ set ptPict' pic pt) + = (dams w , Just $ set btTimer' (t - 1) $ set ptDraw (const pic) pt) where r = _btRad' pt p = _btPos' pt push = _btPush' pt @@ -119,7 +119,7 @@ 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 ptPict' (onLayer PtLayer $ uncurry translate p + 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 @@ -141,7 +141,7 @@ inverseShockwaveAt :: Point2 -> Float -> Int -> Float -> Float -> World -> World inverseShockwaveAt p rad dam push pushexp = over particles' ((:) theShockwave) where theShockwave = Particle' - { _ptPict' = blank + { _ptDraw = const blank , _ptUpdate' = moveInverseShockWave 10 p rad push pushexp } moveInverseShockWave :: Int -> Point2 -> Float -> Float -> Float -> World -> Particle' -> (World, Maybe Particle') @@ -149,7 +149,7 @@ moveInverseShockWave 0 _ _ _ _ w _ = (w, Nothing) moveInverseShockWave t p r push pushexp w pt = (dams w, Just $ newupdate $ newpic pt ) where newupdate = set ptUpdate' $ moveInverseShockWave (t-1) p r push pushexp - newpic = set ptPict' (onLayer PtLayer $ uncurry translate p + newpic = set ptDraw (const $ onLayer PtLayer $ uncurry translate p $ color cyan $ thickCircle rad thickness) rad = r - (4/40) * r * fromIntegral (10 - t) thickness = (fromIntegral (10 - t))**2 * rad / 40 @@ -175,7 +175,7 @@ createSpark time colid pos dir maycid w = over worldEvents -- . flareAt' white 0.02 0.05 pos') . sparkFlashAt pos') ) w - where spark = Bul' { _ptPict' = blank + where spark = Bul' { _ptDraw = drawBul , _ptUpdate' = mvGenBullet' , _btVel' = rotateV dir (5,0) , _btColor' = numColor colid @@ -192,12 +192,15 @@ createSpark time colid pos dir maycid w = over worldEvents 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 time colid pos dir maycid w = over worldEvents ((.) $ ( over particles' ((:) spark) . sparkFlashAt pos') ) w - where spark = Bul' { _ptPict' = blank + where spark = Bul' { _ptDraw = drawBul , _ptUpdate' = mvGenBullet' , _btVel' = rotateV dir (5,0) , _btColor' = numColor colid @@ -221,7 +224,7 @@ makeFlameletTimed pos vel levelInt maycid size time w = set randGen g $ over particles' ((:) theFlamelet) w -- $ flareAt' white 0.01 0.1 pos w where theFlamelet = - Pt' { _ptPict' = blank + Pt' { _ptDraw = const blank , _ptUpdate' = moveFlamelet levelInt rot , _btVel' = vel , _btColor' = red @@ -236,7 +239,7 @@ makeFlameletTimed pos vel levelInt maycid size time w makeFlamelet :: Point2 -> Point2 -> Int -> Maybe Int -> Float -> World -> World makeFlamelet pos vel levelInt maycid size w = set randGen g $ over particles' ((:) theFlamelet) w where theFlamelet = - Pt' { _ptPict' = blank + Pt' { _ptDraw = const blank , _ptUpdate' = moveFlamelet levelInt rot , _btVel' = vel , _btColor' = red @@ -257,7 +260,7 @@ moveFlamelet levelInt rot w pt = ep = sp +.+ vel size = _btWidth' pt siz2 = size + 0.2 - mvPt = Just $ pt {_btTimer' = time - 1, _btPos' = ep, _ptPict' = thepicture + mvPt = Just $ pt {_btTimer' = time - 1, _btPos' = ep, _ptDraw = const thepicture , _btPassThrough' = Nothing ,_btVel' = 0.8 *.* vel} damcrs = foldr ($) w $ map dodam $ filter closeCrs $ IM.elems $ _creatures w diff --git a/src/Dodge/WorldEvent/Bullet.hs b/src/Dodge/WorldEvent/Bullet.hs index e46f0029a..fe334d814 100644 --- a/src/Dodge/WorldEvent/Bullet.hs +++ b/src/Dodge/WorldEvent/Bullet.hs @@ -21,21 +21,18 @@ mvBulletTrajectory velF w bt | t <= 0 = (w, Nothing) | t < 4 = (w, Just $ set btPassThrough' Nothing $ set btTrail' (replicate numPs p ++ (p:ps) ) - $ set ptPict' (bulLineLen numPs col wth (replicate numPs p ++ (p:ps) ) ) $ set btTimer' (t-1) bt ) | otherwise = (w, Just $ set btPassThrough' Nothing $ set btVel' newVel -- this may be useful for hit effects $ set btTrail' (init (reverse newPs) ++ (p:ps)) - $ set ptPict' (bulLineLen numPs col wth (init (reverse newPs) ++ (p:ps))) $ set btTimer' (t-1) bt ) -- | otherwise = case firstThingHit $ thingsHitExceptCrCurve mcr (p:newPs) w of -- (_,Nothing) -> (w, Just $ set btPassThrough' Nothing -- $ set btVel' newVel -- this may be useful for hit effects -- $ set btTrail' (init (reverse newPs) ++ (p:ps)) --- $ set ptPict' (bulLineLen numPs col wth (init (reverse newPs) ++ (p:ps))) -- $ set btTimer' (t-1) bt -- ) -- (mvPs,Just (hitp,thing)) @@ -46,7 +43,6 @@ mvBulletTrajectory velF w bt -- , Just $ set btPassThrough' Nothing -- $ set btVel' hitVel -- this may be useful for hit effects -- $ set btTrail' (newMvPs ++ (p:ps)) --- $ set ptPict' (bulLineLen numPs col wth (newMvPs ++ (p:ps)) ) -- $ set btTimer' 3 bt -- ) where mcr = _btPassThrough' bt @@ -85,7 +81,6 @@ mvGenBullet' w bt | t <= 0 = (w, Nothing) | t < 4 = (w, Just $ set btPassThrough' Nothing $ set btTrail' (p:p:ps) - $ set ptPict' (bulLine col wth (p:p:ps)) $ set btTimer' (t-1) bt ) | otherwise = hiteff bt (thingsHitExceptCr mcr p (p +.+ vel) w) w @@ -97,38 +92,3 @@ mvGenBullet' w bt wth = _btWidth' bt t = _btTimer' bt -bulLineLen :: Int -> Color -> Float -> [Point2] -> Picture -bulLineLen n c w ps = - setLayer 1 . onLayer HPtLayer $ color c $ thickLine (take (n * 2) ps) w - -bulLine c w = setLayer 1 . bulLineb w - -bulLineb :: Float -> [Point2] -> Picture -bulLineb w ps = color white $ thickLine (take 2 ps) w - -bulLinea :: Color -> Float -> [Point2] -> Picture -bulLinea _ _ [] = blank -bulLinea _ _ (x:[]) = blank -bulLinea col width (a:b:[]) -- (a:b:[]) - = onLayer HPtLayer $ pictures $ reverse - [polygonCol $ zip (wedgeGeom width b a) $ [white,withAlpha 0 white,withAlpha 0 white] - ,polygonCol $ zip (lineGeom (width+1.5) a b) $ [col,col,withAlpha 0 col,withAlpha 0 col] - ] -bulLinea col width (a:b:c:[]) -- (a:b:[]) - = onLayer HPtLayer $ pictures $ reverse - [polygonCol $ zip (wedgeGeom width b a) $ repeat white - ,polygonCol $ zip (wedgeGeom width b c) $ [white,white,withAlpha 0 white] - ,polygonCol $ zip (lineGeom (width+1.5) a c) $ [col,col,withAlpha 0 col,withAlpha 0 col] - ] -bulLinea col width (a:b:_:c:[]) -- (a:b:[]) - = onLayer HPtLayer $ pictures $ reverse - [polygonCol $ zip (wedgeGeom width b a) $ repeat white - ,polygonCol $ zip (wedgeGeom width b c) $ [white,white,withAlpha 0 white] - ,polygonCol $ zip (lineGeom (width+1.5) a c) $ [col,col,withAlpha 0 col,withAlpha 0 col] - ] -bulLinea col width (a:b:_:_:c:_) -- (a:b:[]) - = onLayer HPtLayer $ pictures $ reverse - [polygonCol $ zip (wedgeGeom width b a) $ repeat white - ,polygonCol $ zip (wedgeGeom width b c) $ [white,white,withAlpha 0 white] - ,polygonCol $ zip (lineGeom (width+1.5) a c) $ [col,col,withAlpha 0 col,withAlpha 0 col] - ] diff --git a/src/Dodge/WorldEvent/Flash.hs b/src/Dodge/WorldEvent/Flash.hs index 18e856654..8f9c4dc32 100644 --- a/src/Dodge/WorldEvent/Flash.hs +++ b/src/Dodge/WorldEvent/Flash.hs @@ -55,7 +55,7 @@ glareLine t len wdth col alphay a b w = w & particles' %~ (maybeToList linePt ++ glareBetween :: Int -> Float -> Float -> Color -> Float -> Point2 -> Point2 -> World -> Maybe Particle' glareBetween 0 _ _ _ _ _ _ _ = Nothing glareBetween t len wdth col alphay a b w - = Just $ Particle' {_ptPict' = lowLightPic len wdth col alphay a b w + = Just $ Particle' {_ptDraw = const $ lowLightPic len wdth col alphay a b w ,_ptUpdate' = \ w' _ -> (w',glareBetween (t-1) len wdth col alphay a b w') } @@ -76,7 +76,7 @@ lowLightPic len wdth col alphay a b w flashFlareAt :: Color -> Float -> Point2 -> Particle' flashFlareAt col alphax (x,y) = Particle' - { _ptPict' = setLayer 2 . setDepth (-0.9) . translate x y + { _ptDraw = const $ setLayer 2 . setDepth (-0.9) . translate x y $ circleSolidCol (withAlpha 0 col) (withAlpha alphax col) 30 , _ptUpdate' = ptTimer' 1 } @@ -102,7 +102,7 @@ muzzleFlashAt p = over particles' ((:) (muzzleFlashPt p)) muzzleFlashPt :: Point2 -> Particle' muzzleFlashPt (x,y) = Particle' - { _ptPict' = setDepth 0 + { _ptDraw = const $ setDepth 0 . setLayer 2 . translate x y $ circleSolidCol (withAlpha 0 white) (withAlpha 0.2 white) 20 diff --git a/src/Dodge/WorldEvent/Projectile.hs b/src/Dodge/WorldEvent/Projectile.hs index 7fe0a9030..0143ddc4a 100644 --- a/src/Dodge/WorldEvent/Projectile.hs +++ b/src/Dodge/WorldEvent/Projectile.hs @@ -22,10 +22,8 @@ destroyOnImpact crEff wlEff ffEff pt hitThings w = case hitThings of ((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 @@ -41,15 +39,10 @@ penWalls crEff wlEff ffEff pt hitThings w = case hitThings of -> 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