From 95c9610b74fdc7e45476842e4f8b9004aac2b477 Mon Sep 17 00:00:00 2001 From: jgk Date: Fri, 12 Mar 2021 21:17:24 +0100 Subject: [PATCH] Small cleanup, delete unneeded code --- src/Dodge/Item/Weapon/Bullet.hs | 2 - src/Dodge/Rendering.hs | 5 +- src/Dodge/WorldActions.hs | 192 -------------------------------- 3 files changed, 3 insertions(+), 196 deletions(-) diff --git a/src/Dodge/Item/Weapon/Bullet.hs b/src/Dodge/Item/Weapon/Bullet.hs index 1591dba26..e063a7586 100644 --- a/src/Dodge/Item/Weapon/Bullet.hs +++ b/src/Dodge/Item/Weapon/Bullet.hs @@ -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 diff --git a/src/Dodge/Rendering.hs b/src/Dodge/Rendering.hs index 793700ad7..4abd2aac8 100644 --- a/src/Dodge/Rendering.hs +++ b/src/Dodge/Rendering.hs @@ -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 diff --git a/src/Dodge/WorldActions.hs b/src/Dodge/WorldActions.hs index 4466fbb9a..d224a715c 100644 --- a/src/Dodge/WorldActions.hs +++ b/src/Dodge/WorldActions.hs @@ -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)