Add shatterGun

src/Dodge/Block.hs

@@ -1,5 +1,6 @@
 module Dodge.Block where
 import Dodge.Data
+import Dodge.Block.Debris
 import Dodge.SoundLogic
 import Dodge.Zone
 import Dodge.WorldEvent.Sound
@@ -37,13 +38,6 @@ matSplintSound mat = case mat of
     DirtBlock  -> originIDsAt (BlockDegradeSound 1) [impact1S,impact3S]
     WoodBlock  -> originIDsAt (BlockDegradeSound 1) [impact1S,impact2S,impact3S]
     MetalBlock -> originIDsAt (BlockDegradeSound 1) [impact2S,impact3S]
-matDesSound :: BlockMaterial -> Point2 -> World -> World
-matDesSound mat = case mat of
-    GlassBlock -> mkSoundBreakGlass
-    StoneBlock -> mkSoundSplinterBlock
-    DirtBlock  -> originIDsAt (BlockDegradeSound 1) [impact1S,impact3S]
-    WoodBlock  -> originIDsAt (BlockDegradeSound 1) [impact1S,impact2S,impact3S]
-    MetalBlock -> originIDsAt (BlockDegradeSound 1) [impact2S,impact3S]
 
 destroyBlock :: Block -> World -> World
 destroyBlock bl w = w

src/Dodge/Block/Debris.hs

@@ -1,5 +1,7 @@
 module Dodge.Block.Debris where
 import Dodge.Prop.Moving
+import Dodge.WorldEvent.Sound
+import Dodge.SoundLogic
 --import Dodge.Zone
 import Dodge.Base
 import Dodge.Data
@@ -13,17 +15,21 @@ import RandomHelp
 import qualified Quaternion as Q
 --import Data.List (zip4)
 
-makeBlockDebris :: BlockMaterial -> Block -> World -> World
-makeBlockDebris _ bl w = w
+makeBlockDebris :: Block -> World -> World
+makeBlockDebris bl = makeDebris (_blMaterial bl) (_blPos bl)
+
+makeDebris :: BlockMaterial -> Point2 -> World -> World
+makeDebris bm p w = w
     & flip (foldr (plNew props pjID)) thedebris
     & randGen .~ newg
+    & matDesSound bm p
   where
     (thedebris,newg) = runState (mapM f [35,55..95]) $ _randGen w
     f h = do
         v <- randInCirc 2
         q <- Q.vToQuat (V3 0 0 1) <$> randOnUnitSphere
         return $ someDebris
-            & prPos .~ _blPos bl
+            & prPos .~ p
             & pjColor .~ greyN 0.5
             & pjVel .~ v
             & pjQuatSpin .~ Q.axisAngle (vNormal v `v2z` 0) (-0.1)
@@ -48,3 +54,11 @@ someDebris = PropZ
     }
 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
+    StoneBlock -> mkSoundSplinterBlock
+    DirtBlock  -> originIDsAt (BlockDegradeSound 1) [impact1S,impact3S]
+    WoodBlock  -> originIDsAt (BlockDegradeSound 1) [impact1S,impact2S,impact3S]
+    MetalBlock -> originIDsAt (BlockDegradeSound 1) [impact2S,impact3S]

src/Dodge/Combine/Data.hs

@@ -130,6 +130,8 @@ data ItemBaseType
     | REMOTELAUNCHER
     | POISONSPRAYER
     | DRONELAUNCHER
+    
+    | SHATTERGUN
 --    | GRENADE
 --    | REMOTEBOMB
     -- Utility items

src/Dodge/Creature.hs

@@ -235,6 +235,7 @@ inventoryX c = case c of
         , makeTypeCraftNum 5 INCENDIARYMODULE
         , makeTypeCraftNum 5 STATICMODULE
         ]
+    'H' -> [ shatterGun ]
     _ -> []
 
 testInventory :: IM.IntMap Item

src/Dodge/Data/DamageType.hs

@@ -10,6 +10,7 @@ data DamageType
     | CUTTING  
     | SPARKING
     | CRUSHING
+    | SHATTERING
     | FLAMING  
     | LASERING 
     | ELECTRICAL

src/Dodge/Item.hs

@@ -88,6 +88,7 @@ itemFromBase ibt = case ibt of
     BLINKERUNSAFE       -> unsafeBlinkGun
     FORCEFIELDGUN       -> forceFieldGun
     SHRINKER        -> shrinkGun
+    SHATTERGUN        -> shatterGun
     SPAWNER     -> error "need to datify creatures first"
     -- Equipment
     CLICKDETECTOR d -> clickDetector d
@@ -224,6 +225,7 @@ baseToFamily ibt = case ibt of
     REMOTELAUNCHER      -> HeldFamily
     POISONSPRAYER       -> HeldFamily
     DRONELAUNCHER       -> HeldFamily
+    SHATTERGUN          -> HeldFamily
 --  | GRENADE
 --  | REMOTEBOMB
     BOOSTER             -> LeftClickFamily

src/Dodge/Item/Weapon.hs

@@ -2,6 +2,7 @@
 module Dodge.Item.Weapon 
     ( module Dodge.Item.Weapon.BulletGuns
     , module Dodge.Item.Weapon.SonicGuns
+    , module Dodge.Item.Weapon.Shatter
     , module Dodge.Item.Weapon.TriggerType
     , module Dodge.Item.Weapon.ExtraEffect
     , module Dodge.Item.Weapon.UseEffect
@@ -20,6 +21,7 @@ import Dodge.Item.Weapon.BulletGuns
 import Dodge.Item.Weapon.Drone
 import Dodge.Item.Weapon.TriggerType
 import Dodge.Item.Weapon.SonicGuns
+import Dodge.Item.Weapon.Shatter
 import Dodge.Item.Weapon.ExtraEffect
 import Dodge.Item.Weapon.UseEffect
 import Dodge.Item.Weapon.Remote

src/Dodge/Item/Weapon/BatteryGuns.hs

@@ -99,8 +99,8 @@ teslaGun = defaultBatteryGun
     & itType . iyBase .~ TESLAGUN
 teslaGunPic :: Item -> SPic
 teslaGunPic _ = noPic $ colorSH blue $
-           upperPrismPoly 5 (rectNESW xb    8 xa    0)
-        ++ upperPrismPoly 5 (rectNESW (-xa) 8 (-xb) 0)
+       upperPrismPoly 5 (rectNESW xb    8 xa    0)
+    ++ upperPrismPoly 5 (rectNESW (-xa) 8 (-xb) 0)
   where
     xa = 1
     xb = 9

src/Dodge/Item/Weapon/Shatter.hs

@@ -0,0 +1,65 @@
+module Dodge.Item.Weapon.Shatter where
+--import Dodge.WorldEvent.HitEffect
+--import Dodge.Item.Weapon.BulletGun.Clip
+import Dodge.Data
+import Dodge.Wall.Damage
+--import Dodge.SoundLogic
+import Dodge.Block.Debris
+import Dodge.Base.Collide
+import Dodge.Zone
+import Dodge.Creature.HandPos
+--import Dodge.ChainEffect
+import Dodge.Default.Weapon
+import Dodge.Default
+--import Dodge.Item.Attachment
+--import Dodge.Item.Weapon.ExtraEffect
+--import Dodge.Item.Weapon.InventoryDisplay
+--import Dodge.Item.Draw
+import Dodge.Item.Weapon.TriggerType
+--import Dodge.SoundLogic.LoadSound
+import Picture
+import Geometry
+import ShapePicture
+import Shape
+--import Sound.Data
+import LensHelp
+
+import qualified Data.IntMap.Strict as IM
+
+shatterGun :: Item
+shatterGun = defaultGun
+    & itType . iyBase .~ SHATTERGUN
+    & itConsumption .~ defaultAmmo
+    & itUse .~ ruseRate 10 shootShatter upHammer
+        [ ammoHammerCheck
+        , useTimeCheck
+--        , withSoundStart tap3S
+        , useAmmoAmount 1
+        ]
+    & itUse . useAim . aimStance .~ TwoHandFlat
+    & itDimension . dimSPic .~ shatterGunSPic
+
+shatterGunSPic :: Item -> SPic
+shatterGunSPic _ = noPic $ colorSH blue $
+       upperPrismPoly 5 (rectNESW xb    8 xa    0)
+    ++ upperPrismPoly 5 (rectNESW (-xa) 8 (-xb) 0)
+  where
+    xa = 1
+    xb = 9
+shootShatter :: Item -> Creature -> World -> World
+shootShatter it cr w = maybe w (uncurry $ shatterWall w sp ep) $ collidePointWallsWall sp ep 
+    $ IM.filter canshatter 
+    $ wallsAlongLine sp ep w
+  where
+    canshatter wl = case _wlOpacity wl of
+        Opaque -> True
+        _ -> False
+    sp = _crPos cr +.+ aimingMuzzlePos cr it *.* unitVectorAtAngle dir
+    dir = _crDir cr
+    ep = sp +.+ 200 *.* unitVectorAtAngle dir
+
+shatterWall :: World -> Point2 -> Point2 -> Point2 -> Wall -> World
+shatterWall w sp ep p wl = w & makeDebris StoneBlock p
+    & damageWall (Damage SHATTERING 100 sp p ep NoDamageEffect) wl
+    & damageWall (Damage SHATTERING 100 sp p ep NoDamageEffect) wl
+    & damageWall (Damage SHATTERING 100 sp p ep NoDamageEffect) wl

src/Dodge/Placement/PlaceSpot/Block.hs

@@ -34,7 +34,7 @@ addBlock (p:ps) wl hp hps bm w
         & blocks %~ IM.insert blid Block 
             {_blID = blid,_blWallIDs = IS.fromList is, _blHPs = hp:hps, _blShadows=[], _blMaterial = bm
                 , _blFootprint = p:ps, _blPos = centroid (p:ps), _blDraw = const mempty
-                , _blDeath = makeBlockDebris bm}
+                , _blDeath = makeBlockDebris}
   where 
     blid = IM.newKey $ _blocks w
     lns = zip (p:ps) (ps ++ [p])
@@ -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 = makeBlockDebris bm}
+        , _blPos = p, _blDraw = const mempty , _blDeath = makeBlockDebris}
     insertBlocks = flip (foldr insertBlock) $ zip is blockCenPs
     ksAtI i = map ( + (wlid + i*4) ) [0,1,2,3]
     visibilityAt i 

src/Dodge/Prop/Moving.hs

@@ -29,7 +29,7 @@ fallSmallBounceDamage pr w = w
         | _pjPosZ pr < 25 = creatures %~ fmap dodamage'
         | otherwise = id
     dodamage' cr
-        | dist (_crPos cr) p < _crRad cr = cr & crState . crDamage 
+        | dist (_crPos cr) p < _crRad cr + 5 = cr & crState . crDamage 
             .:~ Damage CRUSHING (floor . (*10) . max 0 . subtract 5 . abs $ _pjVelZ pr) (p -.- v) p (p +.+ v) NoDamageEffect
         | otherwise = cr
 

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
+    SHATTERING  -> blHPs %~ reduceHead dam
     CRUSHING    -> blHPs %~ reduceHead (dam `div` 4)
     LASERING    -> id
     SPARKING    -> id

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
+    SHATTERING  -> wlDustAt wl outTo
     CRUSHING    -> id
     EXPLOSIVE   -> id
     CUTTING     -> id