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

Further strictifying

Browse Source
This commit is contained in:
jgk
2021-07-30 00:23:02 +02:00
parent bd8ef3f416
commit 2d8b27746c
33 changed files with 228 additions and 211 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/WorldEvent/Cloud.hs
+2 -2
View File
@@ -3,7 +3,7 @@ module Dodge.WorldEvent.Cloud
import Dodge.Data
import Dodge.Base
--import Geometry
import Geometry.Data
import Picture
--import qualified IntMapHelp as IM
@@ -14,7 +14,7 @@ makeCloudAt rad t drawFunc p w = w & clouds %~ (theCloud :)
where
theCloud = Cloud
{ _clPos = p
, _clVel = (0,0)
, _clVel = (V2 0 0)
, _clPict = drawFunc
, _clRad = rad
, _clTimer = t
src/Dodge/WorldEvent/Flash.hs
+3 -3
View File
@@ -70,7 +70,7 @@ lowLightPic len wdth col (a,b) w = case thingsHit a b w of
where
(wa,wb) = _wlLine wall
((p, E3x1 cr):_)
-> setCol . uncurry translate cp . rotate (-0.25 * pi + argV (p -.- cp))
-> setCol . uncurryV translate cp . rotate (-0.25 * pi + argV (p -.- cp))
$ thickArc 0 (pi/2) (_crRad cr) wdth
where
cp = _crPos cr
@@ -78,7 +78,7 @@ lowLightPic len wdth col (a,b) w = case thingsHit a b w of
where setCol = color col . setDepth (-0.5) . setLayer 2
flashFlareAt :: Color -> Float -> Point2 -> Particle
flashFlareAt col alphax (x,y) = Particle
flashFlareAt col alphax (V2 x y) = Particle
{ _ptDraw = const $ setLayer 2 . setDepth (-0.9) . translate x y
$ circleSolidCol (withAlpha 0 col) (withAlpha alphax col) 30
, _ptUpdate' = ptTimer' 1
@@ -105,7 +105,7 @@ muzzleFlashAt p = over particles (muzzleFlashPt p : )
. glareAt 2 10 5 (withAlpha 0.5 white) 20 30 p
muzzleFlashPt :: Point2 -> Particle
muzzleFlashPt (x,y) = Particle
muzzleFlashPt (V2 x y) = Particle
{ _ptDraw = const $ setDepth 0
. setLayer 2
. translate x y
src/Dodge/WorldEvent/SpawnParticle.hs
+29 -29
View File
@@ -59,28 +59,28 @@ drawFlame rotd pt = thePic
ep = _btPos' pt
thePic = pictures
[ glow
, aPic 3 prot2 18 (scaleChange + 1,2) red
, aPic 4 prot 19 (scaleChange + 0.5,1.5) orange
, aPic 5 prot3 20 (scaleChange,1) white
, aPic 3 prot2 18 (V2 (scaleChange + 1) (2)) red
, aPic 4 prot 19 (V2 (scaleChange + 0.5) (1.5)) orange
, aPic 5 prot3 20 (V2 (scaleChange) (1)) white
]
aPic :: Int -> (Point2 -> Point2) -> Float -> Point2 -> Color -> Picture
aPic lay offset depth (scalex,scaley) col
aPic lay offset depth (V2 scalex scaley) col
= setLayer lay
. setDepth depth
. uncurry translate (offset ep)
. uncurryV 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
glow = setLayer 1 $ setDepth 0.3 $ uncurryV 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)
prot p' = p' +.+ rotateV (fromIntegral time) (V2 0 1)
prot2 p' = p' +.+ rotateV (negate $ fromIntegral time) (V2 0 1)
prot3 p' = p' +.+ rotateV (2 + fromIntegral time * 0.1) (V2 0 2)
{- TODO: add generalised area damage particles/hiteffects. -}
moveFlame
@@ -134,7 +134,7 @@ makeFlameletTimed
-> Int -- ^ Timer
-> World
-> World
makeFlameletTimed (x,y) z vel maycid size time w = w
makeFlameletTimed (V2 x y) z vel maycid size time w = w
& randGen .~ g
& particles %~ (theFlamelet :)
where
@@ -143,7 +143,7 @@ makeFlameletTimed (x,y) z vel maycid size time w = w
, _ptUpdate' = moveFlamelet
, _btVel' = vel
, _btColor' = red
, _btPos' = (x,y)
, _btPos' = (V2 x y)
, _btPassThrough' = maycid
, _btWidth' = size
, _btTimer' = time
@@ -170,16 +170,16 @@ drawFlameletZ rot pt = pictures
size = _btWidth' pt
siz2 = size + 0.2
time = _btTimer' pt
glow = setDepth 19 $ uncurry translate ep
glow = setDepth 19 $ uncurryV translate ep
$ circleSolidCol (withAlpha 0 red) (withAlpha 0.05 red) 30
piu = setDepth (z + 20)
. uncurry translate ep
. uncurryV translate ep
. color (dark red)
. rotate (negate (rot - 0.1 * fromIntegral time))
. scale s1 s1
$ polygon (rectNSWE siz2 (-siz2) (-siz2) siz2)
pi2 = setDepth (z + 20)
. uncurry translate ep
. uncurryV translate ep
. color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time)
orange (dark red)
)
@@ -187,13 +187,13 @@ drawFlameletZ rot pt = pictures
. scale s2 s2
$ polygon (rectNSWE siz2 (-siz2) (-siz2) siz2)
pic = setDepth (z + 20)
. uncurry translate ep
. uncurryV translate ep
. color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time)
white (dark red)
)
. rotate (negate ( 0.1 * fromIntegral time + rot))
. scale sc sc
$ polygon [(-size,-size),(size,-size),(size,size),(-size,size)]
$ polygon $ map toV2 [(-size,-size),(size,-size),(size,size),(-size,size)]
sc = (*) 2 $ log $ 1 + fromIntegral time / 20
s1 = (*) 2 $ log $ 2 + fromIntegral time / 40
s2 = 0.5 * (sc + s1)
@@ -210,17 +210,17 @@ drawFlamelet rot pt = setLayer 1 $ pictures [pic , piu , pi2 , glow]
size = _btWidth' pt
siz2 = size + 0.2
time = _btTimer' pt
glow = setDepth 19 $ uncurry translate ep
glow = setDepth 19 $ uncurryV translate ep
$ circleSolidCol (withAlpha 0 red) (withAlpha 0.05 red) 30
piu = setDepth 20
. uncurry translate ep
. uncurryV translate ep
. color (dark red)
. rotate (negate (rot - 0.1 * fromIntegral time))
. scale s1 s1
. polygon
$ rectNSWE siz2 (-siz2) (-siz2) siz2
pi2 = setDepth 20.2
. uncurry translate ep
. uncurryV translate ep
. color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time)
orange (dark red)
)
@@ -229,13 +229,13 @@ drawFlamelet rot pt = setLayer 1 $ pictures [pic , piu , pi2 , glow]
. polygon
$ rectNSWE siz2 (-siz2) (-siz2) siz2
pic = setDepth 20.4
. uncurry translate ep
. uncurryV translate ep
. color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time)
white (dark red)
)
. rotate (negate ( 0.1 * fromIntegral time + rot))
. scale sc sc
$ polygon [(-size,-size),(size,-size),(size,size),(-size,size)]
$ polygon $ map toV2 [(-size,-size),(size,-size),(size,size),(-size,size)]
sc = (*) 2 $ log $ 1 + fromIntegral time / 20
s1 = (*) 2 $ log $ 2 + fromIntegral time / 40
s2 = 0.5 * (sc + s1)
@@ -392,7 +392,7 @@ crOrWallSensitive
-> World
-> Either3 Creature Point2 Point2
crOrWallSensitive p dir wlAttract w =
fromMaybe (E3x3 $ p +.+ rotateV dir (arcLen,0))
fromMaybe (E3x3 $ p +.+ rotateV dir (V2 arcLen 0))
. listToMaybe
. sortBy (compare `on` g)
$ catMaybes [cr,wlp]
@@ -405,7 +405,7 @@ crOrWallSensitive p dir wlAttract w =
( fmap fst
. (\p1 -> reflectPointWalls p p1 $ wallsNearPoint p w)
. (+.+) p
. (\d -> rotateV d (100,0))
. (\d -> rotateV d (V2 100 0))
. (+ dir)
. (* wlAttract)
)
@@ -419,7 +419,7 @@ crOrWallSensitive p dir wlAttract w =
{- Finds whether a creature or wall is in front of a given point and direction.
Evaluates to a creature as an 'E3x1' or a wall as an 'E3x2'. -}
crOrWall :: Point2 -> Float -> World -> Either3 Creature Point2 Point2
crOrWall p dir w = fromMaybe (E3x3 $ p +.+ rotateV dir (arcLen,0))
crOrWall p dir w = fromMaybe (E3x3 $ p +.+ rotateV dir (V2 arcLen 0))
$ listToMaybe $ sortBy (compare `on` g)
$ catMaybes [cr,wlp]
where
@@ -431,7 +431,7 @@ crOrWall p dir w = fromMaybe (E3x3 $ p +.+ rotateV dir (arcLen,0))
( fmap fst
. (\p1 -> reflectPointWalls p p1 $ wallsNearPoint p w)
. (+.+) p
. (\d -> rotateV d (100,0))
. (\d -> rotateV d (V2 100 0))
. (+) dir
)
[-(3*pi/8),-pi/4,-pi/8,0,pi/8,pi/4,3*pi/8]
@@ -451,7 +451,7 @@ createSpark time colid pos dir maycid w
spark = Bul'
{ _ptDraw = drawBul
, _ptUpdate' = mvGenBullet
, _btVel' = rotateV dir (5,0)
, _btVel' = rotateV dir (V2 5 0)
, _btColor' = numColor colid
, _btTrail' = [pos]
, _btPassThrough' = maycid
@@ -459,7 +459,7 @@ createSpark time colid pos dir maycid w
, _btTimer' = time
, _btHitEffect' = destroyOnImpact sparkEff noEff noEff
}
pos' = pos +.+ rotateV dir (5,0)
pos' = pos +.+ rotateV dir (V2 5 0)
sparkEff bt p cr
= creatures . ix (_crID cr) . crState . crDamage %~ ( SparkDam 1 sp p ep : )
where
@@ -472,7 +472,7 @@ createSparkCol time col pos dir maycid w
spark = Bul'
{ _ptDraw = drawBul
, _ptUpdate' = mvGenBullet
, _btVel' = rotateV dir (5,0)
, _btVel' = rotateV dir (V2 5 0)
, _btColor' = col
, _btTrail' = [pos]
, _btPassThrough' = maycid
@@ -480,7 +480,7 @@ createSparkCol time col pos dir maycid w
, _btTimer' = time
, _btHitEffect' = destroyOnImpact sparkEff noEff noEff
}
pos' = pos +.+ rotateV dir (5,0)
pos' = pos +.+ rotateV dir (V2 5 0)
sparkEff bt p cr
= creatures . ix (_crID cr) . crState . crDamage %~ ( SparkDam 1 sp p ep : )
where