From 62c4baaec8de09c4c03ff1ad21c936eddd0062af Mon Sep 17 00:00:00 2001
From: jgk <justin.g.kruger@gmail.com>
Date: Tue, 25 May 2021 02:15:38 +0200
Subject: [PATCH] Improve booster (graphics + bugfixes)

---
 src/Dodge/Creature/State.hs      |  5 +--
 src/Dodge/Item/Weapon.hs         |  2 +-
 src/Dodge/Item/Weapon/Booster.hs | 69 ++++++++++++++++++++++++--------
 3 files changed, 56 insertions(+), 20 deletions(-)

diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs
index 9f340d52c..b50b90472 100644
--- a/src/Dodge/Creature/State.hs
+++ b/src/Dodge/Creature/State.hs
@@ -119,10 +119,9 @@ movementSideEff cr w
 invSideEff :: Creature -> World -> World
 invSideEff cr w = weaponReloadSounds cr $ IM.foldrWithKey f w (_crInv cr)
   where 
-    f i it w' = case it ^? itEffect of
+    f i it w' = case it ^? itEffect . itInvEffect of
         Nothing -> w'
-        Just NoItEffect -> w'
-        Just g  -> dbArg _itInvEffect g cr i w'
+        Just g  -> g (_itEffect it) cr i w'
 
 weaponReloadSounds :: Creature -> World -> World
 weaponReloadSounds cr w = case _crInv cr IM.!? _crInvSel cr of
diff --git a/src/Dodge/Item/Weapon.hs b/src/Dodge/Item/Weapon.hs
index 059a42ecb..a9dd02d62 100644
--- a/src/Dodge/Item/Weapon.hs
+++ b/src/Dodge/Item/Weapon.hs
@@ -588,7 +588,7 @@ boosterGun = defaultGun
     , _wpReloadState = 0
     , _itUseRate = 0
     , _itUseTime = 0
-    , _itUse = boostSelf 20
+    , _itUse = boostSelf 10
     , _wpSpread = 0.05
     , _wpRange = 20
     , _itFloorPict = onLayer FlItLayer $ polygon [(-2,-2),(-2,2),(2,2),(2,0),(0,0),(0,-2)]
diff --git a/src/Dodge/Item/Weapon/Booster.hs b/src/Dodge/Item/Weapon/Booster.hs
index de00e43a9..4de3e89de 100644
--- a/src/Dodge/Item/Weapon/Booster.hs
+++ b/src/Dodge/Item/Weapon/Booster.hs
@@ -22,7 +22,7 @@ boostPoint x cr w = case mayp2 of
   where
     cpos = _crPos cr
     r = 1.5 * _crRad cr
-    p1 = cpos +.+ x *.* normalizeV (mouseWorldPos w -.- cpos)
+    p1 = cpos +.+ x *.* safeNormalizeV (mouseWorldPos w -.- cpos)
     mayp2 = reflectPointWalls cpos p1 $ wallsAlongLine cpos p1 w
 
 boostSelf
@@ -31,15 +31,31 @@ boostSelf
     -> World
     -> World
 boostSelf x cr w = case boostPoint x cr w of
-    Left p -> wWithShock 
-        & creatures . ix cid %~ ( (crPos .~ p) . (crInv . ix (_crInvSel cr) . wpLoadedAmmo .~ 1))
-    Right p -> wWithShock & creatures . ix cid . crPos .~ p
+    Left p -> wWithShock p
+        & creatures . ix cid %~ 
+            ( (crPos .~ p) 
+            . (crInv . ix (_crInvSel cr) %~ 
+                (wpLoadedAmmo .~ 0)
+                . (itEffect . itEffectCounter .~ 1)
+                . (itAttachment .~ Just (ItInt pid))
+                )
+            )
+    Right p -> wWithShock p & creatures . ix cid . crPos .~ p
+        & creatures . ix cid %~ 
+            ( (crPos .~ p) 
+            . (crInv . ix (_crInvSel cr) %~ 
+                (wpLoadedAmmo -~ 1)
+                . (itEffect . itEffectCounter .~ 1)
+                . (itAttachment .~ Just (ItInt pid))
+                )
+            )
   where
     cid = _crID cr
-    cpos = _crPos cr
+    --cpos = _crPos cr
     r = _crRad cr
-    pid = fromMaybe (IM.newKey $ _projectiles w) (cr ^? crInv . ix (_crInvSel cr) . itAttachment . _Just . itInt)
-    wWithShock = addBoostShockwave pid cpos (r *.* unitVectorAtAngle (_crDir cr)) w
+    pid = fromMaybe (IM.newKey $ _projectiles w) 
+        (cr ^? crInv . ix (_crInvSel cr) . itAttachment . _Just . itInt)
+    wWithShock p' = addBoostShockwave pid p' (r *.* unitVectorAtAngle (_crDir cr)) w
 
 addBoostShockwave
     :: Int
@@ -55,7 +71,7 @@ addBoostShockwave pjid p v w = w & projectiles %~
         , _pjID = pjid
         , _pjUpdate = updateLinearShockwave
         , _pjPoints = [(p,v)]
-        , _pjTimer = 10
+        , _pjTimer = maxT
         }
     f newVal oldVal = newVal & pjPoints %~ (++ _pjPoints oldVal)
 
@@ -68,21 +84,42 @@ updateLinearShockwave pj w
     t = _pjTimer pj
 
 drawBoostShockwave :: Projectile -> Picture
-drawBoostShockwave pj = setLayer 1 $ onLayer UPtLayer $ color red $  pictures $
-    [ line (map fst pvs)
-    , line [(0,0),(0,200)]
-    , uncurry translate (fst $ head pvs) $ circle 20
+drawBoostShockwave pj = setLayer 1 $ onLayer UPtLayer $ pictures $
+    theArc ++
+    [ lineCol $ zip (reverse lps) $ map (flip withAlpha white) [0,0.05..]
+    , lineCol $ zip (reverse rps) $ map (flip withAlpha white) [0,0.05..]
     ]
   where
+-- drawing half a circle here is not perfect, a slightly smaller arc would fit
+-- better, but this depends upon the angle formed by the following lines, which
+-- is not fixed (it varies with speed and angle of last turn)
+    theArc = maybeToList $ do
+        (hp,hv) <- safeHead pvs
+        r <- safeHead xs
+        return $ color (snd $ last lpairs) $ uncurry translate hp 
+            $ arc (argV hv - pi/2) (argV hv + pi/2) $ r * magV hv
+    cols = map (flip withAlpha white) [0,0.05..]
+    lpairs = zip (reverse lps) cols
     pvs = _pjPoints pj
     t = _pjTimer pj
-    xs = drop (10 - t) [1,1.2..]
+    xs = take t $ drop (20 - t) [1,1.2..]
     lps = zipWith f pvs xs
     rps = zipWith g pvs xs
-    f (p,v) x = p -- +.+ x *.* vNormal v
-    g (p,v) x = p -- -.- x *.* vNormal v
+    f (p,v) x = p  +.+ x *.* vNormal v
+    g (p,v) x = p  -.- x *.* vNormal v
+
+safeHead :: [a] -> Maybe a
+safeHead (x:_) = Just x
+safeHead _ = Nothing
+
+maxT :: Int
+maxT = 20
 
 resetAttachmentID :: ItEffect
 resetAttachmentID = ItInvEffect f 0
   where
-    f _ cr invid w = w
+    f iteff cr invid w 
+        | _itEffectCounter iteff < 0 = w & pointToIt . itAttachment .~ Nothing
+        | otherwise = w & pointToIt . itEffect . itEffectCounter -~ 1
+      where
+        pointToIt = creatures . ix (_crID cr) . crInv . ix invid