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

Work on room generation/laser run past

Browse Source
This commit is contained in:
justin
2026-03-17 21:50:28 +00:00
parent 13b12f01a8
commit 3b4cf68a15
18 changed files with 656 additions and 528 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Block/Debris.hs
+36 -26
View File
@@ -1,20 +1,20 @@
module Dodge.Block.Debris (
cubeShape,
-- dirtColor,
-- dirtColor,
makeDoorDebris,
makeBlockDebris,
makeDebris,
makeDebrisDirected,
) where
import Dodge.Material.Color
import qualified Data.IntMap.Strict as IM
import Dodge.ShiftPoint
import Data.Foldable
import qualified Data.IntMap.Strict as IM
import qualified Data.IntSet as IS
import Data.Maybe
import Dodge.Data.World
import Dodge.Material.Color
import Dodge.Material.Sound
import Dodge.ShiftPoint
import Dodge.WorldEvent.Sound
import Geometry
import Grid
@@ -30,7 +30,7 @@ makeDoorDebris dr w = w & makeDebris mt p
p = centroid . fmap fst $ (dr ^. drFootPrint) & each . each %~ shiftPointBy p2a
mt = fromMaybe Stone $ do
wlids <- w ^? cWorld . lWorld . doors . ix (_drID dr) . drFootPrint
((wlid,_),_) <- IM.minViewWithKey wlids
((wlid, _), _) <- IM.minViewWithKey wlids
w ^? cWorld . lWorld . walls . ix wlid . wlMaterial
makeBlockDebris :: Block -> World -> World
@@ -44,33 +44,39 @@ makeBlockDebris bl w = foldl' (flip $ makeDebris mt) w ps
wl <- w ^? cWorld . lWorld . walls . ix wlid
return $ _wlMaterial wl
--makeDebris :: Material -> Color -> Point2 -> World -> World
-- makeDebris :: Material -> Color -> Point2 -> World -> World
makeDebris :: Material -> Point2 -> World -> World
makeDebris = makeDebrisDirected (2 * pi) 0
makeDebrisDirected :: Float -> Float -> Material -> Point2 -> World -> World
--makeDebrisDirected :: Float -> Float -> Material -> Color -> Point2 -> World -> World
--makeDebrisDirected arcrad dir bm col p w =
makeDebrisDirected :: Float -> Float -> Material -> Point2 -> World -> World
-- makeDebrisDirected :: Float -> Float -> Material -> Color -> Point2 -> World -> World
-- makeDebrisDirected arcrad dir bm col p w =
makeDebrisDirected arcrad dir bm p w =
w
-- & flip (foldl' (flip $ plNew (cWorld . lWorld . props) prID)) thedebris
& cWorld . lWorld . debris <>~ thedebris
& randGen .~ newg
-- & flip (foldl' (flip $ plNew (cWorld . lWorld . props) prID)) thedebris
& cWorld
. lWorld
. debris
<>~ thedebris
& randGen
.~ newg
& soundOriginsIDsAt [MaterialSound bm i | i <- [0, 1, 2]] (destroyMatS bm) p
where
(thedebris, newg) = mapM f [35, 55, 75, 95] & runState $ _randGen w
f h = do
v <- rotateV (dir - arcrad / 2) <$> randInArcStrip 1 2 arcrad
spinspeed <- randomR (-0.2, -0.1) & state
-- basedebris <- baseDebris bm
return $ DebrisChunk
{ _dbPos = p `v2z` h
-- , _dbType = BlockDebris col
, _dbType = BlockDebris (materialColor bm)
, _dbVel = v `v2z` 0
, _dbRot = Q.qID
, _dbSpin = Q.axisAngle (vNormal v `v2z` 0) spinspeed
}
-- basedebris <- baseDebris bm
return $
DebrisChunk
{ _dbPos = p `v2z` h
, -- , _dbType = BlockDebris col
_dbType = BlockDebris (materialColor bm)
, _dbVel = v `v2z` 0
, _dbRot = Q.qID
, _dbSpin = Q.axisAngle (vNormal v `v2z` 0) spinspeed
}
-- basedebris
-- & prColor .~ col
-- & prPos .~ p
@@ -91,9 +97,13 @@ debrisSize mt = case mt of
Electronics -> 10
Flesh -> 10
ForceField -> 10
Photovoltaic -> 10
LightningRod -> 10
Pyroelectric -> 10
Piezoelectric -> 10
--shardShape :: Float -> Shape
--shardShape size =
-- shardShape :: Float -> Shape
-- shardShape size =
-- translateSHz (- size) $
-- upperPrismPolySU
-- size
@@ -102,10 +112,10 @@ debrisSize mt = case mt of
-- , V2 (- size) (-1)
-- ]
--
--jaggedShape :: State StdGen Shape
--jaggedShape = do
-- jaggedShape :: State StdGen Shape
-- jaggedShape = do
-- s <- randomR (4, 10) & state
-- return $ shardShape s
cubeShape :: Float -> Shape
cubeShape size = translateSHz (- size) $ upperPrismPolySU (2 * size) $ square size
cubeShape size = translateSHz (-size) $ upperPrismPolySU (2 * size) $ square size