Fix bug in randArc

This commit is contained in:
2022-06-16 12:40:27 +01:00
parent 4d6e547b74
commit 2bc30d0a6b
3 changed files with 8 additions and 7 deletions
+5 -4
View File
@@ -19,17 +19,18 @@ makeBlockDebris :: Block -> World -> World
makeBlockDebris bl = makeDebris (greyN 0.5) (_blMaterial bl) (_blPos bl)
makeDebris :: Color -> BlockMaterial -> Point2 -> World -> World
makeDebris = makeDebrisDirected (2*pi) 0
makeDebris = makeDebrisDirected 1 2 (2*pi) 0
makeDebrisDirected :: Float -> Float -> Color -> BlockMaterial -> Point2 -> World -> World
makeDebrisDirected arcrad dir col bm p w = w
makeDebrisDirected :: Float -> Float
-> Float -> Float -> Color -> BlockMaterial -> Point2 -> World -> World
makeDebrisDirected mindist maxdist arcrad dir col bm p w = w
& flip (foldr (plNew props pjID)) thedebris
& randGen .~ newg
& matDesSound bm p
where
(thedebris,newg) = runState (mapM f [35,55..95]) $ _randGen w
f h = do
v <- rotateV (dir - arcrad/2) <$> randInArcStrip 2 3 arcrad
v <- rotateV (dir - arcrad/2) <$> randInArcStrip mindist maxdist arcrad
q <- Q.vToQuat (V3 0 0 1) <$> randOnUnitSphere
return $ someDebris
& prPos .~ p
+1 -1
View File
@@ -61,5 +61,5 @@ shootShatter it cr w = maybe w (uncurry $ shatterWall w sp ep) $ collidePointWal
shatterWall :: World -> Point2 -> Point2 -> Point2 -> Wall -> World
shatterWall w sp ep p wl = w
& makeDebris (_wlColor wl) StoneBlock p
& makeDebrisDirected (pi/2) (argV $ vNormal $ uncurry (-.-) $ _wlLine wl) (_wlColor wl) StoneBlock p
& makeDebrisDirected 1 2 (pi/2) (argV $ vNormal $ uncurry (-.-) $ _wlLine wl) (_wlColor wl) StoneBlock p
& damageWall (Damage SHATTERING 1000 sp p ep NoDamageEffect) wl
+2 -2
View File
@@ -66,13 +66,13 @@ randProb p = do
return (p1 < p)
randInCirc :: RandomGen g => Float -> State g Point2
randInCirc = randInArc (2*pi)
randInCirc rad = randInArc rad (2*pi)
randInArc :: RandomGen g => Float -> Float -> State g Point2
randInArc = randInArcStrip 0
randInArcStrip :: RandomGen g => Float -> Float -> Float -> State g Point2
randInArcStrip minrad maxangle maxRad = do
randInArcStrip minrad maxRad maxangle = do
rad <- state $ randomR (minrad,maxRad)
ang <- state $ randomR (0,maxangle)
return $ rad *.* unitVectorAtAngle ang