Add shatterGun

2022-06-16 11:13:44 +01:00
parent 6d5d651566
commit fa762c7687
13 changed files with 98 additions and 15 deletions
@@ -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