Fix aiming with no weapon crash

src/Dodge/Base.hs

@@ -280,6 +280,16 @@ collideCircWalls p1 p2 rad ws
 --        . _wlLine') ws
 --  where 
 --    f (a,_) = magV (p1 -.- a)
+--
+-- | Looks for first collision of a point with walls.
+-- If found, gives point and wall.
+collidePointWallsWall :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe (Point2,Wall)
+collidePointWallsWall p1 p2 ws 
+    = safeMinimumOn f 
+    $ IM.mapMaybe ( \wl -> uncurry (intersectSegSeg p1 p2) (_wlLine wl) <&> ( , wl ) ) 
+        ws
+  where 
+    f (a,_) = magV (p1 -.- a)
 
 -- | Looks for first collision of a point with walls.
 -- If found, gives point and normal of wall.

src/Dodge/Clock.hs

@@ -1,7 +1,6 @@
 module Dodge.Clock
     ( clockCycle
-    )
+    ) where
-    where
 import Dodge.Data
 
 import qualified Data.Vector as V

src/Dodge/Combine.hs

@@ -31,15 +31,15 @@ combinationsTrie = foldr (uncurry insertInTrie . first (sortOn snd))
 -- trie going through each combine type in your inventory in order, rather than
 -- creating all multisets of combine types.
 
-lookupItems' :: [(CombineType,Int,Int)] -> [ ([Int],Item) ]
+lookupItems :: [(CombineType,Int,Int)] -> [ ([Int],Item) ]
-lookupItems' xs = lookupItems (sortOn (\(ct,_,_) -> ct) xs) combinationsTrie
+lookupItems xs = lookupItemsUsingTrie (sortOn (\(ct,_,_) -> ct) xs) combinationsTrie
 
-lookupItems :: [(CombineType,Int,Int)] -> Trie (Int,CombineType) Item -> [ ([Int],Item) ]
+lookupItemsUsingTrie :: [(CombineType,Int,Int)] -> Trie (Int,CombineType) Item -> [ ([Int],Item) ]
-lookupItems [] t = maybeToList $ ([],) <$> _trieMVal t
+lookupItemsUsingTrie [] t = maybeToList $ ([],) <$> _trieMVal t
-lookupItems ((ct,i,n):xs) t = do
+lookupItemsUsingTrie ((ct,i,n):xs) t = do
     n' <- [1..min n 4]
     let is = replicate n' i
-    concatMap (map (first (is ++)) . lookupItems xs) $ maybeToList (_trieChildren t M.!? (n',ct))
+    concatMap (map (first (is ++)) . lookupItemsUsingTrie xs) $ maybeToList (_trieChildren t M.!? (n',ct))
 
 invertListInvMult :: IM.IntMap Item -> [[(CombineType,Int,Int)]]
 invertListInvMult = powlistUpToN 4 . invertListInv
@@ -50,7 +50,7 @@ invertListInv = IM.foldrWithKey
     []
 
 combineItemListYou :: World -> [([Int],Item)]
-combineItemListYou = concatMap lookupItems' . invertListInvMult . yourInv
+combineItemListYou = concatMap lookupItems . invertListInvMult . yourInv
 
 toggleCombineInv :: World -> World
 toggleCombineInv w = case _inventoryMode w of

src/Dodge/Combine/Combinations.hs

@@ -2,6 +2,7 @@
 module Dodge.Combine.Combinations where
 import Dodge.Data
 import Dodge.Item.Equipment
+import Dodge.Item.Craftable
 import Dodge.Item.Weapon.BulletGuns
 import Dodge.Item.Weapon.Launcher
 import Dodge.Item.Weapon.SprayGuns
@@ -44,6 +45,10 @@ itemCombinations =
     , po [FLAMESTICK,DRUM,DRUM] flameWall
 
     , po [MAGNET,TIN] magShield
+
+    , p [p 4 CAN] plateCraft
+
+    , p [p 2 PLATE] flatShield
     ] 
     ++ map (\i -> po [PIPE,BANGSTICK i] $ bangStick (i+1)) [1..8]
     ++ map (\i -> po [REVOLVERX i,CAN]  $ revolverX (i+1)) [1..5]

src/Dodge/Combine/Data.hs

@@ -40,6 +40,7 @@ data CombineType
     | LONGGUN
     | TESLAGUN
     | LASGUN
+    | SONICGUN
     | TRACTORGUN
     | LAUNCHER
     | SPRAYER

src/Dodge/Creature.hs

@@ -171,14 +171,15 @@ testInventory = IM.fromList $ zip [0..]
     , makeTypeCraftNum 1 MAGNET
     , makeTypeCraftNum 5 HARDWARE
     , makeTypeCraftNum 3 SPRING
-    , makeTypeCraftNum 3 CAN
+    , makeTypeCraftNum 10 CAN
     , makeTypeCraftNum 3 TIN
     , makeTypeCraftNum 3 PLANK
     , makeTypeCraftNum 1 MOTOR
     ]
 stackedInventory :: IM.IntMap Item
 stackedInventory = IM.fromList $ zip [0..] 
-    [spreadGun
+    [sonicGun
+    ,spreadGun
     , pipe
     ,rewindGun
     ,tractorGun

src/Dodge/Creature/Impulse/Movement.hs

@@ -34,18 +34,15 @@ crMvAbsolute p' cr = advanceStepCounter (magV p) cr
     & crPos %~ (+.+ p)
     & crMvDir .~ argV p
   where 
-    p =  (*.*) (equipFactor * aimingFactor) p'
+    p = (equipFactor * aimingFactor) *.* p'
-    equipFactor 
+    isAiming = _posture (_crStance cr) == Aiming || _posture (_crStance cr) == Reloading
-        | _posture (_crStance cr) == Aiming 
+    invItSpeed
-                    = product $ map equipAimSpeed $ IM.elems $ _crInv cr
+        | isAiming  = equipAimSpeed
-        | _posture (_crStance cr) == Reloading
+        | otherwise = equipSpeed
-                    = product $ map equipAimSpeed $ IM.elems $ _crInv cr
+    equipFactor = product $ invItSpeed <$> _crInv cr
-        | otherwise = product $ map equipSpeed $ IM.elems $ _crInv cr
     aimingFactor 
-        | _posture (_crStance cr) == Aiming || _posture (_crStance cr) == Reloading
+        | isAiming  = fromMaybe 1 $ cr ^? crInv . ix (_crInvSel cr) . itUse . useAim . aimSpeed
-                    = fromMaybe 1 $ it ^? itUse . useAim . aimSpeed
         | otherwise = 1
-    it = _crInv cr IM.! _crInvSel cr
 
 crMvForward 
     :: Float    -- ^ Speed

src/Dodge/Creature/Impulse/UseItem.hs

@@ -11,10 +11,10 @@ import Control.Lens
 import Data.Maybe
 
 useItem :: Int -> World -> World
-useItem cid w = itemEffect cr it w
+useItem cid w = tryUseItem cr w -- itemEffect cr it w
   where 
     cr = _creatures w IM.! cid
-    it = _crInv cr IM.! _crInvSel cr
+    --it = _crInv cr IM.! _crInvSel cr
 
 tryUseItem :: Creature -> World -> World
 tryUseItem cr' w = fromMaybe w $ do

src/Dodge/Creature/State.hs

@@ -101,13 +101,13 @@ movementSideEff cr w
     | hasJetPack = case cr ^? crStance . carriage of
         Just (Boosting v) -> w
             & randGen .~ g
-            & makeFlameletTimed 
+            & makeFlamelet 
-                        (oldPos +.+ (_crRad cr + 3) *.* unitVectorAtAngle (_crDir cr + pi))
+                (oldPos +.+ (_crRad cr + 3) *.* unitVectorAtAngle (_crDir cr + pi))
-                        20
+                20
-                        (momentum +.+ 1 *.* rotateV randDir (vInverse v)) 
+                (momentum +.+ 1 *.* rotateV randDir (vInverse v)) 
-                        Nothing
+                Nothing
-                        1
+                1
-                        20
+                20
         _   -> w
     | otherwise = footstepSideEffect cr w
   where 
@@ -122,9 +122,9 @@ movementSideEff cr w
 
 heldItemUpdate :: Item -> Item
 heldItemUpdate = invItemUpdate
-    . (itUse %~ useupdate)
+--    . (itUse %~ useupdate)
-  where
+--  where
-    useupdate = id
+--    useupdate = id
 
 invItemUpdate :: Item -> Item
 invItemUpdate = itUse %~ useupdate

src/Dodge/Data.hs

@@ -77,6 +77,8 @@ data World = World
     , _itemPositions        :: IM.IntMap ItemPos
     , _clouds               :: [Cloud]
     , _cloudsZone           :: Zone [Cloud]
+    , _gusts                :: IM.IntMap Gust
+    , _gustsZone            :: Zone (IM.IntMap Gust)
     , _props                :: IM.IntMap Prop
     , _instantParticles     :: [Particle]
     , _particles            :: [Particle]
@@ -191,6 +193,12 @@ data Corpse = Corpse
     , _cpPict :: Picture
     , _cpRes :: Creature
     }
+data Gust = Gust
+    { _guID  :: Int
+    , _guPos :: Point2
+    , _guVel :: Point2
+    , _guTime :: Int
+    }
 data Cloud = Cloud
     { _clPos :: Point3
     , _clVel :: Point3
@@ -361,44 +369,6 @@ data Item
         , _itParams     :: ItemParams
         , _itTweaks     :: ItemTweaks
         }
---     | Equipment
---        { _itName :: String
---        , _itFloorPict :: Item -> SPic
---        , _itEquipPict :: Creature -> Int -> SPic
-----        , _itIdentity :: ItemIdentity
---        , _itEffect :: ItEffect
---        , _itID :: Maybe Int
---        , _itType :: CombineType
---        , _itZoom :: ItZoom
---        , _itInvSize    :: Float
---        , _itInvDisplay :: Item -> [String]
---        , _itInvColor :: Color
---        , _itCurseStatus :: CurseStatus
---        , _itDimension  :: ItemDimension
---        }
---     | Throwable
---        { _itName       :: String
---        , _itMaxStack   :: Int
-----        , _itAmount     :: Int
---        , _itFloorPict :: Item -> SPic
---        , _twMaxRange   :: Float
---        , _twAccuracy   :: Float
---        , _itUse        :: ItemUse
-----        , _itZoom       :: ItZoom
---        , _itEquipPict :: Creature -> Int -> SPic
---        --, _itIdentity   :: ItemIdentity
---        , _itID         :: Maybe Int
---        , _itAttachment :: ItAttachment
---        , _itType :: CombineType
---        , _itInvSize    :: Float
---        , _itInvDisplay :: Item -> [String]
---        , _itInvColor   :: Color
---        , _itEffect     :: ItEffect
---        , _itScroll     :: Float -> Creature -> Item -> Item
---        , _itCurseStatus :: CurseStatus
---        , _itDimension  :: ItemDimension
---        }
---     | NoItem
 
 data ItemDimension = ItemDimension
     { _dimRad    :: Float
@@ -467,33 +437,41 @@ data Particle
         , _btDrag   :: Float
         , _ptColor  :: Color
         , _ptTrail  :: [Point2]
-        , _btPassThrough' :: Maybe Int
+        , _ptCrIgnore :: Maybe Int
-        , _btWidth' :: Float 
+        , _ptWidth :: Float 
-        , _btTimer' :: Int
+        , _ptTimer :: Int
-        , _btHitEffect' :: HitEffect
+        , _ptHitEff :: HitEffect
         }
     | PtZ  
         { _ptDraw :: Particle -> Picture
         , _ptUpdate :: World -> Particle -> (World, Maybe Particle)
         , _ptVel    :: Point2
         , _ptColor  :: Color
-        , _btPos' :: Point2
+        , _ptPos :: Point2
-        , _btPassThrough' :: Maybe Int
+        , _ptCrIgnore :: Maybe Int
-        , _btWidth' :: Float 
+        , _ptWidth :: Float 
-        , _btTimer' :: Int
+        , _ptTimer :: Int
-        , _btHitEffect' :: HitEffect
+        , _ptHitEff :: HitEffect
         , _ptZ :: Float
         }
     | Shockwave
         { _ptDraw       :: Particle -> Picture
-        , _ptUpdate    :: World -> Particle -> (World, Maybe Particle)
+        , _ptUpdate     :: World -> Particle -> (World, Maybe Particle)
         , _ptColor      :: Color
-        , _btPos'       :: Point2
+        , _ptPos        :: Point2
-        , _btRad'       :: Float
+        , _ptRad        :: Float
-        , _btDam'       :: Int
+        , _ptDam        :: Int
-        , _btPush'      :: Float
+        , _ptPush       :: Float
-        , _btMaxTime'   :: Int
+        , _ptMaxTime    :: Int
-        , _btTimer'     :: Int
+        , _ptTimer      :: Int
+        }
+    | ShockLine 
+        { _ptDraw :: Particle -> Picture
+        , _ptUpdate :: World -> Particle -> (World, Maybe Particle)
+        , _ptPointDirs :: [[(Point2,Float)]]
+        , _ptTimer :: Int
+        , _ptColor :: Color
+        , _ptCenter :: Point2
         }
 type HitEffect = Particle 
     -> [(Point2, Either Creature Wall)] 
@@ -645,7 +623,7 @@ data Prop
         , _pjPayload :: Point2 -> World -> World
         , _pjTimer :: Int
         }
-    | LinearShockwave 
+    | LinearShockwave
         { _prDraw :: Prop -> SPic
         , _pjPos :: Point2
         , _pjID :: Int
@@ -930,3 +908,4 @@ makeLenses ''Maybe'
 makeLenses ''InventoryMode
 makeLenses ''ItemPortage
 makeLenses ''Magnet
+makeLenses ''Gust

src/Dodge/Default/World.hs

@@ -31,6 +31,8 @@ defaultWorld = World
     , _creatureGroups = IM.empty
     , _clouds = []
     , _cloudsZone = Zone IM.empty
+    , _gusts = IM.empty
+    , _gustsZone = Zone IM.empty
     , _itemPositions = IM.empty
     , _props = IM.empty
     , _instantParticles = []

src/Dodge/Event.hs

@@ -104,13 +104,15 @@ handlePressedMouseButton but w
         _ -> Just w
     | otherwise = Just w
 
+-- note "reverse" on the inventory indices; otherwise
+-- lower items may be shifted up and items below these removed instead
 doCombine :: Int -> World -> World
 doCombine i w = case combineItemListYou w !? i of
     Nothing -> w
     Just (is,it) -> enterCombineInv
         . uncurry (putItemInInvID yid)
         . copyItemToFloorID (_crPos $ you w) it
-        $ foldr (rmInvItem yid) w is & enterCombineInv
+        $ foldr (rmInvItem yid) w (reverse is) & enterCombineInv
   where
     yid = _yourID w
 

src/Dodge/Item/Craftable.hs

@@ -18,3 +18,6 @@ makeTypeCraft :: CombineType -> Item
 makeTypeCraft = makeTypeCraftNum 1
 pipe :: Item
 pipe = makeTypeCraft PIPE
+
+plateCraft :: Item
+plateCraft = makeTypeCraft PLATE

src/Dodge/Item/Draw.hs

@@ -20,15 +20,6 @@ pictureWeaponOnAim cr i = pictureWeaponOnAimItem (itSPic it) cr i
 itSPic :: Item -> SPic
 itSPic it = _dimSPic (_itDimension it) it
 
-pictureWeaponOnAim'
-    :: (Item -> SPic)
-    -> Creature 
-    -> Int  -- ^ Position of item in inventory
-    -> SPic
-pictureWeaponOnAim' f cr i = pictureWeaponOnAimItem pic cr i
-  where
-    pic = f (_crInv cr IM.! i)
-
 pictureWeaponAim
     :: (Item -> SPic)
     -> Creature 

src/Dodge/Item/Equipment.hs

@@ -1,6 +1,7 @@
 module Dodge.Item.Equipment where
 import Dodge.Data
 import Dodge.Item.Draw
+import Dodge.Item.Weapon.InventoryDisplay
 import Dodge.Default
 import Dodge.Default.Wall
 import Dodge.Picture.Layer
@@ -14,8 +15,7 @@ import Geometry
 import ShapePicture
 import Shape
 import qualified IntMapHelp as IM
-
+import LensHelp
-import Control.Lens
 
 magShield :: Item
 magShield = defaultEquipment
@@ -66,10 +66,29 @@ frontArmour = defaultEquipment
     }
 flatShield :: Item
 flatShield = defaultEquipment
-    { _itEquipPict = pictureWeaponOnAim' flatShieldEquipSPic -- this will not work any more because the shield has no aim stance
+    { _itEquipPict = pictureWeaponAim flatShieldEquipSPic
     , _itEffect = effectOnOffEquip createShieldWall removeShieldWall
-    , _itName   = "SHIELD"
+        -- the above seems to work, but I am not sure why: it may break on edge
+        -- cases
+    , _itName   = "FLATSHIELD"
     , _itType = FLATSHIELD
+    , _itUse  = RightUse
+        { _rUse = \_ _ -> id
+        , _useDelay = NoDelay
+        , _useMods = []
+        , _useHammer = NoHammer
+        , _useAim = AimParams
+            { _aimSpeed = 0.5
+            , _aimRange = 0
+            , _aimZoom = ItZoom 20 0.2 1
+            , _aimStance = TwoHandFlat
+            }
+        }
+    , _itInvSize = 3
+    , _itInvDisplay = \it -> head (basicItemDisplay it) : 
+        ["*" ++ replicate 13 ' ' ++ "*"
+        ,"*" ++ replicate 13 ' ' ++ "*"
+        ]
     }
 flatShieldEquipSPic :: Item -> SPic
 flatShieldEquipSPic _ = 
@@ -102,8 +121,8 @@ shieldWall crid = defaultWall
 shieldWallDamage :: DamageType -> Wall -> Int -> World -> World
 shieldWallDamage dt wl crid w = case dt of
     Lasering {_dmFrom=df,_dmAt=da} -> 
-        w & instantParticles %~ (makeLaserAt 5 (da +.+ normalizeV (df -.- da)) (reflDirWall df da wl) :)
+        w & instantParticles .:~ lasRayAt 5 (da +.+ normalizeV (df -.- da)) (reflDirWall df da wl)
-    d | isMovementDam d -> w & creatures . ix crid . crState . crDamage %~ (d :)
+    d | isMovementDam d -> w & creatures . ix crid . crState . crDamage .:~ d
     _ -> w
 
 createShieldWall :: Creature -> Int -> World -> World

src/Dodge/Item/Weapon.hs

@@ -1,6 +1,7 @@
 {- | Rexport all weapons -}
 module Dodge.Item.Weapon 
     ( module Dodge.Item.Weapon.BulletGuns
+    , module Dodge.Item.Weapon.SonicGuns
     , module Dodge.Item.Weapon.TriggerType
     , module Dodge.Item.Weapon.ExtraEffect
     , module Dodge.Item.Weapon.UseEffect
@@ -16,6 +17,7 @@ module Dodge.Item.Weapon
     ) where
 import Dodge.Item.Weapon.BulletGuns
 import Dodge.Item.Weapon.TriggerType
+import Dodge.Item.Weapon.SonicGuns
 import Dodge.Item.Weapon.ExtraEffect
 import Dodge.Item.Weapon.UseEffect
 import Dodge.Item.Weapon.Remote

src/Dodge/Item/Weapon/BatteryGuns.hs

@@ -2,7 +2,7 @@ module Dodge.Item.Weapon.BatteryGuns
     ( lasGun
     , teslaGun
     , tractorGun
-    , makeLaserAt
+    , lasRayAt
     ) where
 import Dodge.Data
 import Dodge.Creature.HandPos
@@ -67,7 +67,7 @@ teslaGunPic _ = noPic $ colorSH blue $
     xb = 9
 lasGun :: Item
 lasGun = defaultAutoGun 
-    { _itName = "LASGUN ////"
+    { _itName = "LASGUN"
     , _itType = LASGUN
     , _itConsumption = defaultAmmo
         { _ammoMax = 200
@@ -156,15 +156,14 @@ aTeslaArc cr w = set randGen g w
     chooseColor _ = cyan
 
 aLaser :: Item -> Creature -> World -> World
-aLaser it cr = particles .:~ makeLaserAt phasev pos dir
+aLaser it cr = particles .:~ lasRayAt phasev pos dir
   where 
     pos = _crPos cr +.+ aimingMuzzlePos cr it *.* unitVectorAtAngle dir
     dir = _crDir cr
-    phasev = _phaseV . _itParams $ _crInv cr IM.! j
+    phasev = _phaseV . _itParams $ _crInv cr IM.! _crInvSel cr
-    j = _crInvSel cr
 
-makeLaserAt :: Float -> Point2 -> Float -> Particle
+lasRayAt :: Float -> Point2 -> Float -> Particle
-makeLaserAt phasev pos dir = Particle
+lasRayAt phasev pos dir = Particle
     { _ptDraw = const blank
     , _ptUpdate = mvLaser phasev pos dir
     }

src/Dodge/Item/Weapon/BulletGun/Cane.hs

@@ -44,7 +44,9 @@ bangCane = defaultGun
         { _muzVel = 0.8
         , _rifling = 0.9
         , _bore = 2
-        , _gunBarrels = SingleBarrel 0.1
+        , _gunBarrels = SingleBarrel 
+            { _brlInaccuracy = 0.01
+            }
         }
     , _itConsumption = defaultAmmo 
         { _aoType = basicBullet

src/Dodge/Item/Weapon/BulletGun/Stick.hs

@@ -60,7 +60,7 @@ bangStick i = defaultGun
         , withMuzFlareI
         , torqueAfterI (0.18 + 0.02 * fromIntegral i)
         , spreadLoaded
-        , applyInaccuracy
+--        , applyInaccuracy
         , withRecoilI 25
         ]
     , _itID = Nothing
@@ -73,7 +73,7 @@ bangStick i = defaultGun
         , _gunBarrels = MultiBarrel
             {_brlNum = i
             ,_brlSpread = SpreadBarrels baseStickSpread
-            ,_brlInaccuracy = 0.05
+            ,_brlInaccuracy = 0.01
             }
         }
     , _itTweaks = defaultBulletSelTweak

src/Dodge/Item/Weapon/Grenade.hs

@@ -127,7 +127,7 @@ throwArmReset x = ItInvEffect {_itInvEffect = f ,_itEffectCounter = x }
     counterDown it 
         | _itEffectCounter (_itEffect it) == 0 = it 
             & itUse . useHammer . hammerPosition .~ HammerUp 
-            & itEquipPict .~ pictureWeaponOnAim' (\_ -> grenadePic 50)
+            & itEquipPict .~ pictureWeaponAim (\_ -> grenadePic 50)
         | otherwise = it & itEffect . itEffectCounter -~ 1
 
 --flameGrenade :: Item
@@ -277,7 +277,7 @@ explodeRemoteBomb itid pjid cr w
     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)
+                    (pictureWeaponAim $ \_ -> (,) emptySH remoteBombUnarmedPic)
 --    resetScope = creatures . ix cid . crInv . ix j . itScope . _Just . scopePos .~ (0,0)
     j = _crInvSel $ _creatures w IM.! cid
 remoteBombPic 

src/Dodge/Item/Weapon/InventoryDisplay.hs

@@ -26,7 +26,7 @@ basicItemDisplay it = Prelude.take (itSlotsTaken it) $
             Just' x  -> show x ++ "R" ++ show (_ammoLoaded am)
         Just am@ChargeableAmmo{} -> show $ _wpCharge am
         Just x@ItemItselfConsumable{} -> "x" ++ show (_itAmount x)
-        Just NoConsumption -> "NOCONSUMPTION"
+        Just NoConsumption -> ""
         Nothing -> ""
     theparam = fromMaybe []
         . listToMaybe 

src/Dodge/Item/Weapon/Launcher.hs

@@ -138,7 +138,7 @@ doThrust pj w = w
     & randGen .~ g
     & props . ix i . pjVel    %~ (\v -> accel +.+ frict *.* v)
     & soundContinue (ShellSound i) newPos missileLaunchS (Just 1)
-    & makeFlameletTimed (oldPos -.- vel) 0 (vel +.+ rotateV (pi+sparkD) accel) Nothing 3 10
+    & makeFlamelet (oldPos -.- vel) 0 (vel +.+ rotateV (pi+sparkD) accel) Nothing 3 10
     & smokeGen
   where
     accel = _pjAcc pj
@@ -344,7 +344,7 @@ moveRemoteShell cid itid pj w
                 )
             & soundContinue (ShellSound i) newPos missileLaunchS (Just 1)
             & smokeGen
-            & makeFlameletTimed oldPos 20 (0.5 *.* rotateV (pi+sparkD) accel) Nothing 3 10
+            & makeFlamelet oldPos 20 (0.5 *.* rotateV (pi+sparkD) accel) Nothing 3 10
     | time > -200 = case thingHit of
         Just _  -> doExplosion $ stopSoundFrom (ShellSound i) w
         Nothing -> w

src/Dodge/Item/Weapon/Radar.hs

@@ -32,7 +32,7 @@ radar = defaultGun
         & useAim . aimRange .~ 1
         & useAim . aimZoom .~ defaultItZoom {_itZoomFac = 1}
 --    , _itZoom       = defaultItZoom { _itZoomMax = 1}
-    , _itEquipPict = pictureWeaponOnAim' $ \_ -> (,) emptySH $ color blue $ polygon $ rectNESW 5 5 (-5) (-5)
+    , _itEquipPict = pictureWeaponAim $ \_ -> (,) emptySH $ color blue $ polygon $ rectNESW 5 5 (-5) (-5)
     }
 {- |
 Sends out pulses that display creatures.  -}
@@ -50,7 +50,7 @@ sonar = defaultGun
         ]
         & useAim . aimRange .~ 1
         & useAim . aimZoom .~ defaultItZoom {_itZoomFac = 1}
-    , _itEquipPict = pictureWeaponOnAim' $ \_ -> (,) emptySH $ color blue $ polygon $ rectNESW 5 5 (-5) (-5)
+    , _itEquipPict = pictureWeaponAim $ \_ -> (,) emptySH $ color blue $ polygon $ rectNESW 5 5 (-5) (-5)
     }
 {- |
 Automatically sends out pulses that display creatures.  -}

src/Dodge/Item/Weapon/TriggerType.hs

@@ -431,13 +431,14 @@ torqueAfterI
     :: Float                    -- ^ Max possible rotation
     -> ChainEffect
 torqueAfterI torque feff item cr w 
-    | cid == 0  = rotateScope $ set randGen g $ over cameraRot (+rot) $ feff item cr w
+--    | cid == 0  = rotateScope $ set randGen g $ over cameraRot (+rot) $ feff item cr w
+    | cid == 0  = set randGen g $ over cameraRot (+rot) $ feff item cr w
     | otherwise = set randGen g $ over (creatures . ix cid . crDir) (+rot) $ feff item cr w
   where 
     cid = _crID cr
     (rot, g) = randomR (-torque,torque) $ _randGen w
-    rotateScope = creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
+--    rotateScope = creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
-                          . itAttachment . scopePos %~ rotateV rot 
+--                          . itAttachment . scopePos %~ rotateV rot 
 
 spreadNumI :: ChainEffect
 spreadNumI eff item cr w = foldr f w dirs

src/Dodge/Particle/Bullet/Draw.hs

@@ -8,4 +8,4 @@ drawBul :: Particle -> Picture
 drawBul pt = setLayer 1 
     . setDepth 20 
     . color (_ptColor pt) 
-    $ thickLine (take 3 $ _ptTrail pt) (_btWidth' pt)
+    $ thickLine (take 3 $ _ptTrail pt) (_ptWidth pt)

src/Dodge/Particle/Bullet/HitEffect.hs

@@ -52,8 +52,8 @@ bulBounceArmCr' bt p cr w
     reflectVel = magV bulVel *.* newDir
     addBouncer = instantParticles .:~ bouncer
     bouncer = (aGenBulAt Nothing pOut reflectVel (_btDrag bt)
-                                      (_btHitEffect' bt) (_btWidth' bt)
+                                      (_ptHitEff bt) (_ptWidth bt)
-              ) {_btTimer' = _btTimer' bt - 1}
+              ) {_ptTimer = _ptTimer bt - 1}
 {- | Bullet pass through creatures.  -}
 bulPenCr' :: Particle -> Point2 -> Creature -> World -> World
 bulPenCr' bt p cr w = w
@@ -71,8 +71,8 @@ bulPenCr' bt p cr w = w
     sp = head $ _ptTrail bt
     ep = sp +.+ _ptVel bt
     piercer = (aGenBulAt (Just cid) p (_ptVel bt) (_btDrag bt)
-                                      (_btHitEffect' bt) (_btWidth' bt)
+                                      (_ptHitEff bt) (_ptWidth bt)
-              ) {_btTimer' = _btTimer' bt - 1}
+              ) {_ptTimer = _ptTimer bt - 1}
 {- | Heavy bullet effects when hitting creature:
 piercing, blunt, twisting and pushback damage all applied.  -}
 hvBulHitCr :: Particle -> Point2 -> Creature -> World -> World
@@ -92,7 +92,7 @@ hvBulHitCr bt p cr w = w
 {- | Create a flamelet when hitting a creature.  -}
 bulIncCr :: Particle -> Point2 -> Creature -> World -> World
 bulIncCr bt p cr w = w
-    & makeFlameletTimed p 20 v Nothing 3 20
+    & makeFlamelet p 20 v Nothing 3 20
     & bulletHitSound p
     & creatures . ix cid . crState . crDamage .:~ Piercing 60 sp p ep
   where   
@@ -123,8 +123,8 @@ bulBounceWall bt p wl = damageWall (Blunt 50 sp p ep) wl
     ep = sp +.+ _ptVel bt
     sp = head $ _ptTrail bt
     pOut = p +.+ squashNormalizeV (sp -.- p)
-    bouncer = (aGenBulAt Nothing pOut reflectVel (_btDrag bt) (_btHitEffect' bt) (_btWidth' bt)
+    bouncer = (aGenBulAt Nothing pOut reflectVel (_btDrag bt) (_ptHitEff bt) (_ptWidth bt)
-              ) {_btTimer' = _btTimer' bt - 1}
+              ) {_ptTimer = _ptTimer bt - 1}
     reflectVel = reflVelWall wl (_ptVel bt)
 -- the hack is to get around the fact that the particles list gets reset after
 -- all projectiles in it are checked, so we cannot add to it as we accumulate over
@@ -138,7 +138,7 @@ bulIncWall
     -> World 
     -> World
 bulIncWall bt p wl = damageWall (Blunt 50 sp p ep) wl 
-    . makeFlameletTimed pOut 20 reflectVel Nothing 3 20
+    . makeFlamelet pOut 20 reflectVel Nothing 3 20
   where   
     ep = sp +.+ _ptVel bt
     sp = head $ _ptTrail bt

src/Dodge/Particle/Bullet/Spawn.hs

@@ -27,10 +27,10 @@ aGenBulAt maycid pos vel drag hiteff width = BulletPt
     , _btDrag   = drag
     , _ptColor = V4 2 2 2 2
     , _ptTrail = [pos]
-    , _btPassThrough' = maycid
+    , _ptCrIgnore = maycid
-    , _btWidth' = width
+    , _ptWidth = width
-    , _btTimer' = 100
+    , _ptTimer = 100
-    , _btHitEffect' = hiteff
+    , _ptHitEff = hiteff
     }
 aDelayedBulAt
     :: Float    -- ^ Start velocity step factor
@@ -48,10 +48,10 @@ aDelayedBulAt vfact maycid pos vel drag hiteff width = BulletPt
     , _btDrag = drag
     , _ptColor = V4 2 2 2 2
     , _ptTrail = [pos]
-    , _btPassThrough' = maycid
+    , _ptCrIgnore = maycid
-    , _btWidth' = width
+    , _ptWidth = width
-    , _btTimer' = 100
+    , _ptTimer = 100
-    , _btHitEffect' = hiteff
+    , _ptHitEff = hiteff
     }
   where
     resetVel = second $ fmap $ (ptUpdate .~ mvBullet) . (ptVel .~ vel)
@@ -72,11 +72,11 @@ aCurveBulAt maycid col pos control targ hiteff width = BulletPt
     , _btDrag = 1
     , _ptColor = col
     , _ptTrail = [pos]
-    , _btPassThrough' = maycid
+    , _ptCrIgnore = maycid
-    , _btWidth' = width
+    , _ptWidth = width
-    , _btTimer' = 100
+    , _ptTimer = 100
-    , _btHitEffect' = hiteff
+    , _ptHitEff = hiteff
     }
   where 
-    setVel pt = pt & ptVel .~ bf (fromIntegral $ _btTimer' pt - 1) -.- bf (fromIntegral $ _btTimer' pt)
+    setVel pt = pt & ptVel .~ bf (fromIntegral $ _ptTimer pt - 1) -.- bf (fromIntegral $ _ptTimer pt)
     bf t = bQuadToF (pos,control,targ) $ (100 - t) * 0.05

src/Dodge/Particle/Bullet/Update.hs

@@ -8,10 +8,9 @@ import Dodge.Data
 import Dodge.WorldEvent.ThingsHit
 --import Picture
 import Geometry
---import Geometry.Vector3D
+import LensHelp
 
 import Data.Bifunctor
-import Control.Lens
 {- Update for a generic bullet.  -}
 mvBullet :: World -> Particle -> (World, Maybe Particle)
 mvBullet w bt' 
@@ -20,10 +19,10 @@ mvBullet w bt'
         hiteff bt (thingsHitExceptCr mcr p (p +.+ vel) w) w
   where
     bt = foldr (\mg b -> _mgField mg mg b) bt' $ _magnets w
-    dodrag = ptVel %~ (drag *.*)
+    dodrag = ptVel .*.*~ drag
     drag = _btDrag bt
-    mcr     = _btPassThrough' bt
+    mcr     = _ptCrIgnore bt
     (p:_)   = _ptTrail bt
     vel     = _ptVel bt
-    hiteff  = _btHitEffect' bt
+    hiteff  = _ptHitEff bt
-    t       = _btTimer' bt
+    t       = _ptTimer bt

src/Dodge/Particle/Spark.hs

@@ -23,10 +23,10 @@ createBarrelSpark pos dir maycid time colid = instantParticles .:~ BulletPt
     , _btDrag = 0.9
     , _ptColor = numColor colid
     , _ptTrail = [pos]
-    , _btPassThrough' = maycid
+    , _ptCrIgnore = maycid
-    , _btWidth' = 1
+    , _ptWidth = 1
-    , _btTimer' = time
+    , _ptTimer = time
-    , _btHitEffect' = destroyOnImpact sparkEff noEff
+    , _ptHitEff = destroyOnImpact sparkEff noEff
     }
   where 
     sparkEff bt p cr = creatures . ix (_crID cr) . crState . crDamage .:~ SparkDam 1 sp p ep
@@ -49,10 +49,10 @@ colSparkRandDir randDir time col pos baseDir w = w
         , _ptVel = rotateV dir (V2 5 0)
         , _ptColor = col
         , _ptTrail = [pos]
-        , _btPassThrough' = Nothing
+        , _ptCrIgnore = Nothing
-        , _btWidth' = 1
+        , _ptWidth = 1
-        , _btTimer' = time
+        , _ptTimer = time
-        , _btHitEffect' = destroyOnImpact sparkEff noEff
+        , _ptHitEff = destroyOnImpact sparkEff noEff
         }
     sparkEff bt p cr = creatures . ix (_crID cr) . crState . crDamage .:~ SparkDam 1 sp p ep
       where 

src/Dodge/Update.hs

@@ -17,14 +17,14 @@ import Dodge.Update.Camera
 import Dodge.Inventory
 import Sound.Data
 import Geometry
+import LensHelp
 
 import Data.List
 import Data.Maybe
-import Data.Function
+--import Data.Function
 import qualified Data.IntMap.Strict as IM
 import qualified Data.Map.Strict as M
 --import qualified Data.Set as S
-import Control.Lens
 --import Data.Monoid
 --import System.Random
 
@@ -62,6 +62,7 @@ functionalUpdate cfig w = checkEndGame
     . updateIMl _props _pjUpdate  
     . updateLightSources
     . updateClouds
+    . updateGusts
     . zoneClouds
     . updateMIM magnets _mgUpdate
     . updateIMl _machines _mcUpdate
@@ -176,6 +177,16 @@ checkEndGame w
     | _crHP (you w) < 1 = w & sideEffects %~ ( . (menuLayers .~ [gameOverMenu]))
     | otherwise         = w
 
+updateGusts :: World -> World
+updateGusts w = w
+    & gusts %~ IM.mapMaybe (mvGust w)
+
+mvGust :: World -> Gust -> Maybe Gust
+mvGust _ gu
+    | _guTime gu < 0 = Nothing
+    | otherwise      = Just $ gu
+        & guPos .+.+~ _guVel gu
+        & guTime -~ 1
 updateClouds :: World -> World
 updateClouds w = w' & clouds .~ catMaybes mclouds
   where

src/Dodge/WorldEvent/Explosion.hs

@@ -89,7 +89,7 @@ makeExplosionAt p w
     fVs' = zipWith (+.+) fVs $ map inversePushOut fPs'
     sizes = randomRs (2,9) $ _randGen w
     times = randomRs (20,25) $ _randGen w
-    mF q z v size time = makeFlameletTimed q z v Nothing size time
+    mF q z v size time = makeFlamelet q z v Nothing size time
     newFs = zipWith5 mF fPs zs (fmap (3 *.*) fVs') sizes times
     addFlames w' = foldr ($) w' newFs
     pushAgainstWalls q = maybe q (uncurry (+.+)) $ reflectPointWalls p q $ wallsNearPoint q w

src/Dodge/WorldEvent/Flash.hs

@@ -48,13 +48,11 @@ muzFlareAt col tranv dir w = w & instantParticles .:~ theFlare
     (a:b:c:d:_) = randomRs (2,20) (_randGen w)
 
 flareCircleAt :: Color -> Float -> Point3 -> World -> World
-flareCircleAt col alphax tranv = particles .:~ theFlareCircle
+flareCircleAt col alphax tranv = particles .:~  Particle
-  where
+    { _ptDraw = const . setLayer 1 . translate3 tranv
-    theFlareCircle = Particle
+                        $ circleSolidCol (withAlpha alphax col) (withAlpha 0 col) 30
-        { _ptDraw = const . setLayer 1 . translate3 tranv
+    , _ptUpdate = ptSimpleTime 1
-                            $ circleSolidCol (withAlpha alphax col) (withAlpha 0 col) 30
+    }
-        , _ptUpdate = ptSimpleTime 1
-        }
 
 explosionFlashAt :: Point2 -> World -> World
 explosionFlashAt p = tempLightSources .:~ tlsTimeRadFunPos 20 150 intensityFunc (addZ 20 p)
@@ -65,8 +63,8 @@ explosionFlashAt p = tempLightSources .:~ tlsTimeRadFunPos 20 150 intensityFunc
 
 flameFlicker :: Particle -> World -> World
 flameFlicker pt 
-    | _btTimer' pt `mod` 5 == 0 = tempLightSources .:~ theLight
+    | _ptTimer pt `mod` 5 == 0 = tempLightSources 
+        .:~ tlsTimeRadColPos 1 70 (V3 0.5 0 0) (V3 x y 10)
     | otherwise = id
   where
-    V2 x y = _btPos' pt
+    V2 x y = _ptPos pt
-    theLight = tlsTimeRadColPos 1 70 (V3 0.5 0 0) (V3 x y 10)

src/Dodge/WorldEvent/HitEffect.hs

@@ -28,8 +28,8 @@ destroyOnImpact crEff wlEff pt hitThings w = case hitThings of
 mvPt :: Particle -> Maybe Particle
 mvPt pt = Just $ pt
     & ptTrail %~ f
-    & btTimer' -~ 1
+    & ptTimer -~ 1
-    & btPassThrough' .~ Nothing
+    & ptCrIgnore .~ Nothing
   where
     f trl = head trl +.+ _ptVel pt : trl
 
@@ -37,13 +37,13 @@ destroyAt :: Point2 -> Particle -> Maybe Particle
 destroyAt hitp pt = Just $ pt 
     & ptUpdate .~ killBulletUpdate
     & ptTrail  .:~ hitp
-    & btTimer' %~ (min 3 . subtract 1)
+    & ptTimer %~ (min 3 . subtract 1)
 
 killBulletUpdate :: World -> Particle -> (World,Maybe Particle)
 killBulletUpdate w pt 
-    | _btTimer' pt <= 0 = (w,Nothing)
+    | _ptTimer pt <= 0 = (w,Nothing)
     | otherwise = (w
-        ,Just $ pt & btTimer' -~ 1
+        ,Just $ pt & ptTimer -~ 1
             & ptTrail %~ (\(x:xs) -> x:x:xs)
         )
 
@@ -65,7 +65,7 @@ doFlameDam :: Int -> Particle -> Point2 -> Creature -> World -> World
 doFlameDam amount pt p cr = creatures . ix (_crID cr) . crState . crDamage .:~
     Flaming amount sp p ep
   where 
-    sp = _btPos' pt
+    sp = _ptPos pt
     ep = sp +.+ _ptVel pt
 
 noEff :: a -> b -> c -> d -> d

src/Dodge/WorldEvent/Shockwave.hs

@@ -26,39 +26,39 @@ makeShockwaveAt is p rad dam push col = instantParticles .:~ Shockwave
     { _ptDraw       = drawShockwave
     , _ptUpdate     = mvShockwave is
     , _ptColor      = col
-    , _btPos'       = p
+    , _ptPos       = p
-    , _btRad'       = rad
+    , _ptRad       = rad
-    , _btDam'       = dam
+    , _ptDam       = dam
-    , _btPush'      = push
+    , _ptPush      = push
-    , _btMaxTime'   = 10
+    , _ptMaxTime   = 10
-    , _btTimer'     = 10
+    , _ptTimer     = 10
     }
 {- Shockwave picture.  -}
 drawShockwave :: Particle -> Picture
 drawShockwave pt = setDepth 20 
     . setLayer 1
-    . uncurryV translate (_btPos' pt) 
+    . uncurryV translate (_ptPos pt) 
     . color (_ptColor pt) 
     $ thickCircle rad thickness
   where
-    r    = _btRad' pt
+    r    = _ptRad pt
     thickness = tFraction**2 * r 
     rad = r - (3/4) * r * tFraction
-    tFraction = fromIntegral (_btTimer' pt) / fromIntegral (_btMaxTime' pt)
+    tFraction = fromIntegral (_ptTimer pt) / fromIntegral (_ptMaxTime pt)
 
 mvShockwave
     :: [Int]    -- ^ IDs of invulnerable creatures.
     -> World -> Particle -> (World, Maybe Particle)
 mvShockwave is w pt 
-    | _btTimer' pt <= 0 = (       w , Nothing)
+    | _ptTimer pt <= 0 = (       w , Nothing)
-    | otherwise         = (doDams w , Just $ pt & btTimer' -~ 1)
+    | otherwise         = (doDams w , Just $ pt & ptTimer -~ 1)
   where 
-    r    = _btRad' pt
+    r    = _ptRad pt
-    p    = _btPos' pt
+    p    = _ptPos pt
-    push = _btPush' pt
+    push = _ptPush pt
-    dam  = _btDam' pt
+    dam  = _ptDam pt
-    t    = _btTimer' pt
+    t    = _ptTimer pt
-    tFraction = fromIntegral t / fromIntegral (_btMaxTime' pt)
+    tFraction = fromIntegral t / fromIntegral (_ptMaxTime pt)
     rad = r - (3/4) * r * tFraction
     doDams = over creatures (IM.map damCr) . flip (IM.foldl' (flip $ damageWall (Explosive 10000 p))) 
         hitBlocks
@@ -79,12 +79,12 @@ inverseShockwaveAt p rad dam push = particles .:~ Shockwave
     { _ptDraw = drawInverseShockwave
     , _ptUpdate = moveInverseShockwave
     , _ptColor      = cyan
-    , _btPos'       = p
+    , _ptPos       = p
-    , _btRad'       = rad
+    , _ptRad       = rad
-    , _btDam'       = dam
+    , _ptDam       = dam
-    , _btPush'      = push
+    , _ptPush      = push
-    , _btMaxTime'   = 10
+    , _ptMaxTime   = 10
-    , _btTimer'     = 10
+    , _ptTimer     = 10
     }
 moveInverseShockwave 
     :: World
@@ -92,11 +92,11 @@ moveInverseShockwave
     -> (World, Maybe Particle)
 moveInverseShockwave w pt 
     | t <= 0    = (     w, Nothing)
-    | otherwise = (dams w, Just $ btTimer' -~ 1 $ pt )
+    | otherwise = (dams w, Just $ ptTimer -~ 1 $ pt )
   where 
-    p = _btPos' pt
+    p = _ptPos pt
-    r = _btRad' pt
+    r = _ptRad pt
-    t = _btTimer' pt
+    t = _ptTimer pt
     rad = r - 0.1 * r * fromIntegral (10 - t)
     dams = over creatures (IM.map damCr) . flip (foldr (damageBlocksBy 1)) hitBlocks
     hitBlocks = wallsOnCirc p rad $ wallsNearPoint p w 
@@ -110,8 +110,8 @@ drawInverseShockwave  pt
     = setLayer 1 $ onLayer PtLayer $ uncurryV translate p 
                           $ color cyan $ thickCircle rad thickness
   where
-    p = _btPos' pt
+    p = _ptPos pt
-    r = _btRad' pt
+    r = _ptRad pt
-    t = _btTimer' pt
+    t = _ptTimer pt
     rad = r - 0.1 * r * fromIntegral (10 - t)
     thickness = fromIntegral (10 - t) **2 * rad / 40

src/Dodge/WorldEvent/SpawnParticle.hs

@@ -2,7 +2,7 @@
 module Dodge.WorldEvent.SpawnParticle
     ( makeGasCloud
     , aFlameParticle
-    , makeFlameletTimed
+    , makeFlamelet
     ) where
 import Dodge.Data
 import Dodge.Base
@@ -31,11 +31,11 @@ aFlameParticle t pos vel maycid = PtZ
     , _ptUpdate       = moveFlame vel
     , _ptVel          = vel
     , _ptColor        = red
-    , _btPos'         = pos
+    , _ptPos         = pos
-    , _btPassThrough' = maycid
+    , _ptCrIgnore = maycid
-    , _btWidth'       = 4
+    , _ptWidth       = 4
-    , _btTimer'       = t
+    , _ptTimer       = t
-    , _btHitEffect'   = destroyOnImpact (doFlameDam 1) noEff
+    , _ptHitEff   = destroyOnImpact (doFlameDam 1) noEff
     , _ptZ            = 20
     }
 drawFlame 
@@ -49,7 +49,7 @@ drawFlame rotd pt = pictures
     , aPic 1 prot3 20 (V2  scaleChange        0.5  ) $ V4 1 1   1 1
     ]
   where
-    ep = _btPos' pt
+    ep = _ptPos pt
     aPic :: Int -> (Point2 -> Point2) -> Float -> Point2 -> Color -> Picture
     aPic lay offset depth (V2 scalex scaley) col
         = setLayer lay 
@@ -61,7 +61,7 @@ drawFlame rotd pt = pictures
         $ circleSolid 5
     glow = setLayer 1 $ setDepth 0.3 $ uncurryV translate ep
         $ circleSolidCol (withAlpha 0 orange) (withAlpha 0.02 orange) 50
-    time = _btTimer' pt
+    time = _ptTimer pt
     scaleChange 
         | time < 80 = 3
         | otherwise = 3 - (fromIntegral time - 80) * 0.2
@@ -76,20 +76,20 @@ moveFlame
     -> (World, Maybe Particle)
 moveFlame rotd w pt 
     | time <= 0 = (makeFlamerSmokeAt (addZ 20 ep) w, Nothing)
-    | otherwise = case thingsHitExceptCr (_btPassThrough' pt) sp ep w of
+    | otherwise = case thingsHitExceptCr (_ptCrIgnore pt) sp ep w of
         ((_,Left _):_)       -> (doSound damcrs        , mvPt 0.7)
         (thing@(p,Right wl):_) -> (doSound . fst $ hiteff [thing] damcrs , rfl wl p)
         _                     -> (flameFlicker pt $ doSound damcrs        , mvPt 0.98)
   where 
-    time = _btTimer' pt
+    time = _ptTimer pt
     doSound = soundContinue Flame (V2 x y) fireLoudS (Just 2)
-    sp@(V2 x y) = _btPos' pt
+    sp@(V2 x y) = _ptPos pt
     vel = _ptVel pt
     ep = sp +.+ vel
     mvPt speed = Just $ pt 
-        { _btTimer' = time - 1
+        { _ptTimer = time - 1
-        , _btPos' = ep
+        , _ptPos = ep
-        , _btPassThrough' = Nothing
+        , _ptCrIgnore = Nothing
         , _ptVel = speed *.* vel    }
     damcrs = foldr (\cr -> fst . hiteff [(ep,Left cr)]) w 
         $ IM.filter closeCrs $ _creatures w
@@ -97,37 +97,37 @@ moveFlame rotd w pt
                     < _crRad cr + 10 - min 9 (max 0 (fromIntegral time - 80))
                                 + 5 * angleCoeff (angleVV (ep -.- _crPos cr) rotd)
     angleCoeff x' = abs $ 1 - abs ( (x' * 2 - pi) / pi )
-    hiteff = _btHitEffect' pt pt
+    hiteff = _ptHitEff pt pt
     rfl wl p = Just $ pt 
-        { _btTimer' = time -1
+        { _ptTimer = time -1
-        , _btPos' = pOut p
+        , _ptPos = pOut p
         , _ptVel = reflV wl
         }
     pOut p = p +.+ squashNormalizeV (sp -.- p)
     reflV wall = (0.3 *.* reflectIn (uncurry (-.-) . swap $ _wlLine wall) vel )
         +.+ (0.2 *.* vel)
 
-makeFlameletTimed 
+makeFlamelet
     :: Point2       -- ^ Position
     -> Float        -- ^ z position
     -> Point2       -- ^ Velocity
-    -> Maybe Int    -- ^ Creature id
+    -> Maybe Int    -- ^ Ignore creature id
     -> Float        -- ^ Size
     -> Int          -- ^ Timer
     -> World 
     -> World
-makeFlameletTimed (V2 x y) z vel maycid size time w = w
+makeFlamelet (V2 x y) z vel maycid size time w = w
     & randGen   .~ g
     & instantParticles .:~ PtZ 
         { _ptDraw         = drawFlameletZ rot
         , _ptUpdate       = moveFlamelet
         , _ptVel          = vel
         , _ptColor        = red
-        , _btPos'         = V2 x y
+        , _ptPos         = V2 x y
-        , _btPassThrough' = maycid
+        , _ptCrIgnore = maycid
-        , _btWidth'       = size
+        , _ptWidth       = size
-        , _btTimer'       = time
+        , _ptTimer       = time
-        , _btHitEffect'   = destroyOnImpact (doFlameDam 1) noEff
+        , _ptHitEff   = destroyOnImpact (doFlameDam 1) noEff
         , _ptZ = z
         }
   where
@@ -144,12 +144,12 @@ drawFlameletZ rot pt = pictures
     ]
   where
     z = _ptZ pt
-    sp = _btPos' pt
+    sp = _ptPos pt
     vel = _ptVel pt
     ep = sp +.+ vel
-    size = _btWidth' pt
+    size = _ptWidth pt
     siz2 = size + 0.2
-    time = _btTimer' pt
+    time = _ptTimer pt
     piu = setDepth (z + 25)
         .  uncurryV translate ep 
         . color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time) 
@@ -182,17 +182,17 @@ drawFlameletZ rot pt = pictures
 Applies movement and attaches damage to nearby creatures.  -}
 moveFlamelet :: World -> Particle -> (World, Maybe Particle)
 moveFlamelet w pt 
-    | _btTimer' pt <= 0 = (     w, Nothing)
+    | _ptTimer pt <= 0 = (     w, Nothing)
     | otherwise         = (flameFlicker pt damcrs,    mvPt)
   where   
-    sp = _btPos' pt
+    sp = _ptPos pt
     vel = _ptVel pt
     ep = sp +.+ vel
-    size = _btWidth' pt
+    size = _ptWidth pt
-    mvPt = Just $ pt & btTimer'       -~ 1
+    mvPt = Just $ pt & ptTimer   -~ 1
-                     & btPos'         .~ ep
+                     & ptPos     .~ ep
-                     & btPassThrough' .~ Nothing
+                     & ptCrIgnore .~ Nothing
-                     & ptVel         .~ 0.8 *.* vel
+                     & ptVel      .~ 0.8 *.* vel
     damcrs = w & creatures %~ IM.map damifclose
     isClose cr = dist ep (_crPos cr) < _crRad cr + size
     damifclose cr 

src/Dodge/WorldEvent/ThingsHit.hs

@@ -4,6 +4,7 @@ Find which objects lie upon a line.
  -}
 module Dodge.WorldEvent.ThingsHit
     ( thingsHit
+    , wallsHit
     , thingHit
     , thingsHitLongLine
     , thingsHitExceptCr
@@ -59,6 +60,26 @@ thingsHitExceptCr (Just cid) sp ep = filter crNotCid . thingsHit sp ep
     crNotCid (_,Left cr) = _crID cr /= cid
     crNotCid _ = True
 
+wallsHit
+    :: Point2    -- ^ Line start point
+    -> Point2    -- ^ Line end point
+    -> World 
+    -> [(Point2, Wall)]
+wallsHit sp ep w 
+    | sp == ep  = []
+    | otherwise = sortOn (dist sp . fst) wls
+  where 
+    hitWls   = wallsOnLine sp ep 
+        $ IM.unions [f b $ f a $ _znObjects $ _wallsZone w 
+            | a<-[x-1,x,x+1] , b<-[y-1,y,y+1]]
+       -- $ _walls w
+    (x,y) = zoneOfPoint (0.5 *.* (sp +.+ ep))
+    f i m = case IM.lookup i m of 
+        Just val -> val
+        _        -> IM.empty
+    wls = zip (map (fromJust . hitPoint) hitWls) hitWls
+    hitPoint w' = uncurry (intersectSegSeg sp ep) (_wlLine w')
+
 thingsHitExceptCrLongLine 
     :: Maybe Int 
     -> Point2 

src/Geometry.hs

@@ -164,6 +164,13 @@ diffAngles x y
     | otherwise  = diffAngles (x + 2*pi) y
   where 
     diff = x-y
+
+mixAngles :: Float -> Float -> Float -> Float
+mixAngles frac a1 a2
+    | abs (a1 - a2) <= pi = normalizeAngle $ frac * a1 + (1 - frac) * a2
+    | a1 > a2   = mixAngles frac (a1 - 2*pi) a2
+    | otherwise = mixAngles frac (a1 + 2*pi) a2
+
 -- | Return Just a point if it is inside a circle, Nothing otherwise.
 pointInCircle :: Point2 -> Float -> Point2 -> Maybe Point2
 pointInCircle p r c 

src/LensHelp.hs

@@ -3,13 +3,26 @@ module LensHelp
     , (.:~)
     , (.++~)
     , (++.~)
+    , (.*.*~)
+    , (.+.+~)
     ) where
+import Geometry
 import Control.Lens
 
 infixr 4 .:~
 (.:~) :: ASetter s t [a] [a] -> a -> s -> t
 (.:~) m x = m %~ (x :)
 
+infixr 4 .*.*~
+(.*.*~) :: ASetter s t Point2 Point2 -> Float -> s -> t
+{-# INLINABLE (.*.*~) #-}
+(.*.*~) m x = m %~ (x *.*)
+
+infixr 4 .+.+~
+(.+.+~) :: ASetter s t Point2 Point2 -> Point2 -> s -> t
+{-# INLINABLE (.+.+~) #-}
+(.+.+~) m x = m %~ (x +.+)
+
 infixr 4 .++~
 (.++~) :: ASetter s t [a] [a] -> [a] -> s -> t
 (.++~) m x = m %~ (x ++)

src/Picture.hs

@@ -16,6 +16,7 @@ module Picture
     , thickArc
     , thickCircle
     , thickLine
+    , lineThick
     , thickLineCol
     , circleSolid
     , circleSolidCol
@@ -236,6 +237,16 @@ lineCol :: [(Point2,RGBA)] -> Picture
 {-# INLINE lineCol #-}
 lineCol = flip thickLineCol 1
 
+lineThick :: Float -> [Point2] -> Picture
+{-# INLINE lineThick #-}
+lineThick t = pictures . f
+  where 
+    f (x:y:ys) 
+      | x == y      = f (x:ys)
+      | otherwise   = polygon [x +.+ n x y, x -.- n x y, y -.- n x y, y +.+ n x y] : f (y:ys)
+    f _             = []
+    n a b = (t*0.5) *.* errorNormalizeV 42 (vNormal (a -.- b))
+
 thickLine :: [Point2] -> Float -> Picture
 {-# INLINE thickLine #-}
 thickLine ps t = pictures $ f ps