146 lines
4.2 KiB
Haskell
146 lines
4.2 KiB
Haskell
module Dodge.Item.Weapon.Booster
|
|
( boosterGun
|
|
) where
|
|
import Dodge.Data
|
|
import Dodge.Base
|
|
import Dodge.Zone
|
|
import Dodge.Base.Collide
|
|
import Dodge.Default.Weapon
|
|
import Geometry
|
|
import qualified IntMapHelp as IM
|
|
import Dodge.Picture.Layer
|
|
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 *.* safeNormalizeV (mouseWorldPos w -.- cpos)
|
|
mayp2 = reflectPointWalls cpos p1 $ wallsAlongLine cpos p1 w
|
|
|
|
boostSelfL
|
|
:: Float -- ^ boost amount
|
|
-> Creature
|
|
-> Int -- ^ item inventory id
|
|
-> World
|
|
-> World
|
|
boostSelfL x cr invid w = case boostPoint x cr w of
|
|
Left p -> crEff p (wpLoadedAmmo .~ 0)
|
|
Right p -> crEff p (wpLoadedAmmo -~ 1)
|
|
where
|
|
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)
|
|
)
|
|
|
|
boostSelf
|
|
:: Float -- ^ boost amount
|
|
-> Creature
|
|
-> World
|
|
-> World
|
|
boostSelf x cr = boostSelfL x cr (_crInvSel cr)
|
|
|
|
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 1 $ onLayer UPtLayer $ 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"
|
|
, _itIdentity = Blinker
|
|
, _wpMaxAmmo = 100
|
|
, _wpLoadedAmmo = 100
|
|
, _wpReloadTime = 20
|
|
, _wpReloadState = 0
|
|
, _itUseRate = 0
|
|
, _itUseTime = 0
|
|
, _itUse = \_ -> boostSelf 10
|
|
, _itLeftClickUse = Just $ boostSelfL 10
|
|
, _wpSpread = 0.05
|
|
, _wpRange = 20
|
|
, _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-2,-2),(-2,2),(2,2),(2,0),(0,0),(0,-2)]
|
|
, _itAimingSpeed = 1
|
|
, _itAimingRange = 0
|
|
, _itEffect = resetAttachmentID
|
|
}
|
|
resetAttachmentID :: ItEffect
|
|
resetAttachmentID = ItInvEffect f 0
|
|
where
|
|
f iteff cr invid w
|
|
| _itEffectCounter iteff < 0 = w & pointToIt . itAttachment .~ NoItAttachment
|
|
| otherwise = w & pointToIt . itEffect . itEffectCounter -~ 1
|
|
where
|
|
pointToIt = creatures . ix (_crID cr) . crInv . ix invid
|