Fix blink bug

src/Dodge/Creature/Action.hs

@@ -8,7 +8,7 @@ module Dodge.Creature.Action (
     dropUnselected,
     dropExcept,
     dropItem,
-    blinkAction,
+    blinkActionMousePos,
     blinkActionFail,
     unsafeBlinkAction,
     sizeSelf,
@@ -22,6 +22,7 @@ import Data.Bifunctor
 import Data.List (findIndex)
 import Data.Maybe
 import Dodge.Base
+import Dodge.Creature.Action.Blink
 import Dodge.CreatureEffect
 import Dodge.Data.World
 import Dodge.Default
@@ -32,11 +33,9 @@ import Dodge.Inventory.Add
 import Dodge.Path
 import Dodge.SoundLogic
 import Dodge.WallCreatureCollisions
-import Dodge.WorldEvent.Shockwave
 import Geometry
 import qualified IntMapHelp as IM
 import LensHelp
-import Picture
 
 performActions :: World -> Creature -> Creature
 performActions w cr =
@@ -145,88 +144,6 @@ performAction cr w ac = case ac of
         (imps, _) -> (imps, Just $ DoReplicatePartial startac (t -1) startac)
     NoAction -> ([], Nothing)
 
--- | Like a blink action, but no ingoing distortion
-blinkActionFail ::
-    Creature ->
-    World ->
-    World
-blinkActionFail cr w =
-    w
-        & soundMultiFrom [TeleSound 0, TeleSound 1] p3 teleS Nothing
-        & cWorld . distortions .:~ distortionBulge
-        & cWorld . creatures . ix cid . crPos .~ p3
-        & inverseShockwaveAt cpos 40 2 2
-  where
-    distR = 120
-    distortionBulge = RadialDistortion cpos (cpos +.+ V2 distR 0) (cpos +.+ V2 0 distR) 1.9
-    cid = _crID cr
-    p1 = mouseWorldPos w
-    cpos = _crPos cr
-    p2 = bouncePoint (const True) 1 cpos p1 w
-    r = 1.5 * _crRad cr
-    p3 = maybe p1 (mvPointTowardAtSpeed r cpos . fst) p2
-
--- | Teleport a creature to the mouse position
-blinkAction :: Creature -> World -> World
-blinkAction cr w =
-    w
-        & soundMultiFrom [TeleSound 0, TeleSound 1] p3 teleS Nothing
-        & cWorld . distortions .++~ distortionBulge
-        & cWorld . creatures . ix cid . crPos .~ p3
-        & blinkShockwave cid p3
-        & inverseShockwaveAt cpos 40 2 2
-  where
-    distR = 120
-    distortionBulge =
-        [ RadialDistortion p3 (p3 +.+ V2 distR 0) (p3 +.+ V2 0 distR) 0.1
-        , RadialDistortion cpos (cpos +.+ V2 distR 0) (cpos +.+ V2 0 distR) 1.9
-        ]
-    cid = _crID cr
-    p1 = mouseWorldPos w
-    cpos = _crPos cr
-    p2 = bouncePoint (const True) 1 cpos p1 w
-    r = 1.5 * _crRad cr
-    p3 = maybe p1 (mvPointTowardAtSpeed r cpos . fst) p2
-
-{- | Teleport a creature to the mouse position.
-Can go through walls, if ending up in wall does big damage.
--}
-unsafeBlinkAction ::
-    Creature ->
-    World ->
-    World
-unsafeBlinkAction cr w
-    | success =
-        soundMultiFrom [TeleSound 0, TeleSound 1] mwp teleS Nothing
-            . (cWorld . distortions .++~ distortionBulge)
-            . set (cWorld . creatures . ix cid . crPos) mwp
-            . blinkShockwave cid mwp
-            $ inverseShockwaveAt cpos 40 2 2 w
-    | otherwise =
-        w
-            & blinkActionFail cr
-            & cWorld . creatures . ix cid . crState . csDamage
-                .:~ Damage ENTERREMENT 10000 mwp mwp mwp NoDamageEffect
-  where
-    success = fromMaybe True $ do
-        wl <- snd $ collidePointWallsFilter (const True) mwp cpos w
-        return (isLHS mwp `uncurry` _wlLine wl)
-    distR = 120
-    distortionBulge =
-        [ RadialDistortion mwp (mwp +.+ V2 distR 0) (mwp +.+ V2 0 distR) 0.1
-        , RadialDistortion cpos (cpos +.+ V2 distR 0) (cpos +.+ V2 0 distR) 1.9
-        ]
-    cid = _crID cr
-    mwp = mouseWorldPos w
-    cpos = _crPos cr
-
-blinkShockwave ::
-    -- | Blinking creature ID.
-    Int ->
-    Point2 ->
-    World ->
-    World
-blinkShockwave i p = makeShockwaveAt [i] p 60 1 2 cyan
 
 setMinInvSize :: Int -> Creature -> World -> World
 setMinInvSize n cr = cWorld . creatures . ix (_crID cr) . crInvCapacity .~ n

src/Dodge/Creature/Action/Blink.hs

@@ -0,0 +1,103 @@
+{-# LANGUAGE TupleSections #-}
+module Dodge.Creature.Action.Blink (
+    blinkActionMousePos,
+    blinkActionFail,
+    unsafeBlinkAction,
+) where
+
+import Dodge.Zoning.Wall
+import Data.Maybe
+import Dodge.Base
+import Dodge.Data.World
+import Dodge.SoundLogic
+import Dodge.WorldEvent.Shockwave
+import Geometry
+import LensHelp
+import Picture
+
+-- | Teleport a creature to the mouse position
+blinkActionMousePos :: Creature -> World -> World
+blinkActionMousePos cr w =
+    w
+        & soundMultiFrom [TeleSound 0, TeleSound 1] p3 teleS Nothing
+        & blinkDistortions cpos p3
+        & cWorld . creatures . ix cid . crPos .~ p3
+        & blinkShockwave cid p3
+        & inverseShockwaveAt cpos 40 2 2
+  where
+    cid = _crID cr
+    p1 = mouseWorldPos w
+    cpos = _crPos cr
+    --p2 = bouncePoint (const True) 1 cpos p1 w
+    p2 = pushIntoMaybe $ collideCircWalls cpos p1 r (wlsNearSeg cpos p1 w)
+    r = _crRad cr
+    p3 = maybe p1 ((+.+ squashNormalizeV (cpos -.- p1)) . fst) p2 
+    --p3 = maybe p1 (const 0) p2 
+    --p3 = maybe p1 fst p2 
+    pushIntoMaybe :: (a, Maybe b) -> Maybe (a,b)
+    pushIntoMaybe (x,my) = (x,) <$> my
+
+blinkDistortions :: Point2 -> Point2 -> World -> World
+blinkDistortions sp ep = cWorld . distortions .++~ distortionBulge
+  where
+    distR = 120
+    distortionBulge =
+        [ RadialDistortion ep (ep +.+ V2 distR 0) (ep +.+ V2 0 distR) 0.1
+        , RadialDistortion sp (sp +.+ V2 distR 0) (sp +.+ V2 0 distR) 1.9
+        ]
+
+{- | Teleport a creature to the mouse position.
+Can go through walls, if ending up in wall does big damage.
+-}
+unsafeBlinkAction ::
+    Creature ->
+    World ->
+    World
+unsafeBlinkAction cr w
+    | success =
+        soundMultiFrom [TeleSound 0, TeleSound 1] mwp teleS Nothing
+            . blinkDistortions cpos mwp
+            . set (cWorld . creatures . ix cid . crPos) mwp
+            . blinkShockwave cid mwp
+            $ inverseShockwaveAt cpos 40 2 2 w
+    | otherwise =
+        w
+            & blinkActionFail cr
+            & cWorld . creatures . ix cid . crState . csDamage
+                .:~ Damage ENTERREMENT 10000 mwp mwp mwp NoDamageEffect
+  where
+    success = fromMaybe True $ do
+        wl <- snd $ collidePointWallsFilter (const True) mwp cpos w
+        return (isLHS mwp `uncurry` _wlLine wl)
+    cid = _crID cr
+    mwp = mouseWorldPos w
+    cpos = _crPos cr
+
+blinkShockwave ::
+    -- | Blinking creature ID.
+    Int ->
+    Point2 ->
+    World ->
+    World
+blinkShockwave i p = makeShockwaveAt [i] p 60 1 2 cyan
+
+-- | Like a blink action, but no ingoing distortion
+blinkActionFail ::
+    Creature ->
+    World ->
+    World
+blinkActionFail cr w =
+    w
+        & soundMultiFrom [TeleSound 0, TeleSound 1] p3 teleS Nothing
+        & cWorld . distortions .:~ distortionBulge
+        & cWorld . creatures . ix cid . crPos .~ p3
+        & inverseShockwaveAt cpos 40 2 2
+  where
+    distR = 120
+    distortionBulge = RadialDistortion cpos (cpos +.+ V2 distR 0) (cpos +.+ V2 0 distR) 1.9
+    cid = _crID cr
+    p1 = mouseWorldPos w
+    cpos = _crPos cr
+    p2 = bouncePoint (const True) 1 cpos p1 w
+    r = 1.5 * _crRad cr
+    p3 = maybe p1 (mvPointTowardAtSpeed r cpos . fst) p2

src/Dodge/Creature/Impulse/UseItem.hs

@@ -30,7 +30,7 @@ useItem cr' w = fromMaybe (f w) $ do
 itemEffect :: Creature -> Item -> World -> World
 itemEffect cr it w = case it ^. itUse of
     HeldUse{_heldUse = eff, _heldMods = usemods} ->
-        hammerTest $ tryReload cr it w $ foldl' (flip ($)) (useHeld eff) (reverse $ useMod usemods) it cr
+        hammerTest $ tryReload cr it w $ foldl' (&) (useHeld eff) (reverse $ useMod usemods) it cr
     LeftUse{} -> doequipmentchange
     EquipUse{} -> doequipmentchange
     -- ConsumeUse will cause problems if the item is not selected
@@ -125,8 +125,7 @@ useLeftItem cid w
     itmIsConsumable = 
         isJust (cr ^? crInv . ix (crSel cr) . itUse . cUse)
     itmIsEquipable =
-            ( isJust (cr ^? crInv . ix (crSel cr) . itUse . equipEffect . eeUse)
+            isJust (cr ^? crInv . ix (crSel cr) . itUse . equipEffect . eeUse)
                     && _crLeftInvSel cr /= Just (crSel cr)
-               )
 
 -- TODO determine itmShouldBeUsed with reference to config options

src/Dodge/Creature/State.hs

@@ -202,7 +202,7 @@ movementSideEff cr w
 useUpdate :: ItemUse -> ItemUse
 useUpdate =
     (heldHammer %~ moveHammerUp)
-    . (leftHammer %~ moveHammerUp)
+        . (leftHammer %~ moveHammerUp)
         . (leftDelay . rateTime %~ decreaseToZero)
         . (heldDelay . warmTime %~ decreaseToZero)
         . (heldDelay . rateTime %~ decreaseToZero)
@@ -246,7 +246,7 @@ itemUpdate cr i
     | otherwise = baseupdate False
   where
     baseupdate bool =
-        updateAutoRecharge 
+        updateAutoRecharge
             . (itUse %~ useUpdate)
             . (itLocation .~ InInv (_crID cr) i)
             . (itIsHeld .~ bool)