justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Runtime broken level generation

Browse Source
This commit is contained in:
justin
2021-03-29 11:27:30 +02:00
parent e0570ed54c
commit c959b7d59c
9 changed files with 356 additions and 369 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data.hs
+13 -13
View File
@@ -479,21 +479,21 @@ type HitEffect = Particle' -> [(Point2, (Either3 Creature Wall ForceField))] ->
data Projectile data Projectile
= Projectile = Projectile
{ _ptPos :: Point2 { _pjPos :: Point2
, _ptStartPos :: Point2 , _pjStartPos :: Point2
, _ptVel :: Point2 , _pjVel :: Point2
, _ptPict :: Picture , _pjPict :: Picture
, _ptID :: Int , _pjID :: Int
, _ptUpdate :: World -> World , _pjUpdate :: World -> World
} }
| Shell | Shell
{ _ptPos :: Point2 { _pjPos :: Point2
, _ptStartPos :: Point2 , _pjStartPos :: Point2
, _ptVel :: Point2 , _pjVel :: Point2
, _ptPict :: Picture , _pjPict :: Picture
, _ptID :: Int , _pjID :: Int
, _ptUpdate :: World -> World , _pjUpdate :: World -> World
, _ptExplosion :: Point2-> World -> World , _pjPayload :: Point2-> World -> World
} }
data DamageType data DamageType
src/Dodge/Debug.hs
+36 -33
View File
@@ -12,39 +12,42 @@ import Control.Lens
import qualified Data.IntMap.Strict as IM import qualified Data.IntMap.Strict as IM
drawCircleAtFor :: Point2 -> Int -> World -> World drawCircleAtFor :: Point2 -> Int -> World -> World
drawCircleAtFor p t w = drawCircleAtFor p t w = w & projectiles %~
let n = newProjectileKey w IM.insert k Projectile
in over projectiles ( IM.insert n { _pjPos = p
Projectile { _ptPos = p , _pjStartPos = p
, _ptStartPos = p , _pjVel = (0,0)
, _ptVel = (0,0) , _pjPict = onLayer PtLayer $ uncurry translate p $ color white $ circleSolid 20
, _ptPict = onLayer PtLayer $ uncurry translate p $ color white $ circleSolid 20 , _pjID = k
, _ptID = n , _pjUpdate = pjTimer t k
, _ptUpdate = ptTimer t n }
} ) w where
k = newKey $ _projectiles w
drawCircleAtForCol :: Point2 -> Int -> Color -> World -> World drawCircleAtForCol :: Point2 -> Int -> Color -> World -> World
drawCircleAtForCol p t col w = drawCircleAtForCol p t col w = w & projectiles %~
let n = newProjectileKey w IM.insert k Projectile
in over projectiles ( IM.insert n { _pjPos = p
Projectile { _ptPos = p , _pjStartPos = p
, _ptStartPos = p , _pjVel = (0,0)
, _ptVel = (0,0) , _pjPict = onLayer PtLayer $ uncurry translate p $ color col $ circleSolid 20
, _ptPict = onLayer PtLayer $ uncurry translate p $ color col $ circleSolid 20 , _pjID = k
, _ptID = n , _pjUpdate = pjTimer t k
, _ptUpdate = ptTimer t n }
} ) w where
k = newKey $ _projectiles w
drawLineForCol :: [Point2] -> Int -> Color -> World -> World drawLineForCol :: [Point2] -> Int -> Color -> World -> World
drawLineForCol ps t col w = drawLineForCol ps t col w = w & projectiles %~
let n = newProjectileKey w IM.insert k Projectile
in over projectiles ( IM.insert n { _pjPos = head ps
Projectile { _ptPos = head ps , _pjStartPos = head ps
, _ptStartPos = head ps , _pjVel = (0,0)
, _ptVel = (0,0) , _pjPict = onLayer PtLayer $ color col $ lineOfThickness 5 ps
, _ptPict = onLayer PtLayer $ color col $ lineOfThickness 5 ps , _pjID = k
, _ptID = n , _pjUpdate = pjTimer t k
, _ptUpdate = ptTimer t n }
} ) w where
k = newKey $ _projectiles w
ptTimer :: Int -> Int -> World -> World pjTimer :: Int -> Int -> World -> World
ptTimer 0 i = over projectiles (IM.delete i) pjTimer 0 i = projectiles %~ IM.delete i
ptTimer time i = set (projectiles . ix i . ptUpdate) $ ptTimer (time - 1) i pjTimer time i = projectiles . ix i . pjUpdate .~ pjTimer (time - 1) i
src/Dodge/Default.hs
+6 -6
View File
@@ -161,12 +161,12 @@ defaultButton = Button
, _btState = BtOff , _btState = BtOff
} }
defaultPT = Projectile defaultPT = Projectile
{ _ptPos = (0,0) { _pjPos = (0,0)
, _ptStartPos = (0,0) , _pjStartPos = (0,0)
, _ptVel = (0,0) , _pjVel = (0,0)
, _ptPict = blank , _pjPict = blank
, _ptID = 0 , _pjID = 0
, _ptUpdate = id , _pjUpdate = id
} }
defaultPP = PressPlate defaultPP = PressPlate
{ _ppPict = onLayer PressPlateLayer $ color (dim $ dim $ bright $ blue) $ circleSolid 5 { _ppPict = onLayer PressPlateLayer $ color (dim $ dim $ bright $ blue) $ circleSolid 5
src/Dodge/Item/Weapon.hs
+148 -167
View File
@@ -732,84 +732,83 @@ aRocket = aRocket' makeShellAt
makeShellAt :: Int -> Int -> Point2 -> Float -> Projectile makeShellAt :: Int -> Int -> Point2 -> Float -> Projectile
makeShellAt i cid pos dir = Shell makeShellAt i cid pos dir = Shell
{ _ptPos = pos { _pjPos = pos
, _ptStartPos = pos , _pjStartPos = pos
, _ptVel = rotateV dir (1,0) , _pjVel = rotateV dir (1,0)
, _ptPict = blank -- onLayer PtLayer $ uncurry translate pos $ rotate (radToDeg dir) shellPic , _pjPict = blank -- onLayer PtLayer $ uncurry translate pos $ rotate (radToDeg dir) shellPic
, _ptID = i , _pjID = i
, _ptUpdate = moveShell 50 i cid 0 (rotateV dir (2,0)) , _pjUpdate = moveShell 50 i cid 0 (rotateV dir (2,0))
, _ptExplosion = shellExplosionAt , _pjPayload = shellExplosionAt
} }
makeFlameShellAt :: Int -> Int -> Point2 -> Float -> Projectile makeFlameShellAt :: Int -> Int -> Point2 -> Float -> Projectile
makeFlameShellAt i cid pos dir = Shell makeFlameShellAt i cid pos dir = Shell
{ _ptPos = pos { _pjPos = pos
, _ptStartPos = pos , _pjStartPos = pos
, _ptVel = rotateV dir (1,0) , _pjVel = rotateV dir (1,0)
, _ptPict = blank -- onLayer PtLayer $ uncurry translate pos $ rotate (radToDeg dir) shellPic , _pjPict = blank -- onLayer PtLayer $ uncurry translate pos $ rotate (radToDeg dir) shellPic
, _ptID = i , _pjID = i
, _ptUpdate = moveShell 50 i cid 0 (rotateV dir (2,0)) , _pjUpdate = moveShell 50 i cid 0 (rotateV dir (2,0))
, _ptExplosion = makeFlameExplosionAt , _pjPayload = makeFlameExplosionAt
} }
makePoisonShellAt :: Int -> Int -> Point2 -> Float -> Projectile makePoisonShellAt :: Int -> Int -> Point2 -> Float -> Projectile
makePoisonShellAt i cid pos dir = Shell makePoisonShellAt i cid pos dir = Shell
{ _ptPos = pos { _pjPos = pos
, _ptStartPos = pos , _pjStartPos = pos
, _ptVel = rotateV dir (1,0) , _pjVel = rotateV dir (1,0)
, _ptPict = blank -- onLayer PtLayer $ uncurry translate pos $ rotate (radToDeg dir) shellPic , _pjPict = blank -- onLayer PtLayer $ uncurry translate pos $ rotate (radToDeg dir) shellPic
, _ptID = i , _pjID = i
, _ptUpdate = moveShell 50 i cid 0 (rotateV dir (2,0)) , _pjUpdate = moveShell 50 i cid 0 (rotateV dir (2,0))
, _ptExplosion = makePoisonExplosionAt , _pjPayload = makePoisonExplosionAt
} }
makeTeslaShellAt :: Int -> Int -> Point2 -> Float -> Projectile makeTeslaShellAt :: Int -> Int -> Point2 -> Float -> Projectile
makeTeslaShellAt i cid pos dir = Shell makeTeslaShellAt i cid pos dir = Shell
{ _ptPos = pos { _pjPos = pos
, _ptStartPos = pos , _pjStartPos = pos
, _ptVel = rotateV dir (1,0) , _pjVel = rotateV dir (1,0)
, _ptPict = blank -- onLayer PtLayer $ uncurry translate pos $ rotate (radToDeg dir) shellPic , _pjPict = blank -- onLayer PtLayer $ uncurry translate pos $ rotate (radToDeg dir) shellPic
, _ptID = i , _pjID = i
, _ptUpdate = moveShell 50 i cid 0 (rotateV dir (2,0)) , _pjUpdate = moveShell 50 i cid 0 (rotateV dir (2,0))
, _ptExplosion = makeTeslaExplosionAt , _pjPayload = makeTeslaExplosionAt
} }
moveShell :: Int -> Int -> Int -> Float -> Point2 -> World -> World moveShell :: Int -> Int -> Int -> Float -> Point2 -> World -> World
moveShell time i cid rot accel w moveShell time i cid rot accel w
| time > 40 = if circOnSomeWall oldPos 4 w | time > 40 = if circOnSomeWall oldPos 4 w
then projectileExplosion oldPos $ over projectiles (IM.delete i) w then projectileExplosion oldPos $ over projectiles (IM.delete i) w
else over (projectiles . ix i . ptPos) (+.+ vel) else over (projectiles . ix i . pjPos) (+.+ vel)
$ set (projectiles . ix i . ptPict) piclow $ set (projectiles . ix i . pjPict) piclow
$ set (projectiles . ix i . ptUpdate) $ set (projectiles . ix i . pjUpdate)
(moveShell (time-1) i cid rot (rotateV rot accel)) (moveShell (time-1) i cid rot (rotateV rot accel))
w w
| time == 35 = case thingHit of | time == 35 = case thingHit of
Just p -> projectileExplosion oldPos Just p -> projectileExplosion oldPos
$ over projectiles (IM.delete i) w $ over projectiles (IM.delete i) w
Nothing -> over (projectiles . ix i . ptPos) (+.+ vel) Nothing -> over (projectiles . ix i . pjPos) (+.+ vel)
$ set (projectiles . ix i . ptPict) pic $ set (projectiles . ix i . pjPict) pic
$ set (projectiles . ix i . ptUpdate) $ set (projectiles . ix i . pjUpdate)
(moveShell (time-1) i cid spin accel) (moveShell (time-1) i cid spin accel)
w w
| time >= 20 = case thingHit of | time >= 20 = case thingHit of
Just p -> projectileExplosion oldPos Just p -> projectileExplosion oldPos
$ over projectiles (IM.delete i) w $ over projectiles (IM.delete i) w
Nothing -> over (projectiles . ix i . ptPos) (+.+ vel) Nothing -> over (projectiles . ix i . pjPos) (+.+ vel)
$ set (projectiles . ix i . ptPict) pic $ set (projectiles . ix i . pjPict) pic
$ set (projectiles . ix i . ptUpdate) $ set (projectiles . ix i . pjUpdate)
(moveShell (time-1) i cid rot (rotateV rot accel)) (moveShell (time-1) i cid rot (rotateV rot accel))
w w
| time > -99 | time > -99 = case thingHit of
= case thingHit of
Just p -> projectileExplosion oldPos Just p -> projectileExplosion oldPos
$ stopSoundFrom (ShellSound i) $ stopSoundFrom (ShellSound i)
$ over projectiles (IM.delete i) w $ over projectiles (IM.delete i) w
Nothing -> over (projectiles . ix i . ptPos) (+.+ vel) Nothing -> over (projectiles . ix i . pjPos) (+.+ vel)
$ set randGen g $ set randGen g
$ set (projectiles . ix i . ptPict) pic $ set (projectiles . ix i . pjPict) pic
$ set (projectiles . ix i . ptUpdate) $ set (projectiles . ix i . pjUpdate)
(moveShell (time-1) i cid rot (rotateV rot accel)) (moveShell (time-1) i cid rot (rotateV rot accel))
$ 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 $ soundFrom (ShellSound i) (fromIntegral smokeTrailSound) (1) 250
$ makeFlameletTimed oldPos $ makeFlameletTimed oldPos
(0.5 *.* rotateV (pi+sparkD) accel) Nothing 3 10 (0.5 *.* rotateV (pi+sparkD) accel) Nothing 3 10
@@ -819,18 +818,19 @@ moveShell time i cid rot accel w
Just p -> projectileExplosion oldPos Just p -> projectileExplosion oldPos
$ stopSoundFrom (ShellSound i) $ stopSoundFrom (ShellSound i)
$ over projectiles (IM.delete i) w $ over projectiles (IM.delete i) w
Nothing -> over (projectiles . ix i . ptPos) (+.+ vel) Nothing -> over (projectiles . ix i . pjPos) (+.+ vel)
$ set (projectiles . ix i . ptPict) pic $ set (projectiles . ix i . pjPict) pic
$ set (projectiles . ix i . ptUpdate) $ set (projectiles . ix i . pjUpdate)
(moveShell (time-1) i cid rot (rotateV rot accel)) (moveShell (time-1) i cid rot (rotateV rot accel))
w w
| otherwise = projectileExplosion oldPos | otherwise = projectileExplosion oldPos
$ stopSoundFrom (ShellSound i) $ stopSoundFrom (ShellSound i)
$ over projectiles (IM.delete i) w $ over projectiles (IM.delete i) w
where pt = _projectiles w IM.! i where
oldPos = _ptPos pt pj = _projectiles w IM.! i
vel = _ptVel pt oldPos = _pjPos pj
projectileExplosion = _ptExplosion pt vel = _pjVel pj
projectileExplosion = _pjPayload pj
newPos = oldPos +.+ vel newPos = oldPos +.+ vel
(frict,g) = randomR (0.6,0.9) $ _randGen w (frict,g) = randomR (0.6,0.9) $ _randGen w
(sparkD,_) = randomR (-0.5,0.5) $ _randGen w (sparkD,_) = randomR (-0.5,0.5) $ _randGen w
@@ -865,14 +865,15 @@ shellExplosionAt = makeExplosionAt
tractorBeamAt :: Int -> Int -> Point2 -> Float -> Projectile tractorBeamAt :: Int -> Int -> Point2 -> Float -> Projectile
tractorBeamAt colID i pos dir = Projectile tractorBeamAt colID i pos dir = Projectile
{ _ptPos = pos { _pjPos = pos
, _ptStartPos = p' , _pjStartPos = p'
, _ptVel = d , _pjVel = d
, _ptPict = blank , _pjPict = blank
, _ptID = i , _pjID = i
, _ptUpdate = updateTractor colID 10 i , _pjUpdate = updateTractor colID 10 i
} }
where d = unitVectorAtAngle dir where
d = unitVectorAtAngle dir
p' = pos +.+ 400 *.* d p' = pos +.+ 400 *.* d
aGasCloud :: Int -> World -> World aGasCloud :: Int -> World -> World
@@ -925,74 +926,74 @@ reflect a b = a + 2*(a-b)
moveGrenade :: Int -> Float -> Int -> World -> World moveGrenade :: Int -> Float -> Int -> World -> World
moveGrenade 0 dir pID w = over projectiles (IM.delete pID) 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) -- $ set (pointToItem (_itemPositions w IM.! wpID) . itEquipPict)
-- (drawWeapon $ grenadePic 50) -- (drawWeapon $ grenadePic 50)
w w
where where
pt = _projectiles w IM.! pID pj = _projectiles w IM.! pID
explosion = _ptExplosion pt explosion = _pjPayload pj
moveGrenade time dir pID w moveGrenade time dir pID w
= case hitWl of = case hitWl of
Just _ -> soundOnce (fromIntegral tapQuiet) updatedWorld Just _ -> soundOnce (fromIntegral tapQuiet) updatedWorld
_ -> updatedWorld _ -> updatedWorld
where where
updatedWorld = updateV $ set (projectiles . ix pID . ptPos) finalPos updatedWorld = updateV $ set (projectiles . ix pID . pjPos) finalPos
$ set (projectiles .ix pID.ptPict) $ set (projectiles .ix pID.pjPict)
(onLayer PtLayer $ uncurry translate newPos (onLayer PtLayer $ uncurry translate newPos
$ rotate dir $ grenadePic time) $ rotate dir $ grenadePic time)
$ set (projectiles .ix pID.ptUpdate) (moveGrenade (time-1) dir pID) w $ set (projectiles .ix pID.pjUpdate) (moveGrenade (time-1) dir pID) w
pt = _projectiles w IM.! pID pj = _projectiles w IM.! pID
oldPos = _ptPos pt oldPos = _pjPos pj
newPos = _ptVel pt +.+ oldPos newPos = _pjVel pj +.+ oldPos
hitWl = collideCircWalls' oldPos newPos 4 $ wallsNearPoint newPos w hitWl = collideCircWalls' oldPos newPos 4 $ wallsNearPoint newPos w
finalPos = fromMaybe newPos (fmap fst hitWl) 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) updateV = fromMaybe id (fmap (setV.snd) hitWl)
pointToItem (InInv cid invid) = creatures . ix cid . crInv . ix invid pointToItem (InInv cid invid) = creatures . ix cid . crInv . ix invid
pointToItem (OnFloor flid) = floorItems . ix flid . flIt pointToItem (OnFloor flid) = floorItems . ix flid . flIt
retireRemoteRocket :: Int -> Int -> Int -> World -> World 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) = set (pointToItem (_itemPositions w IM.! itid) . itAttachment . _Just . scopePos)
(0,0) (0,0)
$ set (pointToItem (_itemPositions w IM.! itid) . wpFire) $ set (pointToItem (_itemPositions w IM.! itid) . wpFire)
fireRemoteLauncher fireRemoteLauncher
(w & projectiles %~ IM.delete ptid) (w & projectiles %~ IM.delete pjid)
retireRemoteRocket itid t ptid w = setScope w & projectiles . ix ptid . ptUpdate .~ retireRemoteRocket itid (t-1) ptid retireRemoteRocket itid t pjid w = setScope w & projectiles . ix pjid . pjUpdate .~ retireRemoteRocket itid (t-1) pjid
where where
setScope w' = case _itemPositions w' IM.! itid of setScope w' = case _itemPositions w' IM.! itid of
InInv cid invid InInv cid invid
-> w' & creatures . ix cid . crInv . ix invid . itAttachment -> w' & creatures . ix cid . crInv . ix invid . itAttachment
. _Just . scopePos .~ (pos -.- _crPos (_creatures w' IM.! cid)) . _Just . scopePos .~ (pos -.- _crPos (_creatures w' IM.! cid))
_ -> w' _ -> 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 :: Int -> Int -> Int -> World -> World
retireRemoteBomb itid 0 ptid w retireRemoteBomb itid 0 pjid w
= set (pointToItem (_itemPositions w IM.! itid) . itAttachment . _Just . scopePos) = set (pointToItem (_itemPositions w IM.! itid) . itAttachment . _Just . scopePos)
(0,0) (0,0)
$ set (pointToItem (_itemPositions w IM.! itid) . itZoom) $ set (pointToItem (_itemPositions w IM.! itid) . itZoom)
defaultItZoom defaultItZoom
$ set (pointToItem (_itemPositions w IM.! itid) . twFire) $ set (pointToItem (_itemPositions w IM.! itid) . twFire)
throwRemoteBomb throwRemoteBomb
(w & projectiles %~ IM.delete ptid) (w & projectiles %~ IM.delete pjid)
retireRemoteBomb itid t ptid w retireRemoteBomb itid t pjid w
= setScope w & projectiles . ix ptid . ptUpdate .~ retireRemoteBomb itid (t-1) ptid = setScope w & projectiles . ix pjid . pjUpdate .~ retireRemoteBomb itid (t-1) pjid
where where
setScope w' = case _itemPositions w' IM.! itid of setScope w' = case _itemPositions w' IM.! itid of
InInv cid invid InInv cid invid
-> w' & creatures . ix cid . crInv . ix invid . itAttachment -> w' & creatures . ix cid . crInv . ix invid . itAttachment
. _Just . scopePos .~ (pos -.- _crPos (_creatures w' IM.! cid)) . _Just . scopePos .~ (pos -.- _crPos (_creatures w' IM.! cid))
_ -> w' _ -> 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 :: Int -> Int -> Int -> World -> World
moveRemoteBomb itid time pID w moveRemoteBomb itid time pID w
| time < -4 = setScope | time < -4 = setScope
$ updatePicture $ updatePicture
$ set (projectiles .ix pID.ptUpdate) (moveRemoteBomb itid (f time) pID) $ set (projectiles .ix pID.pjUpdate) (moveRemoteBomb itid (f time) pID)
w w
| time < 2 | time < 2
= case hitWl of = case hitWl of
@@ -1004,9 +1005,9 @@ moveRemoteBomb itid time pID w
_ -> updatedWorld _ -> updatedWorld
where where
updatedWorld updatedWorld
= updateV $ set (projectiles . ix pID . ptPos) finalPos = updateV $ set (projectiles . ix pID . pjPos) finalPos
$ updatePicture $ updatePicture
$ set (projectiles .ix pID.ptUpdate) (moveRemoteBomb itid (time-1) pID) $ set (projectiles .ix pID.pjUpdate) (moveRemoteBomb itid (time-1) pID)
$ setScope $ setScope
w w
setScope w' = case _itemPositions w' IM.! itid of setScope w' = case _itemPositions w' IM.! itid of
@@ -1016,20 +1017,20 @@ moveRemoteBomb itid time pID w
& creatures . ix cid . crInv . ix invid . itZoom & creatures . ix cid . crInv . ix invid . itZoom
.~ (defaultItZoom {_itAimZoomMax = 0.5, _itAimZoomMin = 0.5}) .~ (defaultItZoom {_itAimZoomMax = 0.5, _itAimZoomMin = 0.5})
_ -> w' _ -> w'
pt = _projectiles w IM.! pID pj = _projectiles w IM.! pID
oldPos = _ptPos pt oldPos = _pjPos pj
newPos = _ptVel pt +.+ oldPos newPos = _pjVel pj +.+ oldPos
-- this is hacky, should use a version of collidePointWalls' that collides -- this is hacky, should use a version of collidePointWalls' that collides
-- circles and walls -- 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 hitWl = collideCircWalls' oldPos newPos 4 $ wallsNearPoint newPos w
finalPos = fromMaybe newPos (fmap (invShift . fst) hitWl) 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) 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 f x | x < -369 = -10
| otherwise = x - 1 | otherwise = x - 1
updatePicture = set (projectiles . ix pID.ptPict) updatePicture = set (projectiles . ix pID.pjPict)
(onLayer PtLayer $ uncurry translate newPos (onLayer PtLayer $ uncurry translate newPos
$ remoteBombPic time) $ remoteBombPic time)
. lowLightDirected (withAlpha 0.1 red) newPos . lowLightDirected (withAlpha 0.1 red) newPos
@@ -1270,21 +1271,22 @@ remoteBomb = defaultThrowable
throwGrenade' :: (Point2 -> World -> World) -> Int -> Int -> World -> World throwGrenade' :: (Point2 -> World -> World) -> Int -> Int -> World -> World
throwGrenade' explosion fuseTime n w = setWp $ removePict $ over projectiles addG $ set randGen g w throwGrenade' explosion fuseTime n w = setWp $ removePict $ over projectiles addG $ set randGen g w
where addG = IM.insert i where
$ Shell { _ptPos = p addG = IM.insert i $ Shell
, _ptStartPos = p { _pjPos = p
, _ptVel = v , _pjStartPos = p
, _ptPict = onLayer PtLayer $ uncurry translate p $ grenadePic 0 , _pjVel = v
, _ptID = i , _pjPict = onLayer PtLayer $ uncurry translate p $ grenadePic 0
, _ptUpdate = moveGrenade fuseTime dir i , _pjID = i
, _ptExplosion = explosion , _pjUpdate = moveGrenade fuseTime dir i
, _pjPayload = explosion
} }
j = _crInvSel $ _creatures w IM.! n j = _crInvSel $ _creatures w IM.! n
removePict = set (creatures . ix n . crInv . ix j . itEquipPict) $ \ _ _ -> blank removePict = set (creatures . ix n . crInv . ix j . itEquipPict) $ \ _ _ -> blank
i = newProjectileKey w i = newProjectileKey w
(a, g) = randomR (-grenadeAccA,grenadeAccA::Float) (_randGen w) (a, g) = randomR (-grenadeAccA,grenadeAccA::Float) (_randGen w)
(l, _) = randomR (1 - 2*grenadeAccL,1+grenadeAccL::Float) g (l, _) = randomR (1 - 2*grenadeAccL,1+grenadeAccL::Float) g
-- v = 0.02 * l / _cameraZoom w *.* rotateV (a+_cameraRot w) (limitRange $ _mousePos w) -- - 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' = 1 / (fromIntegral fuseTime * _cameraZoom w) *.* rotateV (_cameraRot w) ( _mousePos w)
v | magV v' > 6 = 6 *.* normalizeV v' v | magV v' > 6 = 6 *.* normalizeV v'
| otherwise = v' | otherwise = v'
@@ -1298,32 +1300,6 @@ throwGrenade' explosion fuseTime n w = setWp $ removePict $ over projectiles add
throwGrenade :: Int -> Int -> World -> World throwGrenade :: Int -> Int -> World -> World
throwGrenade = throwGrenade' makeExplosionAt 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 :: Int -> ItEffect
throwArmReset x = throwArmReset x =
@@ -1357,12 +1333,13 @@ fireRemoteLauncher cid w = setLocation $ resetFire $ resetName
cr = _creatures w IM.! cid cr = _creatures w IM.! cid
dir = _crDir cr dir = _crDir cr
pos = _crPos cr +.+ rotateV dir (_crRad cr + 1,0) pos = _crPos cr +.+ rotateV dir (_crRad cr + 1,0)
remRocket = IM.insert i $ Projectile { _ptPos = pos remRocket = IM.insert i $ Projectile
, _ptStartPos = pos { _pjPos = pos
, _ptVel = rotateV dir (1,0) , _pjStartPos = pos
, _ptPict = blank , _pjVel = rotateV dir (1,0)
, _ptID = i , _pjPict = blank
, _ptUpdate = moveRemoteShell 50 i cid itid dir , _pjID = i
, _pjUpdate = moveRemoteShell 50 i cid itid dir
} }
j = _crInvSel $ _creatures w IM.! cid j = _crInvSel $ _creatures w IM.! cid
newitid = newKey $ _itemPositions w newitid = newKey $ _itemPositions w
@@ -1380,17 +1357,17 @@ moveRemoteShell :: Int -> Int -> Int -> Int -> Float -> World -> World
moveRemoteShell time i cid itid dir w moveRemoteShell time i cid itid dir w
| time > 40 = if circOnSomeWall oldPos 4 w | time > 40 = if circOnSomeWall oldPos 4 w
then doExplosion w then doExplosion w
else over (projectiles . ix i . ptPos) (+.+ vel) else over (projectiles . ix i . pjPos) (+.+ vel)
$ set (projectiles . ix i . ptPict) piclow $ set (projectiles . ix i . pjPict) piclow
$ set (projectiles . ix i . ptUpdate) $ set (projectiles . ix i . pjUpdate)
(moveRemoteShell (time-1) i cid itid newdir) (moveRemoteShell (time-1) i cid itid newdir)
$ setScope $ setScope
w w
| time >= 20 = case thingHit of | time >= 20 = case thingHit of
Just p -> doExplosion w Just p -> doExplosion w
Nothing -> over (projectiles . ix i . ptPos) (+.+ vel) Nothing -> over (projectiles . ix i . pjPos) (+.+ vel)
$ set (projectiles . ix i . ptPict) pic $ set (projectiles . ix i . pjPict) pic
$ set (projectiles . ix i . ptUpdate) $ set (projectiles . ix i . pjUpdate)
(moveRemoteShell (time-1) i cid itid newdir) (moveRemoteShell (time-1) i cid itid newdir)
$ setScope $ setScope
w w
@@ -1399,12 +1376,12 @@ moveRemoteShell time i cid itid dir w
Just p -> doExplosion Just p -> doExplosion
$ stopSoundFrom (ShellSound i) $ stopSoundFrom (ShellSound i)
w w
Nothing -> over (projectiles . ix i . ptPos) (+.+ vel) Nothing -> over (projectiles . ix i . pjPos) (+.+ vel)
$ set randGen g $ set randGen g
$ set (projectiles . ix i . ptPict) pic $ set (projectiles . ix i . pjPict) pic
$ set (projectiles . ix i . ptUpdate) $ set (projectiles . ix i . pjUpdate)
(moveRemoteShell (time-1) i cid itid newdir) (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 $ soundFrom (ShellSound i) (fromIntegral smokeTrailSound) (1) 250
$ smokeGen $ smokeGen
$ makeFlameletTimed oldPos $ makeFlameletTimed oldPos
@@ -1415,18 +1392,19 @@ moveRemoteShell time i cid itid dir w
Just p -> doExplosion Just p -> doExplosion
$ stopSoundFrom (ShellSound i) $ stopSoundFrom (ShellSound i)
w w
Nothing -> over (projectiles . ix i . ptPos) (+.+ vel) Nothing -> over (projectiles . ix i . pjPos) (+.+ vel)
$ set (projectiles . ix i . ptPict) pic $ set (projectiles . ix i . pjPict) pic
$ set (projectiles . ix i . ptUpdate) $ set (projectiles . ix i . pjUpdate)
(moveRemoteShell (time-1) i cid itid newdir) (moveRemoteShell (time-1) i cid itid newdir)
$ setScope $ setScope
w w
| otherwise = doExplosion | otherwise = doExplosion
$ stopSoundFrom (ShellSound i) $ stopSoundFrom (ShellSound i)
w w
where pt = _projectiles w IM.! i where
oldPos = _ptPos pt pj = _projectiles w IM.! i
vel = _ptVel pt oldPos = _pjPos pj
vel = _pjVel pj
newPos = oldPos +.+ vel newPos = oldPos +.+ vel
newdir newdir
| SDL.ButtonRight `S.member` (_mouseButtons w) | SDL.ButtonRight `S.member` (_mouseButtons w)
@@ -1456,25 +1434,27 @@ moveRemoteShell time i cid itid dir w
_ -> w' _ -> w'
explodeRemoteRocket :: Int -> Int -> Int -> World -> World explodeRemoteRocket :: Int -> Int -> Int -> World -> World
explodeRemoteRocket itid ptid n w explodeRemoteRocket itid pjid n w
= set (projectiles . ix ptid . ptUpdate) (retireRemoteRocket itid 30 ptid) = set (projectiles . ix pjid . pjUpdate) (retireRemoteRocket itid 30 pjid)
$ set (projectiles . ix ptid . ptPict) blank $ set (projectiles . ix pjid . pjPict) blank
$ set (itPoint . wpFire) (flip const) $ set (itPoint . wpFire) (flip const)
$ resetName $ resetName
$ makeExplosionAt (_ptPos (_projectiles w IM.! ptid)) w $ makeExplosionAt (_pjPos (_projectiles w IM.! pjid)) w
where resetName = set (itPoint . itName) "REMOTELAUNCHER" where
resetName = set (itPoint . itName) "REMOTELAUNCHER"
itPoint = pointToItem $ _itemPositions w IM.! itid itPoint = pointToItem $ _itemPositions w IM.! itid
throwRemoteBomb :: Int -> World -> World throwRemoteBomb :: Int -> World -> World
throwRemoteBomb n w = setLocation $ removePict $ resetFire throwRemoteBomb n w = setLocation $ removePict $ resetFire
$ resetName $ over projectiles addG w $ resetName $ over projectiles addG w
where addG = IM.insert i where
$ Projectile { _ptPos = p addG = IM.insert i $ Projectile
, _ptStartPos = p { _pjPos = p
, _ptVel = v , _pjStartPos = p
, _ptPict = blank , _pjVel = v
, _ptID = i , _pjPict = blank
, _ptUpdate = moveRemoteBomb itid 50 i , _pjID = i
, _pjUpdate = moveRemoteBomb itid 50 i
} }
i = newProjectileKey w i = newProjectileKey w
-- fireDist = zoom *.* (rotateV (_cameraRot w) (_mousePos w) +.+ _cameraCenter w -.- yourPos) -- fireDist = zoom *.* (rotateV (_cameraRot w) (_mousePos w) +.+ _cameraCenter w -.- yourPos)
@@ -1503,16 +1483,17 @@ throwRemoteBomb n w = setLocation $ removePict $ resetFire
explodeRemoteBomb :: Int -> Int -> Int -> World -> World explodeRemoteBomb :: Int -> Int -> Int -> World -> World
explodeRemoteBomb itid ptid n w explodeRemoteBomb itid pjid n w
= set (projectiles . ix ptid . ptUpdate) (retireRemoteBomb itid 30 ptid) = set (projectiles . ix pjid . pjUpdate) (retireRemoteBomb itid 30 pjid)
$ set (projectiles . ix ptid . ptPict) blank $ set (projectiles . ix pjid . pjPict) blank
$ set (creatures . ix n . crInv . ix j . twFire) (flip const) $ set (creatures . ix n . crInv . ix j . twFire) (flip const)
$ resetName $ resetName
$ resetPict $ resetPict
-- $ resetScope -- $ resetScope
$ makeExplosionAt (_ptPos (_projectiles w IM.! ptid)) w $ makeExplosionAt (_pjPos (_projectiles w IM.! pjid)) w
-- $ makeShrapnelBombAt (_ptPos (_projectiles w IM.! ptid)) w -- $ makeShrapnelBombAt (_pjPos (_projectiles w IM.! pjid)) w
where resetName = set (creatures . ix n . crInv . ix j . itName) "REMOTEBOMB" where
resetName = set (creatures . ix n . crInv . ix j . itName) "REMOTEBOMB"
resetPict = set (creatures . ix n . crInv . ix j . itEquipPict ) resetPict = set (creatures . ix n . crInv . ix j . itEquipPict )
(drawWeapon $ remoteBombUnarmedPic) (drawWeapon $ remoteBombUnarmedPic)
-- resetScope = creatures . ix n . crInv . ix j . itScope . _Just . scopePos .~ (0,0) -- resetScope = creatures . ix n . crInv . ix j . itScope . _Just . scopePos .~ (0,0)
@@ -1667,8 +1648,8 @@ moveInt toReload totalAmmo = (x, totalAmmo-x)
updateTractor :: Int -> Int -> Int -> World -> World updateTractor :: Int -> Int -> Int -> World -> World
updateTractor colID time i w updateTractor colID time i w
| time > 0 = set (projectiles . ix i . ptUpdate) (updateTractor colID (time-1) i) | time > 0 = set (projectiles . ix i . pjUpdate) (updateTractor colID (time-1) i)
$ set (projectiles . ix i . ptPict) pic $ set (projectiles . ix i . pjPict) pic
$ over creatures (IM.map tractCr) $ over creatures (IM.map tractCr)
$ over floorItems (IM.map tractFlIt) $ over floorItems (IM.map tractFlIt)
w w
@@ -1693,10 +1674,10 @@ updateTractor colID time i w
iP = _flItPos it iP = _flItPos it
m | dist iP p1 < 350 = 1 m | dist iP p1 < 350 = 1
| otherwise = (410 - dist iP p1) / 60 | otherwise = (410 - dist iP p1) / 60
pt = _projectiles w IM.! i pj = _projectiles w IM.! i
q = _ptVel pt q = _pjVel pj
p1 = _ptPos pt p1 = _pjPos pj
p' = _ptStartPos pt p' = _pjStartPos pj
p2 = fromMaybe p' $ fmap fst $ collidePointWalls p1 p' $ wallsNearPoint p' w p2 = fromMaybe p' $ fmap fst $ collidePointWalls p1 p' $ wallsNearPoint p' w
p4 = vNormal p5 p4 = vNormal p5
p5 = errorNormalizeV 12 $ p2 -.- p1 p5 = errorNormalizeV 12 $ p2 -.- p1
src/Dodge/Rendering.hs
+1 -1
View File
@@ -28,7 +28,7 @@ import qualified Data.Set as S
worldPictures :: World -> Picture worldPictures :: World -> Picture
worldPictures w = pictures $ concat worldPictures w = pictures $ concat
[ IM.elems $ _decorations w [ IM.elems $ _decorations w
, map _ptPict . IM.elems $ _projectiles w , map _pjPict . IM.elems $ _projectiles w
, map drawItem . IM.elems $ _floorItems w , map drawItem . IM.elems $ _floorItems w
, map crDraw . IM.elems $ _creatures w , map crDraw . IM.elems $ _creatures w
, map clDraw . IM.elems $ _clouds w , map clDraw . IM.elems $ _clouds w
src/Dodge/Room/Data.hs
+1
View File
@@ -1,4 +1,5 @@
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-}
module Dodge.Room.Data module Dodge.Room.Data
where where
src/Dodge/Rooms.hs
+4 -2
View File
@@ -148,9 +148,11 @@ roomC x y = Room
, _rmPS = [windowLine (x/2,0) (x/2,y-60) , _rmPS = [windowLine (x/2,0) (x/2,y-60)
] ]
--, _rmBound = rectNSWE y 0 0 x --, _rmBound = rectNSWE y 0 0 x
, _rmBound = [] , _rmBound = rectNSWE (y+5) (-5) (-5) (x+5)
} }
where lnks = [( (x-20, 0),pi) where
lnks =
[( (x-20, 0),pi)
,( ( 20, 0),pi) ,( ( 20, 0),pi)
,( ( 0, 20),pi/2) ,( ( 0, 20),pi/2)
] ]
src/Dodge/Update.hs
+1 -1
View File
@@ -68,7 +68,7 @@ updateSoundQueue = set soundQueue []
updateLightSources w = set tempLightSources (catMaybes tlss) w' updateLightSources w = set tempLightSources (catMaybes tlss) w'
where (w',tlss) = mapAccumR (\a b -> _tlsUpdate b a b) w $ _tempLightSources 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' :: World -> World
updateParticles' w = set particles' (catMaybes ps) w' updateParticles' w = set particles' (catMaybes ps) w'
src/Dodge/WorldEvent/SpawnParticle.hs
+9 -9
View File
@@ -194,19 +194,19 @@ cloudPoisonDamage c w = w & creatures %~ flip (foldr (IM.adjust doDam)) damagedC
makeTeslaArcAt :: Int -> Point2 -> Float -> Projectile makeTeslaArcAt :: Int -> Point2 -> Float -> Projectile
makeTeslaArcAt i pos dir = Projectile makeTeslaArcAt i pos dir = Projectile
{ _ptPos = pos { _pjPos = pos
, _ptStartPos = pos , _pjStartPos = pos
, _ptVel = (0,0) , _pjVel = (0,0)
, _ptPict = onLayer PtLayer $ line [(0,0),(0,0)] , _pjPict = onLayer PtLayer $ line [(0,0),(0,0)]
, _ptID = i , _pjID = i
, _ptUpdate = moveTeslaArc pos dir i , _pjUpdate = moveTeslaArc pos dir i
} }
moveTeslaArc :: Point2 -> Float -> Int -> World -> World moveTeslaArc :: Point2 -> Float -> Int -> World -> World
moveTeslaArc p d i w = moveTeslaArc p d i w =
set (projectiles . ix i . ptPict) pic set (projectiles . ix i . pjPict) pic
$ set (projectiles . ix i . ptUpdate) $ set (projectiles . ix i . pjUpdate)
(ptTimer 2 i) (pjTimer 2 i)
$ set randGen g $ set randGen g
$ createSpark 8 nc q2 (argV sv + d1) Nothing $ createSpark 8 nc q2 (argV sv + d1) Nothing
$ foldr damCrs w hitCrs $ foldr damCrs w hitCrs