{-# 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.WorldEvent.ThingsHit import Dodge.Picture.Layer import Dodge.Creature.Test import Picture import Geometry.Vector import Geometry.Data import Data.Maybe import Control.Lens import qualified Data.IntMap.Strict as IM import qualified Data.Set as S import qualified SDL {- | Creates a laser scope and recocks the weapon. TODO add the laser scope! -} itemLaserScopeEffect :: ItEffect itemLaserScopeEffect = ItInvEffect {_itInvEffect = f ,_itEffectCounter = 0 } where moveHammerUp HammerDown = HammerReleased moveHammerUp !_ = HammerUp f _ cr invid w | invid == _crInvSel cr && crIsAiming' cr = w & particles %~ (:) (makeLaserScope sp ep reloadFrac) & creatures . ix (_crID cr) . crInv . ix invid . itUse . useHammer . hammerPosition %~ moveHammerUp | otherwise = w where p = _crPos cr d = _crDir cr r = _crRad cr sp = p +.+ (r + 3) *.* unitVectorAtAngle d xp = sp +.+ 3000 *.* unitVectorAtAngle d ep = case listToMaybe $ thingsHitLongLine sp xp w of Just (pos,_) -> pos Nothing -> xp --glowPoint = case listToMaybe $ thingsHitLongLine sp xp w of -- Just (pos,E3x2 wl) -> pos +.+ 2 *.* wallNormal wl -- _ -> ep -.- 2 *.* unitVectorAtAngle d wpammo = _itConsumption $ (cr ^. crInv) IM.! invid reloadFrac | _ammoLoaded wpammo == 0 = 1 | otherwise = case _reloadState wpammo of Just' rs -> fromIntegral rs / fromIntegral (_reloadTime wpammo) Nothing' -> 1 --col = mixColors reloadFrac (1-reloadFrac) red green {- | 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 , _tgUpdate = \_ _ _ -> id , _tgDraw = \_ _ _ _ -> mempty , _tgID = Nothing , _tgActive = False , _tgPoints = [] } targetLaser :: Targeting targetLaser = defaultTargeting & tgUpdate .~ targetLaserUpdate & tgDraw .~ targetLaserDraw targetRBPress :: Targeting targetRBPress = defaultTargeting & tgUpdate .~ targetRBPressUpdate & tgDraw .~ targetSimpleDraw targetRBCreature :: Targeting targetRBCreature = defaultTargeting & tgUpdate .~ targetRBCreatureUpdate & tgDraw .~ targetRBCreatureDraw targetCursor :: Targeting targetCursor = defaultTargeting & tgUpdate .~ targetCursorUpdate & tgDraw .~ targetSimpleDraw targetSimpleDraw :: Int -> Item -> Creature -> World -> Picture targetSimpleDraw _ it _ w = fromMaybe mempty $ do mwp <- it ^? itTargeting . tgPos . _Just return $ setLayer 5 $ color red $ onLayer InvLayer $ uncurryV translate mwp $ rotate (_cameraRot w) $ pictures [line [V2 x x, V2 (-x) (-x)] ,line [V2 (-x) x, V2 x (-x)] ] where x = 5 / _cameraZoom w targetRBCreatureDraw :: Int -> Item -> Creature -> World -> Picture targetRBCreatureDraw _ it _ w = fromMaybe mempty $ do mwp <- it ^? itTargeting . tgPos . _Just return $ setLayer 5 $ color thecolor $ onLayer InvLayer $ uncurryV translate mwp $ rotate (_cameraRot w) $ pictures [line [V2 x x, V2 (-x) (-x)] ,line [V2 (-x) x, V2 x (-x)] ] where x = 5 / _cameraZoom w thecolor | _tgActive $ _itTargeting it = red | otherwise = blue targetCursorUpdate :: Item -> Creature -> 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 :: Item -> Creature -> 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 :: Item -> Creature -> World -> Targeting -> Targeting targetRBCreatureUpdate _ _ w t | SDL.ButtonRight `S.member` _mouseButtons w = t & updatePos & tgActive .~ True | otherwise = t & tgID .~ fmap _crID (creatureNearPoint 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 targetLaserDraw :: Int -> Item -> Creature -> World -> Picture targetLaserDraw _ it _ _ = fromMaybe mempty $ do ps <- it ^? itTargeting . tgPoints return $ setLayer 1 $ pictures [ setDepth 19 . color (brightX 0 0.5 red) $ thickLine 5 ps , setDepth 19.5 . color (brightX 5 1 red) $ thickLine 1 ps ] targetLaserUpdate :: Item -> Creature -> World -> Targeting -> Targeting targetLaserUpdate _ cr w t | SDL.ButtonRight `S.member` _mouseButtons w = t & tgPos .~ fmap fst mp & tgPoints .~ ps ++ [sp] & tgActive .~ True | otherwise = t & tgPos %~ const Nothing & tgPoints .~ [] & tgActive .~ False where (mp, ps) = reflectLaserAlong 0.2 [] sp ep w sp = _crPos cr +.+ 15 *.* unitVectorAtAngle (_crDir cr) ep = sp +.+ 1000 *.* normalizeV (mouseWorldPos w -.- sp)