Cleanup, work towards unifying spayguns

src/Dodge/Item/Weapon/ExtraEffect.hs

@@ -1,10 +1,10 @@
-{-# LANGUAGE BangPatterns #-}
+--{-# LANGUAGE BangPatterns #-}
 {- |
 Extra weapon effects, supplementing explicit use effects.
  -}
 module Dodge.Item.Weapon.ExtraEffect
-    ( itemLaserScopeEffect
-    , autoSonarEffect
+    (-- itemLaserScopeEffect
+     autoSonarEffect
     , autoRadarEffect
     , targetRBPress
     , targetRBCreature
@@ -14,11 +14,10 @@ module Dodge.Item.Weapon.ExtraEffect
     ) where
 import Dodge.Data
 import Dodge.Base
-import Dodge.Item.Weapon.Decoration
+--import Dodge.Item.Weapon.Decoration
 import Dodge.Item.Weapon.UseEffect
 import Dodge.Item.Weapon.LaserPath
 --import Dodge.Item.Attachment.Data
-import Dodge.WorldEvent.ThingsHit
 import Dodge.Picture.Layer
 import Dodge.Creature.Test
 import Picture
@@ -27,43 +26,8 @@ import Geometry.Data
 
 import Data.Maybe
 import Control.Lens
-import qualified Data.IntMap.Strict as IM
 import qualified Data.Set as S
 import qualified SDL
-{- |
-Creates a laser scope and recocks the weapon.
-TODO add the laser scope!
- -}
-itemLaserScopeEffect :: ItEffect
-itemLaserScopeEffect 
-    = ItInvEffect {_itInvEffect = f ,_itEffectCounter = 0 }
-  where 
-    moveHammerUp HammerDown = HammerReleased
-    moveHammerUp !_          = HammerUp
-    f _ cr invid w 
-        | invid == _crInvSel cr && crIsAiming' cr = w 
-            & particles %~ (:) (makeLaserScope sp ep reloadFrac)
-            & creatures . ix (_crID cr) . crInv . ix invid . itUse . useHammer . hammerPosition %~ moveHammerUp
-        | otherwise = w
-      where
-        p = _crPos cr
-        d = _crDir cr
-        r = _crRad cr
-        sp = p +.+ (r + 3) *.* unitVectorAtAngle d
-        xp = sp +.+ 3000 *.* unitVectorAtAngle d
-        ep = case listToMaybe $ thingsHitLongLine sp xp w of
-                Just (pos,_) -> pos
-                Nothing -> xp
-        --glowPoint = case listToMaybe $ thingsHitLongLine sp xp w of
-        --        Just (pos,E3x2 wl) -> pos +.+ 2 *.* wallNormal wl
-        --        _ -> ep -.- 2 *.* unitVectorAtAngle d
-        wpammo = _itConsumption $ (cr ^. crInv) IM.! invid
-        reloadFrac 
-            | _ammoLoaded wpammo == 0 = 1
-            | otherwise = case _reloadState wpammo of
-                Just' rs -> fromIntegral rs / fromIntegral (_reloadTime wpammo)
-                Nothing' -> 1
-        --col = mixColors reloadFrac (1-reloadFrac) red green
 {- | Automatically send out radar pulses that detect walls.  -}
 autoRadarEffect :: ItEffect
 autoRadarEffect = ItInvEffect {_itInvEffect = f 50 ,_itEffectCounter = 0 }
@@ -97,7 +61,7 @@ defaultTargeting = TargetingOnHeld
 targetLaser :: Targeting
 targetLaser = defaultTargeting
     & tgUpdate  .~ targetLaserUpdate
-    & tgDraw        .~ targetLaserDraw
+    & tgDraw    .~ targetLaserDraw
 targetRBPress :: Targeting
 targetRBPress = defaultTargeting
     & tgUpdate  .~ targetRBPressUpdate
@@ -170,15 +134,22 @@ targetLaserDraw :: Int -> Item -> Creature -> World -> Picture
 targetLaserDraw _ it _ _ = fromMaybe mempty $ do
     ps <- it ^? itTargeting . tgPoints
     return $ setLayer 1 $ pictures
-        [ setDepth 19   . color (brightX 0 0.5 red) $ thickLine 5 ps
-        , setDepth 19.5 . color (brightX 5 1 red)  $ thickLine 1  ps
+        [ setDepth 19   . color (brightX 0 0.5 col) $ thickLine 5 ps
+        , setDepth 19.5 . color (brightX 5 1 col)  $ thickLine 1  ps
         ]
-
+  where
+    wpammo = _itConsumption it
+    reloadFrac 
+        | _ammoLoaded wpammo == 0 = 1
+        | otherwise = case _reloadState wpammo of
+            Just' rs -> fromIntegral rs / fromIntegral (_reloadTime wpammo)
+            Nothing' -> 1
+    col = mixColors reloadFrac (1-reloadFrac) red green
 targetLaserUpdate :: Item -> Creature -> World -> Targeting -> Targeting
 targetLaserUpdate _ cr w t
-    | SDL.ButtonRight `S.member` _mouseButtons w = t
-        & tgPos .~ fmap fst mp
-        & tgPoints .~ ps ++ [sp]
+    | crIsAiming cr = t
+        & tgPos    .~ fmap fst mp
+        & tgPoints .~ sp:ps
         & tgActive .~ True
     | otherwise = t & tgPos %~ const Nothing
         & tgPoints .~ []