--{-# 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