Implement bullet trajectories using attachable items

src/Dodge/HeldUse.hs

@@ -1,10 +1,14 @@
 {-# LANGUAGE TupleSections #-}
 module Dodge.HeldUse 
+    (heldEffect
+    , mcUseHeld
+    )
 --    ( heldEffect
 --    , mcUseHeld
 --    ) 
     where
 
+import Dodge.Base.Coordinate
 import Dodge.Base.Collide
 import Dodge.Inventory.Lock
 --import Dodge.WorldEvent.Cloud
@@ -38,28 +42,28 @@ import Geometry
 --import qualified IntMapHelp as IM
 import LensHelp
 import RandomHelp
-import Sound.Data
+--import Sound.Data
 --import Data.Foldable
 
-heldEffect :: HeldMod -> LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
-heldEffect effecttype = case effecttype of
-    PistolMod -> bulGunEffect
---    FireRemoteShellMod -> undefined
-    ExplodeRemoteShellMod -> undefined
-    DoNothingMod -> const $ const id
+--heldEffect :: HeldMod -> LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
+--heldEffect effecttype = case effecttype of
+--    PistolMod -> bulGunEffect
+----    FireRemoteShellMod -> undefined
+--    ExplodeRemoteShellMod -> undefined
+--    DoNothingMod -> const $ const id
 
-bulGunEffect :: LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
-bulGunEffect = hammerCheck $ useTimeCheck bulGunEffect'
+heldEffect :: LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
+heldEffect = hammerCheck $ useTimeCheck heldEffectMuzzles
 
-bulGunEffect' :: LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
-bulGunEffect' t cr w = fromMaybe (error "error in bulGunEffect") $ do
-    muzzles <- t ^? ldtValue . itUse . heldAim . aimMuzzles
-    let (upitm,loadedmuzzles) = mapAccumR loadMuzzle t muzzles
-        cmew = foldl' (useLoadedAmmo t cr) (CME 0 0 False,w) $ zip [0..] loadedmuzzles
-    return $ uncurry (applyCME (_ldtValue t) cr) cmew
+heldEffectMuzzles :: LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
+heldEffectMuzzles t cr w = uncurry (applyCME (_ldtValue t) cr) cmew
         & cWorld . lWorld . lTestString .~ map (show . _mzAmmoSlot) muzzles
         & doWeaponRepetitions upitm cr
---        & cWorld . lWorld . lTestInt +~ 1
+  where
+    muzzles = t ^. ldtValue . itUse . heldAim . aimMuzzles
+    (upitm,loadedmuzzles) = mapAccumR loadMuzzle t muzzles
+    cmew = foldl' (useLoadedAmmo t cr) (CME 0 0 False,w) $ zip [0..] loadedmuzzles
+    
 
 -- need to be careful about inventory lock or item ids here
 doWeaponRepetitions :: LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
@@ -192,7 +196,7 @@ useLoadedAmmo :: LabelDoubleTree ComposeLinkType Item
 useLoadedAmmo _ _ (cme,w) (_,Nothing) = (cme, w)
 useLoadedAmmo itmtree cr (cme,w) (mzid,Just (mz,x,magtree)) = (,) (cme & cmeSound .~ True) $ 
         removeAmmoFromMag x mid cr . makeMuzzleFlare mz itm cr $ case _mzEffect mz of
-    MuzzleShootBullet -> shootBullet itm cr w (mz,x,mid)
+    MuzzleShootBullet -> shootBullet itmtree cr (mz,x,magtree) w
     MuzzleLaser -> shootLaser' itm cr mz w
     MuzzleTesla -> shootTeslaArc itm cr mz w
     MuzzleTractor -> shootTractorBeam itm cr w
@@ -268,12 +272,46 @@ removeAmmoFromMag x mid cr = fromMaybe id $ do
     magid <- mid
     return $ cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix magid . itUse . amagLoadStatus . iaLoaded -~ x
 
-shootBullet :: Item -> Creature -> World -> (Muzzle,Int,Maybe Int) -> World
-shootBullet itm cr w (mz,x,mid) = fromMaybe w $ do
-    magid <- mid
+getBulletType :: LabelDoubleTree ComposeLinkType Item 
+    -> LabelDoubleTree ComposeLinkType Item 
+    -> Muzzle
+    -> Creature
+    -> World
+    -> Maybe Bullet
+getBulletType itmtree magtree mz cr w = magtree ^? ldtValue . itUse . amagParams . ampBullet
+    <&> buTrajectory .~ btraj
+  where
+    -- consider modifying other parameters here too
+    btraj = fromMaybe BasicBulletTrajectory $ do
+        targetingtree <- lookup WeaponTargetingLink (itmtree ^. ldtRight) -- left or right for these
+        tp <- targetingtree ^? ldtValue . itUse . tgPos . _Just
+        attree <- lookup AmmoTargetingLink (magtree ^. ldtLeft)
+        bt <- attree ^? ldtValue . itUse . btuBulletTrajectory
+        return $ getBulletTrajectory mz (itmtree ^. ldtValue) bt tp cr w
+
+getBulletTrajectory :: Muzzle -> Item 
+    -> BulletTrajectoryType -> Point2 -> Creature -> World -> BulletTrajectory
+getBulletTrajectory mz itm bt tp cr w = case bt of
+    BasicBulletTrajectoryType -> BasicBulletTrajectory
+    FlechetteTrajectoryType -> FlechetteTrajectory tp
+    BezierTrajectoryType -> BezierTrajectory bulpos tp (mouseWorldPos (w ^. input) (w ^. wCam))
+    MagnetTrajectoryType -> MagnetTrajectory tp
+  where
+    bulpos = _crPos cr + rotateV (_crDir cr) (_mzPos mz + aimingWeaponZeroPos cr itm + V2 0 offset)
+    offset = case itm ^? itUse . heldParams . randomOffset of
+        Just x | x /= 0 -> fst . randomR (-x,x) $ _randGen w
+        _ -> 0
+    
+
+shootBullet :: LabelDoubleTree ComposeLinkType Item 
+    -> Creature 
+    -> (Muzzle,Int,LabelDoubleTree ComposeLinkType Item ) 
+    -> World 
+    -> World
+shootBullet itmtree cr (mz,x,magtree) w = fromMaybe w $ do
     -- should be able to pass the magazine in from elsewhere?
-    thebullet <- cr ^? crInv . ix magid . itUse . amagParams . ampBullet
-    return $ w & flip (foldl' (&)) (replicate x (makeBullet thebullet itm cr mz))
+    thebullet <- getBulletType itmtree magtree mz cr w
+    return $ flip (foldl' (&)) (replicate x (makeBullet thebullet (itmtree ^. ldtValue) cr mz)) w
 --            & makeMuzzleFlare mz itm cr
 --            & makeMuzzleSmoke mz itm cr
 --  where
@@ -310,82 +348,11 @@ mcUseHeld hit = case hit of
     LASGUN -> mcShootLaser
     _ -> \_ _ -> id
 
-useHeld :: Huse -> LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
-useHeld hu = case hu of
-    HeldDoNothing -> const $ const id
---    HeldUseAmmoParams -> shootBullet
---    HeldOverNozzlesUseGasParams -> overNozzles useGasParams
---    HeldPJCreation -> usePjCreation
---    HeldPJCreationX _ -> usePjCreationX
---    HeldFireRemoteShell -> fireRemoteShell
-    HeldDetectorEffect dt -> detectorEffect dt . _ldtValue
---    HeldTeslaArc -> shootTeslaArc . _ldtValue
---    HeldLaser -> shootLaser . _ldtValue
---    HeldCircleLaser -> circleLaser . _ldtValue
---    HeldDualLaser -> shootDualLaser . _ldtValue
---    HeldTractor -> aTractorBeam . _ldtValue
-    --    HeldSonicWave -> aSonicWave
-    HeldForceField -> useForceFieldGun . _ldtValue
---    HeldShatter -> shootShatter . _ldtValue
---    HeldExplodeRemoteShell itid pjid -> const $ const $ explodeRemoteRocket itid pjid
-
---usePjCreation :: LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
---usePjCreation itm cr = fromMaybe id $ do
---    atype <- itm ^? ldtValue . itUse . heldAmmoTypes . ix 0
---    leftitms <- itm ^? ldtLeft
---    mag <- lookup (AmmoInLink 0 atype) leftitms
---    apm <- mag ^? ldtValue
---    muz <- itm ^? ldtValue . itUse . heldAim . aimMuzzles . ix 0
---    return $ createProjectile apm muz (_ldtValue itm) cr
-
---usePjCreationX :: LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
---usePjCreationX = undefined
---usePjCreationX ams itm cr = fromMaybe id $ do
---    muzs <- itm ^? itUse . heldAim . aimMuzzles
---    return $ foldr
---        f id (zip muzs ams)
---  where
---    f (muz,am) = (createProjectile am muz itm cr .)
-
---overNozzles ::
---    (Nozzle -> LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World) ->
---    LabelDoubleTree ComposeLinkType Item ->
---    Creature ->
---    World ->
---    World
---overNozzles = overNozzles' . overNozzle
-
---overNozzles' ::
---    (LabelDoubleTree ComposeLinkType Item -> Creature -> World -> Nozzle -> (World, Nozzle)) ->
---    LabelDoubleTree ComposeLinkType Item ->
---    Creature ->
---    World ->
---    World
---overNozzles' eff itm cr w = neww 
---    & cWorld . lWorld . creatures . ix cid . crInv . ix i . itParams . sprayNozzles .~ newNozzles
---  where
---    it = itm ^. ldtValue
---    cid = _crID cr
---    i = w ^?! cWorld . lWorld . creatures . ix cid . crManipulation . manObject . inInventory . ispItem
---    (neww, newNozzles) = mapAccumR (eff itm cr) w $ _sprayNozzles (_itParams it)
-
---overNozzle ::
---    (Nozzle -> LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World) ->
---    LabelDoubleTree ComposeLinkType Item ->
---    Creature ->
---    World ->
---    Nozzle ->
---    (World, Nozzle)
---overNozzle eff itm cr w nz =
---    ( eff nz itm (cr & crDir +~ wa + na) w & randGen .~ g
---    , nz & nzCurrentWalkAngle .~ wa
---    )
---  where
---    na = _nzDir nz
---    (walkamount, g) = randomR (- aspeed, aspeed) (_randGen w)
---    aspeed = _nzWalkSpeed nz
---    maxa = _nzMaxWalkAngle nz
---    wa = min maxa $ max (negate maxa) (_nzCurrentWalkAngle nz + walkamount)
+--useHeld :: Huse -> LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
+--useHeld hu = case hu of
+--    HeldDoNothing -> const $ const id
+--    HeldDetectorEffect dt -> detectorEffect dt . _ldtValue
+--    HeldForceField -> useForceFieldGun . _ldtValue
 
 useGasParams :: Maybe Int -> Muzzle -> Item -> Creature -> World -> World
 useGasParams mmagid mz itm cr w =
@@ -411,46 +378,17 @@ useGasParams mmagid mz itm cr w =
 gasCreate :: GasFuel -> GasCreate -> GasCreate
 gasCreate = const id
 
-
 doGenFloat :: RandomGen g => GenFloat -> g -> (Float, g)
 doGenFloat (ConstFloat x) g = (x,g)
 doGenFloat (UniRandFloat x y) g = randomR (x,y) g
 
---fireRemoteShell :: LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
---fireRemoteShell = undefined
---fireRemoteShell :: [Item] -> Item -> Creature -> World -> World
---fireRemoteShell ams it cr w =
---    set
---        (cWorld . lWorld . creatures . ix cid . crInv . ix j . itUse . heldUse)
---        (HeldExplodeRemoteShell itid i)
---        $ addRemRocket w
---  where
---    itid = _itID it
---    i = IM.newKey $ w ^. cWorld . lWorld . props
---    cid = _crID cr
---    apm = fromMaybe (error "cannot find shell ammo projectile") $ do
---            ams ^? ix 0
---    addRemRocket =
---        makeShell apm
---                -- the following is unsafe!
---            (it ^?! itUse . heldAim . aimMuzzles . ix 0)
---            it
---            cr
---            [ PJRemoteShellCollisionCheck
---            , PJSetScope itid
---            , PJDecTimMvVel
---            , PJThrust 330 0
---            , PJRemoteDirection 340 0 cid itid
---            ]
---    j = cr ^?! crManipulation . manObject . inInventory . ispItem -- unsafe!! TODO change
-
-caneStickSoundChoice :: Item -> SoundID
-caneStickSoundChoice _ = tap3S
+--caneStickSoundChoice :: Item -> SoundID
+--caneStickSoundChoice _ = tap3S
 --  --    | (it ^?! itUse . heldConsumption . laSource . _InternalSource . iaLoaded) < 2 = tap3S
 --  --    | otherwise = shotgunS
 
-bangStickSoundChoice :: Item -> SoundID
-bangStickSoundChoice = caneStickSoundChoice
+--bangStickSoundChoice :: Item -> SoundID
+--bangStickSoundChoice = caneStickSoundChoice
 
 -- do
 --    wth <- state $ randomR (1, 5)