Linting
This commit is contained in:
@@ -42,30 +42,32 @@ makeFlame t pos vel maycid = over particles' (aFlameParticle t 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)
|
||||
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) (0,1)
|
||||
prot2 p' = p' +.+ rotateV (negate $ fromIntegral time) (0,1)
|
||||
prot3 p' = p' +.+ rotateV (2 + fromIntegral time * 0.1) (0,2)
|
||||
|
||||
moveFlame :: Point2 -> World -> Particle' -> (World, Maybe Particle')
|
||||
moveFlame rotd w pt
|
||||
@@ -74,34 +76,35 @@ moveFlame rotd w pt
|
||||
((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
|
||||
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
|
||||
@@ -311,30 +314,30 @@ crOrWall p dir w = fromMaybe (E3x3 $ p +.+ rotateV dir (arcLen,0))
|
||||
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
|
||||
-- | Create a spark.
|
||||
-- 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
|
||||
createSpark time colid pos dir maycid w
|
||||
= over worldEvents ((.) ( over particles' (spark :) . 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)
|
||||
|
||||
@@ -10,26 +10,26 @@ import Data.List
|
||||
import Data.Maybe
|
||||
import Data.Function (on)
|
||||
|
||||
thingsHit :: Point2 -> Point2 -> World -> [(Point2, (Either3 Creature Wall ForceField))]
|
||||
thingsHit :: Point2 -> Point2 -> World -> [(Point2, Either3 Creature Wall ForceField)]
|
||||
thingsHit sp ep w
|
||||
| sp == ep = []
|
||||
| otherwise = sortBy (compare `on` dist sp . fst) (crs ++ walls ++ ffs)
|
||||
where
|
||||
hitCrs = IM.elems $ IM.filter (\cr -> circOnSeg sp ep (_crPos cr) (_crRad cr))
|
||||
$ _creatures w
|
||||
-- $ creaturesAlongLine sp ep w
|
||||
crPs = map (\cr -> ssaTriPoint ep (_crPos cr) sp (_crRad cr)) hitCrs
|
||||
crs = zip crPs (map E3x1 hitCrs)
|
||||
| sp == ep = []
|
||||
| otherwise = sortBy (compare `on` dist sp . fst) (crs ++ walls ++ ffs)
|
||||
where
|
||||
hitCrs = IM.elems $ IM.filter (\cr -> circOnSeg sp ep (_crPos cr) (_crRad cr))
|
||||
$ _creatures w
|
||||
-- $ creaturesAlongLine sp ep w
|
||||
crPs = map (\cr -> ssaTriPoint ep (_crPos cr) sp (_crRad cr)) hitCrs
|
||||
crs = zip crPs (map E3x1 hitCrs)
|
||||
|
||||
hitWls = wallsOnLine sp ep (IM.unions [f b $ f a $ _wallsZone w | a<-[x-1,x,x+1]
|
||||
, b<-[y-1,y,y+1]])
|
||||
(x,y) = zoneOfPoint (0.5 *.* (sp +.+ ep))
|
||||
f i m = case IM.lookup i m of Just val -> val
|
||||
_ -> IM.empty
|
||||
walls = zip (map (fromJust . hitPoint) hitWls) (map E3x2 hitWls)
|
||||
hitPoint w = intersectSegSeg' sp ep (_wlLine w !! 0) (_wlLine w !! 1)
|
||||
hitFFs = mapMaybe (collidePointFF sp ep (_randGen w)) (IM.elems $ _forceFields w)
|
||||
ffs = map (\(p,(_,i)) -> (p, E3x3 $ _forceFields w IM.! i)) hitFFs
|
||||
hitWls = wallsOnLine sp ep (IM.unions [f b $ f a $ _wallsZone w | a<-[x-1,x,x+1]
|
||||
, b<-[y-1,y,y+1]])
|
||||
(x,y) = zoneOfPoint (0.5 *.* (sp +.+ ep))
|
||||
f i m = case IM.lookup i m of Just val -> val
|
||||
_ -> IM.empty
|
||||
walls = zip (map (fromJust . hitPoint) hitWls) (map E3x2 hitWls)
|
||||
hitPoint w = intersectSegSeg' sp ep (_wlLine w !! 0) (_wlLine w !! 1)
|
||||
hitFFs = mapMaybe (collidePointFF sp ep (_randGen w)) (IM.elems $ _forceFields w)
|
||||
ffs = map (\(p,(_,i)) -> (p, E3x3 $ _forceFields w IM.! i)) hitFFs
|
||||
|
||||
|
||||
thingsHitExceptCr :: Maybe Int -> Point2 -> Point2 -> World
|
||||
@@ -37,34 +37,34 @@ thingsHitExceptCr :: Maybe Int -> Point2 -> Point2 -> World
|
||||
thingsHitExceptCr Nothing sp ep = thingsHit sp ep
|
||||
thingsHitExceptCr (Just cid) sp ep = filter crNotCid . thingsHit sp ep
|
||||
where
|
||||
crNotCid (_,(E3x1 cr)) = _crID cr /= cid
|
||||
crNotCid (_,E3x1 cr) = _crID cr /= cid
|
||||
crNotCid _ = True
|
||||
|
||||
thingsHitExceptCrLongLine :: Maybe Int -> Point2 -> Point2 -> World
|
||||
-> [(Point2, (Either3 Creature Wall ForceField))]
|
||||
-> [(Point2, Either3 Creature Wall ForceField)]
|
||||
thingsHitExceptCrLongLine Nothing sp ep = thingsHitLongLine sp ep
|
||||
thingsHitExceptCrLongLine (Just cid) sp ep = filter crNotCid . thingsHitLongLine sp ep
|
||||
where crNotCid (_,(E3x1 cr)) = _crID cr /= cid
|
||||
where crNotCid (_,E3x1 cr) = _crID cr /= cid
|
||||
crNotCid _ = True
|
||||
|
||||
thingsHitLongLine :: Point2 -> Point2 -> World -> [(Point2, (Either3 Creature Wall ForceField))]
|
||||
thingsHitLongLine :: Point2 -> Point2 -> World -> [(Point2, Either3 Creature Wall ForceField)]
|
||||
thingsHitLongLine sp ep w
|
||||
| sp == ep = []
|
||||
| otherwise = sortBy (compare `on` dist sp . fst) (crs ++ walls ++ ffs)
|
||||
where
|
||||
crs = zip crPs (map E3x1 hitCrs)
|
||||
hitCrs = IM.elems $ IM.filter (\cr -> circOnSeg sp ep (_crPos cr) (_crRad cr))
|
||||
$ _creatures w
|
||||
-- $ creaturesAlongLine sp ep w
|
||||
crPs = map (\cr -> ssaTriPoint ep (_crPos cr) sp (_crRad cr)) hitCrs
|
||||
| sp == ep = []
|
||||
| otherwise = sortBy (compare `on` dist sp . fst) (crs ++ walls ++ ffs)
|
||||
where
|
||||
crs = zip crPs (map E3x1 hitCrs)
|
||||
hitCrs = IM.elems $ IM.filter (\cr -> circOnSeg sp ep (_crPos cr) (_crRad cr))
|
||||
$ _creatures w
|
||||
-- $ creaturesAlongLine sp ep w
|
||||
crPs = map (\cr -> ssaTriPoint ep (_crPos cr) sp (_crRad cr)) hitCrs
|
||||
|
||||
walls = zip (map (fromJust . hitPoint) hitWls) (map E3x2 hitWls)
|
||||
hitWls = wallsOnLine sp ep $ wallsAlongLine sp ep w
|
||||
hitPoint wl = intersectSegSeg' sp ep (_wlLine wl !! 0) (_wlLine wl !! 1)
|
||||
walls = zip (map (fromJust . hitPoint) hitWls) (map E3x2 hitWls)
|
||||
hitWls = wallsOnLine sp ep $ wallsAlongLine sp ep w
|
||||
hitPoint wl = intersectSegSeg' sp ep (_wlLine wl !! 0) (_wlLine wl !! 1)
|
||||
|
||||
hitFFs = mapMaybe (collidePointFF sp ep (_randGen w)) (IM.elems $ _forceFields w)
|
||||
ffs = map (\(p,(_,i)) -> (p, E3x3 $ _forceFields w IM.! i)) hitFFs
|
||||
hitFFs = mapMaybe (collidePointFF sp ep (_randGen w)) (IM.elems $ _forceFields w)
|
||||
ffs = map (\(p,(_,i)) -> (p, E3x3 $ _forceFields w IM.! i)) hitFFs
|
||||
|
||||
thingsHitOnPath :: [Point2] -> World -> [ [ ( Point2, (Either3 Creature Wall ForceField) ) ] ]
|
||||
thingsHitOnPath :: [Point2] -> World -> [ [ ( Point2, Either3 Creature Wall ForceField ) ] ]
|
||||
thingsHitOnPath [] _ = error "tried to find thingsHitOnPath containing no points"
|
||||
thingsHitOnPath ps w = map (flip (uncurry thingsHit) w) . zip ps $ tail ps
|
||||
thingsHitOnPath ps w = zipWith (\ a b -> thingsHit a b w) ps $ tail ps
|
||||
|
||||
Reference in New Issue
Block a user