This commit is contained in:
2025-08-02 22:53:39 +01:00
parent ae24720762
commit 5f158cc87a
3 changed files with 29 additions and 78 deletions
+15 -73
View File
@@ -1,6 +1,6 @@
module Dodge.Block.Debris ( module Dodge.Block.Debris (
cubeShape, cubeShape,
dirtColor, -- dirtColor,
makeDoorDebris, makeDoorDebris,
makeBlockDebris, makeBlockDebris,
makeDebris, makeDebris,
@@ -85,78 +85,20 @@ debrisSize mt = case mt of
Electronics -> 10 Electronics -> 10
Flesh -> 10 Flesh -> 10
baseDebris :: Material -> State StdGen Prop --shardShape :: Float -> Shape
baseDebris mt = case mt of --shardShape size =
Stone -> return stoneDebris -- translateSHz (- size) $
Glass -> return glassDebris -- upperPrismPolySU
Crystal -> return crystalDebris -- size
Dirt -> return dirtDebris -- [ V2 size 0
Wood -> return stoneDebris -- , V2 (- size) 1
Metal -> do -- , V2 (- size) (-1)
sh <- jaggedShape -- ]
return $ --
metalDebris --jaggedShape :: State StdGen Shape
& prDraw .~ PropDrawMovingShapeCol sh --jaggedShape = do
Electronics -> baseDebris Metal -- s <- randomR (4, 10) & state
Flesh -> baseDebris Dirt <&> prColor .~ red -- return $ shardShape s
stoneDebris :: Prop
stoneDebris =
PropZ
{ _prPos = 0
, _prStartPos = 0
, _prVel = 0
, _prDraw = PropDrawMovingShapeCol (cubeShape 4)
, _prID = 0
, _prUpdate = PropFallSmallBounceDamage
, _prPosZ = 10
, _prVelZ = 5
, _prQuat = Q.axisAngle (V3 1 0 0) 0
, _prQuatSpin = Q.axisAngle (V3 1 1 0) 0.1
, _prColor = greyN 0.5
}
dirtDebris :: Prop
dirtDebris =
stoneDebris
& prColor .~ dirtColor
& prUpdate .~ PropFallSmallBounce
dirtColor :: Color
dirtColor = V4 (150 / 256) (75 / 256) 0 (250 / 256)
metalDebris :: Prop
metalDebris =
stoneDebris
& prDraw .~ PropDrawMovingShapeCol (shardShape 4)
& prUpdate .~ PropFallSmallBounceDamage
glassDebris :: Prop
glassDebris =
stoneDebris
& prDraw .~ PropDrawMovingShapeCol (shardShape 4)
& prUpdate .~ PropFallSmallBounce
& prColor .~ withAlpha 0.5 cyan
crystalDebris :: Prop
crystalDebris =
glassDebris
& prColor .~ withAlpha 0.5 aquamarine
shardShape :: Float -> Shape
shardShape size =
translateSHz (- size) $
upperPrismPolySU
size
[ V2 size 0
, V2 (- size) 1
, V2 (- size) (-1)
]
jaggedShape :: State StdGen Shape
jaggedShape = do
s <- randomR (4, 10) & state
return $ shardShape s
cubeShape :: Float -> Shape cubeShape :: Float -> Shape
cubeShape size = translateSHz (- size) $ upperPrismPolySU (2 * size) $ square size cubeShape size = translateSHz (- size) $ upperPrismPolySU (2 * size) $ square size
-1
View File
@@ -5,7 +5,6 @@
module Dodge.Data.Prop where module Dodge.Data.Prop where
import Dodge.Data.Material
import Color import Color
import Control.Lens import Control.Lens
import Data.Aeson import Data.Aeson
+14 -4
View File
@@ -1,7 +1,14 @@
module Dodge.Default.Wall where module Dodge.Default.Wall (
defaultWall,
defaultSensorWall,
defaultMachineWall,
defaultWindow,
defaultCrystalWall,
defaultDoorWall,
defaultDirtWall,
) where
import Control.Lens import Control.Lens
import Dodge.Block.Debris
import Dodge.Data.Wall import Dodge.Data.Wall
import Geometry.Data import Geometry.Data
import Picture import Picture
@@ -13,8 +20,8 @@ defaultWall =
{ _wlLine = (V2 0 0, V2 50 0) { _wlLine = (V2 0 0, V2 50 0)
, _wlID = 0 , _wlID = 0
, _wlColor = greyN 0.6 , _wlColor = greyN 0.6
--, _wlOpacity = Opaque 11 , --, _wlOpacity = Opaque 11
, _wlOpacity = Opaque 11 _wlOpacity = Opaque 11
, _wlPathable = False , _wlPathable = False
, _wlPenetrable = False , _wlPenetrable = False
, _wlFireThrough = False , _wlFireThrough = False
@@ -71,6 +78,9 @@ defaultDirtWall =
, _wlMaterial = Dirt , _wlMaterial = Dirt
} }
dirtColor :: Color
dirtColor = V4 (150 / 256) (75 / 256) 0 (250 / 256)
defaultWindow :: Wall defaultWindow :: Wall
defaultWindow = defaultWindow =
defaultWall defaultWall