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

--{-# LANGUAGE BangPatterns #-}

{- |
Extra weapon effects, supplementing explicit use effects.
-}
module Dodge.Item.Weapon.ExtraEffect (
    -- itemLaserScopeEffect
    autoSonarEffect,
    autoEffect,
    autoRadarEffect,
    targetLaserUpdate,
    targetUpdateWith,
    targetRBPressUpdate,
    targetRBCreatureUp,
    targetCursorUpdate,
    --    , rbSetTarget
) where

--import Dodge.Item.Attachment.Data

import qualified Data.Map.Strict as M
import Data.Maybe
import Dodge.Base
import Dodge.Creature.Test
import Dodge.Data.World
import Dodge.Item.Weapon.LaserPath
import Dodge.RadarSweep
import Dodge.SoundLogic
import Dodge.Zoning.Creature
import FoldableHelp
import Geometry.Vector
import LensHelp
import Picture
import qualified SDL
import Sound.Data

autoEffect :: (Item -> Creature -> World -> World) -> Int -> SoundID -> Item -> Creature -> World -> World
autoEffect eff t sid itm cr w
    | _eparamInt (_eeParams (_equipEffect $ _itUse itm)) < 1 =
        eff itm cr w
            & cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID $ _itLocation itm)
                . itUse
                . equipEffect
                . eeParams
                . eparamInt
                .~ t
            & soundStart OnceSound (_crPos cr) sid Nothing
    | otherwise =
        w
            & cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID $ _itLocation itm)
                . itUse
                . equipEffect
                . eeParams
                . eparamInt
                -~ 1

-- | Automatically send out radar pulses that detect walls.
autoRadarEffect :: Item -> Creature -> World -> World
autoRadarEffect = autoEffect (const (aRadarPulse ObWall)) 100 click1S

-- | Automatically send out sonar pulses that detect creatures.
autoSonarEffect :: Item -> Creature -> World -> World
autoSonarEffect = autoEffect (const (aRadarPulse ObCreature)) 50 click1S



targetRBCreatureUp :: Item -> Creature -> World -> Targeting -> (World, Targeting)
targetRBCreatureUp it cr w t
    | not $ _itIsHeld it =
        ( w
        , t
            & tgID .~ Nothing
            & tgPos .~ Nothing
            & tgActive .~ False
        )
    | SDL.ButtonRight `M.member` _mouseButtons (_input w) && isJust (t ^? tgID . _Just)
        && canSeeTarget =
        (w, t & updatePos & tgActive .~ True)
    | otherwise = (w, t & tgID .~ fmap _crID newtarg & updatePos & tgActive .~ False)
  where
    newtarg =
        safeMinimumOn (dist mwp . _crPos)
            . filter (canseepos . _crPos)
            $ crsNearCirc mwp 40 w
    canseepos p = hasLOS (_crPos cr) p w
    mwp = mouseWorldPos w
    updatePos t' = t' & tgPos .~ posFromMaybeID (_tgID t')
    posFromMaybeID Nothing = Nothing
    posFromMaybeID (Just i) = w ^? cWorld . lWorld . creatures . ix i . crPos
    canSeeTarget = fromMaybe False $ do
        cid <- t ^? tgID . _Just
        cpos <- w ^? cWorld . lWorld . creatures . ix cid . crPos
        Just $ hasLOS cpos (_crPos cr) w

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

targetCursorUpdate :: World -> Targeting -> Targeting
targetCursorUpdate w t
    | SDL.ButtonRight `M.member` _mouseButtons (_input w) =
        t
            & tgPos . _Just .~ mouseWorldPos w
            & tgActive .~ True
    | otherwise =
        t & tgPos %~ const Nothing
            & tgActive .~ False

targetRBPressUpdate :: World -> Targeting -> Targeting
targetRBPressUpdate w t
    | SDL.ButtonRight `M.member` _mouseButtons (_input w) =
        t
            & tgPos %~ maybe (Just $ mouseWorldPos w) Just
            & tgActive .~ True
    | otherwise =
        t & tgPos %~ const Nothing
            & tgActive .~ False

targetLaserUpdate :: Item -> Creature -> World -> Targeting -> (World, Targeting)
targetLaserUpdate _ cr w t
    | crIsAiming cr =
        ( addLaserPic w
        , t
            & tgPos .~ fmap fst mp
            & tgActive .~ True
        )
    | otherwise =
        ( w
        , t & tgPos %~ const Nothing
            & tgActive .~ False
        )
  where
    (mp, _) = reflectLaserAlong 0.2 sp ep w
    sp = _crPos cr +.+ 15 *.* unitVectorAtAngle (_crDir cr)
    ep = sp +.+ 5000 *.* normalizeV (mouseWorldPos w -.- sp)
    addLaserPic =
        cWorld . lWorld . lasers
            .:~ LaserStart
                { _lpPhaseV = 1
                , _lpDir = _crDir cr
                , _lpPos = sp
                , _lpColor = col
                , _lpType = TargetLaser
                }
    --wpammo = _itConsumption it
    --    reloadFrac
    --        | _laLoaded wpammo == 0 = 1
    --        | otherwise = case _laTransfer wpammo of
    --            Transfer _ rs -> fromIntegral rs / fromIntegral (_laReloadTime wpammo)
    --            NoTransfer -> 1
    col = blue -- mixColors reloadFrac (1-reloadFrac) blue red