Implement bullet trajectories using attachable items

2024-09-29 21:51:14 +01:00
parent 88c3e02459
commit 4545caa7e6
26 changed files with 504 additions and 570 deletions
@@ -1 +1 @@
-All good (616 modules, at 16:22:03)
+All good (616 modules, at 21:51:07)
@@ -241,19 +241,20 @@ inventoryX c = case c of
    'P' -> [burstRifle , tinMag, bulletSynthesizer]
    'T' -> testInventory
    'U' ->
-        [ targetingScope TARGETLASER
-        , launcher
-        , megaShellMag
-        , homingModule
-        ]
-    'V' -> 
        [targetingScope tt | tt <- [minBound .. maxBound]]
        <>
-        [launcher
+        [ launcher
        , megaShellMag
        , homingModule
        , remoteScreen
        ]
+    'V' -> 
+        [targetingScope tt | tt <- [minBound .. maxBound]]
+        <>
+        [ autoRifle
+        , megaTinMag 10200
+        ] <>
+        [bulletTargetingModule btt | btt <- [minBound .. maxBound]]
    _ -> []

 testInventory :: [Item]
@@ -287,7 +288,7 @@ stackedInventory =
    , megaShellMag
    , targetingScope TARGETLASER
    , burstRifle
-    , megaTinMag
+    , megaTinMag 100
    , teslaGun
    , megaBattery
    , flameThrower
@@ -34,8 +34,7 @@ useRootItem crid w = fromMaybe w $ do

 itemUseEffect :: Creature -> LabelDoubleTree ComposeLinkType Item -> World -> World
 itemUseEffect cr it w = case it ^. ldtValue . itUse of
-    HeldUse{ _heldMods = usemods} -> 
-        heldEffect usemods it cr w
+    HeldUse{ } -> heldEffect it cr w
            & pointerToItem itm . itUse . heldHammer .~ HammerDown
    LeftUse{} -> doequipmentchange
    EquipUse{} -> doequipmentchange
@@ -45,6 +44,7 @@ itemUseEffect cr it w = case it ^. ldtValue . itUse of
    TargetingUse {} -> w
    AmmoMagUse{} -> w
    ScopeUse{} -> w
+    BulletTrajectoryUse{} -> w
  where
    itm = it ^. ldtValue
    doequipmentchange = fromMaybe w $ do
@@ -59,7 +59,7 @@ data BulletTrajectoryType
    | BezierTrajectoryType
    | FlechetteTrajectoryType
    | MagnetTrajectoryType
-    deriving (Show, Eq, Ord, Read) --Generic, Flat)
+    deriving (Show, Eq, Ord, Read, Enum, Bounded) --Generic, Flat)

 makeLenses ''Bullet
 makeLenses ''BulletSpawn
@@ -91,6 +91,7 @@ data ItemBaseType
    | ATTACH {_ibtAttach :: AttachType}
    | AMMOMAG {_ibtAmmoMag :: AmmoMagType}
    | TARGETING {_ibtTargeting :: TargetingType}
+    | HOMING {_ibtHoming :: BulletTrajectoryType}
    deriving (Eq, Ord, Show, Read)

 --deriving (Eq, Ord, Show, Read) --Generic, Flat)
@@ -100,6 +101,7 @@ data AttachType
    | BULLETSYNTHESIZER
    | REMOTESCREEN
    | HOMINGMODULE
+--    | FLETCHINGMODULE
 --    | BULPAYLOADATTACH
 --    | BULTRAJECTORYATTACH
    deriving (Eq, Ord, Show, Read)
@@ -12,14 +12,14 @@ import Dodge.Data.CamouflageStatus
 import Dodge.Data.Item.Combine
 import Control.Lens

-data Huse
-    = HeldDoNothing
--    | HeldFireRemoteShell
--    | HeldExplodeRemoteShell Int Int
-    | HeldDetectorEffect Detector
-    | HeldForceField
--    | HeldShatter
-    deriving (Eq, Ord, Show, Read) --Generic, Flat)
+--data Huse
+--    = HeldDoNothing
+----    | HeldFireRemoteShell
+----    | HeldExplodeRemoteShell Int Int
+--    | HeldDetectorEffect Detector
+--    | HeldForceField
+----    | HeldShatter
+--    deriving (Eq, Ord, Show, Read) --Generic, Flat)

 data Cuse
    = CDoNothing
@@ -56,16 +56,16 @@ data Luse
    | LBoost
    deriving (Eq, Ord, Show, Read) --Generic, Flat)

-data HeldMod
-    = PistolMod
--    | FireRemoteShellMod
-    | ExplodeRemoteShellMod
-    | DoNothingMod
-    deriving (Eq, Ord, Show, Read) --Generic, Flat)
+--data HeldMod
+--    = PistolMod
+----    | FireRemoteShellMod
+--    | ExplodeRemoteShellMod
+--    | DoNothingMod
+--    deriving (Eq, Ord, Show, Read) --Generic, Flat)

 makeLenses ''Euse
 deriveJSON defaultOptions ''Cuse
-deriveJSON defaultOptions ''HeldMod
+--deriveJSON defaultOptions ''HeldMod
 deriveJSON defaultOptions ''Euse
-deriveJSON defaultOptions ''Huse
+--deriveJSON defaultOptions ''Huse
 deriveJSON defaultOptions ''Luse
@@ -35,7 +35,7 @@ data ItemUse
    = HeldUse
        { -- _heldUse :: Huse
          _heldDelay :: UseDelay
-        , _heldMods :: HeldMod
+--        , _heldMods :: HeldMod
        , _heldHammer :: HammerPosition
        , _heldAim :: AimParams
        , _heldAmmoTypes :: IM.IntMap AmmoType
@@ -78,6 +78,9 @@ data ItemUse
        , _tgID :: Maybe Int
        , _tgActive :: Bool
        }
+    | BulletTrajectoryUse
+        { _btuBulletTrajectory :: BulletTrajectoryType
+        }
    deriving (Eq, Show, Read) --Generic, Flat)

 data TriggerType
@@ -47,7 +47,7 @@ singleAmmo x = IM.insert 0 x mempty
 defaultBulletWeapon :: Item
 defaultBulletWeapon =
    defaultHeldItem
-        & itUse . heldMods .~ PistolMod
+--        & itUse . heldMods .~ PistolMod
        & itUse . heldAmmoTypes .~ singleAmmo BulletAmmo
 --        & itUse . heldUse .~ HeldUseAmmoParams -- useAmmoParams
        & itType . iyModules . at ModBulletCollision ?~ EMPTYMODULE
@@ -31,7 +31,7 @@ defaultHeldUse :: ItemUse
 defaultHeldUse =
    HeldUse
        { _heldDelay = FixedRate{_rateMax = 8, _rateTime = 0}
-        , _heldMods = DoNothingMod
+--        , _heldMods = DoNothingMod
        , _heldHammer = HammerUp
        , _heldAim = defaultAimParams
        , _heldAmmoTypes = mempty
@@ -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)
@@ -26,6 +26,7 @@ itemFromBase ibt = case ibt of
    ATTACH at -> itemFromAttachType at
    AMMOMAG t -> itemFromAmmoMag t
    TARGETING tt -> targetingScope tt
+    HOMING btt -> bulletTargetingModule btt

 itemFromAmmoMag :: AmmoMagType -> Item
 itemFromAmmoMag at = case at of
@@ -5,10 +5,10 @@ import Dodge.Data.World
 import Dodge.Default.Item
 import Dodge.Item.Weapon.Bullet

-megaTinMag :: Item
-megaTinMag = tinMag
-        & itUse . amagLoadStatus . iaMax .~ 150000
-        & itUse . amagLoadStatus . iaLoaded .~ 150000
+megaTinMag :: Int -> Item
+megaTinMag x = tinMag
+        & itUse . amagLoadStatus . iaMax .~ x
+        & itUse . amagLoadStatus . iaLoaded .~ x

 tinMag :: Item
 tinMag =
@@ -8,6 +8,7 @@ module Dodge.Item.Display (

 --import Control.Applicative
 --import Control.Monad
+import ShortShow
 import Data.Maybe
 import Dodge.Data.Creature
 --import Dodge.Item.Info
@@ -71,6 +72,7 @@ itemBaseName itm = case _iyBase $ _itType itm of
    ATTACH ait -> showAttachItem ait itm
    AMMOMAG ait -> show ait
    TARGETING tt -> show tt
+    HOMING btt -> show btt

 showAttachItem :: AttachType -> Item -> String
 showAttachItem t itm = case t of
@@ -117,11 +119,12 @@ itemNumberDisplay cr itm = case iu of
    --ConsumeUse {_useAmount = x} -> [show $ x ^. getItAmount]
    ConsumeUse {} -> []
    AttachUse {} -> [] --[showReloadProgress cr itm]
-    AmmoMagUse {} -> [showLoadedAmount itm]
-    ScopeUse OpticScope {_opticZoom = x} -> [show x]
+    AmmoMagUse {} -> [maybe "" shortShow $ itm ^? itUse . amagLoadStatus . iaLoaded]
+    ScopeUse OpticScope {_opticZoom = x} -> [shortShow x]
    ScopeUse {} -> []
-    TargetingUse {_tgPos = mp} -> [maybe "" show mp]
+    TargetingUse {_tgPos = mp} -> [maybe "" shortShow mp]
        -- this could be cleaner here...
+    BulletTrajectoryUse {} -> mempty
  where
    iu = itm ^?! itUse

@@ -134,51 +137,6 @@ showEquipmentNumber _ itm = case _eeUse ee of
  where
    ee = itm ^?! itUse . equipEffect

--showAmmoSource :: Creature -> Item -> [String]
--showAmmoSource cr itm = fromMaybe ["FAIL"] $ do
--    eu <- itm ^? itUse . equipEffect . eeUse
--    atype <- eu ^? euseAmmoSourceType
--    x <- fmap showIntKMG' $ eu ^? euseAmmoAmount
--    i <- itm ^? itLocation . ipInvID
--    ( do
--            at' <- cr ^? crInv . ix (i + 1) . itUse . heldConsumption . laSourceType
--            as <- cr ^? crInv . ix (i + 1) . itUse . heldConsumption . laSource
--            guard (at' == atype && as == AboveSource)
--            return ["vvvv", x]
--        )
--        <|> Just [x]
-
-showLoadedAmount :: Item -> String
-showLoadedAmount itm = maybe [] show $ itm ^? itUse . amagLoadStatus . iaLoaded
-
--showReloadProgress :: Creature -> Item -> String
--showReloadProgress _ itm = fromMaybe [] $ do
--    ia <- itm ^? itUse . amagLoadStatus
--    return $ case ia ^? iaProgress . _Just . ix 0 of
--        Nothing -> maybe "" show $ ia ^? iaLoaded
--        Just la -> showLoadActionType la ia
--showReloadProgress :: Creature -> Item -> String
--showReloadProgress cr itm = case ic ^? laSource of
--    Just (InternalSource ia) -> case ia ^? iaProgress . _Just . ix 0 of
--        Nothing -> maybe "" show $ ic ^? laSource . _InternalSource . iaLoaded
--        Just la -> showLoadActionType la (_laSource ic)
--    Just AboveSource -> fromMaybe "^^^^" $ do
--        i <- fmap (subtract 1) $ itm ^? itLocation . ipInvID
--        _ <- cr ^? crInv . ix i . itUse . equipEffect . eeUse . euseAmmoAmount
--        return ""
--    _ -> ""
--  where
--    ic = itm ^?! itUse . heldConsumption
-
--showLoadActionType :: LoadAction -> ReloadStatus -> String
--showLoadActionType la as = case la of
--    LoadEject{} -> "E"
--    LoadInsert{} -> "L"
--    LoadAdd{} -> "A" ++ x
--    LoadPrime{} -> "P"
--  where
--    x = maybe "" show $ as ^? iaLoaded
-
 maybeWarmupStatus :: Item -> Maybe String
 maybeWarmupStatus it = case it ^? itUse . heldDelay . warmMax of
    Nothing -> Nothing
@@ -35,6 +35,7 @@ itemSPic it =
        ATTACH {} -> defSPic
        AMMOMAG {} -> defSPic
        TARGETING {} -> defSPic
+        HOMING {} -> defSPic

 equipItemSPic :: EquipItemType -> Item -> SPic
 equipItemSPic et _ = case et of
@@ -41,8 +41,17 @@ basePartiallyComposedItem itm = case itm ^. itType . iyBase of
    TARGETING {} -> (itm,WeaponTargetingSF, LinkTest (const Nothing) (const Nothing))
    ATTACH ZOOMSCOPE -> (itm,WeaponScopeSF, LinkTest (const Nothing) (const Nothing))
    ATTACH HOMINGMODULE -> (itm,AmmoTargetingSF ProjectileAmmo, LinkTest (const Nothing) (const Nothing))
+    HOMING {}
+        -> (itm,AmmoTargetingSF BulletAmmo, LinkTest (const Nothing) (const Nothing))
    ATTACH REMOTESCREEN -> (itm,RemoteScreenSF, LinkTest (const Nothing) (const Nothing))
-    _ -> (itm,UncomposableIsolateSF, LinkTest (const Nothing) (const Nothing))
+    ATTACH BULLETSYNTHESIZER -> (itm,AmmoModifierSF BulletAmmo, LinkTest (const Nothing) (const Nothing))
+    LEFT {} -> isolate
+    EQUIP {} -> isolate
+    CONSUMABLE {} -> isolate
+    CRAFT {} -> isolate
+--    _ -> 
+  where
+    isolate = (itm,UncomposableIsolateSF, LinkTest (const Nothing) (const Nothing))

 ammoComposedItem :: Item -> PartiallyComposedItem
 ammoComposedItem itm = fromMaybe (error "in ammoComposedItem, wrong item") $ do
@@ -28,7 +28,7 @@ teslaGun =
        & itParams .~ teslaParams
 --        & itUse . heldUse .~ HeldTeslaArc --shootTeslaArc
        & itUse . heldDelay .~ NoDelay
-        & itUse . heldMods .~ PistolMod
+--        & itUse . heldMods .~ PistolMod
        & itUse . heldAim . aimWeight .~ 6
        & itUse . heldAim . aimStance .~ TwoHandFlat
        -- & itUse . heldAim . aimMuzPos .~ 4
@@ -44,7 +44,7 @@ lasGun :: Item
 lasGun =
    defaultHeldItem
        & itType . iyModules .~ batteryModules
-        & itUse . heldMods .~ PistolMod 
+--        & itUse . heldMods .~ PistolMod 
        & itUse . heldParams .~ BeamShooterParams (Just (tone440sawtoothquietS,2))
        & itUse . heldAmmoTypes .~ singleAmmo ElectricalAmmo
        & itUse . heldDelay .~ NoDelay
@@ -14,7 +14,7 @@ bangCone =
        & itDimension . dimRad .~ 8
        & itDimension . dimCenter .~ V3 5 0 0
        & itUse . heldDelay . rateMax .~ 20
-        & itUse . heldMods .~ PistolMod
+--        & itUse . heldMods .~ PistolMod
        -- & itUse . heldAim . aimHandlePos .~ 5
        & itUse . heldAim . aimMuzzles 
            .~ replicate 15 (Muzzle (V2 15 0) 0 0.5 0 DefaultFlareType MuzzleShootBullet)
@@ -28,7 +28,7 @@ launcher =
        & itUse . heldDelay . rateMax .~ 20
 --        & itUse . heldUse .~ HeldPJCreation --usePjCreation
 --        & itUse . heldMods .~ LauncherMod
-        & itUse . heldMods .~ PistolMod
+--        & itUse . heldMods .~ PistolMod
        & itUse . heldAim . aimWeight .~ 8
        & itUse . heldAim . aimRange .~ 0.5
        & itUse . heldAim . aimStance .~ TwoHandOver
@@ -81,7 +81,7 @@ flameThrower =
 --        & itUse . heldUse .~ HeldOverNozzlesUseGasParams -- overNozzles useGasParams
        & itUse . heldDelay .~ NoDelay
 --        & itUse . heldMods .~ FlameThrowerMod
-        & itUse . heldMods .~ PistolMod
+--        & itUse . heldMods .~ PistolMod
        & itUse . heldAim . aimWeight .~ 5
        & itUse . heldAim . aimZoom .~ defaultItZoom{_izMax = 5, _izMin = 1.5}
        & itUse . heldAim . aimStance .~ TwoHandUnder
@@ -25,7 +25,7 @@ bangStick i =
        & itDimension . dimCenter .~ V3 5 0 0
        & itUse . heldDelay . rateMax .~ 8
 --        & itUse . heldMods .~ BangStickMod
-        & itUse . heldMods .~ PistolMod
+--        & itUse . heldMods .~ PistolMod
        & itUse . heldAim . aimMuzzles 
            .~ [Muzzle (V2 10 0) a 0.01 0 DefaultFlareType MuzzleShootBullet | a <- spreadAroundCenter i baseStickSpread]

@@ -37,7 +37,7 @@ pistol =
    bangStick 1
 --        & itUse . heldAmmoTypes .~ [BulletAmmo]
        & itUse . heldDelay . rateMax .~ 6
-        & itUse . heldMods .~ PistolMod
+--        & itUse . heldMods .~ PistolMod
        & itUse . heldAim . aimMuzzles . ix 0 . mzPos %~ const (V2 10 0)
        & itUse . heldAim . aimMuzzles . ix 0 . mzInaccuracy %~ const 0.05
        & itUse . heldAim . aimMuzzles . ix 0 . mzFlareType %~ const PistolFlare
@@ -53,7 +53,7 @@ pistol =
 autoPistol :: Item
 autoPistol =
    pistol
-        & itUse . heldMods .~ PistolMod
+--        & itUse . heldMods .~ PistolMod
        & itUse . heldTriggerType .~ AutoTrigger
        & itUse . heldParams . bulGunSound ?~ (tap1S,0)
        & itType . iyBase .~ HELD AUTOPISTOL
@@ -64,7 +64,7 @@ machinePistol =
    autoPistol
        & itUse . heldDelay .~ WarmUpNoDelay {_warmTime = 0, _warmMax = 50, _warmSound = crankSlowS} 
        --rateMax .~ 2
-        & itUse . heldMods .~ PistolMod -- (ammoCheckI : machinePistolAfterHamMods)
+--        & itUse . heldMods .~ PistolMod -- (ammoCheckI : machinePistolAfterHamMods)
        & itType . iyBase .~ HELD MACHINEPISTOL
        & itType . iyModules . at ModAutoMag .~ Nothing
        & itUse . heldParams . recoil .~ 20
@@ -72,7 +72,7 @@ machinePistol =
 smg :: Item
 smg =
    autoPistol -- & some parameter affecting stability
-        & itUse . heldMods .~ PistolMod --(ammoCheckI : smgAfterHamMods)
+--        & itUse . heldMods .~ PistolMod --(ammoCheckI : smgAfterHamMods)
        & itType . iyBase .~ HELD SMG
        & itUse . heldAim . aimStance .~ TwoHandUnder
        & itUse . heldAim . aimMuzzles . ix 0 . mzPos .~ V2 20 0
@@ -44,20 +44,6 @@ showInt i = case i of
    12 -> "a dozen"
    _ -> "more than a dozen"

-showIntKMG :: Int -> String
-showIntKMG x
-    | x < 1000 = show x
-    | x < 1000000 = show (x `div` 1000) ++ "K"
-    | x < 1000000000 = show (x `div` 1000000) ++ "M"
-    | otherwise = show (x `div` 1000000000) ++ "G"
-
-showIntKMG' :: Int -> String
-showIntKMG' x
-    | x < 1000 = show x
-    | x < 1000000 = take 3 (show ((fromIntegral x :: Float) / 1000)) ++ "K"
-    | x < 1000000000 = take 3 (show ((fromIntegral x :: Float) / 1000000)) ++ "M"
-    | otherwise = take 3 (show ((fromIntegral x :: Float) / 1000000000)) ++ "G"
-
 heldInfo :: HeldItemType -> String
 heldInfo hit = case hit of
    BANGSTICK 1 -> "A firearm with a short barrel that requires reloading after each shot."
@@ -14,3 +14,4 @@ itemInvColor itm = case itm ^. itType . iyBase of
    ATTACH {} -> orange
    TARGETING {} -> chartreuse
    AMMOMAG {} -> greyN 0.8
+    HOMING {} -> rose
@@ -3,6 +3,8 @@ module Dodge.Item.Scope (
    targetingScope,
    remoteScreen,
    homingModule,
+    fletchingModule,
+    bulletTargetingModule,
 ) where

 import Control.Lens
@@ -28,6 +30,15 @@ homingModule =
        & itType . iyBase .~ ATTACH HOMINGMODULE
        & itUse .~ AttachUse Nothing

+fletchingModule :: Item
+fletchingModule = bulletTargetingModule FlechetteTrajectoryType
+
+bulletTargetingModule :: BulletTrajectoryType -> Item
+bulletTargetingModule btt =
+    defaultHeldItem
+        & itType . iyBase .~ HOMING btt
+        & itUse .~ BulletTrajectoryUse btt
+
 remoteScreen :: Item
 remoteScreen =
    defaultHeldItem
@@ -1,4 +1,6 @@
-module ShortShow where
+module ShortShow 
+    ( shortShow
+    ) where
 import Geometry

 --import Data.Typeable
@@ -13,5 +15,28 @@ instance ShortShow a => ShortShow (V2 a) where
 instance ShortShow Float where
    shortShow x = showFFloat (Just 2) x ""

+instance ShortShow Int where
+    shortShow x
+        | x < k = show x
+        | x < m = fdiv x k "K"
+        | x < g = fdiv x m "M"
+        | x < t = fdiv x g "G"
+        | x < p = fdiv x t "T"
+        | otherwise = show x ++ "P"
+
+fdiv :: Int -> Int -> String -> String
+fdiv x y s = removeDot (take 3 (show ((fromIntegral x / fromIntegral y)::Float))) ++ s
+
+removeDot :: String -> String
+removeDot (a:b:'.':[]) = a:b:[]
+removeDot xs = xs
+
+k,m,g,t,p :: Int
+k = 10 ^ (3 :: Int)
+m = 10 ^ (6 :: Int)
+g = 10 ^ (9 :: Int)
+t = 10 ^ (12:: Int)
+p = 10 ^ (15:: Int)
+
 instance (ShortShow a,ShortShow b) => ShortShow (a,b) where
    shortShow (a,b) = '(' : shortShow a ++ "," ++ shortShow b ++ ")"