Reorganise weapons, start work on drones

src/Dodge/Creature.hs

@@ -16,6 +16,7 @@ import Dodge.Creature.State.Data
 import Dodge.Item.Weapon.Grenade
 import Dodge.Item.Weapon.Booster
 import Dodge.Item.Weapon.Utility
+import Dodge.Item.Weapon.Drone
 --import Dodge.Creature.ReaderUpdate
 --import Dodge.Creature.AlertLevel
 --import Dodge.Creature.SetTarget
@@ -33,11 +34,6 @@ import Dodge.Creature.ArmourChase
 import Dodge.Data
 import Dodge.Default
 import Dodge.Item.Weapon
-import Dodge.Item.Weapon.SprayGuns
-import Dodge.Item.Weapon.BatteryGuns
-import Dodge.Item.Weapon.Launcher
-import Dodge.Item.Weapon.BulletGuns
-import Dodge.Item.Weapon.Bezier
 import Dodge.Item.Equipment
 import Dodge.Item.Consumable
 import Dodge.WorldEvent.Cloud
@@ -167,7 +163,7 @@ startCr = defaultCreature
 {- | Items you start with.  -}
 startInvList :: [Item]
 startInvList =
-    [
+    [ lasDrones
     ]
 startInventory :: IM.IntMap Item
 startInventory = IM.fromList $ zip [0..defaultInvSize -1] $ startInvList ++ repeat NoItem

src/Dodge/Creature/Action.hs

@@ -27,6 +27,7 @@ import Dodge.Base.Collide
 import Dodge.SoundLogic
 --import Dodge.WorldEvent
 import Dodge.Inventory
+import Dodge.FloorItem
 --import Dodge.LightSources
 import Geometry
 import Picture
@@ -37,7 +38,6 @@ import Control.Lens
 --import Control.Applicative
 import Data.Maybe
 import Data.List (findIndex)
-import System.Random
 import Control.Monad.Reader
 --import qualified Data.Map as M
 performActions :: World -> Creature -> Creature
@@ -239,40 +239,7 @@ copyInvItemToFloor :: Creature -> Int -> World -> World
 copyInvItemToFloor cr i w = case _crInv cr IM.! i of
     NoItem  -> w
     it      -> copyItemToFloor (_crPos cr) it w
-{- | Copy an item to the floor. -}
-copyItemToFloor :: Point2 -> Item -> World -> World
-copyItemToFloor pos it w = w'
-    & floorItems %~ IM.insert flid theflit
-    & updateLocation 
-  where
-    (p',w') = findWallFreeDropPoint (_itRad $ _itDimension it) pos w
-    rot = fst . randomR (-pi,pi) $ _randGen w
-    updateLocation = case it ^? itID of
-        Just (Just i')  -> itemPositions . ix i' .~ OnFloor flid
-        _ -> id
-    flid = IM.newKey $ _floorItems w
-    theflit = FlIt 
-        {_flIt = it
-        ,_flItPos = p'
-        ,_flItRot = rot
-        ,_flItID = flid
-        }
-findWallFreeDropPoint :: Float -> Point2 -> World -> (Point2,World)
-findWallFreeDropPoint r p w = (head $ mapMaybe f cardinalVectors ++ [p]
-    , w {_randGen = g})
-  where
-    f q = testOnWall r $ p +.+ rotateV rot (10 *.* q)
-    testOnWall r' q | circOnSomeWall q r' w = Nothing
-        | otherwise = Just q
-    (rot, g) = randomR (0,2*pi) $ _randGen w
 
-cardinalVectors :: [Point2]
-cardinalVectors =
-    [ V2   1    0
-    , V2   0    1
-    , V2 (-1)   0
-    , V2   0  (-1)
-    ]
     
 
 {- | Pick up a specific item. -}

src/Dodge/Data.hs

@@ -510,6 +510,8 @@ data Ammo
         , _amBulWth :: Float
         , _amBulVel :: Point2
         }
+    | DroneAmmo
+        { _amString :: String }
     | GenericAmmo
 data PjParam = PjParam
     { _pjMoveParam :: Int -> Item -> Creature -> Prop -> World -> World
@@ -541,6 +543,14 @@ data Prop
         , _pjID :: Int
         , _pjUpdate :: Prop -> World -> World
         }
+    | Drone
+        { _pjPos :: Point2
+        , _pjStartPos :: Point2
+        , _pjVel :: Point2
+        , _prDraw :: Prop -> SPic
+        , _pjID :: Int
+        , _pjUpdate :: Prop -> World -> World
+        }
     | RecursiveProp
         { _pjPos    :: Point2
         , _pjID     :: Int

src/Dodge/Data/DamageType.hs

@@ -19,6 +19,7 @@ data DamageType
     | Flaming  {_dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 }
     | Lasering {_dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 }
     | Electrical {_dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 }
+    | Explosive {_dmAmount :: Int , _dmFrom :: Point2 }
     | Concussive 
         { _dmAmount :: Int 
         , _dmFrom :: Point2 

src/Dodge/FloorItem.hs

@@ -0,0 +1,45 @@
+module Dodge.FloorItem 
+    (copyItemToFloor
+    ) where
+import Dodge.Data
+import Dodge.Base
+import Geometry
+import qualified IntMapHelp as IM
+
+import Control.Lens
+import System.Random
+import Data.Maybe
+
+{- | Copy an item to the floor. -}
+copyItemToFloor :: Point2 -> Item -> World -> World
+copyItemToFloor pos it w = w'
+    & floorItems %~ IM.insert flid theflit
+    & updateLocation 
+  where
+    (p',w') = findWallFreeDropPoint (_itRad $ _itDimension it) pos w
+    rot = fst . randomR (-pi,pi) $ _randGen w
+    updateLocation = case it ^? itID of
+        Just (Just i')  -> itemPositions . ix i' .~ OnFloor flid
+        _ -> id
+    flid = IM.newKey $ _floorItems w
+    theflit = FlIt 
+        {_flIt = it
+        ,_flItPos = p'
+        ,_flItRot = rot
+        ,_flItID = flid
+        }
+cardinalVectors :: [Point2]
+cardinalVectors =
+    [ V2   1    0
+    , V2   0    1
+    , V2 (-1)   0
+    , V2   0  (-1)
+    ]
+findWallFreeDropPoint :: Float -> Point2 -> World -> (Point2,World)
+findWallFreeDropPoint r p w = (head $ mapMaybe f cardinalVectors ++ [p]
+    , w {_randGen = g})
+  where
+    f q = testOnWall r $ p +.+ rotateV rot (10 *.* q)
+    testOnWall r' q | circOnSomeWall q r' w = Nothing
+        | otherwise = Just q
+    (rot, g) = randomR (0,2*pi) $ _randGen w

src/Dodge/Item/Attachment.hs

@@ -66,3 +66,9 @@ changeFuse scrollAmount _ it = it
     oldTime = _itFuseTime $ _itAttachment it
     newTime = min 90 $ max 20 $ oldTime - round (5 * scrollAmount)
     zm = 50 / fromIntegral newTime
+
+--removeItAttachment :: Int -> Int -> World -> World
+--removeItAttachment i _ w = w & creatures . ix i . crInv . ix itRef . itAttachment .~ NoItAttachment
+--  where 
+--    cr = _creatures w IM.! i
+--    itRef = _crInvSel cr

src/Dodge/Item/Craftable.hs

@@ -0,0 +1,23 @@
+module Dodge.Item.Craftable where
+import Dodge.Data
+import Dodge.Default.Weapon
+import Dodge.Picture.Layer
+import Picture
+import Geometry
+
+pipe :: Item
+pipe = Craftable
+    { _itIdentity = Generic
+    , _itDimension = defaultItemDimension
+    , _itCurseStatus = Uncursed
+    , _itName = "PIPE"
+    , _itMaxStack = 3
+    , _itAmount = 3
+    , _itFloorPict = \_ -> (,) mempty 
+        $ onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)]
+    , _itEquipPict = \_ _ -> mempty
+    , _itID = Nothing
+    , _itInvDisplay = _itName
+    , _itInvColor = green
+    , _itAimStance = LeaveHolstered
+    }

src/Dodge/Item/Weapon.hs

@@ -1,361 +1,29 @@
-{- | Definitions of weapons.
+{- | Rexport all weapons -}
-In progress: move out effects into other modules.  -}
+module Dodge.Item.Weapon 
-module Dodge.Item.Weapon where
+    ( module Dodge.Item.Weapon.BulletGuns
-import Dodge.Data
+    , module Dodge.Item.Weapon.TriggerType
-import Dodge.Base
+    , module Dodge.Item.Weapon.ExtraEffect
-import Dodge.Zone
+    , module Dodge.Item.Weapon.UseEffect
-import Dodge.Picture.Layer
+    , module Dodge.Item.Weapon.Remote
-import Dodge.SoundLogic
+    , module Dodge.Item.Weapon.Grenade
-import Dodge.WorldEvent
+    , module Dodge.Item.Weapon.Spawn
-import Dodge.Default
+    , module Dodge.Item.Weapon.Radar
-import Dodge.Item.Draw
+    , module Dodge.Item.Weapon.Utility
+    , module Dodge.Item.Weapon.SprayGuns
+    , module Dodge.Item.Weapon.BatteryGuns
+    , module Dodge.Item.Weapon.Launcher
+    , module Dodge.Item.Weapon.Bezier
+    ) where
 import Dodge.Item.Weapon.BulletGuns
 import Dodge.Item.Weapon.TriggerType
 import Dodge.Item.Weapon.ExtraEffect
 import Dodge.Item.Weapon.UseEffect
 import Dodge.Item.Weapon.Remote
-import Dodge.Default.Weapon
 import Dodge.Item.Weapon.Grenade
-import Geometry
+import Dodge.Item.Weapon.Spawn
-import Picture
+import Dodge.Item.Weapon.Utility
-import qualified IntMapHelp as IM
+import Dodge.Item.Weapon.Radar
-import Shape
+import Dodge.Item.Weapon.SprayGuns
-import ShapePicture
+import Dodge.Item.Weapon.BatteryGuns
-
+import Dodge.Item.Weapon.Launcher
-import Data.Maybe
+import Dodge.Item.Weapon.Bezier
-import Data.Function
-import Control.Lens
-
-effectGun :: String -> (Creature -> World -> World) -> Item
-effectGun name eff = defaultGun
-    { _itName = name ++ "Gun"
-    , _itUse = const eff
-    }
-autoEffectGun :: String -> (Creature -> World -> World) -> Item
-autoEffectGun name eff = defaultAutoGun
-    { _itName = name ++ "Gun"
-    , _itUse = const eff
-    }
-forceFieldGun :: Item
-forceFieldGun = defaultGun 
-    { _itName = "FORCEFIELD"
-    , _itIdentity = ForceFieldGun
-    , _wpMaxAmmo = 100
-    , _wpLoadedAmmo = 100
-    , _wpReloadTime = 40
-    , _wpReloadState = 0
-    , _itUseRate = 10
-    , _itUseTime = 0
-    , _itUse = undefined
-    , _wpSpread = 0.02
-    , _wpRange = 20
-    , _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-4,-4),(-4,4),(4,4),(4,0),(0,0),(0,-4)]
-    , _itAimingSpeed = 0.4
-    , _itAimingRange = 0.5
-    }
--- grapGun = defaultGun 
---     { _itName = "grapGun"
---     , _itIdentity = GrapGun
---     , _wpMaxAmmo = 1
---     , _wpLoadedAmmo = 1
---     , _wpReloadTime = 40
---     , _wpReloadState = 0
---     , _itUseRate = 10
---     , _itUseTime = 0
---     , _itUse = grapFire
---     , _wpSpread = 0.002
---     , _wpRange = 20
---     , _wpIsAuto = False
---     , _itFloorPict = onLayer FlItLayer $ polygon [(-4,-4),(-4,4),(4,4),(4,0),(0,0),(0,-4)]
---     , _itAmount = 1
---     , _itMaxStack = 1
---     , _itAimingSpeed = 1
---     , _itAimingRange = 0.5
---     }
-
-removeItAttachment :: Int -> Int -> World -> World
-removeItAttachment i _ w = w & creatures . ix i . crInv . ix itRef . itAttachment .~ NoItAttachment
-  where 
-    cr = _creatures w IM.! i
-    itRef = _crInvSel cr
-
-shellExplosionAt :: Point2 -> World -> World
-shellExplosionAt = makeExplosionAt
-
-reflect :: Float -> Float -> Float
-reflect a b = a + 2*(a-b)
-
-retireRemoteBomb :: Int -> Int -> Int -> World -> World
-retireRemoteBomb itid 0 pjid w = w
-    & pointToItem (_itemPositions w IM.! itid) %~ 
-        ( (itAttachment . scopePos .~ V2 0 0)
-        . (itZoom .~ defaultItZoom)
-        . (itUse .~ const throwRemoteBomb)
-        )
-    & props %~ IM.delete pjid
-retireRemoteBomb itid t pjid w = setScope w 
-    & props . ix pjid . pjUpdate .~ (\_ -> retireRemoteBomb itid (t-1) pjid)
-  where
-    setScope w' = case _itemPositions w' IM.! itid of
-        InInv cid invid -> w' 
-            & creatures . ix cid . crInv . ix invid . itAttachment 
-                    . scopePos .~ (pos -.- _crPos (_creatures w' IM.! cid))
-        _   -> w'
-    pos = fromMaybe (V2 0 0) $ w ^? props . ix pjid . pjPos
-
-moveRemoteBomb :: Int -> Int -> Int -> World -> World
-moveRemoteBomb itid time pID w 
-    | time < -4 = updatePicture
-                $ set (props .ix pID.pjUpdate) (\_ -> moveRemoteBomb itid (f time) pID)
-                    w
-    | time < 2 = case hitWl of
-            Just (p,_) -> soundStart (Tap 0) p tapQuietS Nothing $ halfV updatedWorld
-            _      -> halfV updatedWorld
-    | otherwise = case hitWl of
-            Just (p,_) -> soundStart (Tap 0) p tapQuietS Nothing updatedWorld
-            _      -> updatedWorld
-  where 
-    updatedWorld 
-        = updateV $ set (props . ix pID . pjPos) finalPos
-            $ updatePicture
-            $ set (props .ix pID.pjUpdate) (\_ -> moveRemoteBomb itid (time-1) pID)
-                w
-    pj     = _props w IM.! pID
-    oldPos = _pjPos pj
-    newPos = _pjVel pj +.+ oldPos
-    -- this is hacky, should use a version of collidePointWalls' that collides
-    -- circles and walls
-    invShift x = x -.- 5 *.* normalizeV (_pjVel pj)
-    hitWl  = collideCircWalls oldPos newPos 4 $ wallsNearPoint newPos w
-    finalPos = maybe newPos (invShift . fst) hitWl
-    setV v = set (props . ix pID . pjVel) v
-    updateV = maybe id (setV . snd) hitWl
-    halfV = props . ix pID . pjVel %~ (0.5 *.*)
-    f x | x < -369 = -10
-        | otherwise = x - 1
-    updatePicture = 
-        set (props . ix pID . prDraw)
-            (\_ -> (,) mempty $ onLayer PtLayer $ uncurryV translate newPos $ remoteBombPic time)
-
-
-setRemoteBombScope :: Int -> Prop -> World -> World
-setRemoteBombScope itid pj w' = case _itemPositions w' IM.! itid of
-    InInv cid invid 
-        -> w' & creatures . ix cid . crInv . ix invid . itAttachment 
-                . scopePos .~ (_pjPos pj -.- _crPos (_creatures w' IM.! cid))
-              & creatures . ix cid . crInv . ix invid . itAimZoom 
-                    .~ (defaultItZoom {_itZoomMax = 0.5, _itZoomMin = 0.5})
-    _   -> w'
-
-defaultThrowable :: Item
-defaultThrowable = grenade
-remoteBomb :: Item
-remoteBomb = defaultThrowable
-    { _itName = "REMOTEBOMB"
-    , _itIdentity = RemoteBomb
-    , _itMaxStack = 1
-    , _itAmount = 1
-    , _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2 
-        [(-3,-3),(-3,3),(3,3),(3,-3)]
-    , _twMaxRange = 150
-    , _twAccuracy = 30
-    , _itUse = const throwRemoteBomb
-    , _itUseModifiers =
-        [ hammerCheckI
-        ]
-    , _itAttachment = ItScope (V2 0 0) 0 1 True
-    , _itEquipPict = pictureWeaponOnAim' $ \_ -> (,) emptySH remoteBombUnarmedPic
-    }
-
-
-throwRemoteBomb :: Creature -> World -> World
-throwRemoteBomb cr w = setLocation 
-    $ removePict 
-    $ resetFire 
-    $ resetName 
-    $ over props addG w
-  where 
-    cid = _crID cr
-    addG = IM.insert i $ Projectile 
-        { _pjPos = p
-        , _pjStartPos = p
-        , _pjVel = v
-        , _prDraw = const mempty
-        , _pjID = i
-        , _pjUpdate = \_ -> moveRemoteBomb itid 50 i
-        }
-    i = newProjectileKey w
-    v' = 0.02 / _cameraZoom w *.* rotateV (_cameraRot w) ( _mousePos w)
-    v   | magV v' > 6 = 6 *.* normalizeV v'
-        | otherwise   = v'
-    j = _crInvSel cr
-    resetName = set (creatures . ix cid . crInv . ix j . itName) "REMOTE"
-    removePict = set (creatures . ix cid . crInv . ix j . itEquipPict) $ \ _ _ -> emptyBlank
-    resetFire = set (creatures . ix cid . crInv . ix j . itUse) 
-        $ \_ -> explodeRemoteBomb itid i
-    p' = _crPos cr +.+ rotateV (_crDir cr) (V2 (_crRad cr) 0)
-    p | circOnSomeWall p' 4 w = _crPos cr +.+ rotateV (_crDir cr) (V2 (_crRad cr-4) 0)
-      | otherwise             = p'
-    maybeitid = w ^? creatures . ix cid . crInv . ix j . itID . _Just
-    setLocation :: World -> World
-    setLocation w' = case maybeitid of
-        Nothing -> w' & creatures . ix cid . crInv . ix j . itID ?~ newitid
-                      & itemPositions %~ IM.insert newitid (InInv cid j)
-        _ -> w'
-    newitid = IM.newKey $ _itemPositions w
-    itid = fromMaybe newitid maybeitid
-
-explodeRemoteBomb :: Int -> Int -> Creature -> World -> World
-explodeRemoteBomb itid pjid cr w
-    = set (props . ix pjid . pjUpdate) (\_ -> retireRemoteBomb itid 30 pjid)
---        $ set (props . ix pjid . pjDraw) (\_ -> blank)
-        $ set (creatures . ix cid . crInv . ix j . itUse) (\_ -> const id)
-        $ resetName
-        $ resetPict
---        $ resetScope
-        $ makeExplosionAt (_pjPos (_props w IM.! pjid)) w
-        -- - $ makeShrapnelBombAt (_pjPos (_props w IM.! pjid)) w
-  where 
-    cid = _crID cr
-    resetName = set (creatures . ix cid . crInv . ix j . itName) "REMOTEBOMB"
-    resetPict = set (creatures . ix cid . crInv . ix j . itEquipPict ) 
-                    (pictureWeaponOnAim' $ \_ -> (,) emptySH remoteBombUnarmedPic)
---    resetScope = creatures . ix cid . crInv . ix j . itScope . _Just . scopePos .~ (0,0)
-    j = _crInvSel $ _creatures w IM.! cid
-remoteBombPic 
-    :: Int -- ^ time
-    -> Picture
-remoteBombPic _ = pictures 
-    [ color (dark $ dark orange) $ circleSolid 5
-    ]
-
-remoteBombUnarmedPic :: Picture
-remoteBombUnarmedPic = color (dark $ dark orange) $ circleSolid 5
-
-pipe :: Item
-pipe = Craftable
-    { _itIdentity = Generic
-    , _itDimension = defaultItemDimension
-    , _itCurseStatus = Uncursed
-    , _itName = "PIPE"
-    , _itMaxStack = 3
-    , _itAmount = 3
-    , _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)]
-    , _itEquipPict = \_ _ -> emptyBlank
-    , _itID = Nothing
-    , _itInvDisplay = _itName
-    , _itInvColor = green
-    , _itAimStance = LeaveHolstered
-    }
-{- |
-Sends out pulses that display walls.  -}
-radar :: Item
-radar = defaultGun 
-    { _itName = "RADAR"
-    , _itIdentity = Generic
-    , _wpMaxAmmo = 100
-    , _wpLoadedAmmo = 100
-    , _wpReloadTime = 200
-    , _wpReloadState = 0
-    , _itUseRate = 120
-    , _itUseTime = 0
-    , _itUse = const aRadarPulse
-    , _itUseModifiers =
-        [ ammoUseCheckI
-        ]
-    , _wpSpread = autogunSpread
-    , _wpRange = 20
-    , _itHammer = HammerUp
-    , _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ color blue $ polygon $ rectNESW 5 5 (-5) (-5)
-    , _itAimingRange = 1
-    , _itZoom       = defaultItZoom { _itZoomMax = 1}
-    , _itAimZoom    = defaultItZoom { _itZoomMax = 1}
-    , _itEquipPict = pictureWeaponOnAim' $ \_ -> (,) emptySH $ color blue $ polygon $ rectNESW 5 5 (-5) (-5)
-    }
-{- |
-Sends out pulses that display creatures.  -}
-sonar :: Item
-sonar = defaultGun 
-    { _itName = "SONAR"
-    , _itIdentity = Generic
-    , _wpMaxAmmo = 100
-    , _wpLoadedAmmo = 100
-    , _wpReloadTime = 200
-    , _wpReloadState = 0
-    , _itUseRate = 120
-    , _itUseTime = 0
-    , _itUse = const aSonarPulse
-    , _itUseModifiers =
-        [ ammoUseCheckI
-        ]
-    , _wpRange = 20
-    , _itHammer = HammerUp
-    , _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ color blue $ polygon $ rectNESW 5 5 (-5) (-5)
-    , _itAimingRange = 1
-    , _itZoom       = defaultItZoom {_itZoomMax = 1}
-    , _itAimZoom    = defaultItZoom {_itZoomMax = 1}
-    , _itEquipPict = pictureWeaponOnAim' $ \_ -> (,) emptySH $ color blue $ polygon $ rectNESW 5 5 (-5) (-5)
-    }
-{- |
-Automatically sends out pulses that display creatures.  -}
-autoSonar :: Item
-autoSonar = defaultEquipment
-    { _itIdentity = Generic
-    , _itName = "AUTOSONAR"
-    , _itMaxStack = 1
-    , _itAmount = 1
-    , _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ color yellow $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)]
-    , _itEquipPict = \_ _ -> (,) emptySH blank
-    , _itEffect = autoSonarEffect
-    , _itID = Nothing
-    , _itAimingSpeed = 1
-    , _itAimingRange = 0
-    , _itZoom = defaultItZoom {_itZoomMax = 1}
-    , _itAimZoom = defaultItZoom {_itZoomMax = 1}
-    }
-{- |
-Automatically sends out pulses that display walls.  -}
-autoRadar :: Item
-autoRadar = defaultEquipment
-    { _itIdentity = Generic
-    , _itName = "AUTORADAR"
-    , _itMaxStack = 1
-    , _itAmount = 1
-    , _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ color yellow $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)]
-    , _itEquipPict = \_ _ -> (,) emptySH blank
-    , _itEffect = autoRadarEffect
-    , _itID = Nothing
-    , _itAimingSpeed = 1
-    , _itAimingRange = 0
-    , _itZoom = defaultItZoom {_itZoomMax = 1}
-    , _itAimZoom = defaultItZoom {_itZoomMax = 1}
-    }
-{- |
-Creates a creature next to the creature using the item.  -}
-spawnGun :: Creature -> Item
-spawnGun cr = defaultGun
-    { _itName       = "SPAWNER"
-    , _wpMaxAmmo    = 1
-    , _wpLoadedAmmo = 1
-    , _wpReloadTime = 80
-    , _wpReloadState = 0
-    , _itUseRate   = 100
-    , _itUse       = \_ -> spawnCrNextTo cr
-    , _itUseModifiers =
-        [ ammoCheckI
-        , hammerCheckI
-        ]
-    }
-spawnCrNextTo 
-    :: Creature -- ^ Creature to spawn
-    -> Creature -- ^ existing creature that will be spawned next to
-    -> World 
-    -> World
-spawnCrNextTo cr sCr w = w & creatures %~ IM.insert k newCr
-  where
-    k = IM.newKey $ _creatures w
-    newCr = cr
-        & crID  .~ k
-        & crPos .~ _crPos sCr +.+ unitVectorAtAngle (_crDir sCr)
-        & crOldPos .~ _crPos sCr +.+ unitVectorAtAngle (_crDir sCr)
-

src/Dodge/Item/Weapon/BatteryGuns.hs

@@ -82,7 +82,7 @@ lasGun = defaultAutoGun
         [ ammoCheckI
         , useTimeCheckI
         , withTempLight 1 100 (V3 1 1 0)
-        , withSoundForI tone440sawtoothS 1
+        , withSoundForI tone440sawtoothquietS 2
         , useAmmo 1
         ]
     , _wpSpread = 0.001

src/Dodge/Item/Weapon/Drone.hs

@@ -0,0 +1,81 @@
+module Dodge.Item.Weapon.Drone where
+import Dodge.Data
+import Dodge.Default.Weapon
+import Dodge.Default.Shell
+import Dodge.SoundLogic.LoadSound
+import Dodge.Item.Weapon.TriggerType
+import Geometry
+import Geometry.Vector3D
+import Picture
+import qualified IntMapHelp as IM
+import ShapePicture
+import Shape
+
+--import qualified Data.Set as S
+--import qualified SDL
+--import Data.Maybe
+import Control.Lens
+--import Control.Applicative
+--import Control.Monad.State
+--import System.Random
+
+lasDrones :: Item
+lasDrones = defaultGun 
+    { _itName = "ROCKO"
+    , _itIdentity = Launcher
+    , _wpMaxAmmo = 30
+    , _wpLoadedAmmo = 30
+    , _wpReloadTime = 80
+    , _wpReloadState = 0
+    , _itUseRate = 20
+    , _itUseTime = 0
+    , _itUse = aDroneWithItemParams
+    , _itUseModifiers =
+        [ ammoCheckI
+        , useTimeCheckI
+        , withSoundStart tap4S
+        , useAmmo 1
+        ]
+    , _wpSpread = 0.02
+    , _wpRange = 20
+    , _itFloorPict = lasDronesPic
+    , _itAimingSpeed = 0.2
+    , _itAimingRange = 0.5
+    , _itHammer = NoHammer
+    , _itEffect = NoItEffect
+    , _wpAmmo = DroneAmmo
+        { _amString = "LASDRONE" }
+    , _itAimStance = TwoHandTwist
+    }
+
+lasDronesPic :: Item -> SPic
+lasDronesPic _ = 
+    ( colorSH chartreuse $ prismPoly
+        (map (+.+.+ V3 10 0 4.5) $ polyCircx 4 5)
+        (map (+.+.+ V3 (-10) 0 4.5) $ polyCircx 4 5)
+    , mempty
+    )
+
+aDroneWithItemParams
+    :: Item   -- ^ Firing item
+    -> Creature
+    -> World
+    -> World
+aDroneWithItemParams it cr w = over props (IM.insert i theShell) w
+  where 
+    am = _wpAmmo it
+    i = IM.newKey $ _props w
+    pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir)
+    dir = _crDir cr
+    --ammoMvs pj w' = foldr (\pjP -> _pjMoveParam pjP (_pjIntParam pjP) it cr pj) w' (_amPjParams am)
+    theShell = defaultShell
+        { _pjPos = pos
+        , _pjStartPos = pos
+        , _pjVel = rotateV dir (V2 1 0)
+        , _pjAcc = rotateV dir (V2 3 0)
+        , _prDraw = _amPjDraw am
+        , _pjID = i
+        , _pjUpdate = \_ -> id
+        , _pjPayload = _amPayload am
+        , _pjTimer = 50
+        }

src/Dodge/Item/Weapon/Grenade.hs

@@ -1,10 +1,10 @@
 module Dodge.Item.Weapon.Grenade
-    ( grenade
+     where
-    ) where
 import Dodge.Data
 import Dodge.Picture.Layer
 import Dodge.WorldEvent.Explosion
 import Dodge.Item.Weapon.TriggerType
+import Dodge.Item.Weapon.Remote
 import Dodge.Default
 import Dodge.Default.Weapon
 import Dodge.Base
@@ -18,9 +18,10 @@ import Picture
 import Geometry
 import ShapePicture
 import Shape
+import qualified IntMapHelp as IM
 
+import Data.Maybe
 import Control.Lens
-import qualified Data.IntMap.Strict as IM
 
 grenade :: Item
 grenade = Throwable
@@ -151,3 +152,168 @@ throwArmReset x = ItInvEffect {_itInvEffect = f ,_itEffectCounter = x }
 --    }
 --  where 
 --    fuseTime = 50 :: Int
+--
+--retireRemoteBomb :: Int -> Int -> Int -> World -> World
+--retireRemoteBomb itid 0 pjid w = w
+--    & pointToItem (_itemPositions w IM.! itid) %~ 
+--        ( (itAttachment . scopePos .~ V2 0 0)
+--        . (itZoom .~ defaultItZoom)
+--        . (itUse .~ const throwRemoteBomb)
+--        )
+--    & props %~ IM.delete pjid
+--retireRemoteBomb itid t pjid w = setScope w 
+--    & props . ix pjid . pjUpdate .~ (\_ -> retireRemoteBomb itid (t-1) pjid)
+--  where
+--    setScope w' = case _itemPositions w' IM.! itid of
+--        InInv cid invid -> w' 
+--            & creatures . ix cid . crInv . ix invid . itAttachment 
+--                    . scopePos .~ (pos -.- _crPos (_creatures w' IM.! cid))
+--        _   -> w'
+--    pos = fromMaybe (V2 0 0) $ w ^? props . ix pjid . pjPos
+
+moveRemoteBomb :: Int -> Int -> Int -> World -> World
+moveRemoteBomb itid time pID w 
+    | time < -4 = updatePicture
+                $ set (props .ix pID.pjUpdate) (\_ -> moveRemoteBomb itid (f time) pID)
+                    w
+    | time < 2 = case hitWl of
+            Just (p,_) -> soundStart (Tap 0) p tapQuietS Nothing $ halfV updatedWorld
+            _      -> halfV updatedWorld
+    | otherwise = case hitWl of
+            Just (p,_) -> soundStart (Tap 0) p tapQuietS Nothing updatedWorld
+            _      -> updatedWorld
+  where 
+    updatedWorld 
+        = updateV $ set (props . ix pID . pjPos) finalPos
+            $ updatePicture
+            $ set (props .ix pID.pjUpdate) (\_ -> moveRemoteBomb itid (time-1) pID)
+                w
+    pj     = _props w IM.! pID
+    oldPos = _pjPos pj
+    newPos = _pjVel pj +.+ oldPos
+    -- this is hacky, should use a version of collidePointWalls' that collides
+    -- circles and walls
+    invShift x = x -.- 5 *.* normalizeV (_pjVel pj)
+    hitWl  = collideCircWalls oldPos newPos 4 $ wallsNearPoint newPos w
+    finalPos = maybe newPos (invShift . fst) hitWl
+    setV v = set (props . ix pID . pjVel) v
+    updateV = maybe id (setV . snd) hitWl
+    halfV = props . ix pID . pjVel %~ (0.5 *.*)
+    f x | x < -369 = -10
+        | otherwise = x - 1
+    updatePicture = 
+        set (props . ix pID . prDraw)
+            (\_ -> (,) mempty $ onLayer PtLayer $ uncurryV translate newPos $ remoteBombPic time)
+
+
+setRemoteBombScope :: Int -> Prop -> World -> World
+setRemoteBombScope itid pj w' = case _itemPositions w' IM.! itid of
+    InInv cid invid 
+        -> w' & creatures . ix cid . crInv . ix invid . itAttachment 
+                . scopePos .~ (_pjPos pj -.- _crPos (_creatures w' IM.! cid))
+              & creatures . ix cid . crInv . ix invid . itAimZoom 
+                    .~ (defaultItZoom {_itZoomMax = 0.5, _itZoomMin = 0.5})
+    _   -> w'
+
+defaultThrowable :: Item
+defaultThrowable = grenade
+remoteBomb :: Item
+remoteBomb = defaultThrowable
+    { _itName = "REMOTEBOMB"
+    , _itIdentity = RemoteBomb
+    , _itMaxStack = 1
+    , _itAmount = 1
+    , _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2 
+        [(-3,-3),(-3,3),(3,3),(3,-3)]
+    , _twMaxRange = 150
+    , _twAccuracy = 30
+    , _itUse = const throwRemoteBomb
+    , _itUseModifiers =
+        [ hammerCheckI
+        ]
+    , _itAttachment = ItScope (V2 0 0) 0 1 True
+    , _itEquipPict = pictureWeaponOnAim' $ \_ -> (,) emptySH remoteBombUnarmedPic
+    }
+
+
+throwRemoteBomb :: Creature -> World -> World
+throwRemoteBomb cr w = setLocation 
+    $ removePict 
+    $ resetFire 
+    $ resetName 
+    $ over props addG w
+  where 
+    cid = _crID cr
+    addG = IM.insert i $ Projectile 
+        { _pjPos = p
+        , _pjStartPos = p
+        , _pjVel = v
+        , _prDraw = const mempty
+        , _pjID = i
+        , _pjUpdate = \_ -> moveRemoteBomb itid 50 i
+        }
+    i = newProjectileKey w
+    v' = 0.02 / _cameraZoom w *.* rotateV (_cameraRot w) ( _mousePos w)
+    v   | magV v' > 6 = 6 *.* normalizeV v'
+        | otherwise   = v'
+    j = _crInvSel cr
+    resetName = set (creatures . ix cid . crInv . ix j . itName) "REMOTE"
+    removePict = set (creatures . ix cid . crInv . ix j . itEquipPict) $ \ _ _ -> emptyBlank
+    resetFire = set (creatures . ix cid . crInv . ix j . itUse) 
+        $ \_ -> explodeRemoteBomb itid i
+    p' = _crPos cr +.+ rotateV (_crDir cr) (V2 (_crRad cr) 0)
+    p | circOnSomeWall p' 4 w = _crPos cr +.+ rotateV (_crDir cr) (V2 (_crRad cr-4) 0)
+      | otherwise             = p'
+    maybeitid = w ^? creatures . ix cid . crInv . ix j . itID . _Just
+    setLocation :: World -> World
+    setLocation w' = case maybeitid of
+        Nothing -> w' & creatures . ix cid . crInv . ix j . itID ?~ newitid
+                      & itemPositions %~ IM.insert newitid (InInv cid j)
+        _ -> w'
+    newitid = IM.newKey $ _itemPositions w
+    itid = fromMaybe newitid maybeitid
+
+explodeRemoteBomb :: Int -> Int -> Creature -> World -> World
+explodeRemoteBomb itid pjid cr w
+    = set (props . ix pjid . pjUpdate) (\_ -> retireRemoteBomb itid 30 pjid)
+--        $ set (props . ix pjid . pjDraw) (\_ -> blank)
+        $ set (creatures . ix cid . crInv . ix j . itUse) (\_ -> const id)
+        $ resetName
+        $ resetPict
+--        $ resetScope
+        $ makeExplosionAt (_pjPos (_props w IM.! pjid)) w
+        -- - $ makeShrapnelBombAt (_pjPos (_props w IM.! pjid)) w
+  where 
+    cid = _crID cr
+    resetName = set (creatures . ix cid . crInv . ix j . itName) "REMOTEBOMB"
+    resetPict = set (creatures . ix cid . crInv . ix j . itEquipPict ) 
+                    (pictureWeaponOnAim' $ \_ -> (,) emptySH remoteBombUnarmedPic)
+--    resetScope = creatures . ix cid . crInv . ix j . itScope . _Just . scopePos .~ (0,0)
+    j = _crInvSel $ _creatures w IM.! cid
+remoteBombPic 
+    :: Int -- ^ time
+    -> Picture
+remoteBombPic _ = pictures 
+    [ color (dark $ dark orange) $ circleSolid 5
+    ]
+
+remoteBombUnarmedPic :: Picture
+remoteBombUnarmedPic = color (dark $ dark orange) $ circleSolid 5
+
+retireRemoteBomb :: Int -> Int -> Int -> World -> World
+retireRemoteBomb itid 0 pjid w = w
+    & pointToItem (_itemPositions w IM.! itid) %~ 
+        ( (itAttachment . scopePos .~ V2 0 0)
+        . (itZoom .~ defaultItZoom)
+        . (itUse .~ const throwRemoteBomb)
+        )
+    & props %~ IM.delete pjid
+retireRemoteBomb itid t pjid w = setScope w 
+    & props . ix pjid . pjUpdate .~ (\_ -> retireRemoteBomb itid (t-1) pjid)
+  where
+    setScope w' = case _itemPositions w' IM.! itid of
+        InInv cid invid -> w' 
+            & creatures . ix cid . crInv . ix invid . itAttachment 
+                    . scopePos .~ (pos -.- _crPos (_creatures w' IM.! cid))
+        _   -> w'
+    pos = fromMaybe (V2 0 0) $ w ^? props . ix pjid . pjPos

src/Dodge/Item/Weapon/Radar.hs

@@ -0,0 +1,99 @@
+module Dodge.Item.Weapon.Radar where
+import Dodge.Data
+import Dodge.Picture.Layer
+import Dodge.Default
+import Dodge.Item.Draw
+import Dodge.Item.Weapon.BulletGuns
+import Dodge.Item.Weapon.TriggerType
+import Dodge.Item.Weapon.ExtraEffect
+import Dodge.Item.Weapon.UseEffect
+--import Dodge.Item.Weapon.Remote
+import Dodge.Default.Weapon
+--import Dodge.Item.Weapon.Grenade
+import Geometry
+import Picture
+import Shape
+
+{- |
+Sends out pulses that display walls.  -}
+radar :: Item
+radar = defaultGun 
+    { _itName = "RADAR"
+    , _itIdentity = Generic
+    , _wpMaxAmmo = 100
+    , _wpLoadedAmmo = 100
+    , _wpReloadTime = 200
+    , _wpReloadState = 0
+    , _itUseRate = 120
+    , _itUseTime = 0
+    , _itUse = const aRadarPulse
+    , _itUseModifiers =
+        [ ammoUseCheckI
+        ]
+    , _wpSpread = autogunSpread
+    , _wpRange = 20
+    , _itHammer = HammerUp
+    , _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ color blue $ polygon $ rectNESW 5 5 (-5) (-5)
+    , _itAimingRange = 1
+    , _itZoom       = defaultItZoom { _itZoomMax = 1}
+    , _itAimZoom    = defaultItZoom { _itZoomMax = 1}
+    , _itEquipPict = pictureWeaponOnAim' $ \_ -> (,) emptySH $ color blue $ polygon $ rectNESW 5 5 (-5) (-5)
+    }
+{- |
+Sends out pulses that display creatures.  -}
+sonar :: Item
+sonar = defaultGun 
+    { _itName = "SONAR"
+    , _itIdentity = Generic
+    , _wpMaxAmmo = 100
+    , _wpLoadedAmmo = 100
+    , _wpReloadTime = 200
+    , _wpReloadState = 0
+    , _itUseRate = 120
+    , _itUseTime = 0
+    , _itUse = const aSonarPulse
+    , _itUseModifiers =
+        [ ammoUseCheckI
+        ]
+    , _wpRange = 20
+    , _itHammer = HammerUp
+    , _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ color blue $ polygon $ rectNESW 5 5 (-5) (-5)
+    , _itAimingRange = 1
+    , _itZoom       = defaultItZoom {_itZoomMax = 1}
+    , _itAimZoom    = defaultItZoom {_itZoomMax = 1}
+    , _itEquipPict = pictureWeaponOnAim' $ \_ -> (,) emptySH $ color blue $ polygon $ rectNESW 5 5 (-5) (-5)
+    }
+{- |
+Automatically sends out pulses that display creatures.  -}
+autoSonar :: Item
+autoSonar = defaultEquipment
+    { _itIdentity = Generic
+    , _itName = "AUTOSONAR"
+    , _itMaxStack = 1
+    , _itAmount = 1
+    , _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ color yellow $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)]
+    , _itEquipPict = \_ _ -> (,) emptySH blank
+    , _itEffect = autoSonarEffect
+    , _itID = Nothing
+    , _itAimingSpeed = 1
+    , _itAimingRange = 0
+    , _itZoom = defaultItZoom {_itZoomMax = 1}
+    , _itAimZoom = defaultItZoom {_itZoomMax = 1}
+    }
+{- |
+Automatically sends out pulses that display walls.  -}
+autoRadar :: Item
+autoRadar = defaultEquipment
+    { _itIdentity = Generic
+    , _itName = "AUTORADAR"
+    , _itMaxStack = 1
+    , _itAmount = 1
+    , _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ color yellow $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)]
+    , _itEquipPict = \_ _ -> (,) emptySH blank
+    , _itEffect = autoRadarEffect
+    , _itID = Nothing
+    , _itAimingSpeed = 1
+    , _itAimingRange = 0
+    , _itZoom = defaultItZoom {_itZoomMax = 1}
+    , _itAimZoom = defaultItZoom {_itZoomMax = 1}
+    }

src/Dodge/Item/Weapon/Spawn.hs

@@ -0,0 +1,41 @@
+module Dodge.Item.Weapon.Spawn where
+import Dodge.Data
+import Dodge.Item.Weapon.TriggerType
+--import Dodge.Item.Weapon.Remote
+import Dodge.Default.Weapon
+--import Dodge.Item.Weapon.Grenade
+import Geometry
+import qualified IntMapHelp as IM
+
+import Data.Function
+import Control.Lens
+
+
+{- |
+Creates a creature next to the creature using the item.  -}
+spawnGun :: Creature -> Item
+spawnGun cr = defaultGun
+    { _itName       = "SPAWNER"
+    , _wpMaxAmmo    = 1
+    , _wpLoadedAmmo = 1
+    , _wpReloadTime = 80
+    , _wpReloadState = 0
+    , _itUseRate   = 100
+    , _itUse       = \_ -> spawnCrNextTo cr
+    , _itUseModifiers =
+        [ ammoCheckI
+        , hammerCheckI
+        ]
+    }
+spawnCrNextTo 
+    :: Creature -- ^ Creature to spawn
+    -> Creature -- ^ existing creature that will be spawned next to
+    -> World 
+    -> World
+spawnCrNextTo cr sCr w = w & creatures %~ IM.insert k newCr
+  where
+    k = IM.newKey $ _creatures w
+    newCr = cr
+        & crID  .~ k
+        & crPos .~ _crPos sCr +.+ unitVectorAtAngle (_crDir sCr)
+        & crOldPos .~ _crPos sCr +.+ unitVectorAtAngle (_crDir sCr)

src/Dodge/Item/Weapon/Utility.hs

@@ -80,3 +80,50 @@ aSelf = blinkAction
 
 aSelfL :: Creature -> Int -> World -> World
 aSelfL cr _ = blinkAction cr
+
+effectGun :: String -> (Creature -> World -> World) -> Item
+effectGun name eff = defaultGun
+    { _itName = name ++ "Gun"
+    , _itUse = const eff
+    }
+autoEffectGun :: String -> (Creature -> World -> World) -> Item
+autoEffectGun name eff = defaultAutoGun
+    { _itName = name ++ "Gun"
+    , _itUse = const eff
+    }
+forceFieldGun :: Item
+forceFieldGun = defaultGun 
+    { _itName = "FORCEFIELD"
+    , _itIdentity = ForceFieldGun
+    , _wpMaxAmmo = 100
+    , _wpLoadedAmmo = 100
+    , _wpReloadTime = 40
+    , _wpReloadState = 0
+    , _itUseRate = 10
+    , _itUseTime = 0
+    , _itUse = undefined
+    , _wpSpread = 0.02
+    , _wpRange = 20
+    , _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-4,-4),(-4,4),(4,4),(4,0),(0,0),(0,-4)]
+    , _itAimingSpeed = 0.4
+    , _itAimingRange = 0.5
+    }
+-- grapGun = defaultGun 
+--     { _itName = "grapGun"
+--     , _itIdentity = GrapGun
+--     , _wpMaxAmmo = 1
+--     , _wpLoadedAmmo = 1
+--     , _wpReloadTime = 40
+--     , _wpReloadState = 0
+--     , _itUseRate = 10
+--     , _itUseTime = 0
+--     , _itUse = grapFire
+--     , _wpSpread = 0.002
+--     , _wpRange = 20
+--     , _wpIsAuto = False
+--     , _itFloorPict = onLayer FlItLayer $ polygon [(-4,-4),(-4,4),(4,4),(4,0),(0,0),(0,-4)]
+--     , _itAmount = 1
+--     , _itMaxStack = 1
+--     , _itAimingSpeed = 1
+--     , _itAimingRange = 0.5
+--     }

src/Dodge/Placement/Instance/Turret.hs

@@ -3,6 +3,7 @@ import Color
 import Dodge.Data
 import Dodge.LevelGen.Data
 import Dodge.Default
+import Dodge.FloorItem
 import Dodge.Wall.Delete
 import Dodge.WorldEvent.Explosion
 import Dodge.Item.Weapon.BatteryGuns
@@ -37,6 +38,7 @@ updateTurret rotSpeed mc w
     | _mcHP mc < 1 = w & machines %~ IM.delete mcid
         & deleteWallIDs (_mcWallIDs mc)
         & makeExplosionAt mcpos
+        & copyItemToFloor mcpos lasGun
     | otherwise = w & doDamage & maybeFire & elecDamBranch
   where
     doDamage = machines . ix mcid %~ 
@@ -46,10 +48,11 @@ updateTurret rotSpeed mc w
     elecDamBranch
         | elecDam < 10 = updateFiringStatus . doTurn
         | otherwise = id
+    -- TODO make this use the same function as the lasgun
     maybeFire
         | _tuFireTime (_mcType mc) > 0
             = ( particles %~ (makeLaserAt 5 (mcpos + 15 *.* unitVectorAtAngle mcdir) mcdir :) )
-            . soundContinue (MachineSound mcid) mcpos tone440sawtoothS (Just 1)
+            . soundContinue (MachineSound mcid) mcpos tone440sawtoothquietS (Just 1)
         | otherwise = id
     mcid = _mcID mc
     ypos = _crPos $ you w

src/Dodge/Room/Procedural.hs

@@ -21,7 +21,6 @@ import Dodge.Item.Consumable
 import Dodge.Item.Equipment
 import Dodge.Room.Foreground
 import Dodge.Item.Weapon
-import Dodge.Item.Weapon.Launcher
 import Dodge.RandomHelp
 import Dodge.Placement.PlaceSpot
 import Dodge.LevelGen.Data

src/Dodge/Room/Start.hs

@@ -73,7 +73,7 @@ lasSensorTurretTest :: RandomGen g => Int -> State g (Tree (Either Room Room))
 lasSensorTurretTest n = do
     cenroom <- randomiseOutLinks $ centralLasTurret {_rmLabel = Just n}
     let doorroom = switchDoorRoom {_rmTakeFrom = Just n}
-    return $ treeFromPost [Left cenroom,Left doorroom] (Right door)
+    return $ treeFromPost [Left door,Left cenroom,Left doorroom] (Right door)
 
 rezThenLasTurret :: RandomGen g => State g (Tree (Either Room Room))
 rezThenLasTurret = do

src/Dodge/Wall/Damage.hs

@@ -27,6 +27,7 @@ wallEff dt wl = case dt of
     Piercing _ sp p _ -> colSpark' 0.2 8 pSparkCol (outTo sp p) (reflDirWall sp p wl)
         . wlDustAt wl (outTo sp p)
     Blunt    _ sp p _ -> wlDustAt wl (outTo sp p)
+    Explosive _ _ -> id
     Cutting {} -> id
     SparkDam {} -> id
     Flaming  {} -> id
@@ -46,6 +47,7 @@ damageBlockWith dt = case dt of
     Piercing dam _ _ _ -> blHPs %~ reduceHead dam
     Blunt    dam _ _ _ -> blHPs %~ reduceHead dam
     Cutting  dam _ _ _ -> blHPs %~ reduceHead dam
+    Explosive dam _    -> blHPs %~ reduceHead dam
     Concussive dam _ _ _ _ -> blHPs %~ reduceHead dam
     Lasering {} -> id
     SparkDam {} -> id

src/Dodge/WorldEvent/Shockwave.hs

@@ -14,6 +14,7 @@ import Picture
 import qualified Data.IntMap.Strict as IM
 import Control.Lens
 
+-- currently very effective against walls
 makeShockwaveAt 
     :: [Int]    -- ^ IDs of invulnerable creatures.
     -> Point2   -- ^ Center of shockwave.
@@ -63,7 +64,8 @@ mvShockwave is w pt
     t    = _btTimer' pt
     tFraction = fromIntegral t / fromIntegral (_btMaxTime' pt)
     rad = r - (3/4) * r * tFraction
-    doDams = over creatures (IM.map damCr) . flip (IM.foldl' (flip $ damageBlocksBy 1)) hitBlocks
+    doDams = over creatures (IM.map damCr) . flip (IM.foldl' (flip $ damageWall (Explosive 10000 p))) 
+        hitBlocks
     hitBlocks = wallsOnCirc p rad $ wallsNearPoint p w 
     damCr cr 
         | _crID cr `elem` is || dist (_crPos cr) p >= rad + _crRad cr  = cr