From c959b7d59c842acaf08fe24367f524e6688eb3ab Mon Sep 17 00:00:00 2001 From: jgk Date: Mon, 29 Mar 2021 11:27:30 +0200 Subject: [PATCH] Runtime broken level generation --- src/Dodge/Data.hs | 26 +- src/Dodge/Debug.hs | 69 +-- src/Dodge/Default.hs | 12 +- src/Dodge/Item/Weapon.hs | 583 +++++++++++++------------- src/Dodge/Rendering.hs | 2 +- src/Dodge/Room/Data.hs | 1 + src/Dodge/Rooms.hs | 12 +- src/Dodge/Update.hs | 2 +- src/Dodge/WorldEvent/SpawnParticle.hs | 18 +- 9 files changed, 356 insertions(+), 369 deletions(-) diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 4269e558f..39ba76d6f 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -479,21 +479,21 @@ type HitEffect = Particle' -> [(Point2, (Either3 Creature Wall ForceField))] -> data Projectile = Projectile - { _ptPos :: Point2 - , _ptStartPos :: Point2 - , _ptVel :: Point2 - , _ptPict :: Picture - , _ptID :: Int - , _ptUpdate :: World -> World + { _pjPos :: Point2 + , _pjStartPos :: Point2 + , _pjVel :: Point2 + , _pjPict :: Picture + , _pjID :: Int + , _pjUpdate :: World -> World } | Shell - { _ptPos :: Point2 - , _ptStartPos :: Point2 - , _ptVel :: Point2 - , _ptPict :: Picture - , _ptID :: Int - , _ptUpdate :: World -> World - , _ptExplosion :: Point2-> World -> World + { _pjPos :: Point2 + , _pjStartPos :: Point2 + , _pjVel :: Point2 + , _pjPict :: Picture + , _pjID :: Int + , _pjUpdate :: World -> World + , _pjPayload :: Point2-> World -> World } data DamageType diff --git a/src/Dodge/Debug.hs b/src/Dodge/Debug.hs index 5ec296c47..17abdbf4c 100644 --- a/src/Dodge/Debug.hs +++ b/src/Dodge/Debug.hs @@ -12,39 +12,42 @@ import Control.Lens import qualified Data.IntMap.Strict as IM drawCircleAtFor :: Point2 -> Int -> World -> World -drawCircleAtFor p t w = - let n = newProjectileKey w - in over projectiles ( IM.insert n - Projectile { _ptPos = p - , _ptStartPos = p - , _ptVel = (0,0) - , _ptPict = onLayer PtLayer $ uncurry translate p $ color white $ circleSolid 20 - , _ptID = n - , _ptUpdate = ptTimer t n - } ) w +drawCircleAtFor p t w = w & projectiles %~ + IM.insert k Projectile + { _pjPos = p + , _pjStartPos = p + , _pjVel = (0,0) + , _pjPict = onLayer PtLayer $ uncurry translate p $ color white $ circleSolid 20 + , _pjID = k + , _pjUpdate = pjTimer t k + } + where + k = newKey $ _projectiles w drawCircleAtForCol :: Point2 -> Int -> Color -> World -> World -drawCircleAtForCol p t col w = - let n = newProjectileKey w - in over projectiles ( IM.insert n - Projectile { _ptPos = p - , _ptStartPos = p - , _ptVel = (0,0) - , _ptPict = onLayer PtLayer $ uncurry translate p $ color col $ circleSolid 20 - , _ptID = n - , _ptUpdate = ptTimer t n - } ) w +drawCircleAtForCol p t col w = w & projectiles %~ + IM.insert k Projectile + { _pjPos = p + , _pjStartPos = p + , _pjVel = (0,0) + , _pjPict = onLayer PtLayer $ uncurry translate p $ color col $ circleSolid 20 + , _pjID = k + , _pjUpdate = pjTimer t k + } + where + k = newKey $ _projectiles w drawLineForCol :: [Point2] -> Int -> Color -> World -> World -drawLineForCol ps t col w = - let n = newProjectileKey w - in over projectiles ( IM.insert n - Projectile { _ptPos = head ps - , _ptStartPos = head ps - , _ptVel = (0,0) - , _ptPict = onLayer PtLayer $ color col $ lineOfThickness 5 ps - , _ptID = n - , _ptUpdate = ptTimer t n - } ) w +drawLineForCol ps t col w = w & projectiles %~ + IM.insert k Projectile + { _pjPos = head ps + , _pjStartPos = head ps + , _pjVel = (0,0) + , _pjPict = onLayer PtLayer $ color col $ lineOfThickness 5 ps + , _pjID = k + , _pjUpdate = pjTimer t k + } + where + k = newKey $ _projectiles w -ptTimer :: Int -> Int -> World -> World -ptTimer 0 i = over projectiles (IM.delete i) -ptTimer time i = set (projectiles . ix i . ptUpdate) $ ptTimer (time - 1) i +pjTimer :: Int -> Int -> World -> World +pjTimer 0 i = projectiles %~ IM.delete i +pjTimer time i = projectiles . ix i . pjUpdate .~ pjTimer (time - 1) i diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index 027e44db6..10b2ed9c8 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -161,12 +161,12 @@ defaultButton = Button , _btState = BtOff } defaultPT = Projectile - { _ptPos = (0,0) - , _ptStartPos = (0,0) - , _ptVel = (0,0) - , _ptPict = blank - , _ptID = 0 - , _ptUpdate = id + { _pjPos = (0,0) + , _pjStartPos = (0,0) + , _pjVel = (0,0) + , _pjPict = blank + , _pjID = 0 + , _pjUpdate = id } defaultPP = PressPlate { _ppPict = onLayer PressPlateLayer $ color (dim $ dim $ bright $ blue) $ circleSolid 5 diff --git a/src/Dodge/Item/Weapon.hs b/src/Dodge/Item/Weapon.hs index 090f6489c..1cb76928c 100644 --- a/src/Dodge/Item/Weapon.hs +++ b/src/Dodge/Item/Weapon.hs @@ -732,121 +732,121 @@ aRocket = aRocket' makeShellAt makeShellAt :: Int -> Int -> Point2 -> Float -> Projectile makeShellAt i cid pos dir = Shell - { _ptPos = pos - , _ptStartPos = pos - , _ptVel = rotateV dir (1,0) - , _ptPict = blank -- onLayer PtLayer $ uncurry translate pos $ rotate (radToDeg dir) shellPic - , _ptID = i - , _ptUpdate = moveShell 50 i cid 0 (rotateV dir (2,0)) - , _ptExplosion = shellExplosionAt + { _pjPos = pos + , _pjStartPos = pos + , _pjVel = rotateV dir (1,0) + , _pjPict = blank -- onLayer PtLayer $ uncurry translate pos $ rotate (radToDeg dir) shellPic + , _pjID = i + , _pjUpdate = moveShell 50 i cid 0 (rotateV dir (2,0)) + , _pjPayload = shellExplosionAt } makeFlameShellAt :: Int -> Int -> Point2 -> Float -> Projectile makeFlameShellAt i cid pos dir = Shell - { _ptPos = pos - , _ptStartPos = pos - , _ptVel = rotateV dir (1,0) - , _ptPict = blank -- onLayer PtLayer $ uncurry translate pos $ rotate (radToDeg dir) shellPic - , _ptID = i - , _ptUpdate = moveShell 50 i cid 0 (rotateV dir (2,0)) - , _ptExplosion = makeFlameExplosionAt + { _pjPos = pos + , _pjStartPos = pos + , _pjVel = rotateV dir (1,0) + , _pjPict = blank -- onLayer PtLayer $ uncurry translate pos $ rotate (radToDeg dir) shellPic + , _pjID = i + , _pjUpdate = moveShell 50 i cid 0 (rotateV dir (2,0)) + , _pjPayload = makeFlameExplosionAt } makePoisonShellAt :: Int -> Int -> Point2 -> Float -> Projectile makePoisonShellAt i cid pos dir = Shell - { _ptPos = pos - , _ptStartPos = pos - , _ptVel = rotateV dir (1,0) - , _ptPict = blank -- onLayer PtLayer $ uncurry translate pos $ rotate (radToDeg dir) shellPic - , _ptID = i - , _ptUpdate = moveShell 50 i cid 0 (rotateV dir (2,0)) - , _ptExplosion = makePoisonExplosionAt + { _pjPos = pos + , _pjStartPos = pos + , _pjVel = rotateV dir (1,0) + , _pjPict = blank -- onLayer PtLayer $ uncurry translate pos $ rotate (radToDeg dir) shellPic + , _pjID = i + , _pjUpdate = moveShell 50 i cid 0 (rotateV dir (2,0)) + , _pjPayload = makePoisonExplosionAt } makeTeslaShellAt :: Int -> Int -> Point2 -> Float -> Projectile makeTeslaShellAt i cid pos dir = Shell - { _ptPos = pos - , _ptStartPos = pos - , _ptVel = rotateV dir (1,0) - , _ptPict = blank -- onLayer PtLayer $ uncurry translate pos $ rotate (radToDeg dir) shellPic - , _ptID = i - , _ptUpdate = moveShell 50 i cid 0 (rotateV dir (2,0)) - , _ptExplosion = makeTeslaExplosionAt + { _pjPos = pos + , _pjStartPos = pos + , _pjVel = rotateV dir (1,0) + , _pjPict = blank -- onLayer PtLayer $ uncurry translate pos $ rotate (radToDeg dir) shellPic + , _pjID = i + , _pjUpdate = moveShell 50 i cid 0 (rotateV dir (2,0)) + , _pjPayload = makeTeslaExplosionAt } moveShell :: Int -> Int -> Int -> Float -> Point2 -> World -> World moveShell time i cid rot accel w | time > 40 = if circOnSomeWall oldPos 4 w - then projectileExplosion oldPos $ over projectiles (IM.delete i) w - else over (projectiles . ix i . ptPos) (+.+ vel) - $ set (projectiles . ix i . ptPict) piclow - $ set (projectiles . ix i . ptUpdate) - (moveShell (time-1) i cid rot (rotateV rot accel)) - w + then projectileExplosion oldPos $ over projectiles (IM.delete i) w + else over (projectiles . ix i . pjPos) (+.+ vel) + $ set (projectiles . ix i . pjPict) piclow + $ set (projectiles . ix i . pjUpdate) + (moveShell (time-1) i cid rot (rotateV rot accel)) + w | time == 35 = case thingHit of - Just p -> projectileExplosion oldPos - $ over projectiles (IM.delete i) w - Nothing -> over (projectiles . ix i . ptPos) (+.+ vel) - $ set (projectiles . ix i . ptPict) pic - $ set (projectiles . ix i . ptUpdate) - (moveShell (time-1) i cid spin accel) - w + Just p -> projectileExplosion oldPos + $ over projectiles (IM.delete i) w + Nothing -> over (projectiles . ix i . pjPos) (+.+ vel) + $ set (projectiles . ix i . pjPict) pic + $ set (projectiles . ix i . pjUpdate) + (moveShell (time-1) i cid spin accel) + w | time >= 20 = case thingHit of - Just p -> projectileExplosion oldPos - $ over projectiles (IM.delete i) w - Nothing -> over (projectiles . ix i . ptPos) (+.+ vel) - $ set (projectiles . ix i . ptPict) pic - $ set (projectiles . ix i . ptUpdate) - (moveShell (time-1) i cid rot (rotateV rot accel)) - w - | time > -99 - = case thingHit of - Just p -> projectileExplosion oldPos - $ stopSoundFrom (ShellSound i) - $ over projectiles (IM.delete i) w - Nothing -> over (projectiles . ix i . ptPos) (+.+ vel) - $ set randGen g - $ set (projectiles . ix i . ptPict) pic - $ set (projectiles . ix i . ptUpdate) - (moveShell (time-1) i cid rot (rotateV rot accel)) - $ over (projectiles . ix i . ptVel) (\v -> accel +.+ frict *.* v) - $ soundFrom (ShellSound i) (fromIntegral smokeTrailSound) (1) 250 - $ makeFlameletTimed oldPos - (0.5 *.* rotateV (pi+sparkD) accel) Nothing 3 10 - $ smokeGen - w + Just p -> projectileExplosion oldPos + $ over projectiles (IM.delete i) w + Nothing -> over (projectiles . ix i . pjPos) (+.+ vel) + $ set (projectiles . ix i . pjPict) pic + $ set (projectiles . ix i . pjUpdate) + (moveShell (time-1) i cid rot (rotateV rot accel)) + w + | time > -99 = case thingHit of + Just p -> projectileExplosion oldPos + $ stopSoundFrom (ShellSound i) + $ over projectiles (IM.delete i) w + Nothing -> over (projectiles . ix i . pjPos) (+.+ vel) + $ set randGen g + $ set (projectiles . ix i . pjPict) pic + $ set (projectiles . ix i . pjUpdate) + (moveShell (time-1) i cid rot (rotateV rot accel)) + $ over (projectiles . ix i . pjVel) (\v -> accel +.+ frict *.* v) + $ soundFrom (ShellSound i) (fromIntegral smokeTrailSound) (1) 250 + $ makeFlameletTimed oldPos + (0.5 *.* rotateV (pi+sparkD) accel) Nothing 3 10 + $ smokeGen + w | time > -200 = case thingHit of - Just p -> projectileExplosion oldPos - $ stopSoundFrom (ShellSound i) - $ over projectiles (IM.delete i) w - Nothing -> over (projectiles . ix i . ptPos) (+.+ vel) - $ set (projectiles . ix i . ptPict) pic - $ set (projectiles . ix i . ptUpdate) - (moveShell (time-1) i cid rot (rotateV rot accel)) - w + Just p -> projectileExplosion oldPos + $ stopSoundFrom (ShellSound i) + $ over projectiles (IM.delete i) w + Nothing -> over (projectiles . ix i . pjPos) (+.+ vel) + $ set (projectiles . ix i . pjPict) pic + $ set (projectiles . ix i . pjUpdate) + (moveShell (time-1) i cid rot (rotateV rot accel)) + w | otherwise = projectileExplosion oldPos $ stopSoundFrom (ShellSound i) $ over projectiles (IM.delete i) w - where pt = _projectiles w IM.! i - oldPos = _ptPos pt - vel = _ptVel pt - projectileExplosion = _ptExplosion pt - newPos = oldPos +.+ vel - (frict,g) = randomR (0.6,0.9) $ _randGen w - (sparkD,_) = randomR (-0.5,0.5) $ _randGen w - dir = argV $ vel - pic = onLayer PtLayer $ uncurry translate newPos $ rotate (argV accel) shellPic - piclow = onLayerL [levLayer CrLayer - 2] - $ uncurry translate newPos $ rotate (argV accel) shellPic - hitCr = fmap fst $ collideCircCrsPoint oldPos newPos 4 w - hitWl = fmap fst $ collideCircWalls' oldPos newPos 2 $ wallsNearPoint newPos w - thingHit = hitCr <|> hitWl - spin = case w ^? creatures . ix cid of - Just cr -> min 0.1 $ max (-0.1) - $ (normalizeAnglePi (dir - _crDir cr)) / 20 - _ -> 0 - r1 = _randGen w & evalState (randInCirc 10) - smokeGen = makeSmokeCloudAt (oldPos +.+ r1 +.+ 30 *.* (normalizeV (oldPos -.- newPos))) + where + pj = _projectiles w IM.! i + oldPos = _pjPos pj + vel = _pjVel pj + projectileExplosion = _pjPayload pj + newPos = oldPos +.+ vel + (frict,g) = randomR (0.6,0.9) $ _randGen w + (sparkD,_) = randomR (-0.5,0.5) $ _randGen w + dir = argV $ vel + pic = onLayer PtLayer $ uncurry translate newPos $ rotate (argV accel) shellPic + piclow = onLayerL [levLayer CrLayer - 2] + $ uncurry translate newPos $ rotate (argV accel) shellPic + hitCr = fmap fst $ collideCircCrsPoint oldPos newPos 4 w + hitWl = fmap fst $ collideCircWalls' oldPos newPos 2 $ wallsNearPoint newPos w + thingHit = hitCr <|> hitWl + spin = case w ^? creatures . ix cid of + Just cr -> min 0.1 $ max (-0.1) + $ (normalizeAnglePi (dir - _crDir cr)) / 20 + _ -> 0 + r1 = _randGen w & evalState (randInCirc 10) + smokeGen = makeSmokeCloudAt (oldPos +.+ r1 +.+ 30 *.* (normalizeV (oldPos -.- newPos))) normalizeAnglePi angle | normalizeAngle angle > pi = normalizeAngle angle - 2*pi @@ -865,15 +865,16 @@ shellExplosionAt = makeExplosionAt tractorBeamAt :: Int -> Int -> Point2 -> Float -> Projectile tractorBeamAt colID i pos dir = Projectile - { _ptPos = pos - , _ptStartPos = p' - , _ptVel = d - , _ptPict = blank - , _ptID = i - , _ptUpdate = updateTractor colID 10 i + { _pjPos = pos + , _pjStartPos = p' + , _pjVel = d + , _pjPict = blank + , _pjID = i + , _pjUpdate = updateTractor colID 10 i } - where d = unitVectorAtAngle dir - p' = pos +.+ 400 *.* d + where + d = unitVectorAtAngle dir + p' = pos +.+ 400 *.* d aGasCloud :: Int -> World -> World aGasCloud cid w @@ -925,74 +926,74 @@ reflect a b = a + 2*(a-b) moveGrenade :: Int -> Float -> Int -> World -> World moveGrenade 0 dir pID w = over projectiles (IM.delete pID) - $ explosion (_ptPos (_projectiles w IM.! pID)) + $ explosion (_pjPos (_projectiles w IM.! pID)) -- $ set (pointToItem (_itemPositions w IM.! wpID) . itEquipPict) -- (drawWeapon $ grenadePic 50) w - where - pt = _projectiles w IM.! pID - explosion = _ptExplosion pt + where + pj = _projectiles w IM.! pID + explosion = _pjPayload pj moveGrenade time dir pID w = case hitWl of Just _ -> soundOnce (fromIntegral tapQuiet) updatedWorld _ -> updatedWorld - where - updatedWorld = updateV $ set (projectiles . ix pID . ptPos) finalPos - $ set (projectiles .ix pID.ptPict) + where + updatedWorld = updateV $ set (projectiles . ix pID . pjPos) finalPos + $ set (projectiles .ix pID.pjPict) (onLayer PtLayer $ uncurry translate newPos $ rotate dir $ grenadePic time) - $ set (projectiles .ix pID.ptUpdate) (moveGrenade (time-1) dir pID) w - pt = _projectiles w IM.! pID - oldPos = _ptPos pt - newPos = _ptVel pt +.+ oldPos + $ set (projectiles .ix pID.pjUpdate) (moveGrenade (time-1) dir pID) w + pj = _projectiles w IM.! pID + oldPos = _pjPos pj + newPos = _pjVel pj +.+ oldPos hitWl = collideCircWalls' oldPos newPos 4 $ wallsNearPoint newPos w finalPos = fromMaybe newPos (fmap fst hitWl) - setV v = set (projectiles .ix pID.ptVel) v + setV v = set (projectiles .ix pID.pjVel) v updateV = fromMaybe id (fmap (setV.snd) hitWl) pointToItem (InInv cid invid) = creatures . ix cid . crInv . ix invid pointToItem (OnFloor flid) = floorItems . ix flid . flIt retireRemoteRocket :: Int -> Int -> Int -> World -> World -retireRemoteRocket itid 0 ptid w +retireRemoteRocket itid 0 pjid w = set (pointToItem (_itemPositions w IM.! itid) . itAttachment . _Just . scopePos) (0,0) $ set (pointToItem (_itemPositions w IM.! itid) . wpFire) fireRemoteLauncher - (w & projectiles %~ IM.delete ptid) -retireRemoteRocket itid t ptid w = setScope w & projectiles . ix ptid . ptUpdate .~ retireRemoteRocket itid (t-1) ptid + (w & projectiles %~ IM.delete pjid) +retireRemoteRocket itid t pjid w = setScope w & projectiles . ix pjid . pjUpdate .~ retireRemoteRocket itid (t-1) pjid where setScope w' = case _itemPositions w' IM.! itid of InInv cid invid -> w' & creatures . ix cid . crInv . ix invid . itAttachment . _Just . scopePos .~ (pos -.- _crPos (_creatures w' IM.! cid)) _ -> w' - pos = fromMaybe (0,0) $ w ^? projectiles . ix ptid . ptPos + pos = fromMaybe (0,0) $ w ^? projectiles . ix pjid . pjPos retireRemoteBomb :: Int -> Int -> Int -> World -> World -retireRemoteBomb itid 0 ptid w +retireRemoteBomb itid 0 pjid w = set (pointToItem (_itemPositions w IM.! itid) . itAttachment . _Just . scopePos) (0,0) $ set (pointToItem (_itemPositions w IM.! itid) . itZoom) defaultItZoom $ set (pointToItem (_itemPositions w IM.! itid) . twFire) throwRemoteBomb - (w & projectiles %~ IM.delete ptid) -retireRemoteBomb itid t ptid w - = setScope w & projectiles . ix ptid . ptUpdate .~ retireRemoteBomb itid (t-1) ptid + (w & projectiles %~ IM.delete pjid) +retireRemoteBomb itid t pjid w + = setScope w & projectiles . ix pjid . pjUpdate .~ retireRemoteBomb itid (t-1) pjid where setScope w' = case _itemPositions w' IM.! itid of InInv cid invid -> w' & creatures . ix cid . crInv . ix invid . itAttachment . _Just . scopePos .~ (pos -.- _crPos (_creatures w' IM.! cid)) _ -> w' - pos = fromMaybe (0,0) $ w ^? projectiles . ix ptid . ptPos + pos = fromMaybe (0,0) $ w ^? projectiles . ix pjid . pjPos moveRemoteBomb :: Int -> Int -> Int -> World -> World moveRemoteBomb itid time pID w | time < -4 = setScope $ updatePicture - $ set (projectiles .ix pID.ptUpdate) (moveRemoteBomb itid (f time) pID) + $ set (projectiles .ix pID.pjUpdate) (moveRemoteBomb itid (f time) pID) w | time < 2 = case hitWl of @@ -1004,9 +1005,9 @@ moveRemoteBomb itid time pID w _ -> updatedWorld where updatedWorld - = updateV $ set (projectiles . ix pID . ptPos) finalPos + = updateV $ set (projectiles . ix pID . pjPos) finalPos $ updatePicture - $ set (projectiles .ix pID.ptUpdate) (moveRemoteBomb itid (time-1) pID) + $ set (projectiles .ix pID.pjUpdate) (moveRemoteBomb itid (time-1) pID) $ setScope w setScope w' = case _itemPositions w' IM.! itid of @@ -1016,20 +1017,20 @@ moveRemoteBomb itid time pID w & creatures . ix cid . crInv . ix invid . itZoom .~ (defaultItZoom {_itAimZoomMax = 0.5, _itAimZoomMin = 0.5}) _ -> w' - pt = _projectiles w IM.! pID - oldPos = _ptPos pt - newPos = _ptVel pt +.+ oldPos + pj = _projectiles w IM.! pID + oldPos = _pjPos pj + newPos = _pjVel pj +.+ oldPos -- this is hacky, should use a version of collidePointWalls' that collides -- circles and walls - invShift x = x -.- 5 *.* normalizeV (_ptVel pt) + invShift x = x -.- 5 *.* normalizeV (_pjVel pj) hitWl = collideCircWalls' oldPos newPos 4 $ wallsNearPoint newPos w finalPos = fromMaybe newPos (fmap (invShift . fst) hitWl) - setV v = set (projectiles .ix pID.ptVel) v + setV v = set (projectiles .ix pID.pjVel) v updateV = fromMaybe id (fmap (setV.snd) hitWl) - halfV = over (projectiles . ix pID . ptVel) (\v -> 0.5 *.* v) + halfV = over (projectiles . ix pID . pjVel) (\v -> 0.5 *.* v) f x | x < -369 = -10 | otherwise = x - 1 - updatePicture = set (projectiles . ix pID.ptPict) + updatePicture = set (projectiles . ix pID.pjPict) (onLayer PtLayer $ uncurry translate newPos $ remoteBombPic time) . lowLightDirected (withAlpha 0.1 red) newPos @@ -1270,60 +1271,35 @@ remoteBomb = defaultThrowable throwGrenade' :: (Point2 -> World -> World) -> Int -> Int -> World -> World throwGrenade' explosion fuseTime n w = setWp $ removePict $ over projectiles addG $ set randGen g w - where addG = IM.insert i - $ Shell { _ptPos = p - , _ptStartPos = p - , _ptVel = v - , _ptPict = onLayer PtLayer $ uncurry translate p $ grenadePic 0 - , _ptID = i - , _ptUpdate = moveGrenade fuseTime dir i - , _ptExplosion = explosion - } - j = _crInvSel $ _creatures w IM.! n - removePict = set (creatures . ix n . crInv . ix j . itEquipPict) $ \ _ _ -> blank - i = newProjectileKey w - (a, g) = randomR (-grenadeAccA,grenadeAccA::Float) (_randGen w) - (l, _) = randomR (1 - 2*grenadeAccL,1+grenadeAccL::Float) g - -- v = 0.02 * l / _cameraZoom w *.* rotateV (a+_cameraRot w) (limitRange $ _mousePos w) - v' = 1 / (fromIntegral fuseTime * _cameraZoom w) *.* rotateV (_cameraRot w) ( _mousePos w) - v | magV v' > 6 = 6 *.* normalizeV v' - | otherwise = v' - cr = _creatures w IM.! n - p' = _crPos cr +.+ rotateV (_crDir cr) (_crRad cr,0) - p | circOnSomeWall p' 4 w = _crPos cr +.+ rotateV (_crDir cr) (_crRad cr-4,0) - | otherwise = p' - dir = argV v - setWp :: World -> World - setWp w' = w' & creatures . ix n . crInv . ix j . itEffect .~ throwArmReset 20 + where + addG = IM.insert i $ Shell + { _pjPos = p + , _pjStartPos = p + , _pjVel = v + , _pjPict = onLayer PtLayer $ uncurry translate p $ grenadePic 0 + , _pjID = i + , _pjUpdate = moveGrenade fuseTime dir i + , _pjPayload = explosion + } + j = _crInvSel $ _creatures w IM.! n + removePict = set (creatures . ix n . crInv . ix j . itEquipPict) $ \ _ _ -> blank + i = newProjectileKey w + (a, g) = randomR (-grenadeAccA,grenadeAccA::Float) (_randGen w) + (l, _) = randomR (1 - 2*grenadeAccL,1+grenadeAccL::Float) g +-- - v = 0.02 * l / _cameraZoom w *.* rotateV (a+_cameraRot w) (limitRange $ _mousePos w) + v' = 1 / (fromIntegral fuseTime * _cameraZoom w) *.* rotateV (_cameraRot w) ( _mousePos w) + v | magV v' > 6 = 6 *.* normalizeV v' + | otherwise = v' + cr = _creatures w IM.! n + p' = _crPos cr +.+ rotateV (_crDir cr) (_crRad cr,0) + p | circOnSomeWall p' 4 w = _crPos cr +.+ rotateV (_crDir cr) (_crRad cr-4,0) + | otherwise = p' + dir = argV v + setWp :: World -> World + setWp w' = w' & creatures . ix n . crInv . ix j . itEffect .~ throwArmReset 20 throwGrenade :: Int -> Int -> World -> World throwGrenade = throwGrenade' makeExplosionAt --- setWp $ removePict $ over projectiles addG $ set randGen g w --- where addG = IM.insert i --- $ Shell { _ptPos = p --- , _ptStartPos = p --- , _ptVel = v --- , _ptPict = onLayer PtLayer $ uncurry translate p $ grenadePic 0 --- , _ptID = i --- , _ptUpdate = moveGrenade fuseTime dir i --- , _ptExplosion = makeExplosionAt --- } --- j = _crInvSel $ _creatures w IM.! n --- removePict = set (creatures . ix n . crInv . ix j . itEquipPict) $ \ _ _ -> blank --- i = newProjectileKey w --- (a, g) = randomR (-grenadeAccA,grenadeAccA::Float) (_randGen w) --- (l, _) = randomR (1 - 2*grenadeAccL,1+grenadeAccL::Float) g --- -- v = 0.02 * l / _cameraZoom w *.* rotateV (a+_cameraRot w) (limitRange $ _mousePos w) --- v' = 1 / (fromIntegral fuseTime * _cameraZoom w) *.* rotateV (_cameraRot w) ( _mousePos w) --- v | magV v' > 6 = 6 *.* normalizeV v' --- | otherwise = v' --- cr = _creatures w IM.! n --- p' = _crPos cr +.+ rotateV (_crDir cr) (_crRad cr,0) --- p | circOnSomeWall p' 4 w = _crPos cr +.+ rotateV (_crDir cr) (_crRad cr-4,0) --- | otherwise = p' --- dir = argV v --- setWp :: World -> World --- setWp w' = w' & creatures . ix n . crInv . ix j . itEffect .~ throwArmReset 20 throwArmReset :: Int -> ItEffect throwArmReset x = @@ -1352,45 +1328,46 @@ fireRemoteLauncher :: Int -> World -> World fireRemoteLauncher cid w = setLocation $ resetFire $ resetName $ soundOnce (fromIntegral launcherSound) $ over projectiles remRocket w - where - i = newKey $ _projectiles w - cr = _creatures w IM.! cid - dir = _crDir cr - pos = _crPos cr +.+ rotateV dir (_crRad cr + 1,0) - remRocket = IM.insert i $ Projectile { _ptPos = pos - , _ptStartPos = pos - , _ptVel = rotateV dir (1,0) - , _ptPict = blank - , _ptID = i - , _ptUpdate = moveRemoteShell 50 i cid itid dir - } - j = _crInvSel $ _creatures w IM.! cid - newitid = newKey $ _itemPositions w - maybeitid = w ^? creatures . ix cid . crInv . ix j . itID . _Just - resetFire = set (creatures . ix cid . crInv . ix j . wpFire) $ explodeRemoteRocket itid i - resetName = set (creatures . ix cid . crInv . ix j . itName) "REMOTEROCKET" - setLocation :: World -> World - setLocation w' = case maybeitid of - Nothing -> w' & creatures . ix cid . crInv . ix j . itID .~ Just newitid - & itemPositions %~ IM.insert newitid (InInv cid j) - _ -> w' - itid = fromMaybe newitid maybeitid + where + i = newKey $ _projectiles w + cr = _creatures w IM.! cid + dir = _crDir cr + pos = _crPos cr +.+ rotateV dir (_crRad cr + 1,0) + remRocket = IM.insert i $ Projectile + { _pjPos = pos + , _pjStartPos = pos + , _pjVel = rotateV dir (1,0) + , _pjPict = blank + , _pjID = i + , _pjUpdate = moveRemoteShell 50 i cid itid dir + } + j = _crInvSel $ _creatures w IM.! cid + newitid = newKey $ _itemPositions w + maybeitid = w ^? creatures . ix cid . crInv . ix j . itID . _Just + resetFire = set (creatures . ix cid . crInv . ix j . wpFire) $ explodeRemoteRocket itid i + resetName = set (creatures . ix cid . crInv . ix j . itName) "REMOTEROCKET" + setLocation :: World -> World + setLocation w' = case maybeitid of + Nothing -> w' & creatures . ix cid . crInv . ix j . itID .~ Just newitid + & itemPositions %~ IM.insert newitid (InInv cid j) + _ -> w' + itid = fromMaybe newitid maybeitid moveRemoteShell :: Int -> Int -> Int -> Int -> Float -> World -> World moveRemoteShell time i cid itid dir w | time > 40 = if circOnSomeWall oldPos 4 w then doExplosion w - else over (projectiles . ix i . ptPos) (+.+ vel) - $ set (projectiles . ix i . ptPict) piclow - $ set (projectiles . ix i . ptUpdate) + else over (projectiles . ix i . pjPos) (+.+ vel) + $ set (projectiles . ix i . pjPict) piclow + $ set (projectiles . ix i . pjUpdate) (moveRemoteShell (time-1) i cid itid newdir) $ setScope w | time >= 20 = case thingHit of Just p -> doExplosion w - Nothing -> over (projectiles . ix i . ptPos) (+.+ vel) - $ set (projectiles . ix i . ptPict) pic - $ set (projectiles . ix i . ptUpdate) + Nothing -> over (projectiles . ix i . pjPos) (+.+ vel) + $ set (projectiles . ix i . pjPict) pic + $ set (projectiles . ix i . pjUpdate) (moveRemoteShell (time-1) i cid itid newdir) $ setScope w @@ -1399,12 +1376,12 @@ moveRemoteShell time i cid itid dir w Just p -> doExplosion $ stopSoundFrom (ShellSound i) w - Nothing -> over (projectiles . ix i . ptPos) (+.+ vel) + Nothing -> over (projectiles . ix i . pjPos) (+.+ vel) $ set randGen g - $ set (projectiles . ix i . ptPict) pic - $ set (projectiles . ix i . ptUpdate) + $ set (projectiles . ix i . pjPict) pic + $ set (projectiles . ix i . pjUpdate) (moveRemoteShell (time-1) i cid itid newdir) - $ over (projectiles . ix i . ptVel) (\v -> accel +.+ frict *.* v) + $ over (projectiles . ix i . pjVel) (\v -> accel +.+ frict *.* v) $ soundFrom (ShellSound i) (fromIntegral smokeTrailSound) (1) 250 $ smokeGen $ makeFlameletTimed oldPos @@ -1415,108 +1392,112 @@ moveRemoteShell time i cid itid dir w Just p -> doExplosion $ stopSoundFrom (ShellSound i) w - Nothing -> over (projectiles . ix i . ptPos) (+.+ vel) - $ set (projectiles . ix i . ptPict) pic - $ set (projectiles . ix i . ptUpdate) + Nothing -> over (projectiles . ix i . pjPos) (+.+ vel) + $ set (projectiles . ix i . pjPict) pic + $ set (projectiles . ix i . pjUpdate) (moveRemoteShell (time-1) i cid itid newdir) $ setScope w | otherwise = doExplosion $ stopSoundFrom (ShellSound i) w - where pt = _projectiles w IM.! i - oldPos = _ptPos pt - vel = _ptVel pt - newPos = oldPos +.+ vel - newdir - | SDL.ButtonRight `S.member` (_mouseButtons w) - && w ^? creatures . ix cid . crInvSel == w ^? itemPositions . ix itid . itInvId - = _cameraRot w + (argV $ _mousePos w) - | otherwise = dir - accel = rotateV newdir (2,0) - (frict,g) = randomR (0.6,0.9) $ _randGen w - (sparkD,_) = randomR (-0.5,0.5) $ _randGen w - dir = argV $ vel - pic = onLayer PtLayer $ uncurry translate newPos - $ rotate (argV accel) $ remoteShellPic time - piclow = onLayerL [levLayer CrLayer - 2] - $ uncurry translate newPos $ rotate (argV accel) - $ remoteShellPic time - hitCr = fmap fst $ collideCircCrsPoint oldPos newPos 4 w - hitWl = fmap fst $ collideCircWalls' oldPos newPos 2 $ wallsNearPoint newPos w - thingHit = hitCr <|> hitWl + where + pj = _projectiles w IM.! i + oldPos = _pjPos pj + vel = _pjVel pj + newPos = oldPos +.+ vel + newdir + | SDL.ButtonRight `S.member` (_mouseButtons w) + && w ^? creatures . ix cid . crInvSel == w ^? itemPositions . ix itid . itInvId + = _cameraRot w + (argV $ _mousePos w) + | otherwise = dir + accel = rotateV newdir (2,0) + (frict,g) = randomR (0.6,0.9) $ _randGen w + (sparkD,_) = randomR (-0.5,0.5) $ _randGen w + dir = argV $ vel + pic = onLayer PtLayer $ uncurry translate newPos + $ rotate (argV accel) $ remoteShellPic time + piclow = onLayerL [levLayer CrLayer - 2] + $ uncurry translate newPos $ rotate (argV accel) + $ remoteShellPic time + hitCr = fmap fst $ collideCircCrsPoint oldPos newPos 4 w + hitWl = fmap fst $ collideCircWalls' oldPos newPos 2 $ wallsNearPoint newPos w + thingHit = hitCr <|> hitWl - r1 = _randGen w & evalState (randInCirc 10) - smokeGen = makeSmokeCloudAt (oldPos +.+ r1 +.+ 30 *.* (normalizeV (oldPos -.- newPos))) - doExplosion = explodeRemoteRocket itid i cid - setScope w' = case _itemPositions w' IM.! itid of - InInv cid invid - -> w' & creatures . ix cid . crInv . ix invid . itAttachment - . _Just . scopePos .~ (newPos -.- _crPos (_creatures w' IM.! cid)) - _ -> w' + r1 = _randGen w & evalState (randInCirc 10) + smokeGen = makeSmokeCloudAt (oldPos +.+ r1 +.+ 30 *.* (normalizeV (oldPos -.- newPos))) + doExplosion = explodeRemoteRocket itid i cid + setScope w' = case _itemPositions w' IM.! itid of + InInv cid invid + -> w' & creatures . ix cid . crInv . ix invid . itAttachment + . _Just . scopePos .~ (newPos -.- _crPos (_creatures w' IM.! cid)) + _ -> w' explodeRemoteRocket :: Int -> Int -> Int -> World -> World -explodeRemoteRocket itid ptid n w - = set (projectiles . ix ptid . ptUpdate) (retireRemoteRocket itid 30 ptid) - $ set (projectiles . ix ptid . ptPict) blank +explodeRemoteRocket itid pjid n w + = set (projectiles . ix pjid . pjUpdate) (retireRemoteRocket itid 30 pjid) + $ set (projectiles . ix pjid . pjPict) blank $ set (itPoint . wpFire) (flip const) $ resetName - $ makeExplosionAt (_ptPos (_projectiles w IM.! ptid)) w - where resetName = set (itPoint . itName) "REMOTELAUNCHER" - itPoint = pointToItem $ _itemPositions w IM.! itid + $ makeExplosionAt (_pjPos (_projectiles w IM.! pjid)) w + where + resetName = set (itPoint . itName) "REMOTELAUNCHER" + itPoint = pointToItem $ _itemPositions w IM.! itid throwRemoteBomb :: Int -> World -> World throwRemoteBomb n w = setLocation $ removePict $ resetFire $ resetName $ over projectiles addG w - where addG = IM.insert i - $ Projectile { _ptPos = p - , _ptStartPos = p - , _ptVel = v - , _ptPict = blank - , _ptID = i - , _ptUpdate = moveRemoteBomb itid 50 i - } - i = newProjectileKey w - -- fireDist = zoom *.* (rotateV (_cameraRot w) (_mousePos w) +.+ _cameraCenter w -.- yourPos) - d = argV $ _mousePos w - --(l, _) = randomR (1 - grenadeAccL,1+grenadeAccL) (_randGen w) - --(a, g) = randomR (-grenadeAccA,grenadeAccA) (_randGen w) - v' = 0.02 / _cameraZoom w *.* rotateV (_cameraRot w) ( _mousePos w) - v | magV v' > 6 = 6 *.* normalizeV v' - -- zoom = 1 / _cameraZoom w - j = _crInvSel $ _creatures w IM.! n - resetName = set (creatures . ix n . crInv . ix j . itName) "REMOTE" - removePict = set (creatures . ix n . crInv . ix j . itEquipPict) $ \ _ _ -> blank - resetFire = set (creatures . ix n . crInv . ix j . twFire) $ explodeRemoteBomb itid i - cr = _creatures w IM.! n - p' = _crPos cr +.+ rotateV (_crDir cr) (_crRad cr,0) - p | circOnSomeWall p' 4 w = _crPos cr +.+ rotateV (_crDir cr) (_crRad cr-4,0) - | otherwise = p' - maybeitid = w ^? creatures . ix n . crInv . ix j . itID . _Just - setLocation :: World -> World - setLocation w' = case maybeitid of - Nothing -> w' & creatures . ix n . crInv . ix j . itID .~ Just newitid - & itemPositions %~ IM.insert newitid (InInv n j) - _ -> w' - newitid = newKey $ _itemPositions w - itid = fromMaybe newitid maybeitid + where + addG = IM.insert i $ Projectile + { _pjPos = p + , _pjStartPos = p + , _pjVel = v + , _pjPict = blank + , _pjID = i + , _pjUpdate = moveRemoteBomb itid 50 i + } + i = newProjectileKey w + -- fireDist = zoom *.* (rotateV (_cameraRot w) (_mousePos w) +.+ _cameraCenter w -.- yourPos) + d = argV $ _mousePos w + --(l, _) = randomR (1 - grenadeAccL,1+grenadeAccL) (_randGen w) + --(a, g) = randomR (-grenadeAccA,grenadeAccA) (_randGen w) + v' = 0.02 / _cameraZoom w *.* rotateV (_cameraRot w) ( _mousePos w) + v | magV v' > 6 = 6 *.* normalizeV v' + -- zoom = 1 / _cameraZoom w + j = _crInvSel $ _creatures w IM.! n + resetName = set (creatures . ix n . crInv . ix j . itName) "REMOTE" + removePict = set (creatures . ix n . crInv . ix j . itEquipPict) $ \ _ _ -> blank + resetFire = set (creatures . ix n . crInv . ix j . twFire) $ explodeRemoteBomb itid i + cr = _creatures w IM.! n + p' = _crPos cr +.+ rotateV (_crDir cr) (_crRad cr,0) + p | circOnSomeWall p' 4 w = _crPos cr +.+ rotateV (_crDir cr) (_crRad cr-4,0) + | otherwise = p' + maybeitid = w ^? creatures . ix n . crInv . ix j . itID . _Just + setLocation :: World -> World + setLocation w' = case maybeitid of + Nothing -> w' & creatures . ix n . crInv . ix j . itID .~ Just newitid + & itemPositions %~ IM.insert newitid (InInv n j) + _ -> w' + newitid = newKey $ _itemPositions w + itid = fromMaybe newitid maybeitid explodeRemoteBomb :: Int -> Int -> Int -> World -> World -explodeRemoteBomb itid ptid n w - = set (projectiles . ix ptid . ptUpdate) (retireRemoteBomb itid 30 ptid) - $ set (projectiles . ix ptid . ptPict) blank +explodeRemoteBomb itid pjid n w + = set (projectiles . ix pjid . pjUpdate) (retireRemoteBomb itid 30 pjid) + $ set (projectiles . ix pjid . pjPict) blank $ set (creatures . ix n . crInv . ix j . twFire) (flip const) $ resetName $ resetPict -- $ resetScope - $ makeExplosionAt (_ptPos (_projectiles w IM.! ptid)) w - -- $ makeShrapnelBombAt (_ptPos (_projectiles w IM.! ptid)) w - where resetName = set (creatures . ix n . crInv . ix j . itName) "REMOTEBOMB" - resetPict = set (creatures . ix n . crInv . ix j . itEquipPict ) - (drawWeapon $ remoteBombUnarmedPic) --- resetScope = creatures . ix n . crInv . ix j . itScope . _Just . scopePos .~ (0,0) - j = _crInvSel $ _creatures w IM.! n + $ makeExplosionAt (_pjPos (_projectiles w IM.! pjid)) w + -- $ makeShrapnelBombAt (_pjPos (_projectiles w IM.! pjid)) w + where + resetName = set (creatures . ix n . crInv . ix j . itName) "REMOTEBOMB" + resetPict = set (creatures . ix n . crInv . ix j . itEquipPict ) + (drawWeapon $ remoteBombUnarmedPic) +-- resetScope = creatures . ix n . crInv . ix j . itScope . _Just . scopePos .~ (0,0) + j = _crInvSel $ _creatures w IM.! n remoteBombPic :: Int -> Picture remoteBombPic x = pictures [ color (dark $ dark orange) $ circleSolid 5 , rotate (0 - degToRad (fromIntegral x * 10 + 45)) $ color red $ arc 0 (pi/2) 5 @@ -1667,8 +1648,8 @@ moveInt toReload totalAmmo = (x, totalAmmo-x) updateTractor :: Int -> Int -> Int -> World -> World updateTractor colID time i w - | time > 0 = set (projectiles . ix i . ptUpdate) (updateTractor colID (time-1) i) - $ set (projectiles . ix i . ptPict) pic + | time > 0 = set (projectiles . ix i . pjUpdate) (updateTractor colID (time-1) i) + $ set (projectiles . ix i . pjPict) pic $ over creatures (IM.map tractCr) $ over floorItems (IM.map tractFlIt) w @@ -1693,10 +1674,10 @@ updateTractor colID time i w iP = _flItPos it m | dist iP p1 < 350 = 1 | otherwise = (410 - dist iP p1) / 60 - pt = _projectiles w IM.! i - q = _ptVel pt - p1 = _ptPos pt - p' = _ptStartPos pt + pj = _projectiles w IM.! i + q = _pjVel pj + p1 = _pjPos pj + p' = _pjStartPos pj p2 = fromMaybe p' $ fmap fst $ collidePointWalls p1 p' $ wallsNearPoint p' w p4 = vNormal p5 p5 = errorNormalizeV 12 $ p2 -.- p1 diff --git a/src/Dodge/Rendering.hs b/src/Dodge/Rendering.hs index 404d606b4..ddbe643cc 100644 --- a/src/Dodge/Rendering.hs +++ b/src/Dodge/Rendering.hs @@ -28,7 +28,7 @@ import qualified Data.Set as S worldPictures :: World -> Picture worldPictures w = pictures $ concat [ IM.elems $ _decorations w - , map _ptPict . IM.elems $ _projectiles w + , map _pjPict . IM.elems $ _projectiles w , map drawItem . IM.elems $ _floorItems w , map crDraw . IM.elems $ _creatures w , map clDraw . IM.elems $ _clouds w diff --git a/src/Dodge/Room/Data.hs b/src/Dodge/Room/Data.hs index 17aa51aeb..7bf5a3ed8 100644 --- a/src/Dodge/Room/Data.hs +++ b/src/Dodge/Room/Data.hs @@ -1,4 +1,5 @@ {-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE StrictData #-} module Dodge.Room.Data where diff --git a/src/Dodge/Rooms.hs b/src/Dodge/Rooms.hs index a9ca27ae9..26f419535 100644 --- a/src/Dodge/Rooms.hs +++ b/src/Dodge/Rooms.hs @@ -148,12 +148,14 @@ roomC x y = Room , _rmPS = [windowLine (x/2,0) (x/2,y-60) ] --, _rmBound = rectNSWE y 0 0 x - , _rmBound = [] + , _rmBound = rectNSWE (y+5) (-5) (-5) (x+5) } - where lnks = [( (x-20, 0),pi) - ,( ( 20, 0),pi) - ,( ( 0, 20),pi/2) - ] + where + lnks = + [( (x-20, 0),pi) + ,( ( 20, 0),pi) + ,( ( 0, 20),pi/2) + ] makeRect :: Float -> Float -> [(Point2,Point2)] makeRect x y = [((0,0),(x,0)) diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 1779d8c6f..617d7b20a 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -68,7 +68,7 @@ updateSoundQueue = set soundQueue [] updateLightSources w = set tempLightSources (catMaybes tlss) w' where (w',tlss) = mapAccumR (\a b -> _tlsUpdate b a b) w $ _tempLightSources w -updateProjectiles w = IM.foldr' _ptUpdate w $ _projectiles w +updateProjectiles w = IM.foldr' _pjUpdate w $ _projectiles w updateParticles' :: World -> World updateParticles' w = set particles' (catMaybes ps) w' diff --git a/src/Dodge/WorldEvent/SpawnParticle.hs b/src/Dodge/WorldEvent/SpawnParticle.hs index 7de8c174e..dc900a111 100644 --- a/src/Dodge/WorldEvent/SpawnParticle.hs +++ b/src/Dodge/WorldEvent/SpawnParticle.hs @@ -194,19 +194,19 @@ cloudPoisonDamage c w = w & creatures %~ flip (foldr (IM.adjust doDam)) damagedC makeTeslaArcAt :: Int -> Point2 -> Float -> Projectile makeTeslaArcAt i pos dir = Projectile - { _ptPos = pos - , _ptStartPos = pos - , _ptVel = (0,0) - , _ptPict = onLayer PtLayer $ line [(0,0),(0,0)] - , _ptID = i - , _ptUpdate = moveTeslaArc pos dir i + { _pjPos = pos + , _pjStartPos = pos + , _pjVel = (0,0) + , _pjPict = onLayer PtLayer $ line [(0,0),(0,0)] + , _pjID = i + , _pjUpdate = moveTeslaArc pos dir i } moveTeslaArc :: Point2 -> Float -> Int -> World -> World moveTeslaArc p d i w = - set (projectiles . ix i . ptPict) pic - $ set (projectiles . ix i . ptUpdate) - (ptTimer 2 i) + set (projectiles . ix i . pjPict) pic + $ set (projectiles . ix i . pjUpdate) + (pjTimer 2 i) $ set randGen g $ createSpark 8 nc q2 (argV sv + d1) Nothing $ foldr damCrs w hitCrs