Implement zipper for attachment trees

2024-10-05 14:39:34 +01:00
parent 71d4802a4a
commit 164beeea6d
23 changed files with 391 additions and 277 deletions
@@ -1 +1,5 @@
-All good (598 modules, at 01:27:16)
+/home/justin/Haskell/loop/src/Dodge/Render/ShapePicture.hs:78:1-12: warning: [-Wunused-top-binds]
+    Defined but not used: ‘anyTargeting’
+   |
+78 | anyTargeting w = fromMaybe mempty $ do
+   | ^^^^^^^^^^^^
@@ -244,7 +244,8 @@ inventoryX c = case c of
    'V' -> 
        [targetingScope tt | tt <- [minBound .. maxBound]]
        <>
-        [ augmentedHUD
+        [ battery
+        , augmentedHUD
        , autoRifle
        , megaTinMag 10200
        ] <>
@@ -3,6 +3,8 @@ module Dodge.Creature.State (
    doDamage,
 ) where

+import Dodge.Targeting.Draw
+import Dodge.Data.DoubleTree
 import qualified Data.Map.Strict as M
 import Data.Maybe
 import Data.Monoid
@@ -15,7 +17,6 @@ import Dodge.Creature.State.WalkCycle
 import Dodge.Creature.Test
 import Dodge.Damage
 import Dodge.Data.ComposedItem
-import Dodge.Data.DoubleTree
 import Dodge.Data.World
 import Dodge.DoubleTree
 import Dodge.Euse
@@ -158,26 +159,26 @@ equipmentEffects cr = alaf Endo foldMap (useEquipment cr) (IM.keys $ _crInvEquip

 -- a loop going over all inventory items
 invSideEff :: Creature -> World -> World
-invSideEff cr = alaf Endo foldMap f (_crInv cr) . updateRootItem cr
+invSideEff cr = alaf Endo foldMap f (_crInv cr) . updateHeldRootItem cr
  where
    f it =
        itemInvSideEffect cr it
            . maybe id (\g -> doInvEffect g it cr) (it ^? itEffect . ieInv)

-updateRootItem :: Creature -> World -> World
-updateRootItem cr = fromMaybe id $ do
+updateHeldRootItem :: Creature -> World -> World
+updateHeldRootItem cr = fromMaybe id $ do
    invid <- cr ^? crManipulation . manObject . imRootItem
    itmtree <- invTrees' (_crInv cr) ^? ix invid
-    return $ updateRootItem' itmtree cr
+    return $ updateAttachedItems itmtree cr

-updateRootItem' :: LabelDoubleTree ItemLink Item -> Creature -> World -> World
-updateRootItem' itmtree cr =
-    ldtPropagateFoldTree
+updateAttachedItems :: LabelDoubleTree ItemLink Item -> Creature -> World -> World
+updateAttachedItems itmtree cr =
+    cldtPropagateFold
        chainLinkOrientation
        chainLinkOrientation
        (updateItemWithOrientation cr)
        (heldItemRelativeOrient (_ldtValue itmtree) cr (0, Q.qID))
-        itmtree
+        (LocLDT TopLDT itmtree)

 -- need to check rotation
 chainLinkOrientation ::
@@ -194,15 +195,51 @@ chainLinkOrientation mo par (ILink lt f) child = (p + Q.rotate q p1, q * q1)
 updateItemWithOrientation ::
    Creature ->
    (Point3, Q.Quaternion Float) ->
-    LabelDoubleTree ItemLink Item ->
+    LocationLDT ItemLink Item ->
    World ->
    World
-updateItemWithOrientation cr m itmtree = case _itType itm of
+updateItemWithOrientation cr m loc@(LocLDT _ itmtree) = case _itType itm of
    HELD TORCH -> shineTorch cr itmtree m
+    TARGETING TARGETLASER -> makeTargetLaser cr itmtree m
+    ATTACH AUGMENTEDHUD -> drawAugmentedHUD loc
    _ -> id
  where
    itm = itmtree ^. ldtValue

+drawAugmentedHUD :: LocationLDT ItemLink Item -> World -> World
+drawAugmentedHUD (LocLDT con _) w = fromMaybe w $ do
+    itm <- con ^? cldtParent
+    return $ w & cWorld . lWorld . flares <>~ drawTargeting itm w
+
+makeTargetLaser :: Creature -> LabelDoubleTree ItemLink Item -> (Point3, Q.Quaternion Float)
+    -> World -> World
+makeTargetLaser cr itmtree (p,q) w = fromMaybe (w & pointItUse . tgPos .~ Nothing) $ do
+    guard (crIsAiming cr)
+    (_, mag) <- find (isammolink . _iatType . fst) (itmtree ^. ldtLeft)
+    i <- mag ^? ldtValue . itUse . amagLoadStatus . iaLoaded
+    guard $ i >= x
+    maginvid <- mag ^? ldtValue . itLocation . ilInvID
+    return $ w
+        & cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix maginvid . itUse . amagLoadStatus . iaLoaded -~ x
+       & cWorld . lWorld . lasers .:~ LaserStart
+                        { _lpPhaseV = 1
+                        , _lpDir = _crDir cr + argV (Q.qToV2 q)
+                        , _lpPos = pos
+                        , _lpColor = col
+                        , _lpType = TargetingLaser (_itID itm)
+                        }
+  where
+    x = 1
+    isammolink AmmoInLink{} = True
+    isammolink _ = False
+    pos = _crPos cr + xyV3 (rotate3 cdir (p + V3 5 0 0))
+    cdir = _crDir cr
+    itm = itmtree ^. ldtValue
+    pointItUse = cWorld . lWorld . creatures . ix cid . crInv . ix invid . itUse
+    cid = _crID cr
+    invid = _ilInvID $ _itLocation itm
+    col = blue -- mixColors reloadFrac (1-reloadFrac) blue red
+
 shineTorch :: Creature -> LabelDoubleTree ItemLink Item -> (Point3, Q.Quaternion Float) -> World -> World
 shineTorch cr itmtree (p, q) = fromMaybe id $ do
    (_, mag) <- find (isammolink . _iatType . fst) (itmtree ^. ldtLeft)
@@ -227,21 +264,13 @@ itemInvSideEffect cr itm = case _itType itm of
    _ -> id

 -- this probably needs to be set to null when dropped as well?
+-- does this need to be updated if it is not attached to the used root item?
 updateItemTargeting :: TargetingType -> Creature -> Item -> World -> World
 updateItemTargeting tt cr itm w = case tt of
    _ | not isattached -> w 
            & pointItUse . tgPos .~ Nothing
            & pointItUse . tgActive .~ False
-    TARGETLASER | crIsAiming cr -> w
-                & cWorld . lWorld . lasers
-                    .:~ LaserStart
-                        { _lpPhaseV = 1
-                        , _lpDir = _crDir cr
-                        , _lpPos = sp
-                        , _lpColor = col
-                        , _lpType = TargetingLaser (_itID itm)
-                        }
-    TARGETLASER -> w & pointItUse . tgPos .~ Nothing
+    TARGETLASER -> w
    TargetRBPress | rbpressed -> w
                & pointItUse . tgPos %~ maybe (Just $ mouseWorldPos (w ^. input) (w ^. wCam)) Just
                & pointItUse . tgActive .~ True
@@ -260,8 +289,6 @@ updateItemTargeting tt cr itm w = case tt of
    invid = _ilInvID $ _itLocation itm
    isattached = itm ^?! itLocation . ilIsAttached
    rbpressed = SDL.ButtonRight `M.member` _mouseButtons (_input w)
-    sp = _crPos cr +.+ 15 *.* unitVectorAtAngle (_crDir cr)
-    col = blue -- mixColors reloadFrac (1-reloadFrac) blue red

 setRBCreatureTargeting :: Creature -> World -> ItemUse -> ItemUse
 setRBCreatureTargeting cr w ituse
@@ -41,31 +41,27 @@ data LabelDoubleTree b a = LDT {_ldtValue :: a, _ldtLeft :: [(b,LabelDoubleTree
    deriving (Eq,Ord,Show,Read)

 -- I am not sure about the double use of records here
-data ContextLDT b a = TopLDT 
-        { _cldtValue :: a}
+data ContextLDT b a = TopLDT
    | LeftwardLDT
        { _cldtUp :: ContextLDT b a  
-        , _cldtCloseLeft :: [LabelDoubleTree b a] 
+        , _cldtCloseLeft :: [(b,LabelDoubleTree b a)] 
+        , _cldtParent :: a
        , _cldtLink :: b
-        , _cldtValue :: a
-        , _cldtCloseRight :: [LabelDoubleTree b a]
-        , _cldtFarRight :: [LabelDoubleTree b a]
+        , _cldtCloseRight :: [(b,LabelDoubleTree b a)]
+        , _cldtFarRight :: [(b,LabelDoubleTree b a)]
        }
    | RightwardLDT 
        { _cldtUp :: ContextLDT b a  
-        , _cldtFarLeft :: [LabelDoubleTree b a]
-        , _cldtCloseLeft :: [LabelDoubleTree b a] 
+        , _cldtFarLeft :: [(b,LabelDoubleTree b a)]
+        , _cldtCloseLeft :: [(b,LabelDoubleTree b a)] 
+        , _cldtParent :: a
        , _cldtLink :: b
-        , _cldtValue :: a
-        , _cldtCloseRight :: [LabelDoubleTree b a]
+        , _cldtCloseRight :: [(b,LabelDoubleTree b a)]
        }

-- this is not quite right, it duplicates the value when the context is at the
-- top
 data LocationLDT b a = LocLDT
    { _locLdtContext :: ContextLDT b a
-    , _locLdtLeft :: [LabelDoubleTree b a]
-    , _locLdtRight :: [LabelDoubleTree b a]
+    , _locLDT :: LabelDoubleTree b a
    }

 instance Functor DoubleTree where
@@ -84,5 +80,7 @@ instance Bifunctor LabelDoubleTree where

 makeLenses ''DoubleTree
 makeLenses ''LabelDoubleTree
+makeLenses ''LocationLDT
+makeLenses ''ContextLDT
 deriveJSON defaultOptions ''DoubleTree
 deriveJSON defaultOptions ''LabelDoubleTree
@@ -13,6 +13,7 @@ module Dodge.Data.Item (
    module Dodge.Data.Item.Location,
 ) where

+import qualified Data.IntMap.Strict as IM
 import Control.Lens
 import Data.Aeson
 import Data.Aeson.TH
@@ -34,6 +35,7 @@ data Item = Item
    , _itID :: NewInt ItmInt
    , _itLocation :: ItemLocation
    , _itEffect :: ItEffect
+    , _itAmmoSlots :: IM.IntMap AmmoType
    , _itInvSize :: Int
    , _itDimension :: ItemDimension
    , _itCurseStatus :: CurseStatus
@@ -22,7 +22,6 @@ import Dodge.Data.Item.Scope
 import Control.Lens
 import Data.Aeson
 import Data.Aeson.TH
-import qualified Data.IntMap.Strict as IM
 import Dodge.Data.GenFloat
 import Dodge.Data.Hammer
 import Dodge.Data.Item.HeldDelay
@@ -38,7 +37,7 @@ data ItemUse
        { _heldDelay :: UseDelay
        , _heldHammer :: HammerPosition
        , _heldAim :: AimParams
-        , _heldAmmoTypes :: IM.IntMap AmmoType
+--        , _heldAmmoTypes :: IM.IntMap AmmoType
        , _heldParams :: HeldParams
        , _heldTriggerType :: TriggerType
        }
@@ -26,7 +26,8 @@ defaultHeldItem = Item
        { _itCurseStatus = Uncursed
        , _itType = HELD PISTOL
        , _itEffect = defaultItEffect
-        , _itID = 0
+        , _itID = 0 -- should this return an error ? const $ error "itID not correctly initialised" ?
+        , _itAmmoSlots = mempty
        , _itInvSize = 1
        , _itLocation = InVoid
        , _itDimension = defaultItemDimension
@@ -45,7 +46,7 @@ singleAmmo x = IM.insert 0 x mempty

 defaultBulletWeapon :: Item
 defaultBulletWeapon = defaultHeldItem
-        & itUse . heldAmmoTypes .~ singleAmmo BulletAmmo
+        & itAmmoSlots .~ singleAmmo BulletAmmo
        & itUse . heldAim . aimMuzzles .~ [Muzzle (V2 15 0) 0 0.01 0 PistolFlare MuzzleShootBullet]

 defaultConsumable :: Item
@@ -30,7 +30,6 @@ defaultHeldUse = UseHeld
    { _heldDelay = FixedRate{_rateMax = 8, _rateTime = 0}
    , _heldHammer = HammerUp
    , _heldAim = defaultAimParams
-    , _heldAmmoTypes = mempty
    , _heldParams = BulletShooterParams
        { _muzVel = ConstFloat 0.8
        , _rifling = ConstFloat 0.8
@@ -15,7 +15,7 @@ singleLDT x = LDT x [] []
 ldtToDT :: LabelDoubleTree b a -> DoubleTree a
 ldtToDT (LDT x l r) = DT x (map (ldtToDT . snd) l) (map (ldtToDT . snd) r)

-- propogate two functions down the links of an LDT tree
+-- propagate two functions down the links of an LDT tree
 -- which function is chosen depends on whether it is a left or right branch
 ldtPropagate :: (c -> b -> c) -> (c -> b -> c) 
    -> c 
@@ -110,7 +110,7 @@ dtToLRAdj f (DT x l r) = IM.insert i (Nothing,map g l , map g r)

 -- returns an adjacency map with oldest ancestor and direct parent if they exist
 -- and any left and right children
-- allows to propogate failure in the index discovery
+-- allows to propagate failure in the index discovery
 dtToLRAdjEither :: (a -> Either String Int) -> DoubleTree a 
    -> Either String (IM.IntMap (Maybe (Int,Int),[Int],[Int]))
 dtToLRAdjEither f (DT x l r) = do
@@ -184,4 +184,61 @@ prettyLDT :: (a -> String) -> LabelDoubleTree b a -> [String]
 prettyLDT f (LDT x l r) = concatMap (map ('/':) . prettyLDT f . snd) r 
    ++ (f x : concatMap (map ('\\':) . prettyLDT f . snd) l)

+ldtToLoc :: LabelDoubleTree b a -> LocationLDT b a
+ldtToLoc = LocLDT TopLDT

+-- should probably do tests for these
+locUp :: LocationLDT b a -> Maybe (LocationLDT b a)
+locUp (LocLDT TopLDT _) = Nothing
+locUp (LocLDT c@LeftwardLDT{} t) = Just $ LocLDT (_cldtUp c) 
+    (LDT (_cldtParent c) (_cldtCloseLeft c ++ ((_cldtLink c,t):_cldtCloseRight c)) (_cldtFarRight c))
+locUp (LocLDT c@RightwardLDT{} t) = Just $ LocLDT (_cldtUp c) 
+    (LDT (_cldtParent c) (_cldtFarLeft c) (_cldtCloseLeft c ++ ((_cldtLink c,t):_cldtCloseRight c)))
+
+-- should probably do tests for these
+locGoLeft :: LocationLDT b a -> [LocationLDT b a]
+locGoLeft (LocLDT c (LDT v l r)) = 
+    [ LocLDT (LeftwardLDT c closel v link closer r) t | (closel,(link,t),closer) <- locGoHelp id l]
+
+-- should probably do tests for these
+locGoRight :: LocationLDT b a -> [LocationLDT b a]
+locGoRight (LocLDT c (LDT v l r)) = 
+    [ LocLDT (RightwardLDT c l closel v link closer) t | (closel,(link,t),closer) <- locGoHelp id r]
+
+-- this seems like it might be very inefficient for large lists
+-- difference lists?
+locGoHelp :: (a -> b) -> [a] -> [([a],b,[a])]
+locGoHelp f = go []
+  where
+    go cleft (y:ys) = (cleft,f y, ys) : go (cleft <> [y]) ys
+    go _ [] = []
+
+-- Propgates a value (of type c) down the branches of the ContextLDT.
+-- The value is updated according a "left" or "right" function (lf or rf),
+-- that acts on the parent value, the link, and the child value.
+-- For each context node, the updated value is used to update a final value (of type d).
+cldtPropagateFold :: (c -> a -> b -> a -> c) 
+    -> (c -> a -> b -> a -> c) 
+    -> (c -> LocationLDT b a -> d -> d)
+    -> c 
+    -> LocationLDT b a 
+    -> d 
+    -> d
+cldtPropagateFold lf rf up x loc = 
+    alaf Endo foldMap 
+        (\(LocLDT con' t') -> cldtPropagateFold 
+            lf 
+            rf 
+            up 
+            (lf x (_cldtParent con') (_cldtLink con') (_ldtValue t')) 
+            (LocLDT con' t'))
+        (locGoLeft loc)
+    .    alaf Endo foldMap 
+        (\(LocLDT con' t') -> cldtPropagateFold 
+            lf 
+            rf 
+            up 
+            (rf x (_cldtParent con') (_cldtLink con') (_ldtValue t')) 
+            (LocLDT con' t'))
+        (locGoRight loc)
+    . up x loc
@@ -5,6 +5,7 @@ module Dodge.Item.Grammar (
    invIndentIM,
    invAdj,
    invRootMap,
+    invRootTrees,
 ) where

 import Control.Applicative
@@ -54,13 +55,14 @@ itemToBreakLists itm = case itm ^. itType of
            , (AmmoEffectSF atype, AmmoEffectLink)
            , (RemoteScreenSF, RemoteScreenLink)
            ],[])
+    TARGETING TARGETLASER -> (getAmmoLinks itm ++ [(AugmentedHUDSF,AugmentedHUDLink)],[])
    TARGETING{} -> ([(AugmentedHUDSF,AugmentedHUDLink)],[])
    _ -> ([],[])

 getAmmoLinks :: Item -> [(ItemStructuralFunction, ComposeLinkType)]
 getAmmoLinks itm = map
                (\(i, a) -> (AmmoMagSF a,AmmoInLink i a))
-                (IM.toList $ itm ^. itUse . heldAmmoTypes)
+                (IM.toList $ itm ^. itAmmoSlots)

 itemToFunction :: Item -> ItemStructuralFunction
 itemToFunction itm = case itm ^. itType of
@@ -160,14 +162,21 @@ invIndentIM =
        . map (bimap _iatType (\(x, y, _) -> (x, y)))
        . invLDT

-- returns an intmap with trees for all root items
+-- returns an intmap with trees for all items
 invTrees :: IM.IntMap Item -> IM.IntMap (LabelDoubleTree ComposeLinkType Item)
 invTrees = fmap (first _iatType) . invTrees'

-- returns an intmap with trees for all root items
+-- returns an intmap with trees for all items
 invTrees' :: IM.IntMap Item -> IM.IntMap (LabelDoubleTree ItemLink Item)
 invTrees' = IM.unions . map (ldtToIM getindex . fmap (^. _1)) . map (fmap (\(x, y, _) -> (x, y))) . invLDT
  where
    getindex i =
        fromMaybe (error "in invTrees try to get non-inventory item tree") $
            i ^? itLocation . ilInvID
+
+-- returns an intmap with trees for root items, indexed by inventory position
+invRootTrees :: IM.IntMap Item -> IM.IntMap (LabelDoubleTree ItemLink ComposedItem)
+invRootTrees = IM.fromAscList . reverse . map (getid . fmap (\(x, y, _) ->  (x, y))) . invLDT
+  where
+    getid :: LabelDoubleTree ItemLink ComposedItem -> (Int,LabelDoubleTree ItemLink ComposedItem)
+    getid t = (t ^?! ldtValue . _1 . itLocation . ilInvID, t)
@@ -33,7 +33,7 @@ teslaGun =
        & itUse . heldAim . aimMuzzles . ix 0 . mzFlareType .~ TeslaGunFlare
        & itUse . heldAim . aimMuzzles . ix 0 . mzEffect .~ MuzzleTesla
        & itType .~ HELD TESLAGUN
-        & itUse . heldAmmoTypes .~ singleAmmo ElectricalAmmo
+        & itAmmoSlots .~ singleAmmo ElectricalAmmo
        & itUse . heldTriggerType .~ AutoTrigger

 -- previous phaseV parameters: 0.2, 1, 5
@@ -41,7 +41,7 @@ lasGun :: Item
 lasGun =
    defaultHeldItem
        & itUse . heldParams .~ BeamShooterParams (Just (tone440sawtoothquietS,2))
-        & itUse . heldAmmoTypes .~ singleAmmo ElectricalAmmo
+        & itAmmoSlots .~ singleAmmo ElectricalAmmo
        & itUse . heldDelay .~ NoDelay
        & itUse . heldTriggerType .~ AutoTrigger
        & itUse . heldAim . aimMuzzles . ix 0 . mzPos .~ V2 30 0
@@ -46,7 +46,7 @@ volleyGun i =
        & itUse . heldParams . torqueAfter .~ 0.15 + 0.05 * fromIntegral i
        & itUse . heldParams . recoil .~ 20 + 10 * fromIntegral i
        & itType .~ HELD (VOLLEYGUN i)
-        & itUse . heldAmmoTypes .~ IM.fromList (zip [0..i-1] $ repeat BulletAmmo)
+        & itAmmoSlots .~ IM.fromList (zip [0..i-1] $ repeat BulletAmmo)

 rifle :: Item
 rifle =
@@ -87,7 +87,7 @@ miniGunX i =
        & itUse . heldAim . aimWeight .~ 6
        & itUse . heldAim . aimRange .~ 1
        & itUse . heldAim . aimZoom .~ defaultItZoom{_izFac = 1.5}
-        & itUse . heldAmmoTypes .~ singleAmmo BeltBulletAmmo
+        & itAmmoSlots .~ singleAmmo BeltBulletAmmo
        & itUse . heldParams . bulGunSound ?~ (mini1S,2)
        & itUse . heldAim . aimTurnSpeed .~ 0.5
        & itUse . heldAim . aimMuzzles 
@@ -21,7 +21,7 @@ launcher =
        & itUse . heldAim . aimStance .~ TwoHandOver
        & itUse . heldAim . aimMuzzles . ix 0 . mzInaccuracy .~ 0
        & itUse . heldAim . aimMuzzles . ix 0 . mzEffect .~ MuzzleLauncher
-        & itUse . heldAmmoTypes .~ singleAmmo ProjectileAmmo
+        & itAmmoSlots .~ singleAmmo ProjectileAmmo
        & itType .~ HELD LAUNCHER
        & itUse . heldParams . muzVel .~ ConstFloat 0
        & itUse . heldParams . rifling .~ ConstFloat 0
@@ -39,6 +39,6 @@ launcherX i =
            <*> pure DefaultFlareType
            <*> pure MuzzleLauncher
            )
-        & itUse . heldAmmoTypes .~ IM.fromList [(j,ProjectileAmmo) | j <- [0..i-1]]
+        & itAmmoSlots .~ IM.fromList [(j,ProjectileAmmo) | j <- [0..i-1]]
  where
    angles = take i [0,2*pi/ fromIntegral i ..]
@@ -18,7 +18,7 @@ poisonSprayer :: Item
 poisonSprayer =
    flameThrower
        & itType .~ HELD POISONSPRAYER
-        & itUse . heldAmmoTypes .~ singleAmmo GasAmmo
+        & itAmmoSlots .~ singleAmmo GasAmmo
        & itUse . heldParams . gasCreation .~ CreatePoisonGas --aGasCloud
        & itUse . heldParams . recoil .~ 0
        & itUse . heldParams . torqueAfter .~ 0
@@ -90,7 +90,7 @@ flameThrower =
                        , _nzCurrentWalkAngle = 0
                        }
            ]
-        & itUse . heldAmmoTypes .~ singleAmmo GasAmmo
+        & itAmmoSlots .~ singleAmmo GasAmmo
        & itType .~ HELD FLAMETHROWER
        & itUse . heldParams .~ GasSprayParams
            {_gasCreation = CreateFlame
@@ -28,7 +28,7 @@ torch =
    defaultHeldItem
        & itType .~ HELD TORCH
        & itUse . heldAim . aimMuzzles . ix 0 . mzPos . _x .~ 10
-        & itUse . heldAmmoTypes .~ singleAmmo ElectricalAmmo
+        & itAmmoSlots .~ singleAmmo ElectricalAmmo

 {- |
 Sends out pulses that display walls.
@@ -10,7 +10,7 @@ shatterGun =
    defaultHeldItem
        & itType .~ HELD SHATTERGUN
        & itUse . heldDelay . rateMax .~ 10
-        & itUse . heldAmmoTypes .~ singleAmmo ElectricalAmmo
+        & itAmmoSlots .~ singleAmmo ElectricalAmmo
        & itUse . heldAim . aimMuzzles . ix 0 . mzPos .~ V2 30 0
        & itUse . heldAim . aimMuzzles . ix 0 . mzInaccuracy .~ 0
        & itUse . heldAim . aimMuzzles . ix 0 . mzEffect .~ MuzzleShatter
@@ -10,6 +10,7 @@ import qualified Quaternion as Q
 orientChild :: Item -> (Point3, Q.Quaternion Float)
 orientChild itm = case _itType itm of
    HELD TORCH -> (V3 0 5 0, Q.qID)
+    TARGETING TARGETLASER -> (V3 15 (-5) 0, Q.qID)
    _ -> (0, Q.qID)

 orientByLink :: Item -> ComposeLinkType -> (Point3, Q.Quaternion Float)
@@ -1,3 +1,4 @@
+{-# LANGUAGE LambdaCase #-}
 module Dodge.Item.Scope (
    zoomScope,
    targetingScope,
@@ -20,13 +21,22 @@ zoomScope = defaultHeldItem
    & itUse .~ UseScope OpticScope{_opticPos = 0, _opticZoom = 1, _opticDefaultZoom = 0.5}

 targetingScope :: TargetingType -> Item
-targetingScope tt = defaultHeldItem
-    & itType .~ TARGETING tt
-    & itUse .~ UseTargeting 
-        { _tgPos = Nothing 
-        , _tgID = Nothing 
-        , _tgActive = False
-        }
+targetingScope tt= case tt of
+    TARGETLASER -> defaultHeldItem
+        & itType .~ TARGETING tt
+        & itAmmoSlots .~ singleAmmo ElectricalAmmo
+        & itUse .~ UseTargeting 
+            { _tgPos = Nothing 
+            , _tgID = Nothing 
+            , _tgActive = False
+            }
+    _ -> defaultHeldItem
+        & itType .~ TARGETING tt
+        & itUse .~ UseTargeting 
+            { _tgPos = Nothing 
+            , _tgID = Nothing 
+            , _tgActive = False
+            }

 homingModule :: Item
 homingModule = makeAttach HOMINGMODULE
@@ -16,7 +16,7 @@ droneLauncher =
        & itUse . heldAim . aimWeight .~ 8
        & itUse . heldAim . aimRange .~ 0.5
        & itUse . heldAim . aimStance .~ TwoHandOver
-        & itUse . heldAmmoTypes .~ singleAmmo DroneAmmo
+        & itAmmoSlots .~ singleAmmo DroneAmmo
        & itType .~ HELD DRONELAUNCHER

 lasDronesPic :: Item -> SPic
@@ -39,7 +39,7 @@ worldSPic cfig u =
        <> foldup btSPic (filtOn _btPos _buttons)
        <> foldup mcSPic (filtOn _mcPos _machines)
        <> aimDelaySweep w
-        <> anyTargeting w
+--        <> anyTargeting w
  where
    w = _uvWorld u
    foldup = foldMap'
@@ -20,7 +20,7 @@ import Dodge.Data.Universe
 import qualified IntMapHelp as IM

 testStringInit :: Universe -> [String]
-testStringInit _ = [fromMaybe mempty (Just "A" <> Just "B")]
+testStringInit _ = []
 --testStringInit u = [maybe mempty show $ u ^? uvWorld . cWorld . lWorld . projectiles . ix 0 . prjUpdates . ix 3 . pjuControllerID]
 --testStringInit u = (topTestPart u
 --    <>) $ map showh $