Allow more general detection of item use focus

data/dodge.config.json

@@ -1,7 +1,6 @@
 {
   "_debug_booleans": [
     "Show_ms_frame",
-    "Enable_debug",
     "Circ_collision_test",
     "Show_walls_near_segment"
   ],

src/Dodge/Base/Collide.hs

@@ -149,7 +149,7 @@ overlapCircWalls p r = mapMaybe dointersect
 circHitWall :: Point2 -> Point2 -> Float -> World -> Bool
 circHitWall sp ep r w = any (uncurry (intersectSegSegTest sp ep) . _wlLine)
         (wlsNearSeg sp ep w)
-    || any (uncurry (circOnSeg ep r) . _wlLine) (wlsNearPoint ep w)
+    || circOnSomeWall ep r w
 
 -- | note that this does not push the circle away from the wall at all
 collideCircWalls :: Point2 -> Point2 -> Float -> [Wall] -> (Point2, Maybe Wall)
@@ -190,11 +190,6 @@ circOnSomeWall p rad =
     any (uncurry (circOnSeg p rad) . _wlLine)
         . wlsNearPoint p
 
---circOnSomeWall :: Point2 -> Float -> World -> Bool
---{-# INLINE circOnSomeWall #-}
---circOnSomeWall p rad = runIdentity . S.any_ (uncurry (circOnSeg p rad) . _wlLine)
---    . wlsNearPoint p
-
 circOnAnyCr :: Point2 -> Float -> World -> Bool
 {-# INLINE circOnAnyCr #-}
 circOnAnyCr p r w = IS.foldr f False $ crIXsNearPoint p w

src/Dodge/Creature/Action/Blink.hs

@@ -15,6 +15,9 @@ import Geometry
 import LensHelp
 import Picture
 
+-- note collideCircWalls doesn't always correctly zone walls, this should be
+-- replaced.
+-- I think the test circHitWall DOES work
 -- | Teleport a creature to the mouse position
 blinkActionMousePos :: Creature -> World -> World
 blinkActionMousePos cr w =

src/Dodge/Creature/Impulse/UseItem.hs

@@ -24,7 +24,7 @@ useSelectedItem crid w = (worldEventFlags . at InventoryChange ?~ ()) . fromMayb
     invid <- cr ^? crManipulation . manObject . imSelectedItem
     itmtree <- invRootTrees (_crInv cr) ^? ix itRef
     itmloc <- allInvLocs (_crInv cr) ^? ix invid . _2
-    let usedloc = case itmloc ^. locLDT . ldtValue . _1 . itUseFocus of
+    let usedloc = case useLocation itmloc of
             UseFromLocation -> itmloc ^. locLDT
             UseFromRoot -> locToTop itmloc ^. locLDT
     let itm = usedloc ^. ldtValue . _1
@@ -46,6 +46,13 @@ useSelectedItem crid w = (worldEventFlags . at InventoryChange ?~ ()) . fromMayb
   where
     fst3 (x,_,_) = x
 
+useLocation :: LocationLDT ItemLink ComposedItem -> UseFocus
+useLocation loc 
+    | isJust $ loc ^? locLDT . ldtValue . _1 . itUse . uequipEffect = UseFromLocation
+    | isJust $ loc ^? locLDT . ldtValue . _1 . itUse . uaParams . apLinkedProjectile
+        = UseFromLocation
+    | otherwise = UseFromRoot
+
 toggleEquipmentAt :: Int -> Creature -> World -> World
 toggleEquipmentAt invid cr w = case getEquipmentAllocation w of
     DoNotMoveEquipment -> w

src/Dodge/Data/Item.hs

@@ -41,7 +41,7 @@ data Consumables
 data Item = Item
     { _itUse :: ItemUse
     , _itUseCondition :: UseCondition
-    , _itUseFocus :: UseFocus
+--    , _itUseFocus :: UseFocus
     , _itConsumables :: Consumables
     , _itType :: ItemType
     , _itID :: NewInt ItmInt

src/Dodge/Data/Projectile.hs

@@ -25,7 +25,6 @@ data Projectile
         , _prjTimer :: Int
         , _prjZ :: Float
         , _prjUpdates :: [ProjectileUpdate]
---        , _prjMITID :: Maybe Int
         }
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 

src/Dodge/Default.hs

@@ -24,7 +24,7 @@ import Picture
 
 defaultEquipment :: Item
 defaultEquipment = defaultHeldItem & itUse .~ defaultEquipUse
-    & itUseFocus .~ UseFromLocation
+--    & itUseFocus .~ UseFromLocation
 
 defaultFlIt :: FloorItem
 defaultFlIt = FlIt{_flItRot = 0, _flIt = defaultHeldItem, _flItPos = V2 0 0, _flItID = 0}

src/Dodge/Default/Item.hs

@@ -26,7 +26,6 @@ defaultHeldItem =
         , _itUse = defaultHeldUse
         , _itParams = NoParams
         , _itUseCondition = MustBeHeld
-        , _itUseFocus = UseFromRoot
         }
 
 --defaultLeftItem :: Item

src/Dodge/Payload.hs

@@ -2,7 +2,6 @@ module Dodge.Payload (
     usePayload,
 ) where
 
---import Geometry.Vector
 import Dodge.Item.Weapon.Bullet
 import RandomHelp
 import Control.Monad

src/Dodge/Projectile/Update.hs

@@ -25,7 +25,8 @@ updateProjectile pj w = foldl' (\w' pu -> upProjectile pu pj w') w (_prjUpdates
 
 upProjectile :: ProjectileUpdate -> Projectile -> World -> World
 upProjectile pu pj = case pu of
-    CollisionEffectPU mscreenid -> shellCollisionEffect mscreenid pj
+    CollisionEffectPU mscreenid -> shellCollisionCheck 
+        mscreenid pj
     TimePU -> decTimMvVel pj
     ThrustPU st et
         | act st et -> doThrust pj
@@ -45,17 +46,15 @@ upProjectile pu pj = case pu of
     time = _prjTimer pj
     act st et = time <= st && time >= et
 
-shellCollisionEffect :: Maybe (NewInt ItmInt) -> Projectile -> World -> World
-shellCollisionEffect mscreenid = shellCollisionCheck $
-    \pj -> explodeShell mscreenid (_prjID pj)
-
-shellCollisionCheck :: (Projectile -> World -> World) -> Projectile -> World -> World
+--shellCollisionCheck :: (Projectile -> World -> World) -> Projectile -> World -> World
+shellCollisionCheck :: Maybe (NewInt ItmInt) -> Projectile -> World -> World
 shellCollisionCheck f pj w
-    | time > 330 && circOnSomeWall oldPos 4 w = f pj w
-    | time <= 330 && anythingHitCirc 2 oldPos newPos w = f pj w
-    | time <= 0 = f pj w
+    | time > 330 && circOnSomeWall oldPos 4 w = g
+    | time <= 330 && anythingHitCirc 2 oldPos newPos w = g
+    | time <= 0 = g
     | otherwise = w
   where
+    g = explodeShell f pj w
     time = _prjTimer pj
     oldPos = _prjPos pj
     newPos = oldPos +.+ _prjVel pj
@@ -155,13 +154,12 @@ decTimMvVel pj =
     vel = _prjVel pj
     pjid = _prjID pj
 
-explodeShell :: Maybe (NewInt ItmInt) -> Int -> World -> World
-explodeShell mitid pjid w =
+explodeShell :: Maybe (NewInt ItmInt) -> Projectile -> World -> World
+explodeShell mitid pj w =
     w
         & cWorld . lWorld . projectiles . ix pjid . prjUpdates .~ [DestroyPU mitid 30]
         & cWorld . lWorld . projectiles . ix pjid . prjDraw .~ DrawBlankProjectile
-        & usePayload (_prjPayload thepj) (_prjPos thepj) (_prjVel thepj)
+        & usePayload (_prjPayload pj) (_prjPos pj) (_prjVel pj)
         & stopSoundFrom (ShellSound pjid)
   where
-    --    itPoint = pointerToItemLocation $ w ^?! cWorld . lWorld . itemLocations . ix itid-- _itemLocations (_cWorld w) IM.! itid
-    thepj = w ^?! cWorld . lWorld . projectiles . ix pjid
+    pjid = pj ^. prjID

src/Dodge/SelectUse.hs

@@ -7,6 +7,7 @@ import Data.Maybe
 import Dodge.Data.World
 import Dodge.Payload
 
+-- this could just set the timer to 0?
 selectUse :: Item -> Creature -> World -> World
 selectUse itm _ w = fromMaybe w $ do
     lbtime <- w ^? input . mouseButtons . ix SDL.ButtonLeft 
@@ -26,7 +27,3 @@ selectUse itm _ w = fromMaybe w $ do
   where
     notdestroyed DestroyPU{} = False
     notdestroyed _ = True
-    
-
---  where
---    itPoint = pointerToItemLocation $ w ^?! cWorld . lWorld . itemLocations . ix itid-- _itemLocations (_cWorld w) IM.! itid