Add new bullet trajectories

src/Dodge/Item/Weapon/ExtraEffect.hs

@@ -3,17 +3,20 @@
 Extra weapon effects, supplementing explicit use effects.
  -}
 module Dodge.Item.Weapon.ExtraEffect
-    (-- wpRecock
-     itemLaserScopeEffect
+    ( itemLaserScopeEffect
     , autoSonarEffect
     , autoRadarEffect
     , targetRBPress
+    , targetRBCreature
+    , targetCursor
+    , targetLaser
 --    , rbSetTarget
     ) where
 import Dodge.Data
 import Dodge.Base
 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
@@ -82,16 +85,35 @@ autoSonarEffect = ItInvEffect {_itInvEffect = f 50 ,_itEffectCounter = 0 }
     f t _ cr i w = w 
         & creatures . ix (_crID cr) . crInv . ix i . itEffect . itInvEffect .~ f (t-1)
 
-targetRBPress :: Targeting
-targetRBPress = TargetingOnHeld
+defaultTargeting :: Targeting
+defaultTargeting = TargetingOnHeld
     { _tgPos = Nothing
-    , _tgHeldUpdate = targetRBPressUpdate
-    , _tgDraw = targetRBPressDraw
+    , _tgUpdate = \_ _ _ -> id
+    , _tgDraw = \_ _ _ _ -> mempty
+    , _tgID = Nothing
+    , _tgActive = False
+    , _tgPoints = []
     }
-targetRBPressDraw :: Int -> Item -> Creature -> World -> Picture
-targetRBPressDraw _ it _ w = fromMaybe mempty $ do
+targetLaser :: Targeting
+targetLaser = defaultTargeting
+    & tgUpdate  .~ targetLaserUpdate
+    & tgDraw        .~ targetLaserDraw
+targetRBPress :: Targeting
+targetRBPress = defaultTargeting
+    & tgUpdate  .~ targetRBPressUpdate
+    & tgDraw    .~ targetSimpleDraw
+targetRBCreature :: Targeting
+targetRBCreature = defaultTargeting
+    & tgUpdate  .~ targetRBCreatureUpdate
+    & tgDraw    .~ targetRBCreatureDraw
+targetCursor :: Targeting
+targetCursor = defaultTargeting
+    & tgUpdate  .~ targetCursorUpdate
+    & tgDraw    .~ targetSimpleDraw
+targetSimpleDraw :: Int -> Item -> Creature -> World -> Picture
+targetSimpleDraw _ it _ w = fromMaybe mempty $ do
     mwp <- it ^? itTargeting . tgPos . _Just
-    return $ setLayer 1 $ color red $ onLayer InvLayer $ uncurryV translate mwp 
+    return $ setLayer 5 $ color red $ onLayer InvLayer $ uncurryV translate mwp 
         $ rotate (_cameraRot w)
         $ pictures
             [line [V2   x  x, V2 (-x) (-x)]
@@ -100,8 +122,67 @@ targetRBPressDraw _ it _ w = fromMaybe mempty $ do
   where
     x = 5 / _cameraZoom w
 
+targetRBCreatureDraw :: Int -> Item -> Creature -> World -> Picture
+targetRBCreatureDraw _ it _ w = fromMaybe mempty $ do
+    mwp <- it ^? itTargeting . tgPos . _Just
+    return $ setLayer 5 $ color thecolor $ onLayer InvLayer $ uncurryV translate mwp 
+        $ rotate (_cameraRot w)
+        $ pictures
+            [line [V2   x  x, V2 (-x) (-x)]
+            ,line [V2 (-x) x, V2   x  (-x)]
+            ]
+  where
+    x = 5 / _cameraZoom w
+    thecolor | _tgActive $ _itTargeting it = red
+        | otherwise = blue
+
+targetCursorUpdate :: Item -> Creature -> World -> Targeting -> Targeting
+targetCursorUpdate _ _ w t
+    | SDL.ButtonRight `S.member` _mouseButtons w = t
+        & tgPos . _Just .~ mouseWorldPos w
+        & tgActive .~ True
+    | otherwise = t & tgPos %~ const Nothing
+        & tgActive .~ False
+
 targetRBPressUpdate :: Item -> Creature -> World -> Targeting -> Targeting
 targetRBPressUpdate _ _ w t
     | SDL.ButtonRight `S.member` _mouseButtons w = t
         & tgPos %~ maybe (Just $ mouseWorldPos w) Just
+        & tgActive .~ True
     | otherwise = t & tgPos %~ const Nothing
+        & tgActive .~ False
+
+targetRBCreatureUpdate :: Item -> Creature -> World -> Targeting -> Targeting
+targetRBCreatureUpdate _ _ w t
+    | SDL.ButtonRight `S.member` _mouseButtons w = t & updatePos
+        & tgActive .~ True
+    | otherwise = t & tgID .~ fmap _crID (creatureNearPoint mwp w)
+        & updatePos
+        & tgActive .~ False
+  where
+    mwp = mouseWorldPos w
+    updatePos t' = t' & tgPos .~ posFromMaybeID (_tgID t')
+    posFromMaybeID Nothing = Nothing
+    posFromMaybeID (Just i) = w ^? creatures . ix i . crPos
+
+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
+        ]
+
+targetLaserUpdate :: Item -> Creature -> World -> Targeting -> Targeting
+targetLaserUpdate _ cr w t
+    | SDL.ButtonRight `S.member` _mouseButtons w = t
+        & tgPos .~ fmap fst mp
+        & tgPoints .~ ps ++ [sp]
+        & tgActive .~ True
+    | otherwise = t & tgPos %~ const Nothing
+        & tgPoints .~ []
+        & tgActive .~ False
+  where
+    (mp, ps) = reflectLaserAlong 0.2 [] sp ep w
+    sp = _crPos cr +.+ 15 *.* unitVectorAtAngle (_crDir cr)
+    ep = sp +.+ 1000 *.* normalizeV (mouseWorldPos w -.- sp)