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

Make crytal walls destructible by shatterGun

Browse Source
This commit is contained in:
justin
2022-06-18 01:14:47 +01:00
parent 6a095d3de6
commit 5f68b512dd
10 changed files with 145 additions and 68 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Block.hs
+1
View File
@@ -34,6 +34,7 @@ matSplintSound :: BlockMaterial -> Point2 -> World -> World
matSplintSound mat = case mat of
GlassBlock -> mkSoundSplinterGlass
StoneBlock -> mkSoundSplinterBlock
CrystalBlock -> mkSoundSplinterBlock
DirtBlock -> originIDsAt (BlockDegradeSound 1) [impact1S,impact3S]
WoodBlock -> originIDsAt (BlockDegradeSound 1) [impact1S,impact2S,impact3S]
MetalBlock -> originIDsAt (BlockDegradeSound 1) [impact2S,impact3S]
src/Dodge/Block/Debris.hs
+43 -12
View File
@@ -16,33 +16,38 @@ import qualified Quaternion as Q
--import Data.List (zip4)
makeBlockDebris :: Block -> World -> World
makeBlockDebris bl = makeDebris (greyN 0.5) (_blMaterial bl) (_blPos bl)
makeBlockDebris bl = makeDebris (_blMaterial bl) (_blPos bl)
makeDebris :: Color -> BlockMaterial -> Point2 -> World -> World
makeDebris :: BlockMaterial -> Point2 -> World -> World
makeDebris = makeDebrisDirected 1 2 (2*pi) 0
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
-> Float -> Float -> BlockMaterial -> Point2 -> World -> World
makeDebrisDirected mindist maxdist arcrad dir bm p w = w
& flip (foldr (plNew props pjID)) thedebris
& randGen .~ newg
& matDesSound bm p
where
someDebris = case bm of
StoneBlock -> stoneDebris
GlassBlock -> glassDebris
CrystalBlock -> crystalDebris
DirtBlock -> dirtDebris
WoodBlock -> stoneDebris
MetalBlock -> stoneDebris
(thedebris,newg) = runState (mapM f [35,55..95]) $ _randGen w
f h = do
v <- rotateV (dir - arcrad/2) <$> randInArcStrip mindist maxdist arcrad
q <- Q.vToQuat (V3 0 0 1) <$> randOnUnitSphere
return $ someDebris
& prPos .~ p
& pjColor .~ col
& pjVel .~ v
& pjQuatSpin .~ Q.axisAngle (vNormal v `v2z` 0) (-0.1)
& pjQuat .~ q
& pjVelZ .~ 0
& pjPosZ .~ h
someDebris :: Prop
someDebris = PropZ
stoneDebris :: Prop
stoneDebris = PropZ
{_prPos = 0
,_pjStartPos = 0
,_pjVel = 0
@@ -54,14 +59,40 @@ someDebris = PropZ
,_pjTimer = 20
,_pjQuat = Q.axisAngle (V3 1 0 0) 0
,_pjQuatSpin = Q.axisAngle (V3 1 1 0) 0.1
,_pjColor = white
,_pjColor = greyN 0.5
}
dirtDebris :: Prop
dirtDebris = stoneDebris
& pjColor .~ dirtColor
& pjUpdate .~ fallSmallBounce
dirtColor :: Color
dirtColor = V4 (150/256) ( 75/256) 0 ( 250/256)
glassDebris :: Prop
glassDebris = PropZ
{_prPos = 0
,_pjStartPos = 0
,_pjVel = 0
,_prDraw = \pr -> drawMovingShape pr (debrisShape 2 pr)
,_pjID = 0
,_pjUpdate = fallSmallBounce
,_pjPosZ = 10
,_pjVelZ = 5
,_pjTimer = 20
,_pjQuat = Q.axisAngle (V3 1 0 0) 0
,_pjQuatSpin = Q.axisAngle (V3 1 1 0) 0.1
,_pjColor = withAlpha 0.5 cyan
}
crystalDebris :: Prop
crystalDebris = glassDebris
& pjColor .~ withAlpha 0.5 aquamarine
debrisShape :: Float -> Prop -> Shape
debrisShape size pr = colorSH (_pjColor pr) . translateSHz (-size) $ upperPrismPoly 8 $ square size
matDesSound :: BlockMaterial -> Point2 -> World -> World
matDesSound mat = case mat of
GlassBlock -> mkSoundBreakGlass
CrystalBlock -> mkSoundBreakGlass -- this should be more crunchy
StoneBlock -> mkSoundSplinterBlock
DirtBlock -> originIDsAt (BlockDegradeSound 1) [impact1S,impact3S]
WoodBlock -> originIDsAt (BlockDegradeSound 1) [impact1S,impact2S,impact3S]
src/Dodge/Data.hs
+20 -18
View File
@@ -929,6 +929,7 @@ data Block = Block
, _blDeath :: Block -> World -> World
}
data BlockMaterial = WoodBlock | DirtBlock | StoneBlock | GlassBlock | MetalBlock
| CrystalBlock
data TerminalStatus = TerminalOff | TerminalBusy | TerminalReady
deriving (Eq,Ord,Show)
data TerminalInput = TerminalInput
@@ -1016,21 +1017,22 @@ data Door = Door
data DoorStatus = DoorOpen | DoorClosed | DoorHalfway | DoorInt Int
deriving (Eq, Ord, Show)
data Wall = Wall
{ _wlLine :: (Point2,Point2)
, _wlID :: Int
, _wlColor :: Color
, _wlSeen :: Bool
, _wlOpacity :: Opacity
, _wlPathable :: Bool
, _wlWalkable :: Bool
, _wlTouchThrough :: Bool
, _wlFireThrough :: Bool
, _wlReflect :: Bool
, _wlDraw :: Bool
, _wlRotateTo :: Bool
, _wlStructure :: WallStructure
, _wlHeight :: Float
, _wlDamageEff :: Damage -> Wall -> World -> World
{ _wlLine :: (Point2,Point2)
, _wlID :: Int
, _wlColor :: Color
, _wlSeen :: Bool
, _wlOpacity :: Opacity
, _wlPathable :: Bool
, _wlWalkable :: Bool
, _wlTouchThrough :: Bool
, _wlFireThrough :: Bool
, _wlReflect :: Bool
, _wlDraw :: Bool
, _wlRotateTo :: Bool
, _wlStructure :: WallStructure
, _wlHeight :: Float
, _wlDamageEff :: Damage -> Wall -> World -> World
, _wlMaterial :: BlockMaterial
}
data Opacity
= SeeThrough
@@ -1039,9 +1041,9 @@ data Opacity
| Opaque
data WallStructure
= StandaloneWall
| DoorPart { _wlStDoor :: Int }
| MachinePart { _wlStMachine :: Int }
| BlockPart { _wlStBlock :: Int }
| DoorPart { _wsDoor :: Int }
| MachinePart { _wsMachine :: Int }
| BlockPart { _wsBlock :: Int }
| CreaturePart
{ _wlStCreature :: Int
, _wlStDamCreature :: Damage -> Wall -> Int -> World -> World
src/Dodge/Default/Wall.hs
+28
View File
@@ -1,6 +1,7 @@
module Dodge.Default.Wall
where
import Dodge.Data
import Dodge.Block.Debris -- this dependency is (directly) for dirtColor
import Dodge.Wall.DamageEffect
import Picture
import Geometry.Data
@@ -22,12 +23,14 @@ defaultWall = Wall
, _wlWalkable = False
, _wlHeight = 100
, _wlDamageEff = defaultWallDamage
, _wlMaterial = StoneBlock
}
{- Indestructible see-through wall. -}
defaultCrystalWall :: Wall
defaultCrystalWall = defaultWall
{ _wlColor = withAlpha 0.5 aquamarine
, _wlOpacity = SeeThrough
, _wlMaterial = CrystalBlock
}
defaultMachineWall :: Wall
defaultMachineWall = defaultWall
@@ -35,4 +38,29 @@ defaultMachineWall = defaultWall
, _wlDraw = False
, _wlRotateTo = False
, _wlStructure = MachinePart 0
, _wlMaterial = MetalBlock
}
defaultDirtWall :: Wall
defaultDirtWall = defaultWall
{ _wlLine = (V2 0 0,V2 50 0)
, _wlID = 0
, _wlColor = dirtColor
, _wlSeen = False
, _wlOpacity = Opaque
, _wlRotateTo = False
, _wlDraw = True
, _wlFireThrough = True
, _wlMaterial = DirtBlock
}
defaultWindow :: Wall
defaultWindow = defaultWall
{ _wlLine = (V2 0 0,V2 50 0)
, _wlDamageEff = windowWallDamage
, _wlID = 0
, _wlColor = withAlpha 0.5 cyan
, _wlSeen = False
, _wlOpacity = SeeThrough
, _wlDraw = True
, _wlFireThrough = True
, _wlMaterial = GlassBlock
}
src/Dodge/Item/Weapon/Shatter.hs
+3 -2
View File
@@ -53,6 +53,7 @@ shootShatter it cr w = maybe w (uncurry $ shatterWall w sp ep) $ collidePointWal
where
canshatter wl = case _wlOpacity wl of
Opaque -> True
SeeThrough -> True
_ -> False
sp = _crPos cr +.+ aimingMuzzlePos cr it *.* unitVectorAtAngle dir
dir = _crDir cr
@@ -60,6 +61,6 @@ 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 1 2 (pi/2) (argV $ vNormal $ uncurry (-.-) $ _wlLine wl) (_wlColor wl) StoneBlock p
& makeDebris (_wlMaterial wl) p
& makeDebrisDirected 1 2 (pi/2) (argV $ vNormal $ uncurry (-.-) $ _wlLine wl) (_wlMaterial wl) p
& damageWall (Damage SHATTERING 1000 sp p ep NoDamageEffect) wl
src/Dodge/Placement/Instance/Wall.hs
+14 -33
View File
@@ -3,6 +3,7 @@ module Dodge.Placement.Instance.Wall
import Dodge.Data
import Dodge.LevelGen.Data
import Dodge.Default.Wall
--import Dodge.Wall.DamageEffect
import Geometry
import Shape
import Color
@@ -71,22 +72,23 @@ Places an breakable window between two points.
Width 8, also extends out from each point by 8.
-}
windowLine :: Point2 -> Point2 -> Placement
windowLine a b = sps0 $ PutLineBlock baseWindowPane GlassBlock 8 8 a b
windowLine a b = sps0 $ PutLineBlock defaultWindow GlassBlock 8 8 a b
{-
Places an unbreakable window between two points.
Width 7, also extends out from each point by 7.
-}
crystalLine :: Point2 -> Point2 -> Placement
crystalLine a b = sps0 $ PutWall ps defaultCrystalWall
where
ps =
[ a +.+ left +.+ up
, (a +.+ left) -.- up
, (b -.- left) -.- up
, (b -.- left) +.+ up
]
left = 7 *.* normalizeV (a-.-b)
up = vNormal left
crystalLine a b = sps0 $ PutLineBlock defaultCrystalWall CrystalBlock 7 7 a b
--crystalLine a b = sps0 $ PutWall ps defaultCrystalWall
-- where
-- ps =
-- [ a +.+ left +.+ up
-- , (a +.+ left) -.- up
-- , (b -.- left) -.- up
-- , (b -.- left) +.+ up
-- ]
-- left = 7 *.* normalizeV (a-.-b)
-- up = vNormal left
{- Places an unbreakable wall between two points.
Depth 15, does not extend wider than points.
-}
@@ -102,7 +104,7 @@ wallLine a b = sps0 $ PutWall ps defaultWall
up = vNormal left
windowLineType :: Point2 -> Point2 -> PSType
windowLineType = PutLineBlock baseWindowPane GlassBlock 8 8
windowLineType = PutLineBlock defaultWindow GlassBlock 8 8
baseBlockPane :: Wall
baseBlockPane = defaultWall
@@ -114,27 +116,6 @@ baseBlockPane = defaultWall
, _wlDraw = True
, _wlFireThrough = True
}
dirtWall :: Wall
dirtWall = defaultWall
{ _wlLine = (V2 0 0,V2 50 0)
, _wlID = 0
, _wlColor = V4 (150/256) ( 75/256) 0 ( 250/256)
, _wlSeen = False
, _wlOpacity = Opaque
, _wlRotateTo = False
, _wlDraw = True
, _wlFireThrough = True
}
baseWindowPane :: Wall
baseWindowPane = defaultWall
{ _wlLine = (V2 0 0,V2 50 0)
, _wlID = 0
, _wlColor = cyan
, _wlSeen = False
, _wlOpacity = SeeThrough
, _wlDraw = True
, _wlFireThrough = True
}
-- TODO find home for this
{- Replaces instances of a given 'PutID' with 'PSType's drawn from a list. -}
replacePutID
src/Dodge/Placement/PlaceSpot.hs
+1 -1
View File
@@ -191,7 +191,7 @@ placeMachineWalls col poly mcid wlid = flip (foldr f) $ zip [wlid..] $ loopPairs
f (wid,l) = IM.insert wid baseWall{_wlID = wid, _wlLine = l}
baseWall = defaultMachineWall
& wlColor .~ col
& wlStructure . wlStMachine .~ mcid
& wlStructure . wsMachine .~ mcid
& wlTouchThrough .~ True
mvLS :: Point3 -> Float -> LightSource -> LightSource
src/Dodge/Room/RoadBlock.hs
+2 -1
View File
@@ -1,5 +1,6 @@
{- Connecting rooms designed with a pass-through technique in mind. -}
module Dodge.Room.RoadBlock where
import Dodge.Default.Wall
import Dodge.Cleat
import Dodge.Data
import Dodge.RoomLink
@@ -66,7 +67,7 @@ blockedCorridor :: RandomGen g => State g (Tree Room)
blockedCorridor = longBlockedCorridor 0
dirtPoly :: [Point2] -> PSType
dirtPoly = PutBlock DirtBlock 1 dirtWall . reverse
dirtPoly = PutBlock DirtBlock 1 defaultDirtWall . reverse
-- | A single corridor with a destructible block blocking it.
blockedCorridorCloseBlocks :: RandomGen g => State g Room
src/Dodge/Wall/Damage.hs
+1 -1
View File
@@ -36,6 +36,6 @@ damageBlockWith dm = case _dmType dm of
dam = _dmAmount dm
damageBlocksBy :: Int -> Wall -> World -> World
damageBlocksBy x wl = case wl ^? wlStructure . wlStBlock of
damageBlocksBy x wl = case wl ^? wlStructure . wsBlock of
Just blid -> blocks . ix blid . blHP -~ x
Nothing -> id
src/Dodge/Wall/DamageEffect.hs
+32
View File
@@ -4,10 +4,12 @@ import Dodge.Particle.Spark
import Dodge.Particle.Bullet.Spawn
import Dodge.Wall.Reflect
import Dodge.Wall.Dust
import Dodge.Block
import Geometry
import LensHelp
import Control.Monad.State
import Data.Maybe
defaultWallDamage :: Damage -> Wall -> World -> World
defaultWallDamage dm wl = wallDamageEffect dm wl . case _dmType dm of
@@ -33,6 +35,36 @@ defaultWallDamage dm wl = wallDamageEffect dm wl . case _dmType dm of
pSparkCol = V4 5 1 0.5 2
lSparkCol = V4 20 (-5) 0 1
windowWallDamage :: Damage -> Wall -> World -> World
windowWallDamage dm wl = wallDamageEffect dm wl . case _dmType dm of
LASERING -> colSparkRandDir 0.2 8 lSparkCol outTo (reflDirWall sp p wl)
PIERCING -> dosplint . colSparkRandDir 0.2 8 pSparkCol outTo (reflDirWall sp p wl) . wlDustAt wl outTo
BLUNT -> dosplint . wlDustAt wl outTo
SHATTERING -> dosplint . muchWlDustAt wl outTo
CRUSHING -> dosplint . id
EXPLOSIVE -> dosplint . id
CUTTING -> dosplint . id
SPARKING -> id
FLAMING -> id
ELECTRICAL -> id
CONCUSSIVE -> dosplint . id
TORQUEDAM -> id
PUSHDAM -> id
POISONDAM -> id
ENTERREMENT -> id
where
dosplint w = fromMaybe w $ do
blid <- wl ^? wlStructure . wsBlock
bl <- w ^? blocks . ix blid
return $ splinterBlock bl w
& blocks . ix blid . blHP %~ min 1
sp = _dmFrom dm
p = _dmAt dm
outTo = p +.+ squashNormalizeV (sp -.- p)
pSparkCol = V4 5 1 0.5 2
lSparkCol = V4 20 (-5) 0 1
wallDamageEffect :: Damage -> Wall -> World -> World
wallDamageEffect dm wl w = case _dmEffect dm of
BounceBullet bt -> w & instantParticles .:~ thebouncer