Cleanup tesla arcs

This commit is contained in:
2022-03-24 08:05:58 +00:00
parent 64be9ee7a8
commit 11d954674c
8 changed files with 111 additions and 196 deletions
+30 -26
View File
@@ -39,6 +39,7 @@ sparkGun :: Item
sparkGun = teslaGun
& itName .~ "SPARKGUN"
& itType .~ SPARKGUN
& itParams . arcSize .~ 10
teslaGun :: Item
teslaGun = defaultGun
{ _itName = "TESLA"
@@ -65,7 +66,13 @@ teslaGun = defaultGun
}
, _dimSPic = teslaGunPic
}
, _itParams = Arcing {_currentArc = Nothing}
, _itParams = Arcing
{ _currentArc = Nothing
, _arcSize = 20
, _arcNumber = 10
, _newArcStep = defaultArcStep
, _previousArcEffect = NoPreviousArcEffect
}
}
teslaGunPic :: Item -> SPic
teslaGunPic _ = noPic $ colorSH blue $
@@ -196,59 +203,56 @@ tractorGunPic it =
-- | assumes that the item is held
shootTeslaArc :: Item -> Creature -> World -> World
shootTeslaArc it cr w = w & randGen .~ g
& particles .:~ aTeslaArcAt' col newarc
& particles .:~ aTeslaArcAt col newarc
& creatures . ix (_crID cr) . crInv . ix (_crInvSel cr) . itParams . currentArc ?~ newarc
where
pos = _crPos cr +.+ aimingMuzzlePos cr it *.* unitVectorAtAngle dir
dir = _crDir cr
(col,g) = takeOne [white,azure,blue,cyan] & runState $ _randGen w
newarc = createArc (_currentArc (_itParams it)) w pos dir & evalState $ _randGen w
newarc = createArc (_itParams it) w pos dir & evalState $ _randGen w
createArc :: RandomGen g
=> Maybe [(Point2,Float,Maybe (Either Creature Wall))]
createArc :: ItemParams
-> World
-> Point2
-> Float
-> State g [(Point2,Float,Maybe (Either Creature Wall))]
createArc Nothing w p dir = createNewArc w p dir
createArc (Just thearc) w p dir = updateArc thearc w p dir
-> State StdGen [(Point2,Float,Maybe (Either Creature Wall))]
createArc arcparams@Arcing{_currentArc = Nothing} w p dir = createNewArc arcparams w p dir
createArc arcparams w p dir = updateArc arcparams w p dir
createNewArc :: RandomGen g => World -> Point2 -> Float
-> State g [(Point2,Float,Maybe (Either Creature Wall))]
createNewArc w p dir = take 10
<$> unfoldrMID (newArcStep w) (p,dir,Nothing)
createNewArc :: ItemParams -> World -> Point2 -> Float
-> State StdGen [(Point2,Float,Maybe (Either Creature Wall))]
createNewArc arcparams w p dir = take (_arcNumber arcparams)
<$> unfoldrMID (_newArcStep arcparams arcparams w) (p,dir,Nothing)
newArcStep :: RandomGen g => World -> (Point2,Float,Maybe (Either Creature Wall))
defaultArcStep :: RandomGen g => ItemParams -> World -> (Point2,Float,Maybe (Either Creature Wall))
-> State g (Maybe (Point2,Float,Maybe (Either Creature Wall)))
newArcStep _ (_,_,Just _) = return Nothing
newArcStep w (p,dir,_) = do
defaultArcStep _ _ (_,_,Just _) = return Nothing
defaultArcStep itparams w (p,dir,_) = do
let csize = _arcSize itparams
rot <- takeOne [pi/4,negate pi/4]
let csize = 10
center = csize *.* rotateV rot (unitVectorAtAngle dir) +.+ p
let center = csize *.* rotateV rot (unitVectorAtAngle dir) +.+ p
newp <- (center +.+) <$> randInCirc csize
let mcr = listToMaybe
. sortOn (dist p . _crPos)
. filter (\cr -> dist p (_crPos cr) < csize)
. sortOn (dist center . _crPos)
. filter (\cr -> dist center (_crPos cr) < csize)
. IM.elems
$ _creatures w
wlsnearpoint = wallsNearPoint p w
mwl = listToMaybe
. sortOn (dist p . fst)
. mapMaybe (\ q -> collidePointWallsWall p q wlsnearpoint)
. map (center +.+)
. mapMaybe (\ q -> collidePointWallsWall p (center +.+ q) wlsnearpoint)
$ polyCirc 6 csize
f (q,wl) = (q,dir,Just $ Right wl)
g (cr) = (_crPos cr +.+ 10 *.* unitVectorAtAngle dir, dir,Just $ Left cr)
g cr = (_crPos cr +.+ csize *.* unitVectorAtAngle dir, dir,Just $ Left cr)
return . listToMaybe . sortOn (dist p . (^. _1))
$ (newp,dir,Nothing) : catMaybes [fmap f mwl,fmap g mcr]
updateArc :: RandomGen g
=> [(Point2,Float,Maybe (Either Creature Wall))]
updateArc :: ItemParams
-> World
-> Point2
-> Float
-> State g [(Point2,Float,Maybe (Either Creature Wall))]
updateArc _ w p dir = createNewArc w p dir
-> State StdGen [(Point2,Float,Maybe (Either Creature Wall))]
updateArc = createNewArc
shootLaser :: Item -> Creature -> World -> World
shootLaser it cr = particles .:~ lasRayAt phasev pos dir