Rehome launcher
This commit is contained in:
@@ -0,0 +1,159 @@
|
||||
module Dodge.Item.Weapon.Launcher
|
||||
where
|
||||
import Dodge.Data
|
||||
import Dodge.Item.Weapon.TriggerType
|
||||
import Dodge.Default.Weapon
|
||||
import Dodge.SoundLogic.Synonyms
|
||||
import Picture
|
||||
import qualified IntMapHelp as IM
|
||||
import Dodge.WorldEvent.Explosion
|
||||
import Dodge.Picture.Layer
|
||||
import Dodge.Item.Draw
|
||||
import Geometry
|
||||
import Dodge.Default.Shell
|
||||
import Dodge.Base
|
||||
import Dodge.SoundLogic
|
||||
import Dodge.WorldEvent.SpawnParticle
|
||||
import Dodge.WorldEvent.Cloud
|
||||
import Dodge.RandomHelp
|
||||
|
||||
import Data.Maybe
|
||||
import Control.Lens
|
||||
import Control.Applicative
|
||||
import Control.Monad.State
|
||||
import System.Random
|
||||
|
||||
launcher :: Item
|
||||
launcher = defaultGun
|
||||
{ _itName = "ROCKO"
|
||||
, _itIdentity = Launcher
|
||||
, _wpMaxAmmo = 30
|
||||
, _wpLoadedAmmo = 30
|
||||
, _wpReloadTime = 80
|
||||
, _wpReloadState = 0
|
||||
, _itUseRate = 20
|
||||
, _itUseTime = 0
|
||||
, _itUse = shootWithSound (fromIntegral launcherSound) $ aRocketWithPayload makeExplosionAt
|
||||
, _wpSpread = 0.02
|
||||
, _wpRange = 20
|
||||
, _itFloorPict = onLayer FlItLayer $ color cyan $ polygon $ rectNESW 5 5 (-5) (-5)
|
||||
, _itAimingSpeed = 0.2
|
||||
, _itAimingRange = 0.5
|
||||
, _itEquipPict = pictureWeaponOnAim $ color cyan $ polygon $ rectNESW 5 5 (-5) (-5)
|
||||
, _itHammer = NoHammer
|
||||
, _itEffect = NoItEffect
|
||||
}
|
||||
flameLauncher :: Item
|
||||
flameLauncher = launcher
|
||||
{ _itName = "FLROCKO"
|
||||
, _itUse = shootWithSound (fromIntegral launcherSound) $ aRocketWithPayload makeFlameExplosionAt
|
||||
}
|
||||
|
||||
poisonLauncher :: Item
|
||||
poisonLauncher = launcher
|
||||
{ _itName = "POISROCK"
|
||||
, _itUse = shootWithSound (fromIntegral launcherSound) $ aRocketWithPayload makePoisonExplosionAt
|
||||
}
|
||||
|
||||
teslaLauncher :: Item
|
||||
teslaLauncher = launcher
|
||||
{ _itName = "TESLROCK"
|
||||
, _itUse = shootWithSound (fromIntegral launcherSound) $ aRocketWithPayload makeTeslaExplosionAt
|
||||
}
|
||||
|
||||
aRocketWithPayload
|
||||
:: (Point2 -> World -> World) -- ^ Payload
|
||||
-> Creature
|
||||
-> World
|
||||
-> World
|
||||
aRocketWithPayload pl cr w = over projectiles (IM.insert i theShell) w
|
||||
where
|
||||
cid = _crID cr
|
||||
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
|
||||
}
|
||||
|
||||
moveShell
|
||||
:: Int -- ^ Timer (frames)
|
||||
-> Int -- ^ Projectile id
|
||||
-> Int -- ^ Creature id
|
||||
-> Float -- ^ Rotation
|
||||
-> Point2 -- ^ Acceleration
|
||||
-> World -> World
|
||||
moveShell time i cid rot accel 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
|
||||
doExplode = w
|
||||
& projectileExplosion oldPos
|
||||
& stopSoundFrom (ShellSound i)
|
||||
& projectiles %~ IM.delete i
|
||||
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.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)]
|
||||
Reference in New Issue
Block a user