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) makeBlockDebris bl = makeDebris (greyN 0.5) (_blMaterial bl) (_blPos bl)
makeDebris :: Color -> BlockMaterial -> Point2 -> World -> World 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 :: Float -> Float
makeDebrisDirected arcrad dir col bm p w = w -> Float -> Float -> Color -> BlockMaterial -> Point2 -> World -> World
makeDebrisDirected mindist maxdist arcrad dir col bm p w = w
& flip (foldr (plNew props pjID)) thedebris & flip (foldr (plNew props pjID)) thedebris
& randGen .~ newg & randGen .~ newg
& matDesSound bm p & matDesSound bm p
where where
(thedebris,newg) = runState (mapM f [35,55..95]) $ _randGen w (thedebris,newg) = runState (mapM f [35,55..95]) $ _randGen w
f h = do 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 q <- Q.vToQuat (V3 0 0 1) <$> randOnUnitSphere
return $ someDebris return $ someDebris
& prPos .~ p & prPos .~ p
src/Dodge/Item/Weapon/Shatter.hs
+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 :: World -> Point2 -> Point2 -> Point2 -> Wall -> World
shatterWall w sp ep p wl = w shatterWall w sp ep p wl = w
& makeDebris (_wlColor wl) StoneBlock p & 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 & damageWall (Damage SHATTERING 1000 sp p ep NoDamageEffect) wl
src/RandomHelp.hs
+2 -2
View File
@@ -66,13 +66,13 @@ randProb p = do
return (p1 < p) return (p1 < p)
randInCirc :: RandomGen g => Float -> State g Point2 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 :: RandomGen g => Float -> Float -> State g Point2
randInArc = randInArcStrip 0 randInArc = randInArcStrip 0
randInArcStrip :: RandomGen g => Float -> Float -> Float -> State g Point2 randInArcStrip :: RandomGen g => Float -> Float -> Float -> State g Point2
randInArcStrip minrad maxangle maxRad = do randInArcStrip minrad maxRad maxangle = do
rad <- state $ randomR (minrad,maxRad) rad <- state $ randomR (minrad,maxRad)
ang <- state $ randomR (0,maxangle) ang <- state $ randomR (0,maxangle)
return $ rad *.* unitVectorAtAngle ang return $ rad *.* unitVectorAtAngle ang