Small cleanup, delete unneeded code

This commit is contained in:
jgk
2021-03-12 21:17:24 +01:00
parent 918f7d23b8
commit 95c9610b74
3 changed files with 3 additions and 196 deletions
-2
View File
@@ -121,8 +121,6 @@ bulConCr' bt p cr w
ep = sp +.+ _btVel' bt
mkwave = over worldEvents $ (.) (makeShockwaveAt p 15 4 1 white)
bulHitWall' :: Particle' -> Point2 -> Wall -> World -> World
bulHitWall' bt p x w = damageBlocks x
$ createSpark 8 colID pOut (reflectDir x) Nothing
+3 -2
View File
@@ -121,8 +121,9 @@ worldPictures w
where tst x y sc t = translate x y $ scale sc sc $ color white $ text t
testPic :: World -> [Picture]
testPic w = [setLayer 1 $ onLayerL [99] $ bezierQuad white red 5 50 (-200,200) (-200,-200) (00,00) ]
-- $ uncurry translate (mouseWorldPos w)
testPic w = [blank]
-- [setLayer 1 $ onLayerL [99] $ bezierQuad white red 5 50 (-200,200) (-200,-200) (00,00) ]
-- $ uncurry translate (mouseWorldPos w)
hudDrawings :: World -> Picture
-192
View File
@@ -176,133 +176,6 @@ moveInverseShockWave t p r push pushexp w pt
cr
| otherwise = cr
-- makeTremorAt :: Int -> Point -> Float -> Particle
-- makeTremorAt i pos d = Particle
-- { _ptPos = (0,0)
-- , _ptStartPos = (0,0)
-- , _ptVel = (0,0)
-- , _ptPict = Line [(0,0),(0,0)]
-- , _ptID = i
-- , _ptUpdate = moveTremor [pos] 200 pos d i
-- }
--
-- moveTremor :: [Point] -> Int -> Point -> Float -> Int -> World -> World
-- moveTremor ps t p1 d i w
-- | t <= -30 = over particles (IM.delete i) . over partUnder (IM.delete i) $ w
-- | t <= 0 = set (particles . ix i . ptUpdate) (moveTremor ps (t-1) p1 d i)
-- . over partUnder
-- (IM.insert i (lineOfThickness (0.1*(fromIntegral t + 30)) ps)) $ w
-- | otherwise = case hitWall of
-- Nothing -> upUndPict . set randGen g . shakeCrs .
-- shatterAt p1 pl $ shatterAt p1 pr
-- $ set (particles . ix i . ptUpdate) (moveTremor (p3:ps) (t-1) p3 d i)
-- $ damCrsOnLine 10 p1 p3 w
-- Just (pw,pRef) -> set (particles . ix i . ptUpdate) (moveTremor ps (t-1) p1 (argV pRef) i) w
-- where p2 = p1 +.+ 5 *.* unitVectorAtAngle d
-- pl = p1 +.+ rotateV (d + pi/4) (75,0)
-- pr = p1 +.+ rotateV (d - pi/4) (75,0)
-- hitWall = collidePointWalls p1 p3 $ wallsAlongLine p1 p3 w
-- (d1,g) = randomR (0,2*pi) $ _randGen w
-- v = unitVectorAtAngle d1
-- p3 = p2 +.+ 5 *.* v
-- shakeCrs = over creatures (IM.map shCr)
-- shCr cr | dist p1 (_crPos cr) < 75 = over crPos (+.+ v) cr
-- | otherwise = cr
-- upUndPict = over partUnder (IM.insert i pic)
-- pic = pictures [color white $ lineOfThickness 3 [p3,head ps]
-- ,lineOfThickness 3 ps]
--
-- makeTremorAt' :: Int -> Point -> Particle
-- makeTremorAt' i pos = Particle
-- { _ptPos = (0,0)
-- , _ptStartPos = (0,0)
-- , _ptVel = (0,0)
-- , _ptPict = Line [(0,0),(0,0)]
-- , _ptID = i
-- , _ptUpdate = rotateTremorAround 10 pos i
-- }
--
-- rotateTremorAround :: Int -> Point -> Int -> World -> World
-- rotateTremorAround 0 p i w = over particles (IM.delete i) w
-- rotateTremorAround t p i w = set (particles . ix i . ptUpdate) (rotateTremorAround (t-1) p i)
-- $ foldr ($) w shatters
-- where rot d = rotateV $ d + fromIntegral t * pi / 7
-- ds = fmap (\x -> fromIntegral x * pi / 2.5) [0..4]
-- shatters = map (\d -> shatterAt p (p +.+ rot d (300,0))) ds
--
-- shatterAt :: Point -> Point -> World -> World
-- shatterAt p1 p2 w = case wlHit of
-- Just (p,v,col) -> makeFallingBlock col (f1 p) (f2 v)
-- $ set randGen g w
-- _ -> w
-- where wlHit = collidePointWallsNormCol p1 p2 $ wallsNearPoint p2 w
-- f1 q = q +.+ 5 *.* errorNormalizeV 10 (p2 -.- p1)
-- (d,g) = randomR (-0.5,0.5) $ _randGen w
-- f2 v' = rotateV d $ 3 *.* errorNormalizeV 11 v'
--
-- fallingWall :: Int -> Color -> Point -> Float -> Particle
-- fallingWall pid col p d
-- = Particle
-- { _ptPos = p
-- , _ptStartPos = p
-- , _ptVel = rotateV d (3,0)
-- , _ptPict = Line [(0,0),(0,0)]
-- , _ptID = pid
-- , _ptUpdate = moveFallingWall 10 p d col pid
-- }
--
-- moveFallingWall :: Int -> Point -> Float -> Color -> Int -> World -> World
-- moveFallingWall 0 p d col i w = over particles (IM.delete i) $ b1 $ b2 w
-- where b1 = makeFallingBlock col (p +.+ ( 3, 3)) (rotateV d (0,5))
-- b2 = makeFallingBlock col (p +.+ (-3,-3)) (rotateV d (0,1))
-- moveFallingWall t p d col i w
-- = set (particles . ix i . ptUpdate) (moveFallingWall (t-1) np d col i)
-- $ set (particles . ix i . ptPict) pic
-- w
-- where np = p +.+ 1 *.* unitVectorAtAngle d
-- pic = uncurry translate p $ rotate (-radToDeg d)
-- $ color col $ polygon [(-6,-6)
-- ,(-6, 6)
-- ,( 6, 6)
-- ,( 6,-6)
-- ]
--
-- makeFallingBlock :: Color -> Point -> Point -> World -> World
-- makeFallingBlock col p v w
-- = over particles (IM.insert i $ fallingBlock i col p v) w
-- where i = newParticleKey w
--
-- fallingBlock :: Int -> Color -> Point -> Point -> Particle
-- fallingBlock pid col p v
-- = Particle
-- { _ptPos = p
-- , _ptStartPos = p
-- , _ptVel = v
-- , _ptPict = Line [(0,0),(0,0)]
-- , _ptID = pid
-- , _ptUpdate = moveFallingBlock 10 p v col pid
-- }
--
-- moveFallingBlock :: Int -> Point -> Point -> Color -> Int -> World -> World
-- moveFallingBlock 0 p v col i w = over particles (IM.delete i) w
-- moveFallingBlock t p v col i w
-- = case hitCr of
-- Nothing -> set (particles . ix i . ptUpdate) (moveFallingBlock (t-1) np v col i)
-- $ set (particles . ix i . ptPict) pic
-- w
-- Just (p1,v1,crID) -> over particles (IM.delete i)
-- $ over (creatures . ix crID . crHP) (\hp -> hp - 1) w
-- where np = p +.+ v
-- pic = uncurry translate p $ rotate (-radToDeg (argV v))
-- $ color col $ polygon [(-3,-3)
-- ,(-3, 3)
-- ,( 3, 3)
-- ,( 3,-3)
-- ]
-- hitCr = reflectCircCreatures 4 p np $ _creatures w
-- 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
@@ -750,61 +623,6 @@ doFlameDam amount pt p cr = over (creatures . ix (_crID cr) . crState . crDamage
where sp = _btPos' pt
ep = sp +.+ _btVel' pt
makeSmokeAt :: Point2 -> World -> World
makeSmokeAt p w = over particles (IM.insert n smP) w
where n = newParticleKey w
smP = Particle
{ _ptPos = p
, _ptStartPos = p
, _ptVel = (0,0)
, _ptPict = onLayer PtLayer $ uncurry translate p $ color black $ circleSolid 1
--, _ptPict = uncurry translate p $ color white $ circleSolid 30
, _ptID = n
, _ptUpdate = moveSmoke p 20 n
}
moveSmoke :: Point2 -> Int -> Int -> World -> World
moveSmoke p time i | time > 0 =
set (particles . ix i . ptPict) pic . set (particles . ix i . ptUpdate) (moveSmoke p (time-1) i)
| time > -50 =
set (particles . ix i . ptPict) pi1 . set (particles . ix i . ptUpdate) (moveSmoke p (time-1) i)
| otherwise =
over particles (IM.delete i)
where pic = onLayer PtLayer $ uncurry translate p $ color (greyN 0.5) $ circleSolid $ 21 - fromIntegral time
pi1 = onLayer PtLayer $ uncurry translate p
$ color (withAlpha (1 + fromIntegral time /50) (greyN 0.5))
$ circleSolid $ 21
makeSmokeAt' :: Float -> Int -> Point2 -> World -> World
makeSmokeAt' scal time p w = over particles (IM.insert n smP) w
where n = newParticleKey w
smP = Particle
{ _ptPos = p
, _ptStartPos = p
, _ptVel = (0,0)
, _ptPict = onLayer PtLayer $ uncurry translate p $ color black $ circleSolid 1
, _ptID = n
, _ptUpdate = moveSmoke' scal p time n
}
moveSmoke' :: Float -> Point2 -> Int -> Int -> World -> World
moveSmoke' scal p time i
| time > 0
= set (particles . ix i . ptPict) pic
. set (particles . ix i . ptUpdate) (moveSmoke' scal p (time-1) i)
| time > -50
= set (particles . ix i . ptPict) pi1
. set (particles . ix i . ptUpdate) (moveSmoke' scal p (time-1) i)
| otherwise
= over particles (IM.delete i)
where pic = onLayer PtLayer $ uncurry translate p $ color (greyN 0.5) $ circleSolid $ (21 - fromIntegral time) * scal
pi1 = onLayer PtLayer $ uncurry translate p
$ color (withAlpha (1 + fromIntegral time /50) (greyN 0.5))
$ circleSolid $ 21 * scal
makeSmokeAt'' :: Point2 -> Float -> Int -> Point2 -> World -> World
makeSmokeAt'' vel scal time p w = over particles' ((:) smokeP) w
where smokeP = Particle'
@@ -876,16 +694,6 @@ moveColorSmoke col scal time i w
$ color (withAlpha (1 + fromIntegral time /50) col)
$ circleSolid $ 21 * scal
thingHit :: Point2 -> Maybe (Point2,a,b) -> Maybe (Point2,c) -> Maybe (Either (Point2,a,b) (Point2,c))
thingHit p Nothing Nothing = Nothing
thingHit p (Just x) Nothing = Just (Left x)
thingHit p Nothing (Just x) = Just (Right x)
thingHit p (Just x@(p1,_,_)) (Just y@(p2,_))
| magV (p -.- p1) > magV (p -.- p2) = Just (Right y)
| otherwise = Just (Left x)
damCrsOnLine :: Int -> Point2 -> Point2 -> World -> World
damCrsOnLine dam p1 p2 = over creatures (IM.map damIfOnLine)
where damIfOnLine cr | circOnLine p1 p2 (_crPos cr) (_crRad cr)