Refactor, try to limit dependencies
This commit is contained in:
@@ -1,95 +1,87 @@
|
||||
--{-# LANGUAGE BangPatterns #-}
|
||||
|
||||
{- |
|
||||
Extra weapon effects, supplementing explicit use effects.
|
||||
-}
|
||||
module Dodge.Item.Weapon.ExtraEffect
|
||||
(-- itemLaserScopeEffect
|
||||
autoSonarEffect
|
||||
, autoEffect
|
||||
, autoRadarEffect
|
||||
, targetRBPress
|
||||
, targetRBCreature
|
||||
, targetCursor
|
||||
, targetLaser
|
||||
, targetLaserUpdate
|
||||
, targetUpdateWith
|
||||
, targetRBPressUpdate
|
||||
, targetRBCreatureUp
|
||||
, targetCursorUpdate
|
||||
-- , rbSetTarget
|
||||
) where
|
||||
import Dodge.Zoning.Creature
|
||||
import FoldableHelp
|
||||
import Dodge.Data
|
||||
import Dodge.Base
|
||||
import Dodge.RadarSweep
|
||||
import Dodge.SoundLogic
|
||||
import Dodge.Item.Weapon.LaserPath
|
||||
-}
|
||||
module Dodge.Item.Weapon.ExtraEffect (
|
||||
-- itemLaserScopeEffect
|
||||
autoSonarEffect,
|
||||
autoEffect,
|
||||
autoRadarEffect,
|
||||
targetLaserUpdate,
|
||||
targetUpdateWith,
|
||||
targetRBPressUpdate,
|
||||
targetRBCreatureUp,
|
||||
targetCursorUpdate,
|
||||
-- , rbSetTarget
|
||||
) where
|
||||
|
||||
--import Dodge.Item.Attachment.Data
|
||||
import Dodge.Creature.Test
|
||||
import Picture
|
||||
import Geometry.Vector
|
||||
import LensHelp
|
||||
import Sound.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 (_eqParams (_eqEq $ _itUse itm)) < 1 = eff itm cr w
|
||||
& cWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID $ _itLocation itm)
|
||||
. itUse . eqEq . eqParams . eparamInt .~ t
|
||||
& soundStart OnceSound (_crPos cr) sid Nothing
|
||||
| otherwise = w
|
||||
& cWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID $ _itLocation itm)
|
||||
. itUse . eqEq . eqParams . eparamInt -~ 1
|
||||
| _eparamInt (_eeParams (_equipEffect $ _itUse itm)) < 1 =
|
||||
eff itm cr w
|
||||
& cWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID $ _itLocation itm)
|
||||
. itUse
|
||||
. equipEffect
|
||||
. eeParams
|
||||
. eparamInt
|
||||
.~ t
|
||||
& soundStart OnceSound (_crPos cr) sid Nothing
|
||||
| otherwise =
|
||||
w
|
||||
& cWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID $ _itLocation itm)
|
||||
. itUse
|
||||
. equipEffect
|
||||
. eeParams
|
||||
. eparamInt
|
||||
-~ 1
|
||||
|
||||
{- | Automatically send out radar pulses that detect walls. -}
|
||||
-- | 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. -}
|
||||
|
||||
-- | Automatically send out sonar pulses that detect creatures.
|
||||
autoSonarEffect :: Item -> Creature -> World -> World
|
||||
autoSonarEffect = autoEffect (const (aRadarPulse ObCreature)) 50 click1S
|
||||
defaultTargeting :: Targeting
|
||||
defaultTargeting = Targeting
|
||||
{ _tgPos = Nothing
|
||||
, _tgUpdate = NoTargetUpdate
|
||||
, _tgDraw = NoTargetDraw
|
||||
, _tgID = Nothing
|
||||
, _tgActive = False
|
||||
}
|
||||
targetLaser :: Targeting
|
||||
targetLaser = defaultTargeting
|
||||
& tgUpdate .~ TargetLaserUpdate
|
||||
targetRBPress :: Targeting
|
||||
targetRBPress = defaultTargeting
|
||||
& tgUpdate .~ TargetRBPressUpdate
|
||||
& tgDraw .~ SimpleDrawTarget
|
||||
targetRBCreature :: Targeting
|
||||
targetRBCreature = defaultTargeting
|
||||
& tgUpdate .~ TargetRBCreatureUpdate
|
||||
& tgDraw .~ TargetRBCreatureDraw
|
||||
|
||||
targetCursor :: Targeting
|
||||
targetCursor = defaultTargeting
|
||||
& tgUpdate .~ TargetCursorUpdate
|
||||
& tgDraw .~ SimpleDrawTarget
|
||||
|
||||
|
||||
targetRBCreatureUp :: Item -> Creature -> World -> Targeting -> (World, Targeting)
|
||||
targetRBCreatureUp it cr w t
|
||||
| not $ _itIsHeld it = (w, t
|
||||
& tgID .~ Nothing
|
||||
& tgPos .~ Nothing
|
||||
& tgActive .~ False
|
||||
| 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 )
|
||||
&& 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
|
||||
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')
|
||||
@@ -100,52 +92,67 @@ targetRBCreatureUp it cr w t
|
||||
cpos <- w ^? cWorld . 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
|
||||
targetUpdateWith ::
|
||||
(World -> Targeting -> Targeting) ->
|
||||
Item ->
|
||||
Creature ->
|
||||
World ->
|
||||
Targeting ->
|
||||
(World, Targeting)
|
||||
targetUpdateWith f it _ w t
|
||||
| _itIsHeld it = (w, f w t)
|
||||
| otherwise = (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
|
||||
| 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
|
||||
| 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 :: Item -> Creature -> World -> Targeting -> (World, Targeting)
|
||||
targetLaserUpdate _ cr w t
|
||||
| crIsAiming cr = (addLaserPic w,t
|
||||
& tgPos .~ fmap fst mp
|
||||
& tgActive .~ True
|
||||
| crIsAiming cr =
|
||||
( addLaserPic w
|
||||
, t
|
||||
& tgPos .~ fmap fst mp
|
||||
& tgActive .~ True
|
||||
)
|
||||
| otherwise = (w,t & tgPos %~ const Nothing
|
||||
& tgActive .~ False
|
||||
| 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 . lasers .:~ LaserStart
|
||||
{ _lpPhaseV = 1
|
||||
, _lpDir = _crDir cr
|
||||
, _lpPos = sp
|
||||
, _lpColor = col
|
||||
, _lpType = TargetLaser
|
||||
}
|
||||
addLaserPic =
|
||||
cWorld . 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
|
||||
-- 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
|
||||
|
||||
Reference in New Issue
Block a user