--{-# LANGUAGE BangPatterns #-}
{- |
Extra weapon effects, supplementing explicit use effects.
 -}
module Dodge.Item.Weapon.ExtraEffect
    (-- itemLaserScopeEffect
     autoSonarEffect
    , autoEffect
    , autoRadarEffect
    , targetRBPress
    , targetRBCreature
    , targetCursor
    , targetLaser
    , targetDistanceDraw
--    , rbSetTarget
    ) where
import Dodge.Data
import Dodge.Base
import Dodge.Zone
import Dodge.SoundLogic
--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 Sound.Data
import ShortShow

import qualified Data.Map.Strict as M
--import Data.Bifunctor
import Data.Maybe
--import qualified Control.Foldl as L
import qualified Streaming.Prelude as S
import qualified SDL
autoEffect :: (Item -> Creature -> World -> World) -> Int -> SoundID -> Item -> Creature -> World -> World
autoEffect eff t sid itm cr w
    | _eparamInt (_eqParams (_eqEq $ _itUse itm)) < 1 = eff itm cr w 
        & creatures . ix (_crID cr) . crInv . ix (_ipInvID $ _itPos itm)
                                     . itUse . eqEq . eqParams . eparamInt .~ t
       & soundStart OnceSound (_crPos cr) sid Nothing
    | otherwise = w 
        & creatures . ix (_crID cr) . crInv . ix (_ipInvID $ _itPos itm)
                                     . itUse . eqEq . eqParams . eparamInt -~ 1

{- | Automatically send out radar pulses that detect walls.  -}
autoRadarEffect :: Item -> Creature -> World -> World
autoRadarEffect = autoEffect (const aWallPulse) 100 click1S
{- | Automatically send out sonar pulses that detect creatures.  -}
autoSonarEffect :: Item -> Creature -> World -> World
autoSonarEffect = autoEffect (const aSonarPulse) 50 click1S
defaultTargeting :: Targeting
defaultTargeting = Targeting
    { _tgPos = Nothing
    , _tgUpdate = \_ _ w t -> (w,t)
    , _tgDraw = \_ _ _ _ -> mempty
    , _tgID = Nothing
    , _tgActive = False
    }
targetLaser :: Targeting
targetLaser = defaultTargeting
    & tgUpdate  .~ targetLaserUpdate
targetRBPress :: Targeting
targetRBPress = defaultTargeting
    & tgUpdate  .~ targetUpdateWith targetRBPressUpdate
    & tgDraw    .~ targetSimpleDraw
targetRBCreature :: Targeting
targetRBCreature = defaultTargeting
    & tgUpdate  .~ targetRBCreatureUp 
    & tgDraw    .~ targetRBCreatureDraw

targetCursor :: Targeting
targetCursor = defaultTargeting
    & tgUpdate  .~ targetUpdateWith targetCursorUpdate
    & tgDraw    .~ targetSimpleDraw

targetDraw :: (Item -> Picture) -> Item -> Creature -> Configuration -> World -> Picture
targetDraw f it _ cfig w = fromMaybe mempty $ do
    p <- it ^? itTargeting . tgPos . _Just
    return $ winScale cfig 
        $ setLayer FixedCoordLayer 
        $ color white 
        $ uncurryV translate (worldPosToScreen w p)
        $ f it
targetSimpleDraw :: Item -> Creature -> Configuration -> World -> Picture
targetSimpleDraw = targetDraw $ const activeTargetCursorPic

targetDistanceDraw :: Item -> Creature -> Configuration -> World -> Picture
targetDistanceDraw itm _ cfig w = fromMaybe mempty $ do
    p <- itm ^? itTargeting . tgPos . _Just
    let p1 = worldPosToScreen w p
        mwp = mouseWorldPos w
        p2 = worldPosToScreen w mwp
        thecol = if dist p mwp > 100 then red else white
    return $ winScale cfig 
        $ setLayer FixedCoordLayer 
        $ color thecol 
        $ line [p1, p2]
            <> transMidLine p1 p2 (scale 0.1 0.1 . text . shortShow $ dist p mwp)

transMidLine :: Point2 -> Point2 -> Picture -> Picture
transMidLine p1 p2 = translate 20 (f p1 p2) . uncurryV translate (0.5 *.* (p1 +.+ p2))
  where
    f (V2 x y) (V2 x' y') 
        | y > y' && x > x' = max (-10) (x'-x)
        | y > y' && x < x' = min 10 (x'-x)
        | x > x'    = min 10 (x-x')
        | otherwise = max (-10) (x-x')


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 w && isJust (t ^? tgID . _Just)
        && canSeeTarget = (w, t & updatePos
        & tgActive .~ True
        )
    | otherwise = (w, t & tgID .~ fmap _crID newtarg
        & updatePos
        & tgActive .~ False 
        )
  where
    newtarg = minStreamOn (dist mwp . _crPos)
        . S.filter (canseepos . _crPos)
        $ crsInsideCirc 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 ^? creatures . ix i . crPos
    canSeeTarget = fromMaybe False $ do
        cid <- t ^? tgID . _Just
        cpos <- w ^? creatures . ix cid . crPos
        Just $ hasLOS cpos (_crPos cr) w

targetRBCreatureDraw :: Item -> Creature -> Configuration -> World -> Picture
targetRBCreatureDraw = targetDraw thepic
  where
    thepic it | _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 it _ w t 
    | _itIsHeld it = (w, f w t)
    | otherwise    = (w,t)

targetCursorUpdate :: World -> Targeting -> Targeting
targetCursorUpdate w t
    | SDL.ButtonRight `M.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 `M.member` _mouseButtons 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, 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 
--        | _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