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

Replace particle pictures with draw functions

Browse Source
This commit is contained in:
justin
2021-03-24 13:42:31 +01:00
parent 27fc9d19d2
commit 3cce959d00
8 changed files with 70 additions and 80 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/WorldEvent.hs
+13 -10
View File
@@ -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