diff --git a/app/Main.hs b/app/Main.hs index ddcf6053c..90f18982c 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -26,7 +26,7 @@ import Control.Concurrent import Control.Lens import Foreign (Word32) -import Control.Monad (when) +import Control.Monad (when,void) import System.Random @@ -53,7 +53,7 @@ main = do (fmap (setWindowSize sizex sizey keyConfig) firstWorld) ( \preData w -> do startTicks <- SDL.ticks - doDrawing (_renderData preData) w + void $ doDrawing (_renderData preData) w playSoundQueue (_soundData preData) (_soundQueue w) newSoundData <- playAndUpdate (_sounds w) (_soundData preData) diff --git a/src/Dodge/CreatureAction.hs b/src/Dodge/CreatureAction.hs index 2057b9a9c..2b3337026 100644 --- a/src/Dodge/CreatureAction.hs +++ b/src/Dodge/CreatureAction.hs @@ -7,7 +7,7 @@ module Dodge.CreatureAction where -- imports {{{ import Dodge.CreatureAction.UseItem - +import Dodge.WorldEvent.Shockwave import Dodge.Data import Dodge.Base import Dodge.SoundLogic @@ -222,7 +222,7 @@ createItemAt p it w = over floorItems (IM.insert i (set flItPos p blinkAction :: Int -> World -> World blinkAction n w = soundOnce teleSound $ set (creatures . ix n . crPos) p3 - $ blinkShockwave p3 + $ blinkShockwave n p3 $ inverseShockwaveAt cp 40 2 2 2 w where p1 = _cameraCenter w +.+ (1 / _cameraZoom w) *.* rotateV (_cameraRot w) (_mousePos w) @@ -231,8 +231,12 @@ blinkAction n w = soundOnce teleSound $ set (creatures . ix n . crPos) p3 r = 1.5 * _crRad (_creatures w IM.! n) p3 = fromMaybe p1 (fmap ((\p -> moveAmountToward p r cp) . fst) p2) -blinkShockwave :: Point2 -> World -> World -blinkShockwave p = makeShockwaveAt p 40 1 2 cyan +blinkShockwave + :: Int -- ^ Blinking creature ID. + -> Point2 + -> World + -> World +blinkShockwave i p = makeShockwaveAt [i] p 60 1 2 cyan moveAmountToward :: Point2 -> Float -> Point2 -> Point2 moveAmountToward p1 am p2 diff --git a/src/Dodge/Item/Weapon.hs b/src/Dodge/Item/Weapon.hs index 2fbdaa5d9..390b51789 100644 --- a/src/Dodge/Item/Weapon.hs +++ b/src/Dodge/Item/Weapon.hs @@ -920,9 +920,6 @@ flamerAngle = 0.3 aSelf :: Int -> World -> World aSelf = blinkAction - - - reflect :: Float -> Float -> Float reflect a b = a + 2*(a-b) diff --git a/src/Dodge/Item/Weapon/Bullet.hs b/src/Dodge/Item/Weapon/Bullet.hs index 5e68943fc..664ae680b 100644 --- a/src/Dodge/Item/Weapon/Bullet.hs +++ b/src/Dodge/Item/Weapon/Bullet.hs @@ -5,6 +5,7 @@ import Dodge.Base import Dodge.WorldEvent import Dodge.SoundLogic import Dodge.RandomHelp +import Dodge.WorldEvent.Shockwave import Dodge.Creature.Property @@ -129,7 +130,7 @@ bulConCr' bt p cr w where cid = _crID cr sp = head $ _btTrail' bt ep = sp +.+ _btVel' bt - mkwave = over worldEvents $ (.) (makeShockwaveAt p 15 4 1 white) + mkwave = over worldEvents $ (.) (makeShockwaveAt [] p 15 4 1 white) bulHitWall' :: Particle' -> Point2 -> Wall -> World -> World bulHitWall' bt p x w = damageBlocks x @@ -195,7 +196,7 @@ bulConWall' bt p wl w = damageBlocks wl Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 5)) w (_blIDs wall) _ -> w wallV = (_wlLine wl !! 1 -.- _wlLine wl !! 0) - mkwave = over worldEvents $ (.) (makeShockwaveAt p 15 4 1 white) + mkwave = over worldEvents $ (.) (makeShockwaveAt [] p 15 4 1 white) hvBulHitWall' :: Particle' -> Point2 -> Wall -> World -> World hvBulHitWall' bt p x w = damageBlocks x diff --git a/src/Dodge/WorldEvent.hs b/src/Dodge/WorldEvent.hs index 8fc255760..9f2e0350a 100644 --- a/src/Dodge/WorldEvent.hs +++ b/src/Dodge/WorldEvent.hs @@ -19,6 +19,7 @@ import Dodge.WorldEvent.Cloud import Dodge.WorldEvent.HitEffect import Dodge.WorldEvent.Explosion import Dodge.WorldEvent.SpawnParticle +import Dodge.WorldEvent.Shockwave import Dodge.LightSources import Dodge.Data @@ -38,52 +39,6 @@ import Data.Function import Data.List import qualified Data.IntMap.Strict as IM - -shockWaveDamage :: Point2 -> Float -> Int -> World -> World -shockWaveDamage p rad amount w = flip (foldr damageBlocks) hitBlocks $ over creatures (IM.map f) w - where f cr | dist (_crPos cr) p < rad + _crRad cr = over (crState . crDamage) - ((:) $ Concussive amount p 2 0.5 rad) cr - | otherwise = cr - hitBlocks = wallsOnCirc p rad $ wallsNearPoint p w - damageBlocks wall w - = case wall ^? blHP of - Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - (div amount 2))) - w - (_blIDs wall) - _ -> w - - -inverseShockwaveAt :: Point2 -> Float -> Int -> Float -> Float -> World -> World -inverseShockwaveAt p rad dam push pushexp = over particles' ((:) theShockwave) - where theShockwave - = Particle' - { _ptDraw = const blank - , _ptUpdate' = moveInverseShockWave 10 p rad push pushexp - } -moveInverseShockWave :: Int -> Point2 -> Float -> Float -> Float -> World -> Particle' -> (World, Maybe Particle') -moveInverseShockWave 0 _ _ _ _ w _ = (w, Nothing) -moveInverseShockWave t p r push pushexp w pt - = (dams w, Just $ newupdate $ newpic pt ) - where newupdate = set ptUpdate' $ moveInverseShockWave (t-1) p r push pushexp - newpic = set ptDraw (const $ onLayer PtLayer $ uncurry translate p - $ color cyan $ thickCircle rad thickness) - rad = r - (4/40) * r * fromIntegral (10 - t) - thickness = (fromIntegral (10 - t))**2 * rad / 40 - dams = over creatures (IM.map damCr) . flip (foldr damageBlocks) hitBlocks - hitBlocks = wallsOnCirc p rad $ wallsNearPoint p w - damageBlocks wall w - = case wall ^? blHP of - Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 1)) - w - (_blIDs wall) - _ -> w - damCr cr | dist (_crPos cr) p < rad + _crRad cr - = over (crState . crDamage) - ((:) $ PushDam 1 (25 *.* safeNormalizeV (p -.- _crPos cr))) - cr - | otherwise = cr - - createBarrelSpark :: Int -> Int -> Point2 -> Float -> Maybe Int -> World -> World createBarrelSpark time colid pos dir maycid w = over worldEvents ((.) $ ( over particles' ((:) spark) diff --git a/src/Dodge/WorldEvent/Explosion.hs b/src/Dodge/WorldEvent/Explosion.hs index 6f0621907..66072012d 100644 --- a/src/Dodge/WorldEvent/Explosion.hs +++ b/src/Dodge/WorldEvent/Explosion.hs @@ -7,7 +7,7 @@ import Dodge.WorldEvent.SpawnParticle import Dodge.WorldEvent.Flash import Dodge.RandomHelp import Dodge.SoundLogic - +import Dodge.WorldEvent.Shockwave import Geometry import Picture @@ -57,7 +57,7 @@ makeExplosionAt :: Point2 -> World -> World makeExplosionAt p w = soundOnce grenadeBang . addFlames . explosionFlashAt p - $ makeShockwaveAt p 50 10 1 white + $ makeShockwaveAt [] p 50 10 1 white w where fVs = fst $ runState ((sequence . take 75 . repeat . randInCirc) 1) $ _randGen w @@ -74,73 +74,3 @@ makeExplosionAt p w = soundOnce grenadeBang pushAgainstWalls q = fromMaybe q $ fmap (\(x,y)-> x +.+ y) $ collidePointWalls p q $ wallsNearPoint q w -makeShockwaveAt :: Point2 -> Float -> Int -> Float -> Color - -> World -> World -makeShockwaveAt p rad dam push col = over particles' ((:) theShockwave) - where theShockwave = shockwaveAt p rad dam push col 10 - -shockwaveAt :: Point2 -> Float -> Int -> Float -> Color -> Int -> Particle' -shockwaveAt p rad dam push col maxtime - = Shockwave' - { _ptDraw = const blank - , _ptUpdate' = mvShockwave' - , _btColor' = col - , _btPos' = p - , _btRad' = rad - , _btDam' = dam - , _btPush' = push - , _btMaxTime' = maxtime - , _btTimer' = maxtime - } - -mvShockwave' :: World -> Particle' -> (World, Maybe Particle') -mvShockwave' w pt - | _btTimer' pt <= 0 = (w, Nothing) - | otherwise - = (dams w , Just $ set btTimer' (t - 1) $ set ptDraw (const pic) pt) - where - r = _btRad' pt - p = _btPos' pt - push = _btPush' pt - dam = _btDam' pt - t = _btTimer' pt - tFraction = fromIntegral t / fromIntegral (_btMaxTime' pt) - pic = onLayer PtLayer $ uncurry translate p - $ color (_btColor' pt) $ thickCircle rad thickness - rad = r - (3/4) * r * tFraction - thickness = tFraction**2 * r - dams = over creatures (IM.map damCr) . flip (foldr damageBlocks) hitBlocks - hitBlocks = wallsOnCirc p rad $ wallsNearPoint p w - damageBlocks wall w - = case wall ^? blHP of - Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 1)) - w - (_blIDs wall) - _ -> w - damCr cr | dist (_crPos cr) p < rad + _crRad cr - = over (crState . crDamage) - ((:) $ PushDam dam (25 * push *.* safeNormalizeV (_crPos cr -.- p))) - cr - | otherwise = cr -moveShockWave :: Int -> Point2 -> Float -> Float -> Float -> World -> Particle' -> (World, Maybe Particle') -moveShockWave 0 _ _ _ _ w _ = (w, Nothing) -moveShockWave t p r push pushexp w pt - = (dams w, Just $ newupdate $ newpic pt ) - where newupdate = set ptUpdate' $ moveShockWave (t-1) p r push pushexp - newpic = set ptDraw (const $ onLayer PtLayer $ uncurry translate p - $ color cyan $ thickCircle rad thickness) - rad = r - (3/40) * r * fromIntegral t - thickness = (fromIntegral t)**2 * rad / 40 - dams = over creatures (IM.map damCr) . flip (foldr damageBlocks) hitBlocks - hitBlocks = wallsOnCirc p rad $ wallsNearPoint p w - damageBlocks wall w - = case wall ^? blHP of - Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 1)) - w - (_blIDs wall) - _ -> w - damCr cr | dist (_crPos cr) p < rad + _crRad cr - = over (crState . crDamage) - ((:) $ PushDam 1 (25 *.* safeNormalizeV (_crPos cr -.- p))) - cr - | otherwise = cr diff --git a/src/Dodge/WorldEvent/Shockwave.hs b/src/Dodge/WorldEvent/Shockwave.hs new file mode 100644 index 000000000..27e7bf910 --- /dev/null +++ b/src/Dodge/WorldEvent/Shockwave.hs @@ -0,0 +1,114 @@ +module Dodge.WorldEvent.Shockwave + ( makeShockwaveAt + , inverseShockwaveAt + ) + where +import Dodge.Data +import Dodge.Base +import Geometry +import Picture + +import qualified Data.IntMap.Strict as IM +import Control.Lens + +makeShockwaveAt + :: [Int] -- ^ IDs of invulnerable creatures. + -> Point2 -- ^ Center of shockwave. + -> Float -- ^ Maximal radius. + -> Int -- ^ Damage caused per frame. + -> Float -- ^ Amount of pushback per frame. + -> Color -- ^ Color of shockwave. + -> World -- ^ Start world. + -> World +makeShockwaveAt is p rad dam push col = over particles' ((:) theShockwave) + where theShockwave = shockwaveAt is p rad dam push col 10 + +shockwaveAt + :: [Int] -- ^ IDs of invulnerable creatures. + -> Point2 -> Float -> Int -> Float -> Color -> Int -> Particle' +shockwaveAt is p rad dam push col maxtime + = Shockwave' + { _ptDraw = drawShockwave + , _ptUpdate' = mvShockwave' is + , _btColor' = col + , _btPos' = p + , _btRad' = rad + , _btDam' = dam + , _btPush' = push + , _btMaxTime' = maxtime + , _btTimer' = maxtime + } + +drawShockwave :: Particle' -> Picture +drawShockwave pt = pic + where + pic = onLayer PtLayer $ uncurry translate p + $ color (_btColor' pt) $ thickCircle rad thickness + p = _btPos' pt + r = _btRad' pt + thickness = tFraction**2 * r + rad = r - (3/4) * r * tFraction + tFraction = fromIntegral t / fromIntegral (_btMaxTime' pt) + t = _btTimer' pt + +mvShockwave' + :: [Int] -- ^ IDs of invulnerable creatures. + -> World -> Particle' -> (World, Maybe Particle') +mvShockwave' is w pt + | _btTimer' pt <= 0 = (w, Nothing) + | otherwise + = (dams w , Just $ set btTimer' (t - 1) pt) -- $ set ptDraw (const pic) pt) + where + r = _btRad' pt + p = _btPos' pt + push = _btPush' pt + dam = _btDam' pt + t = _btTimer' pt + tFraction = fromIntegral t / fromIntegral (_btMaxTime' pt) + rad = r - (3/4) * r * tFraction + dams = over creatures (IM.map damCr) . flip (foldr damageBlocks) hitBlocks + hitBlocks = wallsOnCirc p rad $ wallsNearPoint p w + damageBlocks wall w + = case wall ^? blHP of + Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 1)) + w + (_blIDs wall) + _ -> w + damCr cr | _crID cr `elem` is = cr + | dist (_crPos cr) p < rad + _crRad cr + = over (crState . crDamage) + ((:) $ PushDam dam (25 * push *.* safeNormalizeV (_crPos cr -.- p))) + cr + | otherwise = cr + +------------------------------------------------- + +inverseShockwaveAt :: Point2 -> Float -> Int -> Float -> Float -> World -> World +inverseShockwaveAt p rad dam push pushexp = over particles' ((:) theShockwave) + where theShockwave + = Particle' + { _ptDraw = const blank + , _ptUpdate' = moveInverseShockWave 10 p rad push pushexp + } +moveInverseShockWave :: Int -> Point2 -> Float -> Float -> Float -> World -> Particle' -> (World, Maybe Particle') +moveInverseShockWave 0 _ _ _ _ w _ = (w, Nothing) +moveInverseShockWave t p r push pushexp w pt + = (dams w, Just $ newupdate $ newpic pt ) + where newupdate = set ptUpdate' $ moveInverseShockWave (t-1) p r push pushexp + newpic = set ptDraw (const $ onLayer PtLayer $ uncurry translate p + $ color cyan $ thickCircle rad thickness) + rad = r - (4/40) * r * fromIntegral (10 - t) + thickness = (fromIntegral (10 - t))**2 * rad / 40 + dams = over creatures (IM.map damCr) . flip (foldr damageBlocks) hitBlocks + hitBlocks = wallsOnCirc p rad $ wallsNearPoint p w + damageBlocks wall w + = case wall ^? blHP of + Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 1)) + w + (_blIDs wall) + _ -> w + damCr cr | dist (_crPos cr) p < rad + _crRad cr + = over (crState . crDamage) + ((:) $ PushDam 1 (25 *.* safeNormalizeV (p -.- _crPos cr))) + cr + | otherwise = cr diff --git a/src/Geometry/Intersect.hs b/src/Geometry/Intersect.hs index e43b1fdcf..294219b11 100644 --- a/src/Geometry/Intersect.hs +++ b/src/Geometry/Intersect.hs @@ -115,17 +115,20 @@ ratIntersectLineLine a b c d = fmap toNumPoint2 $ myIntersectLineLine (toRatPoin toNumPoint2 (x,y) = (fromRational x, fromRational y) f = toRatPoint2 . roundPoint2 --- | Round the floats within a 'Point2' to the nearest integer. --- Rounding jumps after intervals of .5: --- --- >>> roundPoint (0.5,0.5001) --- (0.0,1.0) --- --- but is symmetric around 0: --- --- >>> roundPoint2 (0.5,-0.5) --- (0.0,0.0) --- +{- | Round the floats within a 'Point2' to the nearest integer. +__Examples__ +Rounding jumps after intervals of .5: + +>>> roundPoint (0.5,0.5001) +(0.0,1.0) + +but is symmetric around 0: + +>>> roundPoint2 (0.5,-0.5) +(0.0,0.0) + +-} + roundPoint2 :: Point2 -> Point2 roundPoint2 (x,y) = (fromIntegral $ round x,fromIntegral $ round y)