--{-# 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 qualified FoldlHelp as L --import Data.Bifunctor import Data.Maybe --import qualified Control.Foldl as L 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 -> Item -> Creature -> World -> World f 0 itm cr w = aRadarPulse cr w & creatures . ix (_crID cr) . crInv . ix (fromJust $ _itInvPos itm) . itEffect . itInvEffect .~ f 100 f t itm cr w = w & creatures . ix (_crID cr) . crInv . ix (fromJust $ _itInvPos itm) . itEffect . itInvEffect .~ f (t-1) {- | Automatically send out sonar pulses that detect creatures. -} autoSonarEffect :: ItEffect autoSonarEffect = ItInvEffect {_itInvEffect = f ,_itEffectCounter = 50 } where f :: Item -> Creature -> World -> World f itm cr w | _itEffectCounter (_itEffect itm) == 0 = aSonarPulse cr w & decreasecounter | otherwise = decreasecounter w where decreasecounter = creatures . ix (_crID cr) . crInv . ix (fromJust $ _itInvPos itm) . itEffect . itEffectCounter %~ (\i -> (i - 1) `mod` 50) 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) -> Int -> 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 :: Int -> Item -> Creature -> Configuration -> World -> Picture targetSimpleDraw = targetDraw $ const activeTargetCursorPic 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 `S.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 = L.fold (L.prefilter (canseepos . _crPos) $ L.minimumOn (dist mwp . _crPos)) $ creaturesNearPointI 3 mwp 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 :: Int -> 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 `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 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