Implement targeting launcher shells using separate item

ghcidOutput

@@ -1,12 +1 @@
-/home/justin/Haskell/loop/src/Dodge/Creature/Impulse/UseItem.hs:(36,22)-(46,19): warning: [-Wincomplete-patterns]
+All good (616 modules, at 16:22:03)
-    Pattern match(es) are non-exhaustive
-    In a case alternative: Patterns not matched: TargetingUse _ _ _
-   |
-36 | itemEffect cr it w = case it ^. ldtValue . itUse of
-   |                      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^...
-/home/justin/Haskell/loop/src/Dodge/Item/Display.hs:(109,28)-(121,21): warning: [-Wincomplete-patterns]
-    Pattern match(es) are non-exhaustive
-    In a case alternative: Patterns not matched: TargetingUse _ _ _
-    |
-109 | itemNumberDisplay cr itm = case iu of
-    |                            ^^^^^^^^^^...

src/Dodge/Creature.hs

@@ -246,6 +246,14 @@ inventoryX c = case c of
         , megaShellMag
         , homingModule
         ]
+    'V' -> 
+        [targetingScope tt | tt <- [minBound .. maxBound]]
+        <>
+        [launcher
+        , megaShellMag
+        , homingModule
+        , remoteScreen
+        ]
     _ -> []
 
 testInventory :: [Item]
@@ -278,7 +286,6 @@ stackedInventory =
     , remoteScreen
     , megaShellMag
     , targetingScope TARGETLASER
-    , zoomScope
     , burstRifle
     , megaTinMag
     , teslaGun
@@ -286,6 +293,7 @@ stackedInventory =
     , flameThrower
     , chemFuelPouch
     , bulletSynthesizer
+    , zoomScope
     , drumMag
     , launcherX 3
     , megaShellMag

src/Dodge/Creature/Impulse/UseItem.hs

@@ -1,7 +1,7 @@
 module Dodge.Creature.Impulse.UseItem (
     useRootItem,
     useItemLeftClick,
-    itemEffect,
+    itemUseEffect,
     useItemHotkey,
 ) where
 
@@ -29,11 +29,11 @@ useRootItem crid w = fromMaybe w $ do
         itRef <- cr ^? crManipulation . manObject . imRootItem
         it <- invTrees (_crInv cr) ^? ix itRef
         return $
-            itemEffect cr it w
+            itemUseEffect cr it w
                 & worldEventFlags . at InventoryChange ?~ ()
 
-itemEffect :: Creature -> LabelDoubleTree ComposeLinkType Item -> World -> World
+itemUseEffect :: Creature -> LabelDoubleTree ComposeLinkType Item -> World -> World
-itemEffect cr it w = case it ^. ldtValue . itUse of
+itemUseEffect cr it w = case it ^. ldtValue . itUse of
     HeldUse{ _heldMods = usemods} -> 
         heldEffect usemods it cr w
             & pointerToItem itm . itUse . heldHammer .~ HammerDown
@@ -42,6 +42,7 @@ itemEffect cr it w = case it ^. ldtValue . itUse of
     (ConsumeUse eff) -> useC eff (_ldtValue it) cr w
     CraftUse{} -> w
     AttachUse{} -> selectUse it cr  w
+    TargetingUse {} -> w
     AmmoMagUse{} -> w
     ScopeUse{} -> w
   where
@@ -118,7 +119,7 @@ useItemLeftClick' cr' w = fromMaybe w $ do
     itRef <- cr ^? crManipulation . manObject . imSelectedItem
     it <- invTrees (_crInv cr) ^? ix itRef
     return $
-        itemEffect cr it w
+        itemUseEffect cr it w
             & worldEventFlags . at InventoryChange ?~ ()
 --            & f
 --  where

src/Dodge/Creature/State.hs

@@ -3,9 +3,15 @@ module Dodge.Creature.State (
     doDamage,
 ) where
 
-import Dodge.Item.Display -- this should not really be imported... TODO move canAttachTargetingBelow
+import Dodge.Zoning.Creature
-import Control.Applicative
+import FoldableHelp
-import Data.Foldable
+import Data.Maybe
+import qualified Data.Map.Strict as M
+import qualified SDL
+import Dodge.Creature.Test
+--import Dodge.Item.Display -- this should not really be imported... TODO move canAttachTargetingBelow
+--import Control.Applicative
+--import Data.Foldable
 --import Data.Maybe
 import Dodge.Base
 import Dodge.Corpse.Make
@@ -24,7 +30,7 @@ import Dodge.ItEffect
 --import Dodge.LightSource.Torch
 import Dodge.Prop.Gib
 import Dodge.SoundLogic
-import Dodge.Targeting
+--import Dodge.Targeting
 import Geometry
 import qualified IntMapHelp as IM
 import LensHelp
@@ -235,19 +241,20 @@ equipmentEffects cr = flip (foldl' $ flip $ useEquipment cr) (IM.keys $ _crInvEq
 -- a loop going over all inventory items
 invSideEff :: Creature -> World -> World
 invSideEff cr w =
-    updateTargeting (crGetTargeting cr) cr $
+--    updateTargeting (crGetTargeting cr) cr $
 --        weaponReloadSounds cr $
             IM.foldl' f w (_crInv cr)
   where
     -- be careful with side effects that affect creature targeting
-
     f w' it =
         itemInvSideEffect cr it $
             --doItemTargeting i cr w' & maybe id (\g -> doInvEffect g it cr) (it ^? itEffect . ieInv)
             w' & maybe id (\g -> doInvEffect g it cr) (it ^? itEffect . ieInv)
 
 itemInvSideEffect :: Creature -> Item -> World -> World
-itemInvSideEffect _ _ = id
+itemInvSideEffect cr itm = case _iyBase $ _itType itm of
+    TARGETING tt -> updateItemTargeting tt cr itm
+    _ -> id 
 --itemInvSideEffect cr it
 --    | hastorchattach = createAttachLight cr it
 --    | otherwise = id
@@ -259,6 +266,65 @@ itemInvSideEffect _ _ = id
 --  where
 --    attachoff = it ^?! itDimension . dimAttachPos
 
+updateItemTargeting :: TargetingType -> Creature -> Item -> World -> World
+updateItemTargeting tt cr itm w = w & case tt of
+    _ | not isattached
+        -> cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (_ilInvID $ _itLocation itm) . itUse %~
+            ( (tgPos .~ Nothing)
+            . (tgActive .~ False)
+            )
+    TARGETLASER | crIsAiming cr -> cWorld . lWorld . lasers
+            .:~ LaserStart
+                { _lpPhaseV = 1
+                , _lpDir = _crDir cr
+                , _lpPos = sp
+                , _lpColor = col
+                , _lpType = TargetingLaser (_itID itm)
+                }
+    TARGETLASER -> cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (_ilInvID $ _itLocation itm)
+        . itUse . tgPos .~ Nothing
+    TargetRBPress | rbpressed 
+        -> cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (_ilInvID $ _itLocation itm) . itUse %~
+            ( (tgPos %~ maybe (Just $ mouseWorldPos (w ^. input) (w ^. wCam)) Just)
+            . (tgActive .~ True)
+            )
+    TargetRBPress
+        -> cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (_ilInvID $ _itLocation itm) . itUse %~
+            ( (tgPos .~ Nothing)
+            . (tgActive .~ False)
+            )
+    TargetRBCreature -> cWorld . lWorld . creatures . ix (_crID cr) 
+            . crInv . ix (_ilInvID $ _itLocation itm) . itUse %~ setRBCreatureTargeting cr w
+    TargetCursor -> cWorld . lWorld . creatures . ix (_crID cr) 
+            . crInv . ix (_ilInvID $ _itLocation itm) . itUse .~ TargetingUse 
+                (Just (mouseWorldPos (w ^. input) (w ^. wCam))) Nothing True
+    _ -> id
+  where 
+    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
+    | SDL.ButtonRight `M.member` _mouseButtons (_input w) && isJust (ituse ^? tgID . _Just)
+        && canSeeTarget = ituse & updatePos & tgActive .~ True
+    | otherwise = ituse & tgID .~ fmap _crID newtarg & updatePos & tgActive .~ False
+  where
+    newtarg =
+        safeMinimumOn (dist mwp . _crPos)
+            . filter (canseepos . _crPos)
+            $ crsNearCirc mwp 40 w
+    canseepos p = hasLOS (_crPos cr) p w
+    mwp = mouseWorldPos (w ^. input) (w ^. wCam)
+    updatePos t' = t' & tgPos .~ posFromMaybeID (_tgID t')
+    posFromMaybeID Nothing = Nothing
+    posFromMaybeID (Just i) = w ^? cWorld . lWorld . creatures . ix i . crPos
+    canSeeTarget = fromMaybe False $ do
+        cid <- ituse ^? tgID . _Just
+        cpos <- w ^? cWorld . lWorld . creatures . ix cid . crPos
+        Just $ hasLOS cpos (_crPos cr) w
+
 itemUpdate :: Item -> Item
 itemUpdate =
     updateAutoRecharge
@@ -280,19 +346,19 @@ updateAutoRecharge it = case it ^? itUse . leftConsumption of
 -- I feel like there should be a centralised function that supersumes this
 -- i.e. a function that deals with all states that depend upon item positioning
 -- in the inventory
-crGetTargeting :: Creature -> Maybe TargetType
+--crGetTargeting :: Creature -> Maybe TargetingType
-crGetTargeting cr = do
+--crGetTargeting cr = do
-    i <- cr ^? crManipulation . manObject . imRootItem
+--    i <- cr ^? crManipulation . manObject . imRootItem
-    itm <- cr ^? crInv . ix i
+--    itm <- cr ^? crInv . ix i
-    itm ^? itType . iyModules . ix ModTarget . imtTargetType
+--    itm ^? itType . iyModules . ix ModTarget . imtTargetType
-        <|> do
+--        <|> do
-            tt <- cr ^? crInv . ix (i-1) . itType . iyBase . ibtAttach . ibtAttachTarget
+--            tt <- cr ^? crInv . ix (i-1) . itType . iyBase . ibtTargeting
-            guard (canAttachTargeting tt itm) 
+--            guard (canAttachTargeting tt itm) 
-            return tt
+--            return tt
-        <|> do
+--        <|> do
-            tt <- cr ^? crInv . ix (i+1) . itUse . equipTargeting . _Just
+--            tt <- cr ^? crInv . ix (i+1) . itUse . equipTargeting . _Just
-            guard (canAttachTargeting tt itm) 
+--            guard (canAttachTargeting tt itm) 
-            return tt
+--            return tt
 
 --weaponReloadSounds :: Creature -> World -> World
 --weaponReloadSounds cr w = case cr ^? crManipulation . manObject . inInventory . iselAction of

src/Dodge/Data/Creature.hs

@@ -77,14 +77,14 @@ data Creature = Creature
     , _crName :: String
     , _crStatistics :: CreatureStatistics
     , _crCamouflage :: CamouflageStatus
-    , _crTargeting :: CreatureTargeting
+--    , _crTargeting :: CreatureTargeting
     }
 
 --deriving (Eq, Show, Read) --Generic, Flat)
 
 data CreatureTargeting = CreatureTargeting
     { _ctPos :: Maybe Point2
-    , _ctType :: Maybe TargetType
+    , _ctType :: Maybe TargetingType
     , _ctID :: Maybe Int
     , _ctActive :: Bool
     }

src/Dodge/Data/Item/Combine.hs

@@ -77,7 +77,7 @@ data CraftType
     | TIMEMODULE
     | SIZEMODULE
     | GRAVITYMODULE
-    | TARGETMODULE TargetType
+    | TARGETMODULE TargetingType
     deriving (Eq, Ord, Show, Read)
 
 --deriving (Eq, Ord, Show, Enum, Read) --Generic, Flat)
@@ -90,13 +90,13 @@ data ItemBaseType
     | CRAFT CraftType
     | ATTACH {_ibtAttach :: AttachType}
     | AMMOMAG {_ibtAmmoMag :: AmmoMagType}
+    | TARGETING {_ibtTargeting :: TargetingType}
     deriving (Eq, Ord, Show, Read)
 
 --deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 data AttachType
     = ZOOMSCOPE
-    | TARGETATTACH {_ibtAttachTarget :: TargetType}
     | BULLETSYNTHESIZER
     | REMOTESCREEN
     | HOMINGMODULE
@@ -130,7 +130,7 @@ data EquipItemType
     | INVISIBILITYEQUIPMENT EquipSite
     | BRAINHAT
     | HAT
-    | TARGETINGHAT TargetType
+    | TARGETINGHAT TargetingType
     | HEADLAMP
     | POWERLEGS
     | SPEEDLEGS
@@ -208,7 +208,7 @@ data ItemModuleType
     | BULPAY BulletSpawn
     | BULBODY BulletEffect
     | BULTRAJ {_imtBulletTrajectoryType :: BulletTrajectoryType}
-    | TARGET {_imtTargetType :: TargetType}
+    | TARGET {_imtTargetType :: TargetingType}
     | INCENDLAS
     | SPLITLAS
     | STATICLAS

src/Dodge/Data/Item/Targeting.hs

@@ -8,7 +8,7 @@ module Dodge.Data.Item.Targeting where
 import Data.Aeson
 import Data.Aeson.TH
 
-data TargetType
+data TargetingType
     = TARGETLASER
     | TargetRBPress
     | TargetRBLine
@@ -16,4 +16,4 @@ data TargetType
     | TargetCursor
     deriving (Eq, Ord, Show, Read, Enum, Bounded) --Generic, Flat)
 
-deriveJSON defaultOptions ''TargetType
+deriveJSON defaultOptions ''TargetingType

src/Dodge/Data/Item/Use.hs

@@ -57,7 +57,7 @@ data ItemUse
         }
     | EquipUse
         { _equipEffect :: EquipEffect
-        , _equipTargeting :: Maybe TargetType
+        , _equipTargeting :: Maybe TargetingType
         }
     | CraftUse
     | --        {_useAmount :: ItAmount}

src/Dodge/Data/Item/Use/Consumption/Ammo.hs

@@ -20,10 +20,16 @@ import Dodge.Data.Payload
 data ProjectileDraw = DrawShell | DrawRemoteShell | DrawDrone | DrawBlankProjectile
     deriving (Show, Eq, Ord, Enum, Bounded, Read) --Generic, Flat)
 
+data ProjectileHoming 
+    = NoHoming 
+    | HomeUsingRemoteScreen {_phRemoteID :: NewInt ItmInt}
+    | HomeUsingTargeting {_phTargetingID :: NewInt ItmInt}
+    deriving (Show, Eq, Ord, Read) --Generic, Flat)
+
 data ProjectileUpdate
     = ThrustPU {_pjuStart :: Int, _pjuEnd :: Int}
     | StartSpinPU {_pjuTime :: Int, _pjuCID :: Int, _pjuSpinAmound :: Int}
-    | RemoteDirectionPU {_pjuStart :: Int, _pjuEnd :: Int, _pjuControllerID :: Maybe (NewInt ItmInt)}
+    | RemoteDirectionPU {_pjuStart :: Int, _pjuEnd :: Int, _pjuControllerID :: ProjectileHoming}
     | ReduceSpinPU {_pjuReduceSpin :: Float}
     | DestroyPU {_pjuScreenID :: Maybe (NewInt ItmInt), _pjuTimer :: Int}
     | TimePU
@@ -50,7 +56,9 @@ data GasCreate = CreatePoisonGas | CreateFlame
 
 makeLenses ''ProjectileUpdate
 makeLenses ''AmmoType
+makeLenses ''ProjectileHoming
 deriveJSON defaultOptions ''GasFuel
+deriveJSON defaultOptions ''ProjectileHoming
 deriveJSON defaultOptions ''ProjectileDraw
 deriveJSON defaultOptions ''ProjectileUpdate
 deriveJSON defaultOptions ''GasCreate

src/Dodge/Data/LWorld.hs

@@ -31,7 +31,7 @@ module Dodge.Data.LWorld (
     module Dodge.Data.Machine,
     module Dodge.Data.Magnet,
     module Dodge.Data.Modification,
-    module Dodge.Data.PathGraph,
+--    module Dodge.Data.PathGraph,
     module Dodge.Data.PosEvent,
     module Dodge.Data.PressPlate,
     module Dodge.Data.Projectile,
@@ -77,7 +77,7 @@ import Dodge.Data.LinearShockwave
 import Dodge.Data.Machine
 import Dodge.Data.Magnet
 import Dodge.Data.Modification
-import Dodge.Data.PathGraph
+--import Dodge.Data.PathGraph
 import Dodge.Data.PosEvent
 import Dodge.Data.PressPlate
 import Dodge.Data.Projectile

src/Dodge/Data/Laser.hs

@@ -5,6 +5,8 @@
 
 module Dodge.Data.Laser where
 
+import NewInt
+import Dodge.Data.Item.Location
 import Color
 import Control.Lens
 import Data.Aeson
@@ -13,7 +15,7 @@ import Geometry.Data
 
 data LaserType
     = DamageLaser {_laserTypeDamage :: Int}
-    | TargetingLaser
+    | TargetingLaser {_laserEmmiter :: NewInt ItmInt}
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 data LaserStart = LaserStart

src/Dodge/Data/PathGraph.hs

@@ -18,17 +18,17 @@ import Control.Lens
 import Data.Aeson
 import Data.Aeson.TH
 import Data.Graph.Inductive
-import Data.Map.Strict (Map)
+--import Data.Map.Strict (Map)
 import qualified Data.Set as Set
 import Geometry.Data
 
-data PathGraph = PathGraph
+--data PathGraph = PathGraph
-    { _pgGraph :: Gr Point2 PathEdge
+--    { _pgGraph :: Gr Point2 PathEdge
-    , _pgNodeMap :: Map Point2 Int
+--    , _pgNodeMap :: Map Point2 Int
-    , _pgNodeCount :: Int
+--    , _pgNodeCount :: Int
-    , _pgEdgeMap :: Map (V2 Point2) PathEdgeNodes
+--    , _pgEdgeMap :: Map (V2 Point2) PathEdgeNodes
-    }
+--    }
-    deriving (Eq, Show, Read) --, Generic)
+--    deriving (Eq, Show, Read) --, Generic)
 
 data PathEdgeNodes = PathEdgeNodes
     { _penStart :: Int
@@ -59,11 +59,11 @@ data EdgeObstacle
 
 --deriving instance (Flat (Gr Point2 PathEdge))
 
-makeLenses ''PathGraph
+--makeLenses ''PathGraph
 makeLenses ''PathEdge
 makeLenses ''PathEdgeNodes
 deriveJSON defaultOptions ''EdgeObstacle
 deriveJSON defaultOptions ''PathEdge
 deriveJSON defaultOptions ''PathEdgeNodes
 deriveJSON defaultOptions ''Gr
-deriveJSON defaultOptions ''PathGraph
+--deriveJSON defaultOptions ''PathGraph

src/Dodge/Default/Creature.hs

@@ -57,7 +57,7 @@ defaultCreature =
         , _crName = "DEFAULTCRNAME"
         , _crStatistics = CreatureStatistics 50 50 50
         , _crCamouflage = FullyVisible
-        , _crTargeting = defaultCreatureTargeting
+--        , _crTargeting = defaultCreatureTargeting
         }
 
 defaultCreatureTargeting :: CreatureTargeting

src/Dodge/HeldUse.hs

@@ -18,7 +18,7 @@ import Dodge.Data.DoubleTree
 --import Color
 import Data.Maybe
 --import Data.Traversable
-import Dodge.Base.Coordinate
+--import Dodge.Base.Coordinate
 --import Dodge.Bullet
 import Dodge.Creature.HandPos
 import Dodge.Data.World
@@ -31,11 +31,11 @@ import Dodge.Item.Weapon.TriggerType
 import Dodge.Projectile.Create
 import Dodge.SoundLogic
 import Dodge.Tesla.Arc
-import Dodge.Wall.ForceField
+--import Dodge.Wall.ForceField
-import Dodge.Wall.Move
+--import Dodge.Wall.Move
 import Dodge.WorldEvent.Flash
 import Geometry
-import qualified IntMapHelp as IM
+--import qualified IntMapHelp as IM
 import LensHelp
 import RandomHelp
 import Sound.Data
@@ -55,7 +55,7 @@ bulGunEffect' :: LabelDoubleTree ComposeLinkType Item -> Creature -> World -> Wo
 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 (_ldtValue t) cr) (CME 0 0 False,w) $ zip [0..] loadedmuzzles
+        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
@@ -184,23 +184,26 @@ isAmmoIntLink :: Int -> ComposeLinkType -> Bool
 isAmmoIntLink i (AmmoInLink j _) = i == j
 isAmmoIntLink _ _ = False
 
-useLoadedAmmo :: Item -> Creature -> (CumulativeMuzzleEffect,World) 
+useLoadedAmmo :: LabelDoubleTree ComposeLinkType Item 
+    -> Creature 
+    -> (CumulativeMuzzleEffect,World) 
     -> (Int,Maybe (Muzzle,Int,LabelDoubleTree ComposeLinkType Item)) 
     -> (CumulativeMuzzleEffect,World)
 useLoadedAmmo _ _ (cme,w) (_,Nothing) = (cme, w)
-useLoadedAmmo itm cr (cme,w) (mzid,Just (mz,x,magtree)) = (,) (cme & cmeSound .~ True) $ 
+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)
     MuzzleLaser -> shootLaser' itm cr mz w
     MuzzleTesla -> shootTeslaArc itm cr mz w
     MuzzleTractor -> shootTractorBeam itm cr w
-    MuzzleLauncher -> createProjectile magtree mz itm cr w 
+    MuzzleLauncher -> createProjectile magtree mz itmtree cr w 
     MuzzleNozzle {} -> useGasParams mid mz itm cr $ walkNozzle mzid mz itm cr w
     MuzzleShatter -> shootShatter itm cr w
     MuzzleForceField -> useForceFieldGun itm cr w
     MuzzleDetector -> itemDetectorEffect itm cr w 
   where
     mid = magtree ^? ldtValue . itLocation . ilInvID
+    itm = itmtree ^. ldtValue
 
 itemDetectorEffect :: Item -> Creature -> World -> World
 itemDetectorEffect itm cr w = fromMaybe w $ do
@@ -485,32 +488,46 @@ shootTeslaArc itm cr mz w =
 -- the rmb, it is possible for this to do nothing
 -- TODO investigate more and fix
 useForceFieldGun :: Item -> Creature -> World -> World
-useForceFieldGun itm cr w = fromMaybe w $ do
+useForceFieldGun _ _ = id
-    a <- cr ^? crTargeting . ctPos . _Just
+--useForceFieldGun itm cr w = fromMaybe w $ do
-    let mwp = mouseWorldPos (w ^. input) (w ^. wCam)
+--    a <- cr ^? crTargeting . ctPos . _Just
-        b = if dist a mwp < 100 then mwp else a +.+ 100 *.* normalizeV (mwp -.- a)
+--    let mwp = mouseWorldPos (w ^. input) (w ^. wCam)
-        wlline = (a, b)
+--        b = if dist a mwp < 100 then mwp else a +.+ 100 *.* normalizeV (mwp -.- a)
-    return $
+--        wlline = (a, b)
-        w
+--    return $
-            & cWorld . lWorld . walls %~ IM.insertWith (\_ x -> x) i forceField{_wlID = i}
+--        w
-            & cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (_ilInvID (_itLocation itm)) . itParams . paramMID ?~ i
+--            & cWorld . lWorld . walls %~ IM.insertWith (\_ x -> x) i forceField{_wlID = i}
-            & moveWallIDUnsafe i wlline
+--            & cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (_ilInvID (_itLocation itm)) . itParams . paramMID ?~ i
-  where
+--            & moveWallIDUnsafe i wlline
-    i = fromMaybe (IM.newKey (_walls (_lWorld (_cWorld w)))) $ itm ^? itParams . paramMID . _Just
+--  where
+--    i = fromMaybe (IM.newKey (_walls (_lWorld (_cWorld w)))) $ itm ^? itParams . paramMID . _Just
+
+determineProjectileTracking :: LabelDoubleTree ComposeLinkType Item 
+    -> LabelDoubleTree ComposeLinkType Item
+    -> ProjectileHoming
+determineProjectileTracking magtree itmtree = case lookup RemoteScreenLink (magtree ^. ldtLeft) of
+    Just screen -> HomeUsingRemoteScreen (screen ^. ldtValue . itID) 
+    Nothing -> fromMaybe NoHoming $ do
+        _ <- lookup AmmoTargetingLink (magtree ^. ldtLeft) -- should not have to give a direction
+        targetingtree <- lookup WeaponTargetingLink (itmtree ^. ldtRight) -- left or right for these
+        return $ HomeUsingTargeting (targetingtree ^. ldtValue . itID)
 
 createProjectile 
     :: LabelDoubleTree ComposeLinkType Item 
-    -> Muzzle -> Item -> Creature -> World -> World
+    -> Muzzle 
-createProjectile magtree muz itm cr = fromMaybe failsound $ do
+    -> LabelDoubleTree ComposeLinkType Item 
+    -> Creature -> World -> World
+createProjectile magtree muz itmtree cr = fromMaybe failsound $ do
     magid <- magtree ^? ldtValue . itLocation . ilInvID
     ammoitem <- cr ^? crInv . ix magid
-    let mscreen = lookup RemoteScreenLink (magtree ^. ldtLeft)
+    let homing = determineProjectileTracking magtree itmtree
     j <- ammoitem ^? itLocation . ilInvID
     aparams <- ammoitem ^? itUse . amagParams
-    return $ createShell (mscreen ^? _Just . ldtValue) aparams muz itm cr 
+    return $ createShell homing aparams muz itm cr 
         . startthesound
         . useammo j
   where
+    itm = itmtree ^. ldtValue
     useammo j = cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix j . itUse . amagLoadStatus . iaLoaded -~ 1
     
     -- the sound should be moved to the projectile firing

src/Dodge/Item.hs

@@ -25,6 +25,7 @@ itemFromBase ibt = case ibt of
     CRAFT cr -> makeTypeCraft cr
     ATTACH at -> itemFromAttachType at
     AMMOMAG t -> itemFromAmmoMag t
+    TARGETING tt -> targetingScope tt
 
 itemFromAmmoMag :: AmmoMagType -> Item
 itemFromAmmoMag at = case at of
@@ -39,7 +40,6 @@ itemFromAmmoMag at = case at of
 itemFromAttachType :: AttachType -> Item
 itemFromAttachType at = case at of
     ZOOMSCOPE -> zoomScope
-    TARGETATTACH tt -> targetingScope tt
     BULLETSYNTHESIZER -> bulletSynthesizer
     REMOTESCREEN -> remoteScreen
 --    ROCKETHOMER -> rocketHomer

src/Dodge/Item/Display.hs

@@ -16,7 +16,7 @@ import Dodge.Module
 import LensHelp
 import Padding
 
-canAttachTargeting :: TargetType -> Item -> Bool
+canAttachTargeting :: TargetingType -> Item -> Bool
 canAttachTargeting TARGETLASER _ = True
 canAttachTargeting _ itm =
     isJust (itm ^? itType . iyModules . ix ModBulletTrajectory . imtBulletTrajectoryType)
@@ -70,11 +70,12 @@ itemBaseName itm = case _iyBase $ _itType itm of
     CONSUMABLE cit -> show cit
     ATTACH ait -> showAttachItem ait itm
     AMMOMAG ait -> show ait
+    TARGETING tt -> show tt
 
 showAttachItem :: AttachType -> Item -> String
 showAttachItem t itm = case t of
     ZOOMSCOPE -> "ZOOMSCOPE"
-    TARGETATTACH x -> show x
+--    TARGETATTACH x -> show x
     BULLETSYNTHESIZER -> "BSYNTH"
     REMOTESCREEN -> "REMOTE SCREEN " ++ show (itm ^? itUse . atLinkedProjectile . _Just)
     HOMINGMODULE -> "HOMING MOD"
@@ -119,6 +120,7 @@ itemNumberDisplay cr itm = case iu of
     AmmoMagUse {} -> [showLoadedAmount itm]
     ScopeUse OpticScope {_opticZoom = x} -> [show x]
     ScopeUse {} -> []
+    TargetingUse {_tgPos = mp} -> [maybe "" show mp]
         -- this could be cleaner here...
   where
     iu = itm ^?! itUse

src/Dodge/Item/Draw/SPic.hs

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

src/Dodge/Item/Equipment.hs

@@ -108,7 +108,7 @@ hat =
         & itUse . equipEffect . eeSite .~ GoesOnHead
         & itType . iyBase .~ EQUIP HAT
 
-targetingHat :: TargetType -> Item
+targetingHat :: TargetingType -> Item
 targetingHat tt = 
     defaultEquipment
         & itUse . equipEffect . eeSite .~ GoesOnHead

src/Dodge/Item/Grammar.hs

@@ -38,7 +38,7 @@ basePartiallyComposedItem itm = case itm ^. itType . iyBase of
         [(WeaponTargetingSF,WeaponTargetingLink), (WeaponScopeSF,WeaponScopeLink)]
         )
     AMMOMAG _ -> ammoComposedItem itm
-    ATTACH TARGETATTACH{} -> (itm,WeaponTargetingSF, LinkTest (const Nothing) (const Nothing))
+    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))
     ATTACH REMOTESCREEN -> (itm,RemoteScreenSF, LinkTest (const Nothing) (const Nothing))

src/Dodge/Item/Info.hs

@@ -138,7 +138,7 @@ equipInfo eit = case eit of
     BATTERYPACK -> "A collection of batteries with a universal adapter."
     AUTODETECTOR d -> "A device that detects " ++ detectorInfo d ++ " in an expanding radius. Pulses automatically. "
 
-targetingInfo :: TargetType -> String
+targetingInfo :: TargetingType -> String
 targetingInfo tt = case tt of
     TARGETLASER -> "creates a laser, the end of which becomes the target."
     TargetRBPress -> "creates a fixed target."

src/Dodge/Item/InventoryColor.hs

@@ -12,4 +12,5 @@ itemInvColor itm = case itm ^. itType . iyBase of
     CONSUMABLE {} -> blue
     CRAFT {} -> green
     ATTACH {} -> orange
+    TARGETING {} -> chartreuse
     AMMOMAG {} -> greyN 0.8

src/Dodge/Item/Location.hs

@@ -1,4 +1,5 @@
 module Dodge.Item.Location (
+    pointerToItemID,
     pointerToItemLocation,
     getItem,
     pointerToItem,
@@ -50,3 +51,13 @@ pointerToItem ::
     World ->
     f World
 pointerToItem = pointerToItemLocation . _itLocation
+
+pointerToItemID :: 
+    Applicative f =>
+    NewInt ItmInt ->
+    (Item -> f Item) ->
+    World ->
+    f World
+pointerToItemID itid f w = fromMaybe (pure w) $ do
+    itloc <- w ^? cWorld . lWorld . itemLocations . ix (_unNInt itid)
+    return $ pointerToItemLocation itloc f w

src/Dodge/Item/Scope.hs

@@ -16,11 +16,11 @@ zoomScope =
 --        & itUse .~ AttachUse (ScrollAttachParams (ZoomScrollParams{_opticPos = 0, _opticZoom = 1, _opticDefaultZoom = 0.5}))
         & itUse .~ ScopeUse OpticScope{_opticPos = 0, _opticZoom = 1, _opticDefaultZoom = 0.5}
 
-targetingScope :: TargetType -> Item
+targetingScope :: TargetingType -> Item
 targetingScope tt =
     defaultHeldItem
-        & itType . iyBase .~ ATTACH (TARGETATTACH tt)
+        & itType . iyBase .~ TARGETING tt
-        & itUse .~ AttachUse Nothing
+        & itUse .~ TargetingUse Nothing Nothing False
 
 homingModule :: Item
 homingModule =

src/Dodge/Item/Weapon/Targeting.hs

@@ -1,16 +1,16 @@
 module Dodge.Item.Weapon.Targeting (
-    useTargetPos,
+--    useTargetPos,
 ) where
 
-import Control.Lens
+--import Control.Lens
-import Dodge.Data.World
+--import Dodge.Data.World
-import Geometry.Data
+--import Geometry.Data
 
-useTargetPos ::
+--useTargetPos ::
-    (Maybe Point2 -> Creature -> World -> World) ->
+--    (Maybe Point2 -> Creature -> World -> World) ->
-    Creature ->
+--    Creature ->
-    World ->
+--    World ->
-    World
+--    World
-useTargetPos f cr w = case cr ^? crTargeting . ctPos of
+--useTargetPos f cr w = case cr ^? crTargeting . ctPos of
-    Nothing -> w
+--    Nothing -> w
-    Just p -> f p cr w
+--    Just p -> f p cr w

src/Dodge/Laser/Update.hs

@@ -1,7 +1,10 @@
-module Dodge.Laser.Update where
+module Dodge.Laser.Update 
+    ( updateLaser
+    ) where
 
+import Dodge.Item.Location
 import Control.Lens
-import Data.Maybe
+--import Data.Maybe
 import Dodge.Data.World
 import Dodge.Item.Weapon.LaserPath
 import Dodge.WorldEvent.Damage
@@ -9,13 +12,13 @@ import Geometry
 
 updateLaser :: World -> LaserStart -> (World, Laser)
 updateLaser w pt =
-    ( w'
+    ( case _lpType pt of
+        DamageLaser dam -> damThingHitWith 
+            (\p1 p2 p3 -> Damage LASERING dam p1 p2 p3 NoDamageEffect) sp xp thHit w
+        TargetingLaser itid -> w & pointerToItemID itid . itUse . tgPos ?~ last ps
     , Laser{_lzPoints = sp : ps, _lzColor = _lpColor pt, _lzType = _lpType pt}
     )
   where
-    w' = fromMaybe w $ do
-        dam <- pt ^? lpType . laserTypeDamage
-        return $ damThingHitWith (\p1 p2 p3 -> Damage LASERING dam p1 p2 p3 NoDamageEffect) sp xp thHit w
     phasev = _lpPhaseV pt
     sp = _lpPos pt
     dir = _lpDir pt

src/Dodge/Projectile/Create.hs

@@ -2,15 +2,22 @@ module Dodge.Projectile.Create (
     createShell,
 ) where
 
+import Dodge.Item.Location
 import Data.Maybe
 import Dodge.Data.World
 import Geometry
 import qualified IntMapHelp as IM
 import LensHelp
 
+homingDrawType :: ProjectileHoming -> ProjectileDraw
+homingDrawType ht = case ht of
+    NoHoming -> DrawShell
+    HomeUsingRemoteScreen {} -> DrawRemoteShell
+    HomeUsingTargeting {} -> DrawRemoteShell
+
 -- assumes the mscreen is in your inventory
-createShell :: Maybe Item -> AmmoParams -> Muzzle -> Item -> Creature -> World -> World
+createShell :: ProjectileHoming -> AmmoParams -> Muzzle -> Item -> Creature -> World -> World
-createShell mscreen aparams muz it cr w = w
+createShell homing aparams muz it cr w = w
     & updatescreen
     & cWorld . lWorld . projectiles . at i
         ?~ Shell
@@ -18,7 +25,7 @@ createShell mscreen aparams muz it cr w = w
             , _prjZ = 20
             , _prjStartPos = pos
             , _prjVel = rotateV dir (V2 1 0)
-            , _prjDraw = maybe DrawShell (const DrawRemoteShell) mscreen
+            , _prjDraw = homingDrawType homing
             , _prjID = i
             , _prjAcc = rotateV dir (V2 3 0)
             , _prjDir = dir
@@ -26,10 +33,10 @@ createShell mscreen aparams muz it cr w = w
             , _prjPayload = _ampPayload aparams
             , _prjTimer = 350
             , _prjUpdates =
-                [ CollisionEffectPU (mscreen ^? _Just . itID) --Just screenid)
+                [ CollisionEffectPU (homing ^? phRemoteID) --Just screenid)
                 , TimePU
                 , StartSpinPU 335 (_crID cr) (_shellSpinAmount params)
-                , RemoteDirectionPU (350 - thrustdelay) 0 (mscreen ^? _Just . itID)
+                , RemoteDirectionPU (350 - thrustdelay) 0 homing
                 , ThrustPU (350 - thrustdelay) 0
                 , ReduceSpinPU (1 - fromIntegral (_shellSpinDrag params) * 2 / 200)
                 ]
@@ -38,10 +45,8 @@ createShell mscreen aparams muz it cr w = w
     thrustdelay = _shellThrustDelay params
     params = _itParams it
     updatescreen = fromMaybe id $ do
-        screeninvid <- mscreen ^? _Just . itLocation . ilInvID
+        screenid <- homing ^? phRemoteID
-        return $
+        return $ pointerToItemID screenid . itUse
-            cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix screeninvid
-                . itUse
                 . atLinkedProjectile
                 ?~ i
     i = IM.newKey $ w ^. cWorld . lWorld . projectiles

src/Dodge/Projectile/Update.hs

@@ -3,6 +3,7 @@ module Dodge.Projectile.Update
     ( updateProjectile
     ) where
 
+import Dodge.Movement.Turn
 import NewInt
 import Dodge.Payload
 import Control.Lens
@@ -108,16 +109,31 @@ trySpinByCID cid i pj w = w & cWorld . lWorld . projectiles . ix pjid . prjSpin
     spinFactor = 5 * (6 - fromIntegral i)
 
 -- note this only allows YOU to remotely track projectiles
-pjRemoteSetDirection :: Maybe (NewInt ItmInt) -> Projectile -> World -> World
+pjRemoteSetDirection :: ProjectileHoming -> Projectile -> World -> World
-pjRemoteSetDirection mscreenid pj w = fromMaybe w $ do
+pjRemoteSetDirection ph pj w = case ph of
-    screenid <- fmap _unNInt mscreenid
+    NoHoming -> w
-    let newdir
+    HomeUsingRemoteScreen screenid ->
-            | w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . imSelectedItem
+        let newdir
-                    == w ^? cWorld . lWorld . itemLocations . ix screenid . ilInvID
+                | w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . imSelectedItem
-                = (w ^. wCam . camRot) + argV (_mousePos (_input w))
+                        == w ^? cWorld . lWorld . itemLocations . ix (_unNInt screenid) . ilInvID
-            | otherwise = _prjDir pj
+                    = (w ^. wCam . camRot) + argV (_mousePos (_input w))
-        turntonewdir = magV (_prjAcc pj) *.* unitVectorAtAngle newdir
+                | otherwise = _prjDir pj
-    return $ w & cWorld . lWorld . projectiles . ix (_prjID pj) . prjAcc .~ turntonewdir
+        in w & cWorld . lWorld . projectiles . ix (_prjID pj) . prjAcc 
+                .~ magV (_prjAcc pj) *.* unitVectorAtAngle newdir
+    HomeUsingTargeting itid -> fromMaybe w $ do
+        tp <- w ^? pointerToItemID itid . itUse . tgPos . _Just
+        return $ w & cWorld . lWorld . projectiles . ix (_prjID pj) . prjAcc 
+                %~ vecTurnTo 0.2 (_prjPos pj) tp
+        
+--pjRemoteSetDirection mscreenid pj w = fromMaybe w $ do
+--    screenid <- fmap _unNInt mscreenid
+--    let newdir
+--            | w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . imSelectedItem
+--                    == w ^? cWorld . lWorld . itemLocations . ix screenid . ilInvID
+--                = (w ^. wCam . camRot) + argV (_mousePos (_input w))
+--            | otherwise = _prjDir pj
+--        turntonewdir = magV (_prjAcc pj) *.* unitVectorAtAngle newdir
+--    return $ w & cWorld . lWorld . projectiles . ix (_prjID pj) . prjAcc .~ turntonewdir
 
 reduceSpinBy :: Float -> Int -> World -> World
 reduceSpinBy x pjid = cWorld . lWorld . projectiles . ix pjid . prjSpin *~ x

src/Dodge/Render/ShapePicture.hs

@@ -69,11 +69,12 @@ drawSweep cr w = fromMaybe mempty $ do
     mwp = mouseWorldPos theinput campos
 
 anyTargeting :: Configuration -> World -> SPic
-anyTargeting cfig w = fromMaybe mempty $ do
+anyTargeting _ _ = mempty
-    tt <- cr ^? crTargeting . ctType . _Just
+--anyTargeting cfig w = fromMaybe mempty $ do
-    return $ noShape $ drawTargeting tt cr cfig w
+--    tt <- cr ^? crTargeting . ctType . _Just
-  where
+--    return $ noShape $ drawTargeting tt cr cfig w
-    cr = you w
+--  where
+--    cr = you w
 
 drawCreature :: Creature -> SPic
 drawCreature cr = case _crType cr of

src/Dodge/Targeting.hs

@@ -1,119 +1,120 @@
 module Dodge.Targeting (
-    updateTargeting,
+--    updateTargeting,
 ) where
 
-import Color
+--import Color
-import qualified Data.Map.Strict as M
+--import qualified Data.Map.Strict as M
-import Data.Maybe
+--import Data.Maybe
-import Dodge.Base.Collide
+--import Dodge.Base.Collide
-import Dodge.Base.Coordinate
+--import Dodge.Base.Coordinate
-import Dodge.Creature.Test
+--import Dodge.Creature.Test
-import Dodge.Data.World
+--import Dodge.Data.World
-import Dodge.Item.Weapon.LaserPath
+--import Dodge.Item.Weapon.LaserPath
-import Dodge.Zoning.Creature
+--import Dodge.Zoning.Creature
-import FoldableHelp
+--import FoldableHelp
-import Geometry.Vector
+--import Geometry.Vector
-import LensHelp
+--import LensHelp
-import qualified SDL
+--import qualified SDL
 
-updateTargeting :: Maybe TargetType -> Creature -> World -> World
+--updateTargeting :: Maybe TargetingType -> Creature -> World -> World
-updateTargeting tu = case tu of
+--updateTargeting tu = case tu of
-    Nothing -> clearTargeting
+--    Nothing -> clearTargeting
-    Just TARGETLASER -> targetLaserUpdate'
+--    Just TARGETLASER -> targetLaserUpdate'
-    Just TargetRBPress -> upCT (flip targetRBPressUpdate . _crTargeting)
+--    Just TargetRBPress -> upCT (flip targetRBPressUpdate . _crTargeting)
-    Just TargetRBLine  -> upCT (flip targetRBPressUpdate . _crTargeting)
+--    Just TargetRBLine  -> upCT (flip targetRBPressUpdate . _crTargeting)
-    Just TargetRBCreature -> upCT targetRBCreatureUp
+--    Just TargetRBCreature -> upCT targetRBCreatureUp
-    Just TargetCursor -> upCT (flip targetCursorUpdate . _crTargeting)
+--    Just TargetCursor -> upCT (flip targetCursorUpdate . _crTargeting)
 
-clearTargeting :: Creature -> World -> World
+--clearTargeting :: Creature -> World -> World
-clearTargeting cr = cWorld . lWorld . creatures . ix (_crID cr) . crTargeting .~ defaultTargeting
+--clearTargeting cr = cWorld . lWorld . creatures . ix (_crID cr) . crTargeting .~ defaultTargeting
-
+--
-defaultTargeting :: CreatureTargeting
+--defaultTargeting :: CreatureTargeting
-defaultTargeting = CreatureTargeting Nothing Nothing Nothing False
+--defaultTargeting = CreatureTargeting Nothing Nothing Nothing False
-
+--
-upCT :: (Creature -> World -> CreatureTargeting) -> Creature -> World -> World
+--upCT :: (Creature -> World -> CreatureTargeting) -> Creature -> World -> World
-upCT f cr w = w & cWorld . lWorld . creatures . ix (_crID cr) . crTargeting .~ f cr w
+--upCT f cr w = w & cWorld . lWorld . creatures . ix (_crID cr) . crTargeting .~ f cr w
-
+--
-targetRBCreatureUp :: Creature -> World -> CreatureTargeting
+--targetRBCreatureUp :: Creature -> World -> CreatureTargeting
-targetRBCreatureUp cr w
+--targetRBCreatureUp cr w
-    | SDL.ButtonRight `M.member` _mouseButtons (_input w) && isJust (t ^? ctID . _Just)
+--    | SDL.ButtonRight `M.member` _mouseButtons (_input w) && isJust (t ^? ctID . _Just)
-        && canSeeTarget =
+--        && canSeeTarget =
-        t & updatePos & ctActive .~ True
+--        t & updatePos & ctActive .~ True
-            & ctType ?~ TargetRBCreature
+--            & ctType ?~ TargetRBCreature
-    | otherwise = t & ctID .~ fmap _crID newtarg & updatePos & ctActive .~ False
+--    | otherwise = t & ctID .~ fmap _crID newtarg & updatePos & ctActive .~ False
-            & ctType ?~ TargetRBCreature
+--            & ctType ?~ TargetRBCreature
-  where
+--  where
-    t = _crTargeting cr
+--    t = _crTargeting cr
-    newtarg =
+--    newtarg =
-        safeMinimumOn (dist mwp . _crPos)
+--        safeMinimumOn (dist mwp . _crPos)
-            . filter (canseepos . _crPos)
+--            . filter (canseepos . _crPos)
-            $ crsNearCirc mwp 40 w
+--            $ crsNearCirc mwp 40 w
-    canseepos p = hasLOS (_crPos cr) p w
+--    canseepos p = hasLOS (_crPos cr) p w
-    mwp = mouseWorldPos (w ^. input) (w ^. wCam)
+--    mwp = mouseWorldPos (w ^. input) (w ^. wCam)
-    updatePos t' = t' & ctPos .~ posFromMaybeID (_ctID t')
+--    updatePos t' = t' & ctPos .~ posFromMaybeID (_ctID t')
-    posFromMaybeID Nothing = Nothing
+--    posFromMaybeID Nothing = Nothing
-    posFromMaybeID (Just i) = w ^? cWorld . lWorld . creatures . ix i . crPos
+--    posFromMaybeID (Just i) = w ^? cWorld . lWorld . creatures . ix i . crPos
-    canSeeTarget = fromMaybe False $ do
+--    canSeeTarget = fromMaybe False $ do
-        cid <- t ^? ctID . _Just
+--        cid <- t ^? ctID . _Just
-        cpos <- w ^? cWorld . lWorld . creatures . ix cid . crPos
+--        cpos <- w ^? cWorld . lWorld . creatures . ix cid . crPos
-        Just $ hasLOS cpos (_crPos cr) w
+--        Just $ hasLOS cpos (_crPos cr) w
-
+--
-targetCursorUpdate :: World -> CreatureTargeting -> CreatureTargeting
+--targetCursorUpdate :: World -> CreatureTargeting -> CreatureTargeting
-targetCursorUpdate w ct =
+--targetCursorUpdate w ct =
-    ct
+--    ct
-        & ctPos . _Just .~ mouseWorldPos (w ^. input) (w ^. wCam)
+--        & ctPos . _Just .~ mouseWorldPos (w ^. input) (w ^. wCam)
-        & ctActive .~ True
+--        & ctActive .~ True
-            & ctType ?~ TargetCursor
+--            & ctType ?~ TargetCursor
-
+--
-targetRBPressUpdate :: World -> CreatureTargeting -> CreatureTargeting
+--targetRBPressUpdate :: World -> CreatureTargeting -> CreatureTargeting
-targetRBPressUpdate w t
+--targetRBPressUpdate w t
-    | SDL.ButtonRight `M.member` _mouseButtons (_input w) =
+--    | SDL.ButtonRight `M.member` _mouseButtons (_input w) =
-        t
+--        t
-            & ctPos %~ maybe (Just $ mouseWorldPos (w ^. input) (w ^. wCam)) Just
+--            & ctPos %~ maybe (Just $ mouseWorldPos (w ^. input) (w ^. wCam)) Just
-            & ctActive .~ True
+--            & ctActive .~ True
-            & ctType ?~ TargetRBPress
+--            & ctType ?~ TargetRBPress
-    | otherwise =
+--    | otherwise =
-        t
+--        t
-            & ctPos %~ const Nothing
+--            & ctPos %~ const Nothing
-            & ctActive .~ False
+--            & ctActive .~ False
-            & ctType ?~ TargetRBPress
+--            & ctType ?~ TargetRBPress
-
+--
-targetLaserUpdate' :: Creature -> World -> World
+--targetLaserUpdate' :: Creature -> World -> World
-targetLaserUpdate' cr w =
+--targetLaserUpdate' cr w =
-    let (w', ct') = targetLaserUpdate cr w (_crTargeting cr)
+--    let (w', ct') = targetLaserUpdate cr w (_crTargeting cr)
-     in w' & cWorld . lWorld . creatures . ix (_crID cr) . crTargeting .~ ct'
+--     in w' & cWorld . lWorld . creatures . ix (_crID cr) . crTargeting .~ ct'
-
+--
-targetLaserUpdate :: Creature -> World -> CreatureTargeting -> (World, CreatureTargeting)
+--targetLaserUpdate :: Creature -> World -> CreatureTargeting -> (World, CreatureTargeting)
-targetLaserUpdate cr w t
+--targetLaserUpdate cr w t
-    | crIsAiming cr =
+--    | crIsAiming cr =
-        ( addLaserPic w
+--        --( addLaserPic w
-        , t
+--        ( w
-            & ctPos .~ fmap fst mp
+--        , t
-            & ctActive .~ True
+--            & ctPos .~ fmap fst mp
-            & ctType ?~ TARGETLASER
+--            & ctActive .~ True
-        )
+--            & ctType ?~ TARGETLASER
-    | otherwise =
+--        )
-        ( w
+--    | otherwise =
-        , t & ctPos %~ const Nothing
+--        ( w
-            & ctActive .~ False
+--        , t & ctPos %~ const Nothing
-        )
+--            & ctActive .~ False
-  where
+--        )
-    (mp, _) = reflectLaserAlong 0.2 sp ep w
+--  where
-    sp = _crPos cr +.+ 15 *.* unitVectorAtAngle (_crDir cr)
+--    (mp, _) = reflectLaserAlong 0.2 sp ep w
-    ep = sp +.+ 5000 *.* normalizeV (mouseWorldPos (w ^. input) (w ^. wCam) -.- sp)
+--    sp = _crPos cr +.+ 15 *.* unitVectorAtAngle (_crDir cr)
-    addLaserPic =
+--    ep = sp +.+ 5000 *.* normalizeV (mouseWorldPos (w ^. input) (w ^. wCam) -.- sp)
-        cWorld . lWorld . lasers
+----    addLaserPic =
-            .:~ LaserStart
+----        cWorld . lWorld . lasers
-                { _lpPhaseV = 1
+----            .:~ LaserStart
-                , _lpDir = _crDir cr
+----                { _lpPhaseV = 1
-                , _lpPos = sp
+----                , _lpDir = _crDir cr
-                , _lpColor = col
+----                , _lpPos = sp
-                , _lpType = TargetingLaser
+----                , _lpColor = col
-                }
+----                , _lpType = TargetingLaser
-    --wpammo = _itConsumption it
+----                }
-    --    reloadFrac
+--    --wpammo = _itConsumption it
-    --        | _laLoaded wpammo == 0 = 1
+--    --    reloadFrac
-    --        | otherwise = case _laTransfer wpammo of
+--    --        | _laLoaded wpammo == 0 = 1
-    --            Transfer _ rs -> fromIntegral rs / fromIntegral (_laReloadTime wpammo)
+--    --        | otherwise = case _laTransfer wpammo of
-    --            NoTransfer -> 1
+--    --            Transfer _ rs -> fromIntegral rs / fromIntegral (_laReloadTime wpammo)
-    col = blue -- mixColors reloadFrac (1-reloadFrac) blue red
+--    --            NoTransfer -> 1
+----    col = blue -- mixColors reloadFrac (1-reloadFrac) blue red

src/Dodge/Targeting/Draw.hs

@@ -2,16 +2,16 @@ module Dodge.Targeting.Draw (
     drawTargeting,
 ) where
 
-import Data.Maybe
+--import Data.Maybe
-import Dodge.Base
+--import Dodge.Base
 import Dodge.Data.Universe
 import Geometry.Data
-import Geometry.Vector
+--import Geometry.Vector
-import LensHelp
+--import LensHelp
 import Picture
-import ShortShow
+--import ShortShow
 
-drawTargeting :: TargetType -> Creature -> Configuration -> World -> Picture
+drawTargeting :: TargetingType -> Creature -> Configuration -> World -> Picture
 drawTargeting td = case td of
     TargetRBCreature -> targetRBCreatureDraw
     TargetRBLine -> targetDistanceDraw
@@ -23,48 +23,53 @@ targetSimpleDraw :: Creature -> Configuration -> World -> Picture
 targetSimpleDraw = targetDraw activeTargetCursorPic
 
 targetDistanceDraw :: Creature -> Configuration -> World -> Picture
-targetDistanceDraw cr _ w = fromMaybe mempty $ do
+targetDistanceDraw _ _ _ = mempty 
-    p <- cr ^? crTargeting . ctPos . _Just
+--targetDistanceDraw cr _ w = mempty 
-    let p1 = worldPosToScreen cam p
+--  fromMaybe mempty $ do
-        mwp = mouseWorldPos (w ^. input) (w ^. wCam)
+--    p <- cr ^? crTargeting . ctPos . _Just
-        p2 = worldPosToScreen cam mwp
+--    let p1 = worldPosToScreen cam p
-        thecol = if dist p mwp > 100 then red else white
+--        mwp = mouseWorldPos (w ^. input) (w ^. wCam)
-    return .
+--        p2 = worldPosToScreen cam mwp
-            setLayer FixedCoordLayer $
+--        thecol = if dist p mwp > 100 then red else white
-                color thecol $
+--    return .
-                    line [p1, p2]
+--            setLayer FixedCoordLayer $
-                        <> transMidLine p1 p2 (scale 0.1 0.1 . text . shortShow $ dist p mwp)
+--                color thecol $
-  where
+--                    line [p1, p2]
-    cam = w ^. wCam
+--                        <> transMidLine p1 p2 (scale 0.1 0.1 . text . shortShow $ dist p mwp)
+--  where
+--    cam = w ^. wCam
 
 targetDraw :: Picture -> Creature -> Configuration -> World -> Picture
-targetDraw f cr _ _ = fromMaybe mempty $ do
+targetDraw _ _ _ _ = mempty
-    p <- cr ^? crTargeting . ctPos . _Just
+--targetDraw f cr _ _ = mempty
-    return .
+--   fromMaybe mempty $ do
-            setLayer DebugLayer $
+--    p <- cr ^? crTargeting . ctPos . _Just
-                color white $
+--    return .
-                    uncurryV translate p f
+--            setLayer DebugLayer $
+--                color white $
+--                    uncurryV translate p f
 
 activeTargetCursorPic :: Picture
 activeTargetCursorPic =
     fold
         [rotate a $ line [V2 15 0, V2 10 0] <> targCorner | a <- [0, 0.5 * pi, pi, 1.5 * pi]]
 
-transMidLine :: Point2 -> Point2 -> Picture -> Picture
+--transMidLine :: Point2 -> Point2 -> Picture -> Picture
-transMidLine p1 p2 = translate 20 (f p1 p2) . uncurryV translate (0.5 *.* (p1 +.+ p2))
+--transMidLine p1 p2 = translate 20 (f p1 p2) . uncurryV translate (0.5 *.* (p1 +.+ p2))
-  where
+--  where
-    f (V2 x y) (V2 x' y')
+--    f (V2 x y) (V2 x' y')
-        | y > y' && x > x' = max (-10) (x' - x)
+--        | y > y' && x > x' = max (-10) (x' - x)
-        | y > y' && x < x' = min 10 (x' - x)
+--        | y > y' && x < x' = min 10 (x' - x)
-        | x > x' = min 10 (x - x')
+--        | x > x' = min 10 (x - x')
-        | otherwise = max (-10) (x - x')
+--        | otherwise = max (-10) (x - x')
 
 targetRBCreatureDraw :: Creature -> Configuration -> World -> Picture
-targetRBCreatureDraw cr = targetDraw thepic cr
+targetRBCreatureDraw cr = targetDraw targetCursorPic cr
-  where
+--targetRBCreatureDraw cr = targetDraw thepic cr
-    thepic
+--  where
-        | _ctActive $ _crTargeting cr = activeTargetCursorPic
+--    thepic
-        | otherwise = targetCursorPic
+--        | _ctActive $ _crTargeting cr = activeTargetCursorPic
+--        | otherwise = targetCursorPic
 
 targCorner :: Picture
 targCorner = line [V2 (x - y) x, V2 x x, V2 x (x - y)]

src/Dodge/TestString.hs

@@ -20,7 +20,7 @@ import Dodge.Data.Universe
 import qualified IntMapHelp as IM
 
 testStringInit :: Universe -> [String]
-testStringInit = const mempty
+testStringInit u = [maybe mempty show $ u ^? uvWorld . cWorld . lWorld . projectiles . ix 0 . prjUpdates . ix 3 . pjuControllerID]
 --testStringInit u = (topTestPart u
 --    <>) $ map showh $ 
 ----    (IM.toList . IM.filter (\itloc -> itloc ^? ilCrID == Just 0) $ (u ^. uvWorld . cWorld . lWorld . itemLocations)) <> 

src/Dodge/Update.hs

@@ -6,6 +6,7 @@ Description : Simulation update
 -}
 module Dodge.Update (updateUniverse) where
 
+import Data.Monoid
 import NewInt
 import Control.Monad
 import Dodge.Update.Input.InGame
@@ -384,10 +385,12 @@ updateCreatureSoundPositions w =
 --updateIMr :: (World -> IM.IntMap a) -> (a -> a -> World -> World) -> World -> World
 --updateIMr fim fup w = foldr (dbArg fup) w (fim w)
 updateIMl :: (World -> IM.IntMap a) -> (a -> a -> World -> World) -> World -> World
-updateIMl fim fup w = foldl' (flip $ dbArg fup) w (fim w)
+updateIMl fim fup w = alaf Endo foldMap (dbArg fup) (fim w) w
+--updateIMl fim fup w = foldl' (flip $ dbArg fup) w (fim w)
 
 updateIMl' :: (World -> IM.IntMap a) -> (a -> World -> World) -> World -> World
-updateIMl' fim fup w = foldl' (flip fup) w (fim w)
+updateIMl' fim fup w = alaf Endo foldMap fup (fim w) w
+--updateIMl' fim fup w = foldl' (flip fup) w (fim w)
 
 updateCreatureGroups :: World -> World
 updateCreatureGroups w =
@@ -561,10 +564,13 @@ ppEvents :: World -> World
 ppEvents w = IM.foldl' (flip $ \pp -> doPressPlateEvent (_ppEvent pp) pp) w $ w ^. cWorld . lWorld . pressPlates
 
 updateSeenWalls :: World -> World
-updateSeenWalls w = foldl' markWallSeen w (map (_wlID . snd) $ allVisibleWalls w)
+updateSeenWalls w = alaf Endo foldMap (markWallSeen . _wlID . snd) (allVisibleWalls w) w
+--updateSeenWalls w = foldl' markWallSeen w (map (_wlID . snd) $ allVisibleWalls w)
 
-markWallSeen :: World -> Int -> World
+markWallSeen :: Int -> World -> World
-markWallSeen w i = w & cWorld . seenWalls . at i ?~ ()
+markWallSeen i = cWorld . seenWalls . at i ?~ ()
+--markWallSeen :: World -> Int -> World
+--markWallSeen w i = w & cWorld . seenWalls . at i ?~ ()
 
 --markWallSeen !w !i = w & cWorld . lWorld . walls %~ IM.adjust markSeen i
 -- in the past there might have been a space leak, which the following was meant

src/Dodge/WorldEffect.hs

@@ -49,7 +49,7 @@ doWdWd we = case we of
 doItCrWdWd :: ItCrWdWd -> LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
 doItCrWdWd icww = case icww of
     ItCrWdId -> \_ _ -> id
-    ItCrWdItemEffect -> flip itemEffect
+    ItCrWdItemEffect -> flip itemUseEffect
 
 accessTerminal :: Maybe Int -> World -> World
 accessTerminal mtmid w = fromMaybe w $ do

src/NewInt.hs

@@ -13,7 +13,7 @@ import Data.Aeson
 import Data.Aeson.TH
 
 newtype NewInt a = NInt { _unNInt :: Int}
-    deriving newtype (Eq,Ord,Show,Num,Read)
+    deriving newtype (Eq,Ord,Show,Num,Read,Integral,Real,Enum)
 
 newtype NewIntMap a b = NIntMap { _unNIntMap :: IM.IntMap b}
     deriving (Eq,Ord,Show,Read)