diff --git a/src/Dodge/Block.hs b/src/Dodge/Block.hs index 18a3fc671..f14257121 100644 --- a/src/Dodge/Block.hs +++ b/src/Dodge/Block.hs @@ -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] diff --git a/src/Dodge/Block/Debris.hs b/src/Dodge/Block/Debris.hs index 4046ca5fc..7e6de894e 100644 --- a/src/Dodge/Block/Debris.hs +++ b/src/Dodge/Block/Debris.hs @@ -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] diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index a91ec51f1..2c5e51c71 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -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 diff --git a/src/Dodge/Default/Wall.hs b/src/Dodge/Default/Wall.hs index e01032d7b..877f7efc9 100644 --- a/src/Dodge/Default/Wall.hs +++ b/src/Dodge/Default/Wall.hs @@ -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 } diff --git a/src/Dodge/Item/Weapon/Shatter.hs b/src/Dodge/Item/Weapon/Shatter.hs index f467eccf0..7a9fcf259 100644 --- a/src/Dodge/Item/Weapon/Shatter.hs +++ b/src/Dodge/Item/Weapon/Shatter.hs @@ -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 diff --git a/src/Dodge/Placement/Instance/Wall.hs b/src/Dodge/Placement/Instance/Wall.hs index ec56e7194..85c92dd48 100644 --- a/src/Dodge/Placement/Instance/Wall.hs +++ b/src/Dodge/Placement/Instance/Wall.hs @@ -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 diff --git a/src/Dodge/Placement/PlaceSpot.hs b/src/Dodge/Placement/PlaceSpot.hs index 659a779af..b221425f2 100644 --- a/src/Dodge/Placement/PlaceSpot.hs +++ b/src/Dodge/Placement/PlaceSpot.hs @@ -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 diff --git a/src/Dodge/Room/RoadBlock.hs b/src/Dodge/Room/RoadBlock.hs index 4ea06cf91..1c70cb4f4 100644 --- a/src/Dodge/Room/RoadBlock.hs +++ b/src/Dodge/Room/RoadBlock.hs @@ -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 diff --git a/src/Dodge/Wall/Damage.hs b/src/Dodge/Wall/Damage.hs index 28ae6c73b..6a0e0a37c 100644 --- a/src/Dodge/Wall/Damage.hs +++ b/src/Dodge/Wall/Damage.hs @@ -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 diff --git a/src/Dodge/Wall/DamageEffect.hs b/src/Dodge/Wall/DamageEffect.hs index f2ceb1ee2..f955c83ca 100644 --- a/src/Dodge/Wall/DamageEffect.hs +++ b/src/Dodge/Wall/DamageEffect.hs @@ -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