loop/src/Dodge/Item/Weapon/ExtraEffect.hs

{-# LANGUAGE BangPatterns #-}
{- |
Extra weapon effects, supplementing explicit use effects.
 -}
module Dodge.Item.Weapon.ExtraEffect
    ( 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
import Dodge.Creature.Test
import Picture
import Geometry.Vector
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 }
  where 
    f :: Int -> ItEffect -> Creature -> Int -> World -> World
    f 0 _ cr i w = aRadarPulse cr w 
        & creatures . ix (_crID cr) . crInv . ix i 
                                     . itEffect . itInvEffect .~ f 100
    f t _ cr i w = w 
        & creatures . ix (_crID cr) . crInv . ix i 
                                     . itEffect . itInvEffect .~ f (t-1)
{- | Automatically send out sonar pulses that detect creatures.  -}
autoSonarEffect :: ItEffect
autoSonarEffect = ItInvEffect {_itInvEffect = f 50 ,_itEffectCounter = 0 }
  where 
    f :: Int -> ItEffect -> Creature -> Int -> World -> World
    f 0 _ cr i w = aSonarPulse cr w 
        & creatures . ix (_crID cr) . crInv . ix i . itEffect . itInvEffect .~ f 140
    f t _ cr i w = w 
        & creatures . ix (_crID cr) . crInv . ix i . itEffect . itInvEffect .~ f (t-1)

defaultTargeting :: Targeting
defaultTargeting = TargetingOnHeld
    { _tgPos = Nothing
    , _tgUpdate = \_ _ _ -> id
    , _tgDraw = \_ _ _ _ -> mempty
    , _tgID = Nothing
    , _tgActive = False
    , _tgPoints = []
    }
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 5 $ color red $ 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

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)