diff --git a/src/Dodge/Block/Debris.hs b/src/Dodge/Block/Debris.hs index e783f046b..a841457a5 100644 --- a/src/Dodge/Block/Debris.hs +++ b/src/Dodge/Block/Debris.hs @@ -36,9 +36,9 @@ someDebris = PropZ {_prPos = 0 ,_pjStartPos = 0 ,_pjVel = 0 - ,_prDraw = \pr -> drawMovingShape pr (debrisShape pr) + ,_prDraw = \pr -> drawMovingShape pr (debrisShape 4 pr) ,_pjID = 0 - ,_pjUpdate = fallSmallBounce + ,_pjUpdate = fallSmallBounceDamage ,_pjPosZ = 10 ,_pjVelZ = 5 ,_pjTimer = 20 @@ -46,5 +46,5 @@ someDebris = PropZ ,_pjQuatSpin = Q.axisAngle (V3 1 1 0) 0.1 ,_pjColor = white } -debrisShape :: Prop -> Shape -debrisShape pr = colorSH (_pjColor pr) . translateSHz (-5) $ upperPrismPoly 10 $ square 5 +debrisShape :: Float -> Prop -> Shape +debrisShape size pr = colorSH (_pjColor pr) . translateSHz (-size) $ upperPrismPoly 8 $ square size diff --git a/src/Dodge/Data/DamageType.hs b/src/Dodge/Data/DamageType.hs index 6f3ac40b5..3cd288b94 100644 --- a/src/Dodge/Data/DamageType.hs +++ b/src/Dodge/Data/DamageType.hs @@ -9,6 +9,7 @@ data DamageType | BLUNT | CUTTING | SPARKING + | CRUSHING | FLAMING | LASERING | ELECTRICAL diff --git a/src/Dodge/Placement/PlaceSpot/Block.hs b/src/Dodge/Placement/PlaceSpot/Block.hs index 1a6a339a5..75e66f687 100644 --- a/src/Dodge/Placement/PlaceSpot/Block.hs +++ b/src/Dodge/Placement/PlaceSpot/Block.hs @@ -92,7 +92,7 @@ placeLineBlock basePane bm blockWidth depth a b gw = ( 0 { _blID = i + blid, _blWallIDs = IS.fromList $ ksAtI i , _blHPs = [5,5], _blShadows = shadowsAt i, _blMaterial = bm , _blFootprint = cornersAt p -- TODO check winding (clockwise, anticlockwise) - , _blPos = p, _blDraw = const mempty , _blDeath = const id} + , _blPos = p, _blDraw = const mempty , _blDeath = makeBlockDebris bm} insertBlocks = flip (foldr insertBlock) $ zip is blockCenPs ksAtI i = map ( + (wlid + i*4) ) [0,1,2,3] visibilityAt i diff --git a/src/Dodge/Prop/Moving.hs b/src/Dodge/Prop/Moving.hs index 887e2a565..f6a2f59f0 100644 --- a/src/Dodge/Prop/Moving.hs +++ b/src/Dodge/Prop/Moving.hs @@ -1,4 +1,8 @@ -module Dodge.Prop.Moving where +module Dodge.Prop.Moving + ( drawMovingShape + , fallSmallBounceDamage + , fallSmallBounce + ) where import Dodge.Zone import Dodge.Base import Dodge.Data @@ -13,9 +17,25 @@ import LensHelp import qualified Quaternion as Q --import Data.List (zip4) +-- +fallSmallBounceDamage :: Prop -> World -> World +fallSmallBounceDamage pr w = w + & dodamage + & props . ix (_pjID pr) %~ fallSmallBounce' w + where + p = _prPos pr + v = _pjVel pr + dodamage + | _pjPosZ pr < 25 = creatures %~ fmap dodamage' + | otherwise = id + dodamage' cr + | dist (_crPos cr) p < _crRad cr = cr & crState . crDamage + .:~ Damage CRUSHING (floor . (*10) . max 0 . subtract 5 . abs $ _pjVelZ pr) (p -.- v) p (p +.+ v) NoDamageEffect + | otherwise = cr fallSmallBounce :: Prop -> World -> World -fallSmallBounce pr w = w & props . ix (_pjID pr) %~ fallSmallBounce' w +fallSmallBounce pr w = w + & props . ix (_pjID pr) %~ fallSmallBounce' w fallSmallBounce' :: World -> Prop -> Prop fallSmallBounce' w pr diff --git a/src/Dodge/Wall/Damage.hs b/src/Dodge/Wall/Damage.hs index ec52dc4d1..62b149e6f 100644 --- a/src/Dodge/Wall/Damage.hs +++ b/src/Dodge/Wall/Damage.hs @@ -22,6 +22,7 @@ damageBlockWith dm = case _dmType dm of CUTTING -> blHPs %~ reduceHead dam EXPLOSIVE -> blHPs %~ reduceHead dam CONCUSSIVE -> blHPs %~ reduceHead dam + CRUSHING -> blHPs %~ reduceHead (dam `div` 4) LASERING -> id SPARKING -> id FLAMING -> id diff --git a/src/Dodge/Wall/DamageEffect.hs b/src/Dodge/Wall/DamageEffect.hs index a47aa8fa9..09a7b286c 100644 --- a/src/Dodge/Wall/DamageEffect.hs +++ b/src/Dodge/Wall/DamageEffect.hs @@ -14,6 +14,7 @@ defaultWallDamage dm wl = wallDamageEffect dm wl . case _dmType dm of LASERING -> colSparkRandDir 0.2 8 lSparkCol outTo (reflDirWall sp p wl) PIERCING -> colSparkRandDir 0.2 8 pSparkCol outTo (reflDirWall sp p wl) . wlDustAt wl outTo BLUNT -> wlDustAt wl outTo + CRUSHING -> id EXPLOSIVE -> id CUTTING -> id SPARKING -> id