Implement bullet trajectories using attachable items

ghcidOutput

@@ -1 +1 @@
-All good (616 modules, at 16:22:03)
+All good (616 modules, at 21:51:07)

src/Dodge/Creature.hs

@@ -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

src/Dodge/Creature/Impulse/UseItem.hs

@@ -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} -> 
+    HeldUse{ } -> heldEffect it cr w
-        heldEffect usemods 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

src/Dodge/Data/Bullet.hs

@@ -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

src/Dodge/Data/Item/Combine.hs

@@ -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)

src/Dodge/Data/Item/HeldUse.hs

@@ -12,14 +12,14 @@ import Dodge.Data.CamouflageStatus
 import Dodge.Data.Item.Combine
 import Control.Lens
 
-data Huse
+--data Huse
-    = HeldDoNothing
+--    = HeldDoNothing
---    | HeldFireRemoteShell
+----    | HeldFireRemoteShell
---    | HeldExplodeRemoteShell Int Int
+----    | HeldExplodeRemoteShell Int Int
-    | HeldDetectorEffect Detector
+--    | HeldDetectorEffect Detector
-    | HeldForceField
+--    | HeldForceField
---    | HeldShatter
+----    | HeldShatter
-    deriving (Eq, Ord, Show, Read) --Generic, Flat)
+--    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
+--data HeldMod
-    = PistolMod
+--    = PistolMod
---    | FireRemoteShellMod
+----    | FireRemoteShellMod
-    | ExplodeRemoteShellMod
+--    | ExplodeRemoteShellMod
-    | DoNothingMod
+--    | DoNothingMod
-    deriving (Eq, Ord, Show, Read) --Generic, Flat)
+--    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

src/Dodge/Data/Item/Use.hs

@@ -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

src/Dodge/Default/Item.hs

@@ -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

src/Dodge/Default/Item/Use.hs

@@ -31,7 +31,7 @@ defaultHeldUse :: ItemUse
 defaultHeldUse =
     HeldUse
         { _heldDelay = FixedRate{_rateMax = 8, _rateTime = 0}
-        , _heldMods = DoNothingMod
+--        , _heldMods = DoNothingMod
         , _heldHammer = HammerUp
         , _heldAim = defaultAimParams
         , _heldAmmoTypes = mempty

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 :: HeldMod -> LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
-heldEffect effecttype = case effecttype of
+--heldEffect effecttype = case effecttype of
-    PistolMod -> bulGunEffect
+--    PistolMod -> bulGunEffect
---    FireRemoteShellMod -> undefined
+----    FireRemoteShellMod -> undefined
-    ExplodeRemoteShellMod -> undefined
+--    ExplodeRemoteShellMod -> undefined
-    DoNothingMod -> const $ const id
+--    DoNothingMod -> const $ const id
 
-bulGunEffect :: LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
+heldEffect :: LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
-bulGunEffect = hammerCheck $ useTimeCheck bulGunEffect'
+heldEffect = hammerCheck $ useTimeCheck heldEffectMuzzles
 
-bulGunEffect' :: LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
+heldEffectMuzzles :: LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
-bulGunEffect' t cr w = fromMaybe (error "error in bulGunEffect") $ do
+heldEffectMuzzles t cr w = uncurry (applyCME (_ldtValue t) cr) cmew
-    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
         & 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
+getBulletType :: LabelDoubleTree ComposeLinkType Item 
-shootBullet itm cr w (mz,x,mid) = fromMaybe w $ do
+    -> LabelDoubleTree ComposeLinkType Item 
-    magid <- mid
+    -> 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
+    thebullet <- getBulletType itmtree magtree mz cr w
-    return $ w & flip (foldl' (&)) (replicate x (makeBullet thebullet itm cr mz))
+    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 :: Huse -> LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
-useHeld hu = case hu of
+--useHeld hu = case hu of
-    HeldDoNothing -> const $ const id
+--    HeldDoNothing -> const $ const id
---    HeldUseAmmoParams -> shootBullet
+--    HeldDetectorEffect dt -> detectorEffect dt . _ldtValue
---    HeldOverNozzlesUseGasParams -> overNozzles useGasParams
+--    HeldForceField -> useForceFieldGun . _ldtValue
---    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)
 
 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
+--caneStickSoundChoice :: Item -> SoundID
---fireRemoteShell = undefined
+--caneStickSoundChoice _ = tap3S
---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
 --  --    | (it ^?! itUse . heldConsumption . laSource . _InternalSource . iaLoaded) < 2 = tap3S
 --  --    | otherwise = shotgunS
 
-bangStickSoundChoice :: Item -> SoundID
+--bangStickSoundChoice :: Item -> SoundID
-bangStickSoundChoice = caneStickSoundChoice
+--bangStickSoundChoice = caneStickSoundChoice
 
 -- do
 --    wth <- state $ randomR (1, 5)

src/Dodge/Item.hs

@@ -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

src/Dodge/Item/Ammo.hs

@@ -5,10 +5,10 @@ import Dodge.Data.World
 import Dodge.Default.Item
 import Dodge.Item.Weapon.Bullet
 
-megaTinMag :: Item
+megaTinMag :: Int -> Item
-megaTinMag = tinMag
+megaTinMag x = tinMag
-        & itUse . amagLoadStatus . iaMax .~ 150000
+        & itUse . amagLoadStatus . iaMax .~ x
-        & itUse . amagLoadStatus . iaLoaded .~ 150000
+        & itUse . amagLoadStatus . iaLoaded .~ x
 
 tinMag :: Item
 tinMag =

src/Dodge/Item/Display.hs

@@ -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]
+    AmmoMagUse {} -> [maybe "" shortShow $ itm ^? itUse . amagLoadStatus . iaLoaded]
-    ScopeUse OpticScope {_opticZoom = x} -> [show x]
+    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

src/Dodge/Item/Draw/SPic.hs

@@ -35,6 +35,7 @@ itemSPic it =
         ATTACH {} -> defSPic
         AMMOMAG {} -> defSPic
         TARGETING {} -> defSPic
+        HOMING {} -> defSPic
 
 equipItemSPic :: EquipItemType -> Item -> SPic
 equipItemSPic et _ = case et of

src/Dodge/Item/Grammar.hs

@@ -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

src/Dodge/Item/Held/BatteryGuns.hs

@@ -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

src/Dodge/Item/Held/Cone.hs

@@ -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)

src/Dodge/Item/Held/Launcher.hs

@@ -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

src/Dodge/Item/Held/SprayGuns.hs

@@ -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

src/Dodge/Item/Held/Stick.hs

@@ -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

src/Dodge/Item/Info.hs

@@ -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."

src/Dodge/Item/InventoryColor.hs

@@ -14,3 +14,4 @@ itemInvColor itm = case itm ^. itType . iyBase of
     ATTACH {} -> orange
     TARGETING {} -> chartreuse
     AMMOMAG {} -> greyN 0.8
+    HOMING {} -> rose

src/Dodge/Item/Scope.hs

@@ -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

src/ShortShow.hs

@@ -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 ++ ")"