134 lines
4.7 KiB
Haskell
134 lines
4.7 KiB
Haskell
{-# LANGUAGE BangPatterns #-}
|
|
{- |
|
|
Extra weapon effects, supplementing explicit use effects.
|
|
-}
|
|
module Dodge.Item.Weapon.ExtraEffect
|
|
where
|
|
import Dodge.Data
|
|
import Dodge.Base
|
|
import Dodge.Item.Data
|
|
import Dodge.Item.Weapon.Decoration
|
|
import Dodge.Item.Weapon.UseEffect
|
|
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
|
|
{- |
|
|
Controls resetting a weapon, allows for non-continuous fire needing a button release. -}
|
|
wpRecock :: ItEffect
|
|
wpRecock = ItInvEffect
|
|
{_itInvEffect = f
|
|
,_itEffectCounter = 0
|
|
}
|
|
where
|
|
f _ cr i = creatures . ix (_crID cr) . crInv %~ IM.adjust fOnIt i
|
|
moveHammerUp HammerDown = HammerReleased
|
|
moveHammerUp HammerReleased = HammerUp
|
|
moveHammerUp HammerUp = HammerUp
|
|
moveHammerUp NoHammer = NoHammer
|
|
fOnIt it = it & itHammer %~ moveHammerUp
|
|
{- |
|
|
Special recock for the bezier gun.
|
|
Not sure of its purpose at this time... -}
|
|
bezierRecock :: ItEffect
|
|
bezierRecock = ItInvEffect
|
|
{_itInvEffect = f
|
|
,_itEffectCounter = 0
|
|
}
|
|
where
|
|
f _ cr i = creatures . ix (_crID cr) . crInv %~ IM.adjust fOnIt i
|
|
fOnIt it = case _itHammer it of
|
|
HammerDown -> it & itHammer .~ HammerUp
|
|
_ -> it & itAttachment .~ NoItAttachment
|
|
{- |
|
|
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 . itHammer %~ 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
|
|
it = (cr ^. crInv) IM.! invid
|
|
reloadFrac
|
|
| _wpLoadedAmmo it == 0 = 1
|
|
| otherwise = fromIntegral (_wpReloadState it) / fromIntegral (_wpReloadTime it)
|
|
--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)
|
|
|
|
rbSetTarget :: ItEffect
|
|
rbSetTarget = ItInvEffect
|
|
{_itInvEffect = setTarg
|
|
,_itEffectCounter = 0
|
|
}
|
|
where
|
|
setTarg :: ItEffect -> Creature -> Int -> World -> World
|
|
setTarg _ cr invid w
|
|
| _crInvSel cr /= invid = w
|
|
| SDL.ButtonRight `S.member` _mouseButtons w = w
|
|
& creatures . ix (_crID cr) . crInv . ix invid . itTargeting
|
|
%~ maybe (Just $ targetRBMousePos w) Just
|
|
| otherwise = w & creatures . ix (_crID cr) . crInv . ix invid . itTargeting .~ Nothing
|
|
|
|
targetRBMousePos
|
|
:: World
|
|
-> (World -> Maybe Point2, Int -> Item -> Creature -> World -> Picture)
|
|
targetRBMousePos w = (f, \_ _ _ w' -> cursorPic w')
|
|
where
|
|
f _ = Just mwp
|
|
mwp = mouseWorldPos w
|
|
cursorPic w' = setLayer 1 $ 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'
|