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

Cleanup

Browse Source
This commit is contained in:
justin
2021-10-31 13:34:22 +00:00
parent a6867b1fad
commit 8dd6379d8e
8 changed files with 68 additions and 105 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Item/Weapon.hs
-5
View File
@@ -798,11 +798,6 @@ moveRemoteBomb itid time pID w
updatePicture =
set (props . ix pID . prDraw)
(\_ -> (,) mempty $ onLayer PtLayer $ uncurryV translate newPos $ remoteBombPic time)
. lowLightDirected
(withAlpha 0.1 red)
newPos
(50 *.* unitVectorAtAngle (negate $ degToRad (10 * fromIntegral time)))
[-0.2,-0.15,-0.1,-0.05,0,0.05,0.1,0.15,0.2]
setRemoteBombScope :: Int -> Prop -> World -> World
src/Dodge/Item/Weapon/Laser.hs
+1 -1
View File
@@ -25,7 +25,7 @@ import qualified Data.Sequence as Seq
--import qualified Data.IntMap.Strict as IM
aLaser :: Creature -> World -> World
aLaser cr w = over particles (makeLaserAt phaseV pos dir : ) w
aLaser cr = particles %~ (makeLaserAt phaseV pos dir : )
where
pos = _crPos cr +.+ ((_crRad cr +3) *.* unitVectorAtAngle dir)
dir = _crDir cr
src/Dodge/LightSources/Lamp.hs
+2 -2
View File
@@ -30,9 +30,9 @@ colorLightAt col pos i =
,_lsPict = lightSourcePicture
}
lightSourcePicture :: LightSource -> Picture
lightSourcePicture ls = setLayer 1 . translate3 (_lsPos ls) . color col $ circleSolid 3
lightSourcePicture ls = setLayer 1 . translate3 (_lsPos ls) . color col $ circleSolid 4
where
col = V4 r g b 1
col = V4 r g b 2
V3 r g b = _lsIntensity ls
lightAt :: Point3 -> Int -> LightSource
src/Dodge/WorldEvent/Cloud.hs
+10 -8
View File
@@ -1,11 +1,16 @@
module Dodge.WorldEvent.Cloud
where
( makeFlamerSmokeAt
, smokeCloudAt
, makeThinSmokeAt
, makeThickSmokeAt
, shellTrailCloud
, spawnSmokeAtCursor
, makeStartCloudAt
) where
import Dodge.Data
import Dodge.Base
import Geometry.Data
import Picture
--import qualified IntMapHelp as IM
import Control.Lens
@@ -17,7 +22,7 @@ makeCloudAt
-> Point3 -- start position
-> World
-> World
makeCloudAt drawFunc rad t alt p w = w & clouds %~ (theCloud :)
makeCloudAt drawFunc rad t alt p = clouds %~ (theCloud :)
where
theCloud = Cloud
{ _clPos = p
@@ -41,8 +46,7 @@ smokeCloudAt
smokeCloudAt col = makeCloudAt (drawCloudWith (4/3) 800 col)
drawCloudWith :: Float -> Float -> Color -> Cloud -> Picture
drawCloudWith radMult fadet col cl
= setLayer 2
drawCloudWith radMult fadet col cl = setLayer 2
. setDepth 25
$ circleSolidCol (withAlpha 0 col) (withAlpha a col) (radMult * _clRad cl)
where
@@ -55,11 +59,9 @@ makeThinSmokeAt :: Point3 -> World -> World
makeThinSmokeAt = makeCloudAt (drawCloudWith 4 400 (withAlpha 0.05 black)) 5 400 50
makeStartCloudAt :: Point3 -> World -> World
--makeSmokeCloudAt = makeCloudAt 10 200 (drawCloudWith 2 200 (greyN 0.5))
makeStartCloudAt = makeCloudAt (drawCloudWith 2 800 white) 10 400 5
shellTrailCloud :: Point3 -> World -> World
----makeSmokeCloudAt = makeCloudAt 10 200 (drawCloudWith 2 200 (greyN 0.5))
shellTrailCloud = makeCloudAt (drawCloudWith (4/3) 800 (greyN 0.5)) 15 400 40
makeFlamerSmokeAt :: Float -> Point3 -> World -> World
src/Dodge/WorldEvent/DamageBlock.hs
+2 -1
View File
@@ -1,5 +1,6 @@
module Dodge.WorldEvent.DamageBlock
where
( damageBlocksBy
) where
import Dodge.Data
import Control.Lens
src/Dodge/WorldEvent/Explosion.hs
+5 -1
View File
@@ -2,7 +2,11 @@
Explosions: creation of shockwave and particles at a given point.
-}
module Dodge.WorldEvent.Explosion
where
( makeExplosionAt
, makeFlameExplosionAt
, makePoisonExplosionAt
, makeTeslaExplosionAt
) where
import Dodge.Data
import Dodge.Data.SoundOrigin
import Dodge.Default
src/Dodge/WorldEvent/Flash.hs
+4 -41
View File
@@ -13,21 +13,15 @@ module Dodge.WorldEvent.Flash
, explosionFlashAt
, laserGunFlashAt
, teslaGunFlashAt
, lowLightDirected
, flareCircleAt
, muzFlareAt
)
where
import Dodge.Data
--import Dodge.Base
import Dodge.Picture
import Dodge.LightSources.Lamp
import Dodge.WorldEvent.ThingsHit
import Dodge.WorldEvent.HelperParticle
import Picture
import Geometry
import Data.Maybe (maybeToList)
import Control.Lens
import System.Random
@@ -39,37 +33,10 @@ teslaGunFlashAt = flareCircleAt cyan 0.7
laserGunFlashAt :: Point3 -> World -> World
laserGunFlashAt = flareCircleAt yellow 0.2
glareLine' :: Int -> Float -> Float -> Color -> Point2 -> Point2 -> World -> World
glareLine' t len wdth col a b w = w & particles %~ (maybeToList linePt ++)
where
linePt :: Maybe Particle
linePt = glareBetween t len wdth col a b w
glareBetween :: Int -> Float -> Float -> Color -> Point2 -> Point2 -> World -> Maybe Particle
glareBetween 0 _ _ _ _ _ _ = Nothing
glareBetween t len wdth col a b w = Just $ Particle
{_ptDraw = const $ lowLightPic len wdth col (a,b) w
,_ptUpdate = \ w' _ -> (w',glareBetween (t-1) len wdth col a b w')
}
lowLightPic :: Float -> Float -> Color -> (Point2, Point2) -> World -> Picture
lowLightPic len wdth col (a,b) w = case thingsHit a b w of
((p, E3x2 wall):_)
-> setCol . lineOfThickness wdth $ [alongSegBy len p wa, alongSegBy len p wb]
where
(wa,wb) = _wlLine wall
((p, E3x1 cr):_)
-> setCol . uncurryV translate cp . rotate (-0.25 * pi + argV (p -.- cp))
$ thickArc 0 (pi/2) (_crRad cr) wdth
where
cp = _crPos cr
_ -> blank
where setCol = color col . setDepth (-0.5) . setLayer 2
muzFlareAt :: Color -> Point3 -> Float -> World -> World
muzFlareAt col tranv dir w = w & particles %~ (theFlareCircle :)
muzFlareAt col tranv dir w = w & particles %~ (theFlare :)
where
theFlareCircle = Particle
theFlare = Particle
{ _ptDraw = const $ setLayer 1 . translate3 tranv $ theShape
, _ptUpdate = ptSimpleTime 2
}
@@ -84,21 +51,17 @@ flareCircleAt :: Color -> Float -> Point3 -> World -> World
flareCircleAt col alphax tranv = particles %~ (theFlareCircle :)
where
theFlareCircle = Particle
{ _ptDraw = const $ setLayer 2 . translate3 tranv
{ _ptDraw = const . setLayer 1 . translate3 tranv
$ circleSolidCol (withAlpha alphax col) (withAlpha 0 col) 30
, _ptUpdate = ptSimpleTime 1
}
explosionFlashAt :: Point2 -> World -> World
explosionFlashAt p = over tempLightSources ((:) $ tLightTimedIntensity 20 150 intensityFunc p)
explosionFlashAt p = tempLightSources %~ (tLightTimedIntensity 20 150 intensityFunc p :)
where
intensityFunc x
| x < 10 = 1 / (10 - fromIntegral x)
| otherwise = 1
lowLightDirected :: Color -> Point2 -> Point2 -> [Float] -> World -> World
lowLightDirected col a b angles w
= foldr (\angle w' -> glareLine' 2 10 5 col a (a +.+ rotateV angle b) w') w angles
sparkFlashAt :: Point2 -> World -> World
sparkFlashAt _ = id
src/Dodge/WorldEvent/HitEffect.hs
+44 -46
View File
@@ -1,4 +1,9 @@
module Dodge.WorldEvent.HitEffect
( destroyOnImpact
, doFlameDam
, noEff
, penWalls
)
where
import Dodge.Data
import Dodge.Data.DamageType
@@ -13,21 +18,21 @@ type HitCreatureEffect = Particle -> Point2 -> Creature -> World -> World
type HitWallEffect = Particle -> Point2 -> Wall -> World -> World
type HitForceFieldEffect = Particle -> Point2 -> ForceField -> World -> World
passThroughAll
:: HitCreatureEffect
-> HitWallEffect
-> HitForceFieldEffect
-> Particle
-> [(Point2, Either3 Creature Wall ForceField)] -- ^ hit things
-> World
-> (World, Maybe Particle)
passThroughAll _ _ _ pt _ w = (w, mvPt)
where
mvPt = Just $ pt & btTrail' .~ (newP : trl)
& btTimer' %~ (\t -> t - 1)
& btPassThrough' .~ Nothing
trl = _btTrail' pt
newP = head trl +.+ _btVel' pt
--passThroughAll
-- :: HitCreatureEffect
-- -> HitWallEffect
-- -> HitForceFieldEffect
-- -> Particle
-- -> [(Point2, Either3 Creature Wall ForceField)] -- ^ hit things
-- -> World
-- -> (World, Maybe Particle)
--passThroughAll _ _ _ pt _ w = (w, mvPt)
-- where
-- mvPt = Just $ pt & btTrail' .~ (newP : trl)
-- & btTimer' %~ (\t -> t - 1)
-- & btPassThrough' .~ Nothing
-- trl = _btTrail' pt
-- newP = head trl +.+ _btVel' pt
destroyOnImpact
:: HitCreatureEffect
@@ -38,20 +43,23 @@ destroyOnImpact
-> 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)
& btTimer' .~ 3
mvPt = Just $ pt
& btTrail' .~ (newP : trl)
& btTimer' %~ (\t -> t - 1)
& btPassThrough' .~ Nothing
trl = _btTrail' pt
newP = head trl +.+ _btVel' pt
[] -> ( w, mvPt pt)
((p,E3x1 cr):_) -> (crEff pt p cr w, destroyAt p pt)
((p,E3x2 wl):_) -> (wlEff pt p wl w, destroyAt p pt)
((p,E3x3 ff):_) -> (ffEff pt p ff w, destroyAt p pt)
mvPt :: Particle -> Maybe Particle
mvPt pt = Just $ pt
& btTrail' %~ f
& btTimer' -~ 1
& btPassThrough' .~ Nothing
where
f trl = head trl +.+ _btVel' pt : trl
destroyAt :: Point2 -> Particle -> Maybe Particle
destroyAt hitp pt = Just $ pt
& btTrail' %~ (hitp :)
& btTimer' %~ (\t -> min 3 (t-1))
penWalls
:: HitCreatureEffect
@@ -62,26 +70,16 @@ penWalls
-> 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)
[] -> ( w, mvPt pt)
((p,E3x1 cr):_) -> (crEff pt p cr w, destroyAt p pt)
((p,E3x3 ff):_) -> (ffEff pt p ff w, destroyAt p pt)
((p,E3x2 wl):hs) | isJust (wl ^? wlBlockID)
-> 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)
& btTimer' .~ 3
mvPt = Just $ pt
& btTrail' .~ (newP : trl)
& btTimer' %~ (\t -> t - 1)
& btPassThrough' .~ Nothing
trl = _btTrail' pt
newP = head trl +.+ _btVel' pt
-> first (wlEff pt p wl) $ penWalls crEff wlEff ffEff pt hs w
((p,E3x2 wl):_) -> (wlEff pt p wl w, destroyAt p 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)
doFlameDam amount pt p cr = creatures . ix (_crID cr) . crState . crDamage %~
(Flaming amount sp p ep :)
where
sp = _btPos' pt
ep = sp +.+ _btVel' pt