Small cleanup, delete unneeded code
This commit is contained in:
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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)
|
||||
|
||||
Reference in New Issue
Block a user