justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Fix bug in randArc

Browse Source
This commit is contained in:
justin
2022-06-16 12:40:27 +01:00
parent 4d6e547b74
commit 2bc30d0a6b
3 changed files with 8 additions and 7 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Block/Debris.hs
+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