Rehome launcher

2021-05-25 18:03:35 +02:00
parent f737897b18
commit d5fed6c987
15 changed files with 280 additions and 222 deletions
@@ -32,62 +32,29 @@ boostSelfL
    -> World
    -> World
 boostSelfL x cr invid w = case boostPoint x cr w of
-    Left p -> wWithShock p
-        & creatures . ix cid %~ 
-            ( (crPos .~ p) 
-            . (crInv . ix invid %~ 
-                (wpLoadedAmmo .~ 0)
-                . (itEffect . itEffectCounter .~ 1)
-                . (itAttachment .~ Just (ItInt pid))
-                )
-            )
-    Right p -> wWithShock p & creatures . ix cid . crPos .~ p
-        & creatures . ix cid %~ 
-            ( (crPos .~ p) 
-            . (crInv . ix invid %~ 
-                (wpLoadedAmmo -~ 1)
-                . (itEffect . itEffectCounter .~ 1)
-                . (itAttachment .~ Just (ItInt pid))
-                )
-            )
+    Left p -> crEff p (wpLoadedAmmo .~ 0)
+    Right p -> crEff p (wpLoadedAmmo -~ 1)
  where
    cid = _crID cr
-    --cpos = _crPos cr
+    cpos = _crPos cr
    r = _crRad cr
    pid = fromMaybe (IM.newKey $ _projectiles w) 
        (cr ^? crInv . ix invid . itAttachment . _Just . itInt)
-    wWithShock p' = addBoostShockwave pid p' (r *.* unitVectorAtAngle (_crDir cr)) w
+    crEff p ammoEff = addBoostShockwave pid p (r *.* normalizeV (p -.- cpos)) w
+        & creatures . ix cid %~ 
+             (crPos .~ p) 
+            . (crInv . ix invid %~ 
+                ammoEff
+                . (itEffect . itEffectCounter .~ 1)
+                . (itAttachment .~ Just (ItInt pid))
+                )

 boostSelf
    :: Float    -- ^ boost amount
    -> Creature
    -> World
    -> World
-boostSelf x cr w = case boostPoint x cr w of
-    Left p -> wWithShock p
-        & creatures . ix cid %~ 
-            ( (crPos .~ p) 
-            . (crInv . ix (_crInvSel cr) %~ 
-                (wpLoadedAmmo .~ 0)
-                . (itEffect . itEffectCounter .~ 1)
-                . (itAttachment .~ Just (ItInt pid))
-                )
-            )
-    Right p -> wWithShock p & creatures . ix cid . crPos .~ p
-        & creatures . ix cid %~ 
-            ( (crPos .~ p) 
-            . (crInv . ix (_crInvSel cr) %~ 
-                (wpLoadedAmmo -~ 1)
-                . (itEffect . itEffectCounter .~ 1)
-                . (itAttachment .~ Just (ItInt pid))
-                )
-            )
-  where
-    cid = _crID cr
-    r = _crRad cr
-    pid = fromMaybe (IM.newKey $ _projectiles w) 
-        (cr ^? crInv . ix (_crInvSel cr) . itAttachment . _Just . itInt)
-    wWithShock p' = addBoostShockwave pid p' (r *.* unitVectorAtAngle (_crDir cr)) w
+boostSelf x cr = boostSelfL x cr (_crInvSel cr)

 addBoostShockwave
    :: Int
@@ -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)]