Runtime broken level generation
This commit is contained in:
+282
-301
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user