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.Creature.Test
import Dodge.WorldEvent.HelperParticle
import Picture
import Geometry.Vector
import Geometry.Data
import LensHelp

import Data.Maybe
import qualified Data.Set as S
import qualified SDL
{- | 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
    , _tgHeldUpdate = \_ _ w t -> (w,t)
    , _tgNotHeldUpdate = \_ _ w t -> (w,t)
    , _tgDraw = \_ _ _ _ -> mempty
    , _tgID = Nothing
    , _tgActive = False
    }
targetLaser :: Targeting
targetLaser = defaultTargeting
    & tgHeldUpdate  .~ targetLaserUpdate
targetRBPress :: Targeting
targetRBPress = defaultTargeting
    & tgHeldUpdate  .~ targetUpdateWith targetRBPressUpdate
    & tgDraw    .~ targetSimpleDraw
targetRBCreature :: Targeting
targetRBCreature = defaultTargeting
    & tgHeldUpdate  .~ targetUpdateWith targetRBCreatureUpdate
    & tgNotHeldUpdate  .~ targetUpdateWith 
        (const ((tgID .~ Nothing) . (tgPos .~ Nothing) . (tgActive .~ False)))
--        undefined
    & tgDraw    .~ targetRBCreatureDraw
targetCursor :: Targeting
targetCursor = defaultTargeting
    & tgHeldUpdate  .~ targetUpdateWith targetCursorUpdate
    & tgDraw    .~ targetSimpleDraw
targetSimpleDraw :: Int -> Item -> Creature -> Configuration -> World -> Picture
targetSimpleDraw _ it _ cfig w = fromMaybe mempty $ do
    p <- it ^? itTargeting . tgPos . _Just
    return $ winScale cfig $ setLayer FixedCoordLayer $ color white 
        $ uncurryV translate (worldPosToScreen w p)
--        $ rotate (_cameraRot w)
        $ activeTargetCursorPic

targetRBCreatureDraw :: Int -> Item -> Creature -> Configuration -> World -> Picture
targetRBCreatureDraw _ it _ cfig w = fromMaybe mempty $ do
    p <- it ^? itTargeting . tgPos . _Just
    return $ winScale cfig $ setLayer FixedCoordLayer $ color white 
        $ uncurryV translate (worldPosToScreen w p)
--        $ rotate (_cameraRot w)
        $ thepic
  where
    thepic | _tgActive $ _itTargeting it = activeTargetCursorPic
        | otherwise = targetCursorPic

activeTargetCursorPic :: Picture
activeTargetCursorPic = pictures
    [rotate a $ line [V2 15 0,V2 10 0] <> targCorner | a <- [0,0.5*pi,pi,1.5*pi]]

targetCursorPic :: Picture
targetCursorPic = pictures
    [rotate a targCorner | a <- [0,0.5*pi,pi,1.5*pi]]
targCorner :: Picture
targCorner = pictures
    [line [V2   x  x, V2 x (x-y)]
    ,line [V2   x  x, V2 (x-y) x]
    ]
  where
    x = 10
    y = 5

targetUpdateWith :: (World -> Targeting -> Targeting)
    -> Item -> Creature -> World -> Targeting -> (World,Targeting)
targetUpdateWith f _ _ w t = (w, f w t)

targetCursorUpdate :: 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 :: 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 :: World -> Targeting -> Targeting
targetRBCreatureUpdate w t
    | SDL.ButtonRight `S.member` _mouseButtons w && isJust (t ^? tgID . _Just)
                = t & updatePos
        & tgActive .~ True
    | otherwise = t & tgID .~ fmap _crID (creatureNearPointI 3 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

targetLaserUpdate :: Item -> Creature -> World -> Targeting -> (World,Targeting)
targetLaserUpdate it cr w t
    | crIsAiming cr = (addLaserPic w,t
        & tgPos    .~ fmap fst mp
        & tgActive .~ True
        )
    | otherwise = (w,t & tgPos %~ const Nothing
        & tgActive .~ False
        )
  where
    (mp, ps) = reflectLaserAlong 0.2 [] sp ep w
    sp = _crPos cr +.+ 15 *.* unitVectorAtAngle (_crDir cr)
    ep = sp +.+ 5000 *.* normalizeV (mouseWorldPos w -.- sp)
    addLaserPic = instantParticles .:~ Particle
        { _ptDraw = const $ setLayer BloomNoZWrite $ pictures
            [ setDepth 19   . color (brightX 0 0.5 col) $ thickLine 5 (sp:ps)
            , setDepth 19.5 . color (brightX 5 1 col)  $ thickLine 1  (sp:ps)
            ]
        , _ptUpdate = ptSimpleTime 1
        }
    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) blue red