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

Refactor shell movement, modularised in a tweakable way

Browse Source
This commit is contained in:
jgk
2021-05-26 03:35:30 +02:00
parent 7ca7a2f941
commit f05381be47
9 changed files with 170 additions and 112 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature.hs
+1
View File
@@ -30,6 +30,7 @@ import Dodge.Data
import Dodge.Default
import Dodge.Item.Weapon
import Dodge.Item.Weapon.Launcher
import Dodge.Item.Weapon.Bezier
import Dodge.Item.Equipment
import Dodge.Item.Consumable
import Dodge.WorldEvent.Cloud
src/Dodge/Data.hs
+4
View File
@@ -390,6 +390,8 @@ data Ammo
= ShellAmmo
{ _amPayload :: Point2 -> World -> World
, _amString :: String
, _amPjMove :: Item -> Creature -> [Projectile -> World -> World]
, _amPjDraw :: Projectile -> Picture
}
| BulletAmmo
{ _amString :: String
@@ -408,12 +410,14 @@ data Projectile
{ _pjPos :: Point2
, _pjStartPos :: Point2
, _pjVel :: Point2
, _pjAcc :: Point2
, _pjDir :: Float
, _pjSpin :: Float
, _pjDraw :: Projectile -> Picture
, _pjID :: Int
, _pjUpdate :: Projectile -> World -> World
, _pjPayload :: Point2 -> World -> World
, _pjTimer :: Int
}
| LinearShockwave
{ _pjDraw :: Projectile -> Picture
src/Dodge/Default/Shell.hs
+2
View File
@@ -8,10 +8,12 @@ defaultShell = Shell
{ _pjPos = (0,0)
, _pjStartPos = (0,0)
, _pjVel = (0,0)
, _pjAcc = (0,0)
, _pjDir = 0
, _pjSpin = 0
, _pjDraw = \_ -> blank
, _pjID = 0
, _pjTimer = 0
, _pjUpdate = \_ -> id
, _pjPayload = \_ -> id
}
src/Dodge/Default/Weapon.hs
+6
View File
@@ -37,3 +37,9 @@ defaultGun = Weapon
, _itTargeting = Nothing
, _itWorldTrigger = Nothing
}
defaultAutoGun :: Item
defaultAutoGun = defaultGun
{ _itScrollUp = const id
, _itScrollDown = const id
, _itInvDisplay = basicWeaponDisplay
}
src/Dodge/Item/Weapon.hs
+1 -54
View File
@@ -13,8 +13,6 @@ import Dodge.Default
--import Dodge.Default.Shell
import Dodge.Item.Draw
import Dodge.Particle.Bullet.HitEffect
import Dodge.Particle.Bullet.Spawn
--import Dodge.Item.Weapon.Decoration
import Dodge.Item.Weapon.InventoryDisplay
import Dodge.Item.Weapon.TriggerType
import Dodge.Item.Weapon.ExtraEffect
@@ -83,12 +81,6 @@ pistol = Weapon
, _itTargeting = Nothing
, _itWorldTrigger = Nothing
}
defaultAutoGun :: Item
defaultAutoGun = autoGun
{ _itScrollUp = const id
, _itScrollDown = const id
, _itInvDisplay = basicWeaponDisplay
}
effectGun :: String -> (Creature -> World -> World) -> Item
effectGun name eff = defaultGun
{ _itName = name ++ "Gun"
@@ -161,7 +153,7 @@ rezGun = defaultGun
]
}
teslaGun :: Item
teslaGun = defaultAutoGun
teslaGun = defaultGun
{ _itName = "TESLA"
, _itIdentity = TeslaGun
, _wpMaxAmmo = 200
@@ -261,52 +253,7 @@ tractorGun = defaultAutoGun
, _itAimingRange = 0.5
, _itEquipPict = pictureWeaponOnAim $ color blue $ pictures [polygon $ rectNESW 1.5 6 (-1.5) 0 ]
}
useTargetPos
:: (Maybe Point2 -> Creature -> World -> World)
-> Creature
-> World
-> World
useTargetPos f cr w = case cr ^? crInv . ix (_crInvSel cr) . itTargeting . _Just of
Nothing -> w
Just (g,_) -> f (g w) cr w
bezierGun :: Item
bezierGun = defaultAutoGun
{ _itName = "B-GUN"
, _itUse = \_ -> useTargetPos $ \p ->
shootWithSound 0
. withMuzFlare
. withRecoil 40
. torqueBefore 0.05 -- I believe that this doesn't affect
$ shootBezier $ fromJust p -- <- the start point
, _itAttachment = Nothing
, _itScrollUp = removeItAttachment 0
, _itScrollDown = removeItAttachment 0
, _itHammer = HammerUp
, _itEffect = rbSetTarget
, _itZoom = defaultItZoom
, _itAimingRange = 0
}
shootBezier :: Point2 -> Creature -> World -> World
shootBezier targetp cr w = w & particles %~ (theBullet :)
where
theBullet = aCurveBulAt
(Just cid)
white
startp
(controlp +.+ randPos)
(targetp +.+ randPos')
(destroyOnImpact bulHitCr bulHitWall' bulHitFF')
5
controlp = mouseWorldPos w
cid = _crID cr
dir = _crDir cr
startp = _crPos cr +.+ rotateV dir (_crRad cr + 1,0)
(randPos,randPos') = flip evalState (_randGen w) $ do
a <- randInCirc 10
b <- randInCirc 20
return (a,b)
removeItAttachment :: Int -> Int -> World -> World
removeItAttachment i _ w = w & creatures . ix i . crInv . ix itRef . itAttachment .~ Nothing
src/Dodge/Item/Weapon/Bezier.hs
+57
View File
@@ -0,0 +1,57 @@
module Dodge.Item.Weapon.Bezier
where
import Dodge.Data
import Dodge.Base
import Dodge.Default.Weapon
import Dodge.Item.Weapon.Targeting
import Dodge.Item.Weapon.TriggerType
import Dodge.Item.Weapon.ExtraEffect
import Dodge.Default
import Dodge.Particle.Bullet.Spawn
import Dodge.Particle.Bullet.HitEffect
import Dodge.WorldEvent.HitEffect
import Dodge.RandomHelp
import Picture
import Geometry
--import System.Random
import Data.Maybe
import Control.Lens
import Control.Monad.State
bezierGun :: Item
bezierGun = defaultGun
{ _itName = "B-GUN"
, _itUse = \_ -> useTargetPos $ \p ->
shootWithSound 0
. withMuzFlare
. withRecoil 40
. torqueBefore 0.05 -- I believe that this doesn't affect
$ shootBezier $ fromJust p -- <- the start point
, _itAttachment = Nothing
, _itScrollUp = removeItTarget 0
, _itScrollDown = removeItTarget 0
, _itHammer = HammerUp
, _itEffect = rbSetTarget
, _itZoom = defaultItZoom
, _itAimingRange = 0
}
shootBezier :: Point2 -> Creature -> World -> World
shootBezier targetp cr w = w & particles %~ (theBullet :)
where
theBullet = aCurveBulAt
(Just cid)
white
startp
(controlp +.+ randPos)
(targetp +.+ randPos')
(destroyOnImpact bulHitCr bulHitWall' bulHitFF')
5
controlp = mouseWorldPos w
cid = _crID cr
dir = _crDir cr
startp = _crPos cr +.+ rotateV dir (_crRad cr + 1,0)
(randPos,randPos') = flip evalState (_randGen w) $ do
a <- randInCirc 10
b <- randInCirc 20
return (a,b)
src/Dodge/Item/Weapon/ExtraEffect.hs
+3 -3
View File
@@ -111,13 +111,13 @@ rbSetTarget = ItInvEffect
| _crInvSel cr /= invid = w
| SDL.ButtonRight `S.member` _mouseButtons w = w
& creatures . ix (_crID cr) . crInv . ix invid . itTargeting
%~ maybe (Just $ targetCurrentMousePos w) Just
%~ maybe (Just $ targetRBMousePos w) Just
| otherwise = w & creatures . ix (_crID cr) . crInv . ix invid . itTargeting .~ Nothing
targetCurrentMousePos
targetRBMousePos
:: World
-> (World -> Maybe Point2, Int -> Item -> Creature -> World -> Picture)
targetCurrentMousePos w = (f, \_ _ _ w' -> cursorPic w')
targetRBMousePos w = (f, \_ _ _ w' -> cursorPic w')
where
f _ = Just mwp
mwp = mouseWorldPos w
src/Dodge/Item/Weapon/Launcher.hs
+76 -55
View File
@@ -45,8 +45,17 @@ launcher = defaultGun
, _wpAmmo = ShellAmmo
{ _amPayload = makeExplosionAt
, _amString = ""
, _amPjMove = basicAmPjMoves
, _amPjDraw = shellPic
}
}
basicAmPjMoves :: Item -> Creature -> [Projectile -> World -> World]
basicAmPjMoves _ cr =
[reduceSpinBy 0.995
,pjEffAtTime 35 $ trySpinByCID (_crID cr)
]
flameLauncher :: Item
flameLauncher = launcher & wpAmmo . amPayload .~ makeFlameExplosionAt
poisonLauncher :: Item
@@ -61,93 +70,105 @@ aRocketWithItemParams
-> World
aRocketWithItemParams it cr w = over projectiles (IM.insert i theShell) w
where
pl = _amPayload $ _wpAmmo it
cid = _crID cr
am = _wpAmmo it
i = IM.newKey $ _projectiles w
pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir)
dir = _crDir cr
theShell = makeShellAt pl i cid pos dir
makeShellAt
:: (Point2 -> World -> World)
-- ^ Payload
-> Int -- ^ Projectile id
-> Int -- ^ Creature id
-> Point2 -- ^ Start position
-> Float -- ^ Direction
-> Projectile
makeShellAt pl i cid pos dir = defaultShell
{ _pjPos = pos
, _pjStartPos = pos
, _pjVel = rotateV dir (1,0)
, _pjDraw = \_ -> blank
, _pjID = i
, _pjUpdate = \_ -> moveShell 50 i cid 0 (rotateV dir (3,0))
, _pjPayload = pl
}
ammoMvs pj w' = foldr ($ pj) w' (_amPjMove am it cr)
theShell = defaultShell
{ _pjPos = pos
, _pjStartPos = pos
, _pjVel = rotateV dir (1,0)
, _pjAcc = rotateV dir (3,0)
, _pjDraw = _amPjDraw am
, _pjID = i
, _pjUpdate = \pj -> ammoMvs pj . decTimMvVel pj . moveShell pj
, _pjPayload = _amPayload am
, _pjTimer = 50
}
moveShell
:: Int -- ^ Timer (frames)
-> Int -- ^ Projectile id
-> Int -- ^ Creature id
-> Float -- ^ Rotation
-> Point2 -- ^ Acceleration
-> World -> World
moveShell time i cid rot accel w
:: Projectile -- ^ Projectile id
-> World
-> World
moveShell pj w
| time > 40 = if circOnSomeWall oldPos 4 w
then doExplode
else w
& projectiles . ix i . pjPos %~ (+.+ vel)
& projectiles . ix i . pjDraw .~ (\_ -> piclow)
& projectiles . ix i . pjUpdate .~ (\_ -> moveShell (time-1) i cid rot (rotateV rot accel))
| isJust thingHit = doExplode
| time == 35 = w
& projectiles . ix i . pjPos %~ (+.+ vel)
& projectiles . ix i . pjDraw .~ (\_ -> pic)
& projectiles . ix i . pjUpdate .~ \_ -> moveShell (time-1) i cid spin accel
| time >= 20 = w
& projectiles . ix i . pjPos %~ (+.+ vel)
& projectiles . ix i . pjDraw .~ (\_ -> pic)
& projectiles . ix i . pjUpdate .~ (\_ -> moveShell (time-1) i cid rot' (rotateV rot accel))
| time > -99 = w
& projectiles . ix i . pjPos %~ (+.+ vel)
& randGen .~ g
& projectiles . ix i . pjDraw .~ (\_ -> pic)
& projectiles . ix i . pjUpdate .~ (\_ -> moveShell (time-1) i cid rot' (rotateV rot accel))
& projectiles . ix i . pjVel %~ (\v -> accel +.+ frict *.* v)
& soundFromPos (ShellSound i) newPos (fromIntegral smokeTrailSound) 1 250
& makeFlameletTimed (oldPos -.- vel) (vel +.+ rotateV (pi+sparkD) accel) Nothing 3 10
& smokeGen
| time > -200 = w
& projectiles . ix i . pjPos %~ (+.+ vel)
& projectiles . ix i . pjDraw .~ (\_ -> pic)
& projectiles . ix i . pjUpdate .~ (\_ -> moveShell (time-1) i cid rot' (rotateV rot accel))
| otherwise = doExplode
where
time = _pjTimer pj
accel = _pjAcc pj
doExplode = w
& projectileExplosion oldPos
& stopSoundFrom (ShellSound i)
& projectiles %~ IM.delete i
pj = _projectiles w IM.! i
i = _pjID pj
oldPos = _pjPos pj
vel = _pjVel pj
projectileExplosion = _pjPayload pj
newPos = oldPos +.+ vel
(frict,g) = randomR (0.6,0.9) $ _randGen w
(sparkD,_) = randomR (-0.2,0.2) $ _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 = fst <$> collideCircCrsPoint oldPos newPos 4 w
hitWl = fst <$> collideCircWalls' oldPos newPos 2 (wallsNearPoint newPos w)
thingHit = hitCr <|> hitWl
spin = case w ^? creatures . ix cid of
Just cr -> negate $ min 0.2 $ max (-0.2) $ normalizeAnglePi (dir - _crDir cr) / 20
_ -> 0
r1 = randInCirc 10 & evalState $ _randGen w
smokeGen = makeSmokeCloudAt (oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos))
rot' = rot * 0.995
shellPic :: Picture
shellPic = color black $ polygon [(-6,4),(-6,-4),(6,-4),(8,0),(6,4)]
reduceSpinBy :: Float -> Projectile -> World -> World
reduceSpinBy x pj = projectiles . ix (_pjID pj) . pjSpin *~ x
shellPic :: Projectile -> Picture
shellPic pj
| t > 40 = onLayerL [levLayer CrLayer - 2]
$ uncurry translate pos $ rotate (argV accel) basePic
| otherwise = onLayer PtLayer $ uncurry translate pos $ rotate (argV accel) basePic
where
basePic = color black $ polygon [(-6,4),(-6,-4),(6,-4),(8,0),(6,4)]
accel = _pjAcc pj
pos = _pjPos pj
t = _pjTimer pj
decTimMvVel :: Projectile -> World -> World
decTimMvVel pj = projectiles . ix pjid %~
( (pjTimer -~ 1)
. (pjPos %~ (+.+ vel) )
. (pjAcc %~ rotateV rot )
)
where
rot = _pjSpin pj
vel = _pjVel pj
pjid = _pjID pj
pjEffAtTime
:: Int
-> (Projectile -> World -> World)
-> Projectile
-> World
-> World
pjEffAtTime t f pj
| _pjTimer pj == t = f pj
| otherwise = id
trySpinByCID
:: Int -- ^ creature id
-> Projectile
-> World
-> World
trySpinByCID cid pj w = w & projectiles . ix pjid . pjSpin .~ newSpin
where
pjid = _pjID pj
dir = argV $ _pjVel pj
newSpin = case w ^? creatures . ix cid of
Just cr -> negate $ min 0.2 $ max (-0.2) $ normalizeAnglePi (dir - _crDir cr) / 20
_ -> 0
src/Dodge/Item/Weapon/Targeting.hs
+20
View File
@@ -0,0 +1,20 @@
module Dodge.Item.Weapon.Targeting
where
import Dodge.Data
import Control.Lens
import qualified Data.IntMap.Strict as IM
useTargetPos
:: (Maybe Point2 -> Creature -> World -> World)
-> Creature
-> World
-> World
useTargetPos f cr w = case cr ^? crInv . ix (_crInvSel cr) . itTargeting . _Just of
Nothing -> w
Just (g,_) -> f (g w) cr w
removeItTarget :: Int -> Int -> World -> World
removeItTarget i _ w = w & creatures . ix i . crInv . ix itRef . itTargeting .~ Nothing
where
cr = _creatures w IM.! i
itRef = _crInvSel cr