134 lines
3.9 KiB
Haskell
134 lines
3.9 KiB
Haskell
module Dodge.Item.Weapon.Booster
|
|
( boosterGun
|
|
) where
|
|
import Dodge.Data
|
|
import Dodge.Base
|
|
import Dodge.Zone
|
|
import Dodge.Default.Weapon
|
|
import Geometry
|
|
import qualified IntMapHelp as IM
|
|
import Picture
|
|
import ShapePicture
|
|
--import Shape
|
|
|
|
import Data.Maybe
|
|
import Control.Lens
|
|
{- | Move a creature towards the mouse position, with shockwave -}
|
|
boostPoint
|
|
:: Float -- ^ boost amount
|
|
-> Creature
|
|
-> World
|
|
-> Either Point2 Point2
|
|
boostPoint x cr w = case mayp2 of
|
|
Nothing -> Right p1
|
|
Just p2 -> Left $ mvPointTowardAtSpeed r cpos $ fst p2
|
|
where
|
|
cpos = _crPos cr
|
|
r = 1.5 * _crRad cr
|
|
p1 = cpos +.+ x *.* squashNormalizeV (mouseWorldPos w -.- cpos)
|
|
mayp2 = reflectPointWalls cpos p1 $ wallsAlongLine cpos p1 w
|
|
|
|
boostSelfL
|
|
:: Float -- ^ boost amount
|
|
-> Item
|
|
-> Creature
|
|
-> World
|
|
-> World
|
|
boostSelfL x itm cr w = case boostPoint x cr w of
|
|
Left p -> crEff p (itConsumption . ammoLoaded .~ 0)
|
|
Right p -> crEff p (itConsumption . ammoLoaded -~ 1)
|
|
where
|
|
invid = fromJust $ _itInvPos itm
|
|
cid = _crID cr
|
|
cpos = _crPos cr
|
|
r = _crRad cr
|
|
pid = fromMaybe (IM.newKey $ _props w)
|
|
(cr ^? crInv . ix invid . itAttachment . itInt)
|
|
crEff p ammoEff = addBoostShockwave pid p (r *.* normalizeV (p -.- cpos)) w
|
|
& creatures . ix cid %~
|
|
(crPos .~ p)
|
|
. (crInv . ix invid %~
|
|
ammoEff
|
|
. (itEffect . itEffectCounter .~ 1)
|
|
. (itAttachment .~ ItInt pid)
|
|
)
|
|
|
|
addBoostShockwave
|
|
:: Int
|
|
-> Point2
|
|
-> Point2
|
|
-> World
|
|
-> World
|
|
addBoostShockwave pjid p v w = w & props %~
|
|
IM.insertWith f pjid thePJ
|
|
where
|
|
thePJ = LinearShockwave
|
|
{ _prDraw = drawBoostShockwave
|
|
, _pjPos = p
|
|
, _pjID = pjid
|
|
, _pjUpdate = updateLinearShockwave
|
|
, _pjPoints = [(p,v)]
|
|
, _pjTimer = maxT
|
|
}
|
|
f newVal oldVal = newVal & pjPoints %~ (++ _pjPoints oldVal)
|
|
|
|
updateLinearShockwave :: Prop -> World -> World
|
|
updateLinearShockwave pj w
|
|
| t < 1 = w & props %~ IM.delete pjid
|
|
| otherwise = w & props . ix (_pjID pj) . pjTimer -~ 1
|
|
where
|
|
pjid = _pjID pj
|
|
t = _pjTimer pj
|
|
|
|
drawBoostShockwave :: Prop -> SPic
|
|
drawBoostShockwave pj = (,) mempty $ setLayer BloomLayer $ setDepth 20 $ pictures $
|
|
theArc ++
|
|
[ lineCol $ zip (reverse lps) $ map (`withAlpha` white) [0,0.05..]
|
|
, lineCol $ zip (reverse rps) $ map (`withAlpha` white) [0,0.05..]
|
|
]
|
|
where
|
|
-- drawing half a circle here is not perfect, a slightly smaller arc would fit
|
|
-- better, but this depends upon the angle formed by the following lines, which
|
|
-- is not fixed (it varies with speed and angle of last turn)
|
|
theArc = maybeToList $ do
|
|
(hp,hv) <- safeHead pvs
|
|
r <- safeHead xs
|
|
return $ color (snd $ last lpairs) $ uncurryV translate hp
|
|
$ arc (argV hv - pi/2) (argV hv + pi/2) $ r * magV hv
|
|
cols = map (`withAlpha` white) [0,0.05..]
|
|
lpairs = zip (reverse lps) cols
|
|
pvs = _pjPoints pj
|
|
t = _pjTimer pj
|
|
xs = take t $ drop (20 - t) [1,1.2..]
|
|
lps = zipWith f pvs xs
|
|
rps = zipWith g pvs xs
|
|
f (p,v) x = p +.+ x *.* vNormal v
|
|
g (p,v) x = p -.- x *.* vNormal v
|
|
|
|
maxT :: Int
|
|
maxT = 20
|
|
|
|
boosterGun :: Item
|
|
boosterGun = defaultGun
|
|
{ _itName = "BOOSTER"
|
|
, _itType = BOOSTER
|
|
, _itInvColor = cyan
|
|
, _itConsumption = defaultAmmo
|
|
{ _ammoBaseMax = 100
|
|
, _ammoLoaded = 100
|
|
, _reloadTime = 20
|
|
}
|
|
, _itUse = luseInstantNoH $ boostSelfL 10
|
|
, _itEffect = resetAttachmentID
|
|
}
|
|
resetAttachmentID :: ItEffect
|
|
resetAttachmentID = ItInvEffect f 0
|
|
where
|
|
f itm cr w
|
|
| _itEffectCounter iteff < 0 = w & pointToIt . itAttachment .~ NoItAttachment
|
|
| otherwise = w & pointToIt . itEffect . itEffectCounter -~ 1
|
|
where
|
|
iteff = _itEffect itm
|
|
invid = fromJust $ _itInvPos itm
|
|
pointToIt = creatures . ix (_crID cr) . crInv . ix invid
|