Prop reification/splitting
This commit is contained in:
@@ -8,9 +8,6 @@ import Dodge.Default.Weapon
|
||||
import Geometry
|
||||
import qualified IntMapHelp as IM
|
||||
import Picture
|
||||
import ShapePicture
|
||||
import ListHelp (safeHead)
|
||||
--import Shape
|
||||
|
||||
import Data.Maybe
|
||||
import Control.Lens
|
||||
@@ -60,51 +57,16 @@ addBoostShockwave
|
||||
-> Point2
|
||||
-> World
|
||||
-> World
|
||||
addBoostShockwave pjid p v w = w & props %~
|
||||
addBoostShockwave pjid p v w = w & linearShockwaves %~
|
||||
IM.insertWith f pjid thePJ
|
||||
where
|
||||
thePJ = LinearShockwave
|
||||
{ _prDraw = drawBoostShockwave
|
||||
, _prPos = p
|
||||
, _pjID = pjid
|
||||
, _pjUpdate = updateLinearShockwave
|
||||
, _pjPoints = [(p,v)]
|
||||
, _pjTimer = maxT
|
||||
{ _lwPos = p
|
||||
, _lwID = pjid
|
||||
, _lwPoints = [(p,v)]
|
||||
, _lwTimer = 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
|
||||
f newVal oldVal = newVal & lwPoints %~ (++ _lwPoints oldVal)
|
||||
|
||||
maxT :: Int
|
||||
maxT = 20
|
||||
|
||||
@@ -29,15 +29,8 @@ import Dodge.Base
|
||||
--import Dodge.Zone
|
||||
import Geometry
|
||||
import Picture
|
||||
import ShapePicture
|
||||
import LensHelp
|
||||
--import Dodge.RandomHelp
|
||||
--import MonadHelp
|
||||
|
||||
--import Data.Maybe
|
||||
--import Data.List (sortOn)
|
||||
--import System.Random
|
||||
--import Data.Tuple
|
||||
import qualified IntMapHelp as IM
|
||||
import qualified Data.Map.Strict as M
|
||||
--import Control.Monad.State
|
||||
@@ -353,8 +346,7 @@ dualRayAt bt itid w col dam phasev pos dir = basicBeamAt itid w col dam phasev p
|
||||
& bmType .~ bt
|
||||
|
||||
aTractorBeam :: Item -> Creature -> World -> World
|
||||
--aTractorBeam _ cr w = w & props %~ tractorBeamAt i spos outpos dir power
|
||||
aTractorBeam _ cr w = w & plNew props pjID (tractorBeamAt spos outpos dir power)
|
||||
aTractorBeam _ cr w = w & tractorBeams .:~ tractorBeamAt spos outpos dir power
|
||||
where
|
||||
cpos = _crPos cr
|
||||
spos = cpos +.+ (_crRad cr + 10) *.* unitVectorAtAngle dir
|
||||
@@ -363,71 +355,13 @@ aTractorBeam _ cr w = w & plNew props pjID (tractorBeamAt spos outpos dir power)
|
||||
outpos = fst $ collidePointWallsFilterStream (const True) cpos xpos w
|
||||
power = _attractionPower . _itParams $ _crInv cr IM.! crSel cr
|
||||
|
||||
tractorBeamAt :: Point2 -> Point2 -> Float -> Point2 -> Prop
|
||||
tractorBeamAt pos outpos dir power = ProjectileTimed
|
||||
{ _prPos = pos
|
||||
, _pjStartPos = outpos
|
||||
, _pjVel = d
|
||||
, _prDraw = tractorSPic
|
||||
, _pjID = 0
|
||||
, _pjUpdate = updateTractor
|
||||
, _pjTime = 10
|
||||
tractorBeamAt :: Point2 -> Point2 -> Float -> Point2 -> TractorBeam
|
||||
tractorBeamAt pos outpos dir power = TractorBeam
|
||||
{ _tbPos = pos
|
||||
, _tbStartPos = outpos
|
||||
, _tbVel = d
|
||||
, _tbTime = 10
|
||||
}
|
||||
where
|
||||
d = unitVectorAtAngle dir * power
|
||||
{- |
|
||||
The interaction of this with objects, walls etc needs more thought. -}
|
||||
updateTractor :: Prop -> World -> World
|
||||
updateTractor pj w
|
||||
| _pjTime pj <= 0 = w & props %~ IM.delete i
|
||||
| otherwise = w
|
||||
& props . ix i . pjTime -~ 1
|
||||
& creatures %~ IM.map (tractCr pullVel pos outpos)
|
||||
& floorItems %~ IM.map (tractFlIt pullVel pos outpos)
|
||||
where
|
||||
i = _pjID pj
|
||||
pullVel = _pjVel pj
|
||||
pos = _prPos pj
|
||||
outpos = _pjStartPos pj
|
||||
|
||||
tractFlIt :: Point2 -> Point2 -> Point2 -> FloorItem -> FloorItem
|
||||
tractFlIt q p1 outpos it
|
||||
| segOnCirc p1 outpos (_flItPos it) 10 = it & flItPos %~ tractorPullPos q p1
|
||||
| otherwise = it
|
||||
|
||||
tractCr :: Point2 -> Point2 -> Point2 -> Creature -> Creature
|
||||
tractCr q p1 outpos cr
|
||||
| segOnCirc p1 outpos (_crPos cr) 10 = cr & crPos %~ tractorPullPos q p1
|
||||
| otherwise = cr
|
||||
|
||||
tractorPullPos :: Point2 -> Point2 -> Point2 -> Point2
|
||||
tractorPullPos q p1 p = p -.- m *.* (0.3/ x' *.* q +.+ g y *.* p4)
|
||||
where
|
||||
x' = abs y + 1
|
||||
y = errorClosestPointOnLineParam 1 p1 p3 p
|
||||
m | dist p p1 < 350 = 1
|
||||
| otherwise = (400 - dist p p1) / 50
|
||||
g x | x > 5 = (10 - x) / 250
|
||||
| x > 1 = 0.02
|
||||
| x > -1 = x * 0.02
|
||||
| x > -5 = -0.02
|
||||
| otherwise = (x - 10) / 250
|
||||
--p4 = vNormal p5
|
||||
p4 = vNormal $ squashNormalizeV q
|
||||
p3 = p1 +.+ p4
|
||||
|
||||
tractorSPic :: Prop -> SPic
|
||||
tractorSPic pj = (,) mempty $ setLayer BloomNoZWrite $ setDepth 20 $ color (withAlpha 0.5 col) $ polygon
|
||||
[ spos -- not sure if this is anticlockwise...
|
||||
, spos +.+ size *.* (d +.+ n)
|
||||
, xpos +.+ size *.* n
|
||||
, xpos -.- size *.* n
|
||||
, spos +.+ size *.* (d -.- n)
|
||||
]
|
||||
where
|
||||
size = fromIntegral (_pjTime pj)
|
||||
spos = _prPos pj
|
||||
xpos = _pjStartPos pj
|
||||
d = squashNormalizeV $ spos -.- xpos
|
||||
n = vNormal d
|
||||
col = mixColors 0.5 0.5 white blue
|
||||
|
||||
@@ -1,15 +1,9 @@
|
||||
module Dodge.Item.Weapon.Grenade where
|
||||
import Dodge.Zoning.Wall
|
||||
import Dodge.Data
|
||||
import Dodge.Base
|
||||
import Dodge.SoundLogic
|
||||
import Picture
|
||||
import Geometry
|
||||
import ShapePicture
|
||||
import Shape
|
||||
import qualified IntMapHelp as IM
|
||||
|
||||
import Control.Lens
|
||||
|
||||
--grenade :: Item
|
||||
--grenade = Item
|
||||
@@ -40,27 +34,27 @@ import Control.Lens
|
||||
-- fuseTime = 50
|
||||
-- f x = 50 / fromIntegral x
|
||||
|
||||
moveGrenade :: Prop -> World -> World
|
||||
moveGrenade pj w
|
||||
| _pjTimer pj <= 0 = w
|
||||
& props %~ IM.delete pID
|
||||
& _pjPayload pj (_prPos (_props w IM.! pID))
|
||||
-- this should maybe
|
||||
-- be wallsAlongLine
|
||||
-- or something vvv
|
||||
| otherwise = case bounceBall 1 oldPos newPos 4 $ wlsNearPoint newPos w of
|
||||
Nothing -> w & props . ix pID %~ normalUpdate
|
||||
Just (p,v) -> w
|
||||
& soundStart (Tap 0) p tapQuietS Nothing
|
||||
& props . ix pID %~ ( ( prPos .~ p ) . ( pjTimer -~ 1 ) . (pjVel .~ v) )
|
||||
where
|
||||
pID = _pjID pj
|
||||
normalUpdate = (pjTimer -~ 1)
|
||||
. (pjZ %~ (max 0 . (+ _pjVelZ pj)))
|
||||
. (pjVelZ -~ 0.1)
|
||||
. ( prPos .~ newPos )
|
||||
oldPos = _prPos pj
|
||||
newPos = _pjVel pj +.+ oldPos
|
||||
--moveGrenade :: Prop -> World -> World
|
||||
--moveGrenade pj w
|
||||
-- | _pjTimer pj <= 0 = w
|
||||
-- & props %~ IM.delete pID
|
||||
-- & _pjPayload pj (_prPos (_props w IM.! pID))
|
||||
-- -- this should maybe
|
||||
-- -- be wallsAlongLine
|
||||
-- -- or something vvv
|
||||
-- | otherwise = case bounceBall 1 oldPos newPos 4 $ wlsNearPoint newPos w of
|
||||
-- Nothing -> w & props . ix pID %~ normalUpdate
|
||||
-- Just (p,v) -> w
|
||||
-- & soundStart (Tap 0) p tapQuietS Nothing
|
||||
-- & props . ix pID %~ ( ( prPos .~ p ) . ( pjTimer -~ 1 ) . (pjVel .~ v) )
|
||||
-- where
|
||||
-- pID = _pjID pj
|
||||
-- normalUpdate = (pjTimer -~ 1)
|
||||
-- . (pjZ %~ (max 0 . (+ _pjVelZ pj)))
|
||||
-- . (pjVelZ -~ 0.1)
|
||||
-- . ( prPos .~ newPos )
|
||||
-- oldPos = _prPos pj
|
||||
-- newPos = _pjVel pj +.+ oldPos
|
||||
|
||||
grenadePic :: Int -> SPic
|
||||
grenadePic time =
|
||||
@@ -72,9 +66,9 @@ grenadePic time =
|
||||
]
|
||||
)
|
||||
|
||||
grenadeDraw :: Float -> Prop -> SPic
|
||||
grenadeDraw dir prop = translateSPz (_pjZ prop) $ uncurryV translateSPf (_prPos prop)
|
||||
$ rotateSP dir $ grenadePic $ _pjTimer prop
|
||||
--grenadeDraw :: Float -> Prop -> SPic
|
||||
--grenadeDraw dir prop = translateSPz (_pjZ prop) $ uncurryV translateSPf (_prPos prop)
|
||||
-- $ rotateSP dir $ grenadePic $ _pjTimer prop
|
||||
|
||||
--throwGrenade
|
||||
-- :: (Point2 -> World -> World) -- ^ Payload
|
||||
|
||||
Reference in New Issue
Block a user